ソースを参照

Dpkg::Exit: Expose proper functions instead of variables

Add new functions to interact with the exit handlers. Mark @handlers as
deprecated and to stop exporting it on VERSION 2.00.

Addresses Variables::ProhibitPackageVars.

Warned-by: perlcritic
Guillem Jover 13 年 前
コミット
414bd0e370

+ 1 - 0
debian/changelog

@@ -92,6 +92,7 @@ dpkg (1.17.2) UNRELEASED; urgency=low
   * Cleanup libdpkg-perl API:
     - Dpkg::Compression: Deprecate $default_compression_level,
       $default_compression and $compression_re_file_ext package variables.
+    - Dpkg::Exit: Deprecate @handlers package variable.
 
   [ Updated programs translations ]
   * German (Sven Joachim).

+ 67 - 2
scripts/Dpkg/Exit.pm

@@ -1,4 +1,5 @@
 # Copyright © 2002 Adam Heath <doogie@debian.org>
+# Copyright © 2012-2013 Guillem Jover <guillem@debian.org>
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -18,11 +19,64 @@ package Dpkg::Exit;
 use strict;
 use warnings;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
+use Exporter qw(import);
+
+our @EXPORT_OK = qw(push_exit_handler pop_exit_handler run_exit_handlers);
+
+# XXX: Backwards compatibility, stop exporting on VERSION 2.00.
+## no critic (Variables::ProhibitPackageVars)
 our @handlers = ();
-sub exit_handler {
+## use critic
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Exit - program exit handlers
+
+=head1 DESCRIPTION
+
+The Dpkg::Exit module provides support functions to run handlers on exit.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item push_exit_handler($func)
+
+Register a code reference into the exit function handlers stack.
+
+=cut
+
+sub push_exit_handler {
+    my ($func) = shift;
+    push @handlers, $func;
+}
+
+=item pop_exit_handler()
+
+Pop the last registered exit handler from the handlers stack.
+
+=cut
+
+sub pop_exit_handler {
+    pop @handlers;
+}
+
+=item run_exit_handlers()
+
+Run the registered exit handlers.
+
+=cut
+
+sub run_exit_handlers {
     &$_() foreach (reverse @handlers);
+}
+
+sub exit_handler {
+    run_exit_handlers();
     exit(127);
 }
 
@@ -30,4 +84,15 @@ $SIG{INT} = \&exit_handler;
 $SIG{HUP} = \&exit_handler;
 $SIG{QUIT} = \&exit_handler;
 
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.01
+
+New functions: push_exit_handler(), pop_exit_handler(), run_exit_handlers()
+Deprecated variable: @handlers
+
+=cut
+
 1;

+ 4 - 4
scripts/Dpkg/Source/Package.pm

@@ -43,7 +43,7 @@ use Dpkg::Control;
 use Dpkg::Checksums;
 use Dpkg::Version;
 use Dpkg::Compression;
-use Dpkg::Exit;
+use Dpkg::Exit qw(run_exit_handlers);
 use Dpkg::Path qw(check_files_are_the_same find_command);
 use Dpkg::IPC;
 use Dpkg::Vendor qw(run_vendor_hook);
@@ -429,7 +429,7 @@ sub extract {
     # Try extract
     eval { $self->do_extract(@_) };
     if ($@) {
-        &$_() foreach reverse @Dpkg::Exit::handlers;
+        run_exit_handlers();
         die $@;
     }
 
@@ -480,7 +480,7 @@ sub build {
     my $self = shift;
     eval { $self->do_build(@_) };
     if ($@) {
-        &$_() foreach reverse @Dpkg::Exit::handlers;
+        run_exit_handlers();
         die $@;
     }
 }
@@ -514,7 +514,7 @@ sub commit {
     my $self = shift;
     eval { $self->do_commit(@_) };
     if ($@) {
-        &$_() foreach reverse @Dpkg::Exit::handlers;
+        run_exit_handlers();
         die $@;
     }
 }

+ 5 - 5
scripts/Dpkg/Source/Package/V1.pm

@@ -28,7 +28,7 @@ use Dpkg::ErrorHandling;
 use Dpkg::Compression;
 use Dpkg::Source::Archive;
 use Dpkg::Source::Patch;
-use Dpkg::Exit;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
 use Dpkg::Source::Functions qw(erasedir);
 use Dpkg::Source::Package::V3::Native;
 
@@ -331,9 +331,9 @@ sub do_build {
                          'giving up; use -sA, -sK or -sP to override'),
                       $origdir);
             }
-	    push @Dpkg::Exit::handlers, sub { erasedir($origdir) };
+            push_exit_handler(sub { erasedir($origdir) });
             erasedir($origdir);
-	    pop @Dpkg::Exit::handlers;
+            pop_exit_handler();
         } elsif ($! != ENOENT) {
             syserr(_g("unable to check for existence of orig dir `%s'"),
                     $origdir);
@@ -350,7 +350,7 @@ sub do_build {
 	     $sourcepackage, $diffname);
 	my ($ndfh, $newdiffgz) = tempfile("$diffname.new.XXXXXX",
 					DIR => getcwd(), UNLINK => 0);
-        push @Dpkg::Exit::handlers, sub { unlink($newdiffgz) };
+        push_exit_handler(sub { unlink($newdiffgz) });
         my $diff = Dpkg::Source::Patch->new(filename => $newdiffgz,
                                             compression => 'gzip');
         $diff->create();
@@ -360,7 +360,7 @@ sub do_build {
                 options => []); # Force empty set of options to drop the
                                 # default -p option
         $diff->finish() || $ur++;
-        pop @Dpkg::Exit::handlers;
+        pop_exit_handler();
 
 	my $analysis = $diff->analyze($origdir);
 	my @files = grep { ! m{^debian/} } map { s{^[^/]+/+}{}; $_ }

+ 9 - 9
scripts/Dpkg/Source/Package/V2.pm

@@ -29,7 +29,7 @@ use Dpkg::File;
 use Dpkg::Compression;
 use Dpkg::Source::Archive;
 use Dpkg::Source::Patch;
-use Dpkg::Exit;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
 use Dpkg::Source::Functions qw(erasedir is_binary fs_time);
 use Dpkg::Vendor qw(run_vendor_hook);
 use Dpkg::Control;
@@ -360,7 +360,7 @@ sub generate_patch {
 
     # Unpack a second copy for comparison
     my $tmp = tempdir("$dirname.orig.XXXXXX", DIR => $updir);
-    push @Dpkg::Exit::handlers, sub { erasedir($tmp) };
+    push_exit_handler(sub { erasedir($tmp) });
 
     # Extract main tarball
     my $tar = Dpkg::Source::Archive->new(filename => $tarfile);
@@ -385,7 +385,7 @@ sub generate_patch {
     # Create a patch
     my ($difffh, $tmpdiff) = tempfile($self->get_basename(1) . '.diff.XXXXXX',
                                       DIR => File::Spec->tmpdir(), UNLINK => 0);
-    push @Dpkg::Exit::handlers, sub { unlink($tmpdiff) };
+    push_exit_handler(sub { unlink($tmpdiff) });
     my $diff = Dpkg::Source::Patch->new(filename => $tmpdiff,
                                         compression => 'none');
     $diff->create();
@@ -413,8 +413,8 @@ sub generate_patch {
 
     # Remove the temporary directory
     erasedir($tmp);
-    pop @Dpkg::Exit::handlers;
-    pop @Dpkg::Exit::handlers;
+    pop_exit_handler();
+    pop_exit_handler();
 
     return $tmpdiff;
 }
@@ -513,7 +513,7 @@ sub do_build {
         error(_g('aborting due to unexpected upstream changes, see %s'),
               $tmpdiff);
     }
-    push @Dpkg::Exit::handlers, sub { unlink($tmpdiff) };
+    push_exit_handler(sub { unlink($tmpdiff) });
     $binaryfiles->update_debian_source_include_binaries() if $include_binaries;
 
     # Install the diff as the new autopatch
@@ -526,7 +526,7 @@ sub do_build {
         rmdir(File::Spec->catdir($dir, 'debian', 'patches')); # No check on purpose
     }
     unlink($tmpdiff) || syserr(_g('cannot remove %s'), $tmpdiff);
-    pop @Dpkg::Exit::handlers;
+    pop_exit_handler();
 
     # Create the debian.tar
     my $debianfile = "$basenamerev.debian.tar." . $self->{options}{comp_ext};
@@ -644,7 +644,7 @@ sub do_commit {
                                          usage => 'commit');
         $binaryfiles->update_debian_source_include_binaries();
     }
-    push @Dpkg::Exit::handlers, sub { unlink($tmpdiff) };
+    push_exit_handler(sub { unlink($tmpdiff) });
     unless (-s $tmpdiff) {
         unlink($tmpdiff) || syserr(_g('cannot remove %s'), $tmpdiff);
         info(_g('there are no local changes to record'));
@@ -662,7 +662,7 @@ sub do_commit {
     system('sensible-editor', $patch);
     subprocerr('sensible-editor') if $?;
     unlink($tmpdiff) || syserr(_g('cannot remove %s'), $tmpdiff);
-    pop @Dpkg::Exit::handlers;
+    pop_exit_handler();
     info(_g('local changes have been recorded in a new patch: %s'), $patch);
 }
 

+ 3 - 3
scripts/Dpkg/Source/Package/V3/Bzr.pm

@@ -38,7 +38,7 @@ use Dpkg::Gettext;
 use Dpkg::Compression;
 use Dpkg::ErrorHandling;
 use Dpkg::Source::Archive;
-use Dpkg::Exit;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
 use Dpkg::Source::Functions qw(erasedir);
 
 our $CURRENT_MINOR_VERSION = '0';
@@ -137,7 +137,7 @@ sub do_build {
             syserr(_g("unable to chdir to `%s'"), $old_cwd);
 
     my $tmp = tempdir("$dirname.bzr.XXXXXX", DIR => $updir);
-    push @Dpkg::Exit::handlers, sub { erasedir($tmp) };
+    push_exit_handler(sub { erasedir($tmp) });
     my $tardir = "$tmp/$dirname";
 
     system('bzr', 'branch', $dir, $tardir);
@@ -163,7 +163,7 @@ sub do_build {
     $tar->finish();
 
     erasedir($tmp);
-    pop @Dpkg::Exit::handlers;
+    pop_exit_handler();
 
     $self->add_file($debianfile);
 }

+ 3 - 3
scripts/Dpkg/Source/Package/V3/Git.pm

@@ -33,7 +33,7 @@ use File::Temp qw(tempdir);
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
-use Dpkg::Exit;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
 use Dpkg::Source::Functions qw(erasedir);
 
 our $CURRENT_MINOR_VERSION = '0';
@@ -144,7 +144,7 @@ sub do_build {
         chdir($old_cwd) ||
                 syserr(_g("unable to chdir to `%s'"), $old_cwd);
         $tmp = tempdir("$dirname.git.XXXXXX", DIR => $updir);
-        push @Dpkg::Exit::handlers, sub { erasedir($tmp) };
+        push_exit_handler(sub { erasedir($tmp) });
         my $clone_dir = "$tmp/repo.git";
         # file:// is needed to avoid local cloning, which does not
         # create a shallow clone.
@@ -177,7 +177,7 @@ sub do_build {
 
     if (defined $tmp) {
         erasedir($tmp);
-        pop @Dpkg::Exit::handlers;
+        pop_exit_handler();
     }
 
     $self->add_file($bundlefile);

+ 3 - 3
scripts/Dpkg/Source/Package/V3/Native.pm

@@ -26,7 +26,7 @@ use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Compression;
-use Dpkg::Exit;
+use Dpkg::Exit qw(push_exit_handler pop_exit_handler);
 use Dpkg::Version;
 use Dpkg::Source::Archive;
 use Dpkg::Source::Functions qw(erasedir);
@@ -93,7 +93,7 @@ sub do_build {
 
     my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX",
                                    DIR => getcwd(), UNLINK => 0);
-    push @Dpkg::Exit::handlers, sub { unlink($newtar) };
+    push_exit_handler(sub { unlink($newtar) });
 
     my ($dirname, $dirbase) = fileparse($dir);
     my $tar = Dpkg::Source::Archive->new(filename => $newtar,
@@ -105,7 +105,7 @@ sub do_build {
     rename($newtar, $tarname) ||
         syserr(_g("unable to rename `%s' (newly created) to `%s'"),
                $newtar, $tarname);
-    pop @Dpkg::Exit::handlers;
+    pop_exit_handler();
     chmod(0666 &~ umask(), $tarname) ||
         syserr(_g("unable to change permission of `%s'"), $tarname);