ErrorHandling.pm 1.7 KB

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