summaryrefslogtreecommitdiff
path: root/scripts/Dpkg/Source
diff options
context:
space:
mode:
authorGuillem Jover <guillem@debian.org>2012-12-30 02:49:36 +0100
committerGuillem Jover <guillem@debian.org>2013-04-29 18:45:54 +0200
commitf215ebacf1183e33da3287533c8eec60cc5af418 (patch)
tree458435c1647bf7845cec876d15d8c50d6a4d473e /scripts/Dpkg/Source
parent193cfded7822eab6d63e200037ac86df6ba98521 (diff)
downloaddpkg-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.pm29
-rw-r--r--scripts/Dpkg/Source/Package/V3/quilt.pm44
-rw-r--r--scripts/Dpkg/Source/Patch.pm121
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"};