home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / perl / 5.8.8 / Carp.pm < prev    next >
Encoding:
Perl POD Document  |  2007-03-05  |  4.0 KB  |  108 lines
  1. package Carp;
  2.  
  3. our $VERSION = '1.04';
  4.  
  5. # This package is heavily used. Be small. Be fast. Be good.
  6.  
  7. # Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
  8. # _almost_ complete understanding of the package.  Corrections and
  9. # comments are welcome.
  10.  
  11. # The members of %Internal are packages that are internal to perl.
  12. # Carp will not report errors from within these packages if it
  13. # can.  The members of %CarpInternal are internal to Perl's warning
  14. # system.  Carp will not report errors from within these packages
  15. # either, and will not report calls *to* these packages for carp and
  16. # croak.  They replace $CarpLevel, which is deprecated.    The
  17. # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
  18. # text and function arguments should be formatted when printed.
  19.  
  20. # Comments added by Jos I. Boumans <kane@dwim.org> 11-Aug-2004
  21. # I can not get %CarpInternal or %Internal to work as advertised,
  22. # therefor leaving it out of the below documentation.
  23. # $CarpLevel may be decprecated according to the last comment, but
  24. # after 6 years, it's still around and in heavy use ;)
  25.  
  26. $CarpInternal{Carp}++;
  27. $CarpInternal{warnings}++;
  28. $CarpLevel = 0;     # How many extra package levels to skip on carp.
  29.                     # How many calls to skip on confess.
  30.                     # Reconciling these notions is hard, use
  31.                     # %Internal and %CarpInternal instead.
  32. $MaxEvalLen = 0;    # How much eval '...text...' to show. 0 = all.
  33. $MaxArgLen = 64;    # How much of each argument to print. 0 = all.
  34. $MaxArgNums = 8;    # How many arguments to print. 0 = all.
  35. $Verbose = 0;       # If true then make shortmess call longmess instead
  36.  
  37. require Exporter;
  38. @ISA = ('Exporter');
  39. @EXPORT = qw(confess croak carp);
  40. @EXPORT_OK = qw(cluck verbose longmess shortmess);
  41. @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
  42.  
  43. # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
  44. # then the following method will be called by the Exporter which knows
  45. # to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
  46. # 'verbose'.
  47.  
  48. sub export_fail {
  49.     shift;
  50.     $Verbose = shift if $_[0] eq 'verbose';
  51.     return @_;
  52. }
  53.  
  54. # longmess() crawls all the way up the stack reporting on all the function
  55. # calls made.  The error string, $error, is originally constructed from the
  56. # arguments passed into longmess() via confess(), cluck() or shortmess().
  57. # This gets appended with the stack trace messages which are generated for
  58. # each function call on the stack.
  59.  
  60. sub longmess {
  61.     {
  62.     local($@, $!);
  63.     # XXX fix require to not clear $@ or $!?
  64.     # don't use require unless we need to (for Safe compartments)
  65.     require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
  66.     }
  67.     # Icky backwards compatibility wrapper. :-(
  68.     my $call_pack = caller();
  69.     if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
  70.       return longmess_heavy(@_);
  71.     }
  72.     else {
  73.       local $CarpLevel = $CarpLevel + 1;
  74.       return longmess_heavy(@_);
  75.     }
  76. }
  77.  
  78. # shortmess() is called by carp() and croak() to skip all the way up to
  79. # the top-level caller's package and report the error from there.  confess()
  80. # and cluck() generate a full stack trace so they call longmess() to
  81. # generate that.  In verbose mode shortmess() calls longmess() so
  82. # you always get a stack trace
  83.  
  84. sub shortmess {    # Short-circuit &longmess if called via multiple packages
  85.     {
  86.     local($@, $!);
  87.     # XXX fix require to not clear $@ or $!?
  88.     # don't use require unless we need to (for Safe compartments)
  89.     require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
  90.     }
  91.     # Icky backwards compatibility wrapper. :-(
  92.     my $call_pack = caller();
  93.     local @CARP_NOT = caller();
  94.     shortmess_heavy(@_);
  95. }
  96.  
  97. # the following four functions call longmess() or shortmess() depending on
  98. # whether they should generate a full stack trace (confess() and cluck())
  99. # or simply report the caller's package (croak() and carp()), respectively.
  100. # confess() and croak() die, carp() and cluck() warn.
  101.  
  102. sub croak   { die  shortmess @_ }
  103. sub confess { die  longmess  @_ }
  104. sub carp    { warn shortmess @_ }
  105. sub cluck   { warn longmess  @_ }
  106.  
  107. 1;
  108.