diff options
author | Guillem Jover <guillem@debian.org> | 2012-12-30 02:49:36 +0100 |
---|---|---|
committer | Guillem Jover <guillem@debian.org> | 2013-04-29 18:45:54 +0200 |
commit | f215ebacf1183e33da3287533c8eec60cc5af418 (patch) | |
tree | 458435c1647bf7845cec876d15d8c50d6a4d473e /scripts/Dpkg/Source | |
parent | 193cfded7822eab6d63e200037ac86df6ba98521 (diff) | |
download | dpkg-f215ebacf1183e33da3287533c8eec60cc5af418.tar.gz |
scripts: Do not use "nested" functions as they are global
Even if these functions are defined inside another function, they are
still global, make them proper global functions by moving the definition
outside of the outter function and mark them explicitly as being private
by using an underscore prefix. There's no point in making these
anonymous nested functions, as they do not need to access any variable
from the outter functions.
Fixes Subroutines::ProhibitNestedSubs.
Warned-by: perlcritic
Diffstat (limited to 'scripts/Dpkg/Source')
-rw-r--r-- | scripts/Dpkg/Source/Package/V2.pm | 29 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V3/quilt.pm | 44 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Patch.pm | 121 |
3 files changed, 104 insertions, 90 deletions
diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm index de1274769..1021d9e80 100644 --- a/scripts/Dpkg/Source/Package/V2.pm +++ b/scripts/Dpkg/Source/Package/V2.pm @@ -602,22 +602,25 @@ sub register_patch { return $patch; } +sub _is_bad_patch_name { + my ($dir, $patch_name) = @_; + + return 1 if not defined($patch_name); + return 1 if not length($patch_name); + + my $patch = File::Spec->catfile($dir, "debian", "patches", $patch_name); + if (-e $patch) { + warning(_g("cannot register changes in %s, this patch already exists"), + $patch); + return 1; + } + return 0; +} + sub do_commit { my ($self, $dir) = @_; my ($patch_name, $tmpdiff) = @{$self->{'options'}{'ARGV'}}; - sub bad_patch_name { - my ($dir, $patch_name) = @_; - return 1 if not defined($patch_name); - return 1 if not length($patch_name); - my $patch = File::Spec->catfile($dir, "debian", "patches", $patch_name); - if (-e $patch) { - warning(_g("cannot register changes in %s, this patch already exists"), $patch); - return 1; - } - return 0; - } - $self->prepare_build($dir); # Try to fix up a broken relative filename for the patch @@ -645,7 +648,7 @@ sub do_commit { info(_g("there are no local changes to record")); return; } - while (bad_patch_name($dir, $patch_name)) { + while (_is_bad_patch_name($dir, $patch_name)) { # Ask the patch name interactively print STDOUT _g("Enter the desired patch name: "); chomp($patch_name = <STDIN>); diff --git a/scripts/Dpkg/Source/Package/V3/quilt.pm b/scripts/Dpkg/Source/Package/V3/quilt.pm index 3b7d0e319..f32a49909 100644 --- a/scripts/Dpkg/Source/Package/V3/quilt.pm +++ b/scripts/Dpkg/Source/Package/V3/quilt.pm @@ -214,25 +214,27 @@ sub check_patches_applied { $self->apply_patches($dir, usage => 'preparation', verbose => 1); } -sub register_patch { - my ($self, $dir, $tmpdiff, $patch_name) = @_; +sub _add_line { + my ($file, $line) = @_; - sub add_line { - my ($file, $line) = @_; - open(my $file_fh, ">>", $file) || syserr(_g("cannot write %s"), $file); - print $file_fh "$line\n"; - close($file_fh); - } + open(my $file_fh, ">>", $file) || syserr(_g("cannot write %s"), $file); + print $file_fh "$line\n"; + close($file_fh); +} - sub drop_line { - my ($file, $re) = @_; - open(my $file_fh, "<", $file) || syserr(_g("cannot read %s"), $file); - my @lines = <$file_fh>; - close($file_fh); - open($file_fh, ">", $file) || syserr(_g("cannot write %s"), $file); - print($file_fh $_) foreach grep { not /^\Q$re\E\s*$/ } @lines; - close($file_fh); - } +sub _drop_line { + my ($file, $re) = @_; + + open(my $file_fh, "<", $file) || syserr(_g("cannot read %s"), $file); + my @lines = <$file_fh>; + close($file_fh); + open($file_fh, ">", $file) || syserr(_g("cannot write %s"), $file); + print($file_fh $_) foreach grep { not /^\Q$re\E\s*$/ } @lines; + close($file_fh); +} + +sub register_patch { + my ($self, $dir, $tmpdiff, $patch_name) = @_; my $quilt = $self->build_quilt_object($dir); @@ -255,8 +257,8 @@ sub register_patch { $quilt->setup_db(); # Add patch to series file if (not $has_patch) { - add_line($series, $patch_name); - add_line($applied, $patch_name); + _add_line($series, $patch_name); + _add_line($applied, $patch_name); $quilt->load_series(); $quilt->load_db(); } @@ -268,8 +270,8 @@ sub register_patch { } else { # Remove auto_patch from series if ($has_patch) { - drop_line($series, $patch_name); - drop_line($applied, $patch_name); + _drop_line($series, $patch_name); + _drop_line($applied, $patch_name); erasedir($quilt->get_db_file($patch_name)); $quilt->load_db(); $quilt->load_series(); diff --git a/scripts/Dpkg/Source/Patch.pm b/scripts/Dpkg/Source/Patch.pm index bca644269..104bde6d8 100644 --- a/scripts/Dpkg/Source/Patch.pm +++ b/scripts/Dpkg/Source/Patch.pm @@ -310,6 +310,63 @@ sub _fail_not_same_type { $self->register_error(); } +sub _getline { + my $handle = shift; + + my $line = <$handle>; + if (defined $line) { + # Strip end-of-line chars + chomp($line); + $line =~ s/\r$//; + } + return $line; +} + +# Strip timestamp +sub _strip_ts { + my $header = shift; + + # Tab is the official separator, it's always used when + # filename contain spaces. Try it first, otherwise strip on space + # if there's no tab + $header =~ s/\s.*// unless ($header =~ s/\t.*//); + return $header; +} + +sub _intuit_file_patched { + my ($old, $new) = @_; + + return $new unless defined $old; + return $old unless defined $new; + return $new if -e $new and not -e $old; + return $old if -e $old and not -e $new; + + # We don't consider the case where both files are non-existent and + # where patch picks the one with the fewest directories to create + # since dpkg-source will pre-create the required directories + + # Precalculate metrics used by patch + my ($tmp_o, $tmp_n) = ($old, $new); + my ($len_o, $len_n) = (length($old), length($new)); + $tmp_o =~ s{[/\\]+}{/}g; + $tmp_n =~ s{[/\\]+}{/}g; + my $nb_comp_o = ($tmp_o =~ tr{/}{/}); + my $nb_comp_n = ($tmp_n =~ tr{/}{/}); + $tmp_o =~ s{^.*/}{}; + $tmp_n =~ s{^.*/}{}; + my ($blen_o, $blen_n) = (length($tmp_o), length($tmp_n)); + + # Decide like patch would + if ($nb_comp_o != $nb_comp_n) { + return ($nb_comp_o < $nb_comp_n) ? $old : $new; + } elsif ($blen_o != $blen_n) { + return ($blen_o < $blen_n) ? $old : $new; + } elsif ($len_o != $len_n) { + return ($len_o < $len_n) ? $old : $new; + } + return $old; +} + # check diff for sanity, find directories to create as a side effect sub analyze { my ($self, $destdir, %opts) = @_; @@ -322,55 +379,7 @@ sub analyze { my $patch_header = ''; my $diff_count = 0; - sub getline { - my $handle = shift; - my $line = <$handle>; - if (defined $line) { - # Strip end-of-line chars - chomp($line); - $line =~ s/\r$//; - } - return $line; - } - sub strip_ts { # Strip timestamp - my $header = shift; - # Tab is the official separator, it's always used when - # filename contain spaces. Try it first, otherwise strip on space - # if there's no tab - $header =~ s/\s.*// unless ($header =~ s/\t.*//); - return $header; - } - sub intuit_file_patched { - my ($old, $new) = @_; - return $new unless defined $old; - return $old unless defined $new; - return $new if -e $new and not -e $old; - return $old if -e $old and not -e $new; - # We don't consider the case where both files are non-existent and - # where patch picks the one with the fewest directories to create - # since dpkg-source will pre-create the required directories - # - # Precalculate metrics used by patch - my ($tmp_o, $tmp_n) = ($old, $new); - my ($len_o, $len_n) = (length($old), length($new)); - $tmp_o =~ s{[/\\]+}{/}g; - $tmp_n =~ s{[/\\]+}{/}g; - my $nb_comp_o = ($tmp_o =~ tr{/}{/}); - my $nb_comp_n = ($tmp_n =~ tr{/}{/}); - $tmp_o =~ s{^.*/}{}; - $tmp_n =~ s{^.*/}{}; - my ($blen_o, $blen_n) = (length($tmp_o), length($tmp_n)); - # Decide like patch would - if ($nb_comp_o != $nb_comp_n) { - return ($nb_comp_o < $nb_comp_n) ? $old : $new; - } elsif ($blen_o != $blen_n) { - return ($blen_o < $blen_n) ? $old : $new; - } elsif ($len_o != $len_n) { - return ($len_o < $len_n) ? $old : $new; - } - return $old; - } - $_ = getline($self); + $_ = _getline($self); HUNK: while (defined($_) || not eof($self)) { @@ -382,26 +391,26 @@ sub analyze { } else { $patch_header .= "$_\n"; } - last HUNK if not defined($_ = getline($self)); + last HUNK if not defined($_ = _getline($self)); } $diff_count++; # read file header (---/+++ pair) unless(s/^--- //) { error(_g("expected ^--- in line %d of diff `%s'"), $., $diff); } - $path{'old'} = $_ = strip_ts($_); + $path{'old'} = $_ = _strip_ts($_); $fn{'old'} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/}; if (/\.dpkg-orig$/) { error(_g("diff `%s' patches file with name ending .dpkg-orig"), $diff); } - unless (defined($_ = getline($self))) { + unless (defined($_ = _getline($self))) { error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"), $diff, $.); } unless (s/^\+\+\+ //) { error(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.); } - $path{'new'} = $_ = strip_ts($_); + $path{'new'} = $_ = _strip_ts($_); $fn{'new'} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/}; unless (defined $fn{'old'} or defined $fn{'new'}) { @@ -437,7 +446,7 @@ sub analyze { $diff, $fn{'old'}, $.) unless -e $fn{'old'}; } } - my $fn = intuit_file_patched($fn{'old'}, $fn{'new'}); + my $fn = _intuit_file_patched($fn{'old'}, $fn{'new'}); my $dirname = $fn; if ($dirname =~ s{/[^/]+$}{} && not -d $dirname) { @@ -458,14 +467,14 @@ sub analyze { # read hunks my $hunk = 0; - while (defined($_ = getline($self))) { + while (defined($_ = _getline($self))) { # read hunk header (@@) next if /^\\ /; last unless (/^@@ -\d+(,(\d+))? \+\d+(,(\d+))? @\@( .*)?$/); my ($olines, $nlines) = ($1 ? $2 : 1, $3 ? $4 : 1); # read hunk while ($olines || $nlines) { - unless (defined($_ = getline($self))) { + unless (defined($_ = _getline($self))) { if (($olines == $nlines) and ($olines < 3)) { warning(_g("unexpected end of diff `%s'"), $diff) if $opts{"verbose"}; |