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

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;
 }

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

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>);

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();

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"};

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);

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