The following commit has been merged in the master branch:
commit f215ebacf1183e33da3287533c8eec60cc5af418
Author: Guillem Jover <[email protected]>
Date: Sun Dec 30 02:49:36 2012 +0100
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
diff --git a/scripts/Dpkg/Changelog/Entry.pm b/scripts/Dpkg/Changelog/Entry.pm
index e434103..506716d 100644
--- a/scripts/Dpkg/Changelog/Entry.pm
+++ b/scripts/Dpkg/Changelog/Entry.pm
@@ -81,19 +81,20 @@ filehandle.
=cut
+sub _format_output_block {
+ my $lines = shift;
+ return join('', map { $_ . "\n" } @{$lines});
+}
+
sub output {
my ($self, $fh) = @_;
my $str = '';
- sub _block {
- my $lines = shift;
- return join('', map { $_ . "\n" } @{$lines});
- }
$str .= $self->{header} . "\n" if defined($self->{header});
- $str .= _block($self->{blank_after_header});
- $str .= _block($self->{changes});
- $str .= _block($self->{blank_after_changes});
+ $str .= _format_output_block($self->{blank_after_header});
+ $str .= _format_output_block($self->{changes});
+ $str .= _format_output_block($self->{blank_after_changes});
$str .= $self->{trailer} . "\n" if defined($self->{trailer});
- $str .= _block($self->{blank_after_trailer});
+ $str .= _format_output_block($self->{blank_after_trailer});
print $fh $str if defined $fh;
return $str;
}
diff --git a/scripts/Dpkg/Shlibs/SymbolFile.pm
b/scripts/Dpkg/Shlibs/SymbolFile.pm
index 7b6eb2b..c5204b8 100644
--- a/scripts/Dpkg/Shlibs/SymbolFile.pm
+++ b/scripts/Dpkg/Shlibs/SymbolFile.pm
@@ -189,15 +189,15 @@ sub add_symbol {
}
}
+sub _new_symbol {
+ my $base = shift || 'Dpkg::Shlibs::Symbol';
+ return (ref $base) ? $base->clone(@_) : $base->new(@_);
+}
+
# Parameter seen is only used for recursive calls
sub parse {
my ($self, $fh, $file, $seen, $obj_ref, $base_symbol) = @_;
- sub new_symbol {
- my $base = shift || 'Dpkg::Shlibs::Symbol';
- return (ref $base) ? $base->clone(@_) : $base->new(@_);
- }
-
if (defined($seen)) {
return if exists $seen->{$file}; # Avoid include loops
} else {
@@ -219,7 +219,7 @@ sub parse {
}
# Symbol specification
my $deprecated = ($1) ? $1 : 0;
- my $sym = new_symbol($base_symbol, deprecated => $deprecated);
+ my $sym = _new_symbol($base_symbol, deprecated => $deprecated);
if ($self->create_symbol($2, base => $sym)) {
$self->add_symbol($sym, $$obj_ref);
} else {
@@ -231,7 +231,7 @@ sub parse {
my $dir = $file;
my $new_base_symbol;
if (defined $tagspec) {
- $new_base_symbol = new_symbol($base_symbol);
+ $new_base_symbol = _new_symbol($base_symbol);
$new_base_symbol->parse_tagspec($tagspec);
}
$dir =~ s{[^/]+$}{}; # Strip filename
diff --git a/scripts/Dpkg/Source/Package/V2.pm
b/scripts/Dpkg/Source/Package/V2.pm
index de12747..1021d9e 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 3b7d0e3..f32a499 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 bca6442..104bde6 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"};
diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm
index d4944c8..2957404 100644
--- a/scripts/Dpkg/Version.pm
+++ b/scripts/Dpkg/Version.pm
@@ -281,21 +281,23 @@ of the character is used to sort between characters.
=cut
-sub version_compare_string($$) {
- sub order {
- my ($x) = @_;
- if ($x eq '~') {
- return -1;
- } elsif ($x =~ /^\d$/) {
- return $x * 1 + 1;
- } elsif ($x =~ /^[A-Za-z]$/) {
- return ord($x);
- } else {
- return ord($x) + 256;
- }
+sub _version_order {
+ my ($x) = @_;
+
+ if ($x eq '~') {
+ return -1;
+ } elsif ($x =~ /^\d$/) {
+ return $x * 1 + 1;
+ } elsif ($x =~ /^[A-Za-z]$/) {
+ return ord($x);
+ } else {
+ return ord($x) + 256;
}
- my @a = map(order($_), split(//, shift));
- my @b = map(order($_), split(//, shift));
+}
+
+sub version_compare_string($$) {
+ my @a = map(_version_order($_), split(//, shift));
+ my @b = map(_version_order($_), split(//, shift));
while (1) {
my ($a, $b) = (shift @a, shift @b);
return 0 if not defined($a) and not defined($b);
diff --git a/test/100_critic.t b/test/100_critic.t
index fd62ad9..3e91080 100644
--- a/test/100_critic.t
+++ b/test/100_critic.t
@@ -62,6 +62,7 @@ my @policies = qw(
Modules::RequireExplicitPackage
Modules::RequireFilenameMatchesPackage
Subroutines::ProhibitExplicitReturnUndef
+ Subroutines::ProhibitNestedSubs
TestingAndDebugging::ProhibitNoStrict
TestingAndDebugging::ProhibitNoWarnings
TestingAndDebugging::RequireUseStrict
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
