scripts/Dpkg/Exit.pm

   1 # Copyright © 2002 Adam Heath <doogie@debian.org>
   2 # Copyright © 2012-2013 Guillem Jover <guillem@debian.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16
  17 =encoding utf8
  18
  19 =head1 NAME
  20
  21 Dpkg::Exit - program exit handlers
  22
  23 =head1 DESCRIPTION
  24
  25 The Dpkg::Exit module provides support functions to run handlers on exit.
  26
  27 =cut
  28
  29 package Dpkg::Exit 2.00;
  30
  31 use strict;
  32 use warnings;
  33
  34 our @EXPORT_OK = qw(
  35     push_exit_handler
  36     pop_exit_handler
  37     run_exit_handlers
  38 );
  39
  40 use Exporter qw(import);
  41
  42 my @handlers = ();
  43
  44 =head1 FUNCTIONS
  45
  46 =over 4
  47
  48 =item push_exit_handler($func)
  49
  50 Register a code reference into the exit function handlers stack.
  51
  52 =cut
  53
  54 sub push_exit_handler {
  55     my ($func) = shift;
  56
  57     _setup_exit_handlers() if @handlers == 0;
  58     push @handlers, $func;
  59 }
  60
  61 =item pop_exit_handler()
  62
  63 Pop the last registered exit handler from the handlers stack.
  64
  65 =cut
  66
  67 sub pop_exit_handler {
  68     _reset_exit_handlers() if @handlers == 1;
  69     pop @handlers;
  70 }
  71
  72 =item run_exit_handlers()
  73
  74 Run the registered exit handlers.
  75
  76 =cut
  77
  78 sub run_exit_handlers {
  79     while (my $handler = pop @handlers) {
  80         $handler->();
  81     }
  82     _reset_exit_handlers();
  83 }
  84
  85 sub _exit_handler {
  86     run_exit_handlers();
  87     exit(127);
  88 }
  89
  90 my @SIGNAMES = qw(INT HUP QUIT);
  91 my %SIGOLD;
  92
  93 sub _setup_exit_handlers
  94 {
  95     foreach my $signame (@SIGNAMES) {
  96         $SIGOLD{$signame} = $SIG{$signame};
  97         $SIG{$signame} = \&_exit_handler;
  98     }
  99 }
 100
 101 sub _reset_exit_handlers
 102 {
 103     foreach my $signame (@SIGNAMES) {
 104         $SIG{$signame} = $SIGOLD{$signame};
 105     }
 106 }
 107
 108 END {
 109     local $?;
 110     run_exit_handlers();
 111 }
 112
 113 =back
 114
 115 =head1 CHANGES
 116
 117 =head2 Version 2.00 (dpkg 1.20.0)
 118
 119 Hide variable: @handlers.
 120
 121 =head2 Version 1.01 (dpkg 1.17.2)
 122
 123 New functions: push_exit_handler(), pop_exit_handler(), run_exit_handlers()
 124
 125 Deprecated variable: @handlers
 126
 127 =head2 Version 1.00 (dpkg 1.15.6)
 128
 129 Mark the module as public.
 130
 131 =cut
 132
 133 1;