ErrorHandling.pm 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. package Dpkg::ErrorHandling;
  2. use Dpkg;
  3. use Dpkg::Gettext;
  4. use base qw(Exporter);
  5. our @EXPORT_OK = qw(warning warnerror error failure unknown syserr internerr
  6. subprocerr usageerr syntaxerr report
  7. $warnable_error $quiet_warnings);
  8. our $warnable_error = 1;
  9. our $quiet_warnings = 0;
  10. sub report(@)
  11. {
  12. my ($type, $msg) = (shift, shift);
  13. $msg = sprintf($msg, @_) if (@_);
  14. return "$progname: $type: $msg\n";
  15. }
  16. sub warning($;@)
  17. {
  18. warn report(_g("warning"), @_) if (!$quiet_warnings);
  19. }
  20. sub warnerror(@)
  21. {
  22. if ($warnable_error) {
  23. warning(@_);
  24. } else {
  25. error(@_);
  26. }
  27. }
  28. sub failure($;@)
  29. {
  30. die report(_g("failure"), @_);
  31. }
  32. sub syserr($;@)
  33. {
  34. my $msg = shift;
  35. die report(_g("failure"), "$msg: $!", @_);
  36. }
  37. sub error($;@)
  38. {
  39. die report(_g("error"), @_);
  40. }
  41. sub internerr($;@)
  42. {
  43. die report(_g("internal error"), @_);
  44. }
  45. sub unknown($)
  46. {
  47. # XXX: implicit argument
  48. my $field = $_;
  49. warning(_g("unknown information field '%s' in input data in %s"),
  50. $field, $_[0]);
  51. }
  52. sub subprocerr(@)
  53. {
  54. my ($p) = (shift);
  55. $p = sprintf($p, @_) if (@_);
  56. require POSIX;
  57. if (POSIX::WIFEXITED($?)) {
  58. failure(_g("%s gave error exit status %s"), $p, POSIX::WEXITSTATUS($?));
  59. } elsif (POSIX::WIFSIGNALED($?)) {
  60. failure(_g("%s died from signal %s"), $p, POSIX::WTERMSIG($?));
  61. } else {
  62. failure(_g("%s failed with unknown exit code %d"), $p, $?);
  63. }
  64. }
  65. sub usageerr(@)
  66. {
  67. my ($msg) = (shift);
  68. $msg = sprintf($msg, @_) if (@_);
  69. warn "$progname: $msg\n\n";
  70. # XXX: access to main namespace
  71. main::usage();
  72. exit(2);
  73. }
  74. sub syntaxerr {
  75. my ($file, $msg) = @_;
  76. error(_g("syntax error in %s at line %d: %s"), $file, $., $msg);
  77. }
  78. 1;