| OLD | NEW |
| (Empty) |
| 1 # This program is free software; you can redistribute it and/or modify | |
| 2 # it under the terms of the GNU General Public License as published by | |
| 3 # the Free Software Foundation; either version 2 of the License, or | |
| 4 # (at your option) any later version. | |
| 5 # | |
| 6 # This program is distributed in the hope that it will be useful, | |
| 7 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 8 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 9 # GNU General Public License for more details. | |
| 10 # | |
| 11 # You should have received a copy of the GNU General Public License | |
| 12 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
| 13 | |
| 14 package Dpkg::ErrorHandling; | |
| 15 | |
| 16 use strict; | |
| 17 use warnings; | |
| 18 | |
| 19 our $VERSION = '0.02'; | |
| 20 | |
| 21 use Dpkg (); | |
| 22 use Dpkg::Gettext; | |
| 23 | |
| 24 use Exporter qw(import); | |
| 25 our @EXPORT = qw(report_options info warning error errormsg | |
| 26 syserr subprocerr usageerr); | |
| 27 our @EXPORT_OK = qw(report); | |
| 28 | |
| 29 my $quiet_warnings = 0; | |
| 30 my $info_fh = \*STDOUT; | |
| 31 | |
| 32 sub report_options | |
| 33 { | |
| 34 my (%options) = @_; | |
| 35 | |
| 36 if (exists $options{quiet_warnings}) { | |
| 37 $quiet_warnings = $options{quiet_warnings}; | |
| 38 } | |
| 39 if (exists $options{info_fh}) { | |
| 40 $info_fh = $options{info_fh}; | |
| 41 } | |
| 42 } | |
| 43 | |
| 44 sub report(@) | |
| 45 { | |
| 46 my ($type, $msg) = (shift, shift); | |
| 47 | |
| 48 $msg = sprintf($msg, @_) if (@_); | |
| 49 return "$Dpkg::PROGNAME: $type: $msg\n"; | |
| 50 } | |
| 51 | |
| 52 sub info($;@) | |
| 53 { | |
| 54 print { $info_fh } report(_g('info'), @_) if (!$quiet_warnings); | |
| 55 } | |
| 56 | |
| 57 sub warning($;@) | |
| 58 { | |
| 59 warn report(_g('warning'), @_) if (!$quiet_warnings); | |
| 60 } | |
| 61 | |
| 62 sub syserr($;@) | |
| 63 { | |
| 64 my $msg = shift; | |
| 65 die report(_g('error'), "$msg: $!", @_); | |
| 66 } | |
| 67 | |
| 68 sub error($;@) | |
| 69 { | |
| 70 die report(_g('error'), @_); | |
| 71 } | |
| 72 | |
| 73 sub errormsg($;@) | |
| 74 { | |
| 75 print { *STDERR } report(_g('error'), @_); | |
| 76 } | |
| 77 | |
| 78 sub subprocerr(@) | |
| 79 { | |
| 80 my ($p) = (shift); | |
| 81 | |
| 82 $p = sprintf($p, @_) if (@_); | |
| 83 | |
| 84 require POSIX; | |
| 85 | |
| 86 if (POSIX::WIFEXITED($?)) { | |
| 87 error(_g('%s gave error exit status %s'), $p, POSIX::WEXITSTATUS($?)); | |
| 88 } elsif (POSIX::WIFSIGNALED($?)) { | |
| 89 error(_g('%s died from signal %s'), $p, POSIX::WTERMSIG($?)); | |
| 90 } else { | |
| 91 error(_g('%s failed with unknown exit code %d'), $p, $?); | |
| 92 } | |
| 93 } | |
| 94 | |
| 95 my $printforhelp = _g('Use --help for program usage information.'); | |
| 96 | |
| 97 sub usageerr(@) | |
| 98 { | |
| 99 my ($msg) = (shift); | |
| 100 | |
| 101 $msg = sprintf($msg, @_) if (@_); | |
| 102 warn "$Dpkg::PROGNAME: $msg\n\n"; | |
| 103 warn "$printforhelp\n"; | |
| 104 exit(2); | |
| 105 } | |
| 106 | |
| 107 1; | |
| OLD | NEW |