dist/Carp/lib/Carp.pm

   1 package Carp;
   2
   3 { use 5.006; }
   4 use strict;
   5 use warnings;
   6
   7 BEGIN {
   8     no strict "refs";
   9     if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"is_utf8"}) &&
  10             defined(*{*{$::{"utf8::"}}{HASH}->{"is_utf8"}}{CODE})) {
  11         *is_utf8 = \&{"utf8::is_utf8"};
  12     } else {
  13         *is_utf8 = sub { 0 };
  14     }
  15 }
  16
  17 BEGIN {
  18     no strict "refs";
  19     if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"downgrade"}) &&
  20             defined(*{*{$::{"utf8::"}}{HASH}->{"downgrade"}}{CODE})) {
  21         *downgrade = \&{"utf8::downgrade"};
  22     } else {
  23         *downgrade = sub {};
  24     }
  25 }
  26
  27 our $VERSION = '1.26';
  28
  29 our $MaxEvalLen = 0;
  30 our $Verbose    = 0;
  31 our $CarpLevel  = 0;
  32 our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
  33 our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
  34
  35 require Exporter;
  36 our @ISA       = ('Exporter');
  37 our @EXPORT    = qw(confess croak carp);
  38 our @EXPORT_OK = qw(cluck verbose longmess shortmess);
  39 our @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
  40
  41 # The members of %Internal are packages that are internal to perl.
  42 # Carp will not report errors from within these packages if it
  43 # can.  The members of %CarpInternal are internal to Perl's warning
  44 # system.  Carp will not report errors from within these packages
  45 # either, and will not report calls *to* these packages for carp and
  46 # croak.  They replace $CarpLevel, which is deprecated.    The
  47 # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
  48 # text and function arguments should be formatted when printed.
  49
  50 our %CarpInternal;
  51 our %Internal;
  52
  53 # disable these by default, so they can live w/o require Carp
  54 $CarpInternal{Carp}++;
  55 $CarpInternal{warnings}++;
  56 $Internal{Exporter}++;
  57 $Internal{'Exporter::Heavy'}++;
  58
  59 # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
  60 # then the following method will be called by the Exporter which knows
  61 # to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
  62 # 'verbose'.
  63
  64 sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
  65
  66 sub _cgc {
  67     no strict 'refs';
  68     return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
  69     return;
  70 }
  71
  72 sub longmess {
  73     # Icky backwards compatibility wrapper. :-(
  74     #
  75     # The story is that the original implementation hard-coded the
  76     # number of call levels to go back, so calls to longmess were off
  77     # by one.  Other code began calling longmess and expecting this
  78     # behaviour, so the replacement has to emulate that behaviour.
  79     my $cgc = _cgc();
  80     my $call_pack = $cgc ? $cgc->() : caller();
  81     if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
  82         return longmess_heavy(@_);
  83     }
  84     else {
  85         local $CarpLevel = $CarpLevel + 1;
  86         return longmess_heavy(@_);
  87     }
  88 }
  89
  90 our @CARP_NOT;
  91
  92 sub shortmess {
  93     my $cgc = _cgc();
  94
  95     # Icky backwards compatibility wrapper. :-(
  96     local @CARP_NOT = $cgc ? $cgc->() : caller();
  97     shortmess_heavy(@_);
  98 }
  99
 100 sub croak   { die shortmess @_ }
 101 sub confess { die longmess @_ }
 102 sub carp    { warn shortmess @_ }
 103 sub cluck   { warn longmess @_ }
 104
 105 BEGIN {
 106     if("$]" >= 5.015002 || ("$]" >= 5.014002 && "$]" < 5.015) ||
 107             ("$]" >= 5.012005 && "$]" < 5.013)) {
 108         *CALLER_OVERRIDE_CHECK_OK = sub () { 1 };
 109     } else {
 110         *CALLER_OVERRIDE_CHECK_OK = sub () { 0 };
 111     }
 112 }
 113
 114 sub caller_info {
 115     my $i = shift(@_) + 1;
 116     my %call_info;
 117     my $cgc = _cgc();
 118     {
 119         # Some things override caller() but forget to implement the
 120         # @DB::args part of it, which we need.  We check for this by
 121         # pre-populating @DB::args with a sentinel which no-one else
 122         # has the address of, so that we can detect whether @DB::args
 123         # has been properly populated.  However, on earlier versions
 124         # of perl this check tickles a bug in CORE::caller() which
 125         # leaks memory.  So we only check on fixed perls.
 126         @DB::args = \$i if CALLER_OVERRIDE_CHECK_OK;
 127         package DB;
 128         @call_info{
 129             qw(pack file line sub has_args wantarray evaltext is_require) }
 130             = $cgc ? $cgc->($i) : caller($i);
 131     }
 132
 133     unless ( defined $call_info{pack} ) {
 134         return ();
 135     }
 136
 137     my $sub_name = Carp::get_subname( \%call_info );
 138     if ( $call_info{has_args} ) {
 139         my @args;
 140         if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
 141             && ref $DB::args[0] eq ref \$i
 142             && $DB::args[0] == \$i ) {
 143             @DB::args = ();    # Don't let anyone see the address of $i
 144             local $@;
 145             my $where = eval {
 146                 my $func    = $cgc or return '';
 147                 my $gv      =
 148                     *{
 149                         ( $::{"B::"} || return '')       # B stash
 150                           ->{svref_2object} || return '' # entry in stash
 151                      }{CODE}                             # coderef in entry
 152                         ->($func)->GV;
 153                 my $package = $gv->STASH->NAME;
 154                 my $subname = $gv->NAME;
 155                 return unless defined $package && defined $subname;
 156
 157                 # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
 158                 return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
 159                 " in &${package}::$subname";
 160             } || '';
 161             @args
 162                 = "** Incomplete caller override detected$where; \@DB::args were not set **";
 163         }
 164         else {
 165             @args = map { Carp::format_arg($_) } @DB::args;
 166         }
 167         if ( $MaxArgNums and @args > $MaxArgNums )
 168         {    # More than we want to show?
 169             $#args = $MaxArgNums;
 170             push @args, '...';
 171         }
 172
 173         # Push the args onto the subroutine
 174         $sub_name .= '(' . join( ', ', @args ) . ')';
 175     }
 176     $call_info{sub_name} = $sub_name;
 177     return wantarray() ? %call_info : \%call_info;
 178 }
 179
 180 # Transform an argument to a function into a string.
 181 sub format_arg {
 182     my $arg = shift;
 183     if ( ref($arg) ) {
 184         $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
 185     }
 186     if ( defined($arg) ) {
 187         $arg =~ s/'/\\'/g;
 188         $arg = str_len_trim( $arg, $MaxArgLen );
 189
 190         # Quote it?
 191         # Downgrade, and use [0-9] rather than \d, to avoid loading
 192         # Unicode tables, which would be liable to fail if we're
 193         # processing a syntax error.
 194         downgrade($arg, 1);
 195         $arg = "'$arg'" unless $arg =~ /^-?[0-9.]+\z/;
 196     }
 197     else {
 198         $arg = 'undef';
 199     }
 200
 201     # The following handling of "control chars" is direct from
 202     # the original code - it is broken on Unicode though.
 203     # Suggestions?
 204     is_utf8($arg)
 205         or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
 206     return $arg;
 207 }
 208
 209 # Takes an inheritance cache and a package and returns
 210 # an anon hash of known inheritances and anon array of
 211 # inheritances which consequences have not been figured
 212 # for.
 213 sub get_status {
 214     my $cache = shift;
 215     my $pkg   = shift;
 216     $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
 217     return @{ $cache->{$pkg} };
 218 }
 219
 220 # Takes the info from caller() and figures out the name of
 221 # the sub/require/eval
 222 sub get_subname {
 223     my $info = shift;
 224     if ( defined( $info->{evaltext} ) ) {
 225         my $eval = $info->{evaltext};
 226         if ( $info->{is_require} ) {
 227             return "require $eval";
 228         }
 229         else {
 230             $eval =~ s/([\\\'])/\\$1/g;
 231             return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
 232         }
 233     }
 234
 235     return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
 236 }
 237
 238 # Figures out what call (from the point of view of the caller)
 239 # the long error backtrace should start at.
 240 sub long_error_loc {
 241     my $i;
 242     my $lvl = $CarpLevel;
 243     {
 244         ++$i;
 245         my $cgc = _cgc();
 246         my $pkg = $cgc ? $cgc->($i) : caller($i);
 247         unless ( defined($pkg) ) {
 248
 249             # This *shouldn't* happen.
 250             if (%Internal) {
 251                 local %Internal;
 252                 $i = long_error_loc();
 253                 last;
 254             }
 255             else {
 256
 257                 # OK, now I am irritated.
 258                 return 2;
 259             }
 260         }
 261         redo if $CarpInternal{$pkg};
 262         redo unless 0 > --$lvl;
 263         redo if $Internal{$pkg};
 264     }
 265     return $i - 1;
 266 }
 267
 268 sub longmess_heavy {
 269     return @_ if ref( $_[0] );    # don't break references as exceptions
 270     my $i = long_error_loc();
 271     return ret_backtrace( $i, @_ );
 272 }
 273
 274 # Returns a full stack backtrace starting from where it is
 275 # told.
 276 sub ret_backtrace {
 277     my ( $i, @error ) = @_;
 278     my $mess;
 279     my $err = join '', @error;
 280     $i++;
 281
 282     my $tid_msg = '';
 283     if ( defined &threads::tid ) {
 284         my $tid = threads->tid;
 285         $tid_msg = " thread $tid" if $tid;
 286     }
 287
 288     my %i = caller_info($i);
 289     $mess = "$err at $i{file} line $i{line}$tid_msg";
 290     if( defined $. ) {
 291         local $@ = '';
 292         local $SIG{__DIE__};
 293         eval {
 294             CORE::die;
 295         };
 296         if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
 297             $mess .= $1;
 298         }
 299     }
 300     $mess .= "\.\n";
 301
 302     while ( my %i = caller_info( ++$i ) ) {
 303         $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
 304     }
 305
 306     return $mess;
 307 }
 308
 309 sub ret_summary {
 310     my ( $i, @error ) = @_;
 311     my $err = join '', @error;
 312     $i++;
 313
 314     my $tid_msg = '';
 315     if ( defined &threads::tid ) {
 316         my $tid = threads->tid;
 317         $tid_msg = " thread $tid" if $tid;
 318     }
 319
 320     my %i = caller_info($i);
 321     return "$err at $i{file} line $i{line}$tid_msg\.\n";
 322 }
 323
 324 sub short_error_loc {
 325     # You have to create your (hash)ref out here, rather than defaulting it
 326     # inside trusts *on a lexical*, as you want it to persist across calls.
 327     # (You can default it on $_[2], but that gets messy)
 328     my $cache = {};
 329     my $i     = 1;
 330     my $lvl   = $CarpLevel;
 331     {
 332         my $cgc = _cgc();
 333         my $called = $cgc ? $cgc->($i) : caller($i);
 334         $i++;
 335         my $caller = $cgc ? $cgc->($i) : caller($i);
 336
 337         return 0 unless defined($caller);    # What happened?
 338         redo if $Internal{$caller};
 339         redo if $CarpInternal{$caller};
 340         redo if $CarpInternal{$called};
 341         redo if trusts( $called, $caller, $cache );
 342         redo if trusts( $caller, $called, $cache );
 343         redo unless 0 > --$lvl;
 344     }
 345     return $i - 1;
 346 }
 347
 348 sub shortmess_heavy {
 349     return longmess_heavy(@_) if $Verbose;
 350     return @_ if ref( $_[0] );    # don't break references as exceptions
 351     my $i = short_error_loc();
 352     if ($i) {
 353         ret_summary( $i, @_ );
 354     }
 355     else {
 356         longmess_heavy(@_);
 357     }
 358 }
 359
 360 # If a string is too long, trims it with ...
 361 sub str_len_trim {
 362     my $str = shift;
 363     my $max = shift || 0;
 364     if ( 2 < $max and $max < length($str) ) {
 365         substr( $str, $max - 3 ) = '...';
 366     }
 367     return $str;
 368 }
 369
 370 # Takes two packages and an optional cache.  Says whether the
 371 # first inherits from the second.
 372 #
 373 # Recursive versions of this have to work to avoid certain
 374 # possible endless loops, and when following long chains of
 375 # inheritance are less efficient.
 376 sub trusts {
 377     my $child  = shift;
 378     my $parent = shift;
 379     my $cache  = shift;
 380     my ( $known, $partial ) = get_status( $cache, $child );
 381
 382     # Figure out consequences until we have an answer
 383     while ( @$partial and not exists $known->{$parent} ) {
 384         my $anc = shift @$partial;
 385         next if exists $known->{$anc};
 386         $known->{$anc}++;
 387         my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
 388         my @found = keys %$anc_knows;
 389         @$known{@found} = ();
 390         push @$partial, @$anc_partial;
 391     }
 392     return exists $known->{$parent};
 393 }
 394
 395 # Takes a package and gives a list of those trusted directly
 396 sub trusts_directly {
 397     my $class = shift;
 398     no strict 'refs';
 399     no warnings 'once';
 400     return @{"$class\::CARP_NOT"}
 401         ? @{"$class\::CARP_NOT"}
 402         : @{"$class\::ISA"};
 403 }
 404
 405 if(!defined($warnings::VERSION) ||
 406         do { no warnings "numeric"; $warnings::VERSION < 1.03 }) {
 407     # Very old versions of warnings.pm import from Carp.  This can go
 408     # wrong due to the circular dependency.  If Carp is invoked before
 409     # warnings, then Carp starts by loading warnings, then warnings
 410     # tries to import from Carp, and gets nothing because Carp is in
 411     # the process of loading and hasn't defined its import method yet.
 412     # So we work around that by manually exporting to warnings here.
 413     no strict "refs";
 414     *{"warnings::$_"} = \&$_ foreach @EXPORT;
 415 }
 416
 417 1;
 418
 419 __END__
 420
 421 =head1 NAME
 422
 423 Carp - alternative warn and die for modules
 424
 425 =head1 SYNOPSIS
 426
 427     use Carp;
 428
 429     # warn user (from perspective of caller)
 430     carp "string trimmed to 80 chars";
 431
 432     # die of errors (from perspective of caller)
 433     croak "We're outta here!";
 434
 435     # die of errors with stack backtrace
 436     confess "not implemented";
 437
 438     # cluck, longmess and shortmess not exported by default
 439     use Carp qw(cluck longmess shortmess);
 440     cluck "This is how we got here!";
 441     $long_message   = longmess( "message from cluck() or confess()" );
 442     $short_message  = shortmess( "message from carp() or croak()" );
 443
 444 =head1 DESCRIPTION
 445
 446 The Carp routines are useful in your own modules because
 447 they act like C<die()> or C<warn()>, but with a message which is more
 448 likely to be useful to a user of your module.  In the case of
 449 C<cluck()> and C<confess()>, that context is a summary of every
 450 call in the call-stack; C<longmess()> returns the contents of the error
 451 message.
 452
 453 For a shorter message you can use C<carp()> or C<croak()> which report the
 454 error as being from where your module was called.  C<shortmess()> returns the
 455 contents of this error message.  There is no guarantee that that is where the
 456 error was, but it is a good educated guess.
 457
 458 You can also alter the way the output and logic of C<Carp> works, by
 459 changing some global variables in the C<Carp> namespace. See the
 460 section on C<GLOBAL VARIABLES> below.
 461
 462 Here is a more complete description of how C<carp> and C<croak> work.
 463 What they do is search the call-stack for a function call stack where
 464 they have not been told that there shouldn't be an error.  If every
 465 call is marked safe, they give up and give a full stack backtrace
 466 instead.  In other words they presume that the first likely looking
 467 potential suspect is guilty.  Their rules for telling whether
 468 a call shouldn't generate errors work as follows:
 469
 470 =over 4
 471
 472 =item 1.
 473
 474 Any call from a package to itself is safe.
 475
 476 =item 2.
 477
 478 Packages claim that there won't be errors on calls to or from
 479 packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
 480 (if that array is empty) C<@ISA>.  The ability to override what
 481 @ISA says is new in 5.8.
 482
 483 =item 3.
 484
 485 The trust in item 2 is transitive.  If A trusts B, and B
 486 trusts C, then A trusts C.  So if you do not override C<@ISA>
 487 with C<@CARP_NOT>, then this trust relationship is identical to,
 488 "inherits from".
 489
 490 =item 4.
 491
 492 Any call from an internal Perl module is safe.  (Nothing keeps
 493 user modules from marking themselves as internal to Perl, but
 494 this practice is discouraged.)
 495
 496 =item 5.
 497
 498 Any call to Perl's warning system (eg Carp itself) is safe.
 499 (This rule is what keeps it from reporting the error at the
 500 point where you call C<carp> or C<croak>.)
 501
 502 =item 6.
 503
 504 C<$Carp::CarpLevel> can be set to skip a fixed number of additional
 505 call levels.  Using this is not recommended because it is very
 506 difficult to get it to behave correctly.
 507
 508 =back
 509
 510 =head2 Forcing a Stack Trace
 511
 512 As a debugging aid, you can force Carp to treat a croak as a confess
 513 and a carp as a cluck across I<all> modules. In other words, force a
 514 detailed stack trace to be given.  This can be very helpful when trying
 515 to understand why, or from where, a warning or error is being generated.
 516
 517 This feature is enabled by 'importing' the non-existent symbol
 518 'verbose'. You would typically enable it by saying
 519
 520     perl -MCarp=verbose script.pl
 521
 522 or by including the string C<-MCarp=verbose> in the PERL5OPT
 523 environment variable.
 524
 525 Alternately, you can set the global variable C<$Carp::Verbose> to true.
 526 See the C<GLOBAL VARIABLES> section below.
 527
 528 =head1 GLOBAL VARIABLES
 529
 530 =head2 $Carp::MaxEvalLen
 531
 532 This variable determines how many characters of a string-eval are to
 533 be shown in the output. Use a value of C<0> to show all text.
 534
 535 Defaults to C<0>.
 536
 537 =head2 $Carp::MaxArgLen
 538
 539 This variable determines how many characters of each argument to a
 540 function to print. Use a value of C<0> to show the full length of the
 541 argument.
 542
 543 Defaults to C<64>.
 544
 545 =head2 $Carp::MaxArgNums
 546
 547 This variable determines how many arguments to each function to show.
 548 Use a value of C<0> to show all arguments to a function call.
 549
 550 Defaults to C<8>.
 551
 552 =head2 $Carp::Verbose
 553
 554 This variable makes C<carp()> and C<croak()> generate stack backtraces
 555 just like C<cluck()> and C<confess()>.  This is how C<use Carp 'verbose'>
 556 is implemented internally.
 557
 558 Defaults to C<0>.
 559
 560 =head2 @CARP_NOT
 561
 562 This variable, I<in your package>, says which packages are I<not> to be
 563 considered as the location of an error. The C<carp()> and C<cluck()>
 564 functions will skip over callers when reporting where an error occurred.
 565
 566 NB: This variable must be in the package's symbol table, thus:
 567
 568     # These work
 569     our @CARP_NOT; # file scope
 570     use vars qw(@CARP_NOT); # package scope
 571     @My::Package::CARP_NOT = ... ; # explicit package variable
 572
 573     # These don't work
 574     sub xyz { ... @CARP_NOT = ... } # w/o declarations above
 575     my @CARP_NOT; # even at top-level
 576
 577 Example of use:
 578
 579     package My::Carping::Package;
 580     use Carp;
 581     our @CARP_NOT;
 582     sub bar     { .... or _error('Wrong input') }
 583     sub _error  {
 584         # temporary control of where'ness, __PACKAGE__ is implicit
 585         local @CARP_NOT = qw(My::Friendly::Caller);
 586         carp(@_)
 587     }
 588
 589 This would make C<Carp> report the error as coming from a caller not
 590 in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
 591
 592 Also read the L</DESCRIPTION> section above, about how C<Carp> decides
 593 where the error is reported from.
 594
 595 Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
 596
 597 Overrides C<Carp>'s use of C<@ISA>.
 598
 599 =head2 %Carp::Internal
 600
 601 This says what packages are internal to Perl.  C<Carp> will never
 602 report an error as being from a line in a package that is internal to
 603 Perl.  For example:
 604
 605     $Carp::Internal{ (__PACKAGE__) }++;
 606     # time passes...
 607     sub foo { ... or confess("whatever") };
 608
 609 would give a full stack backtrace starting from the first caller
 610 outside of __PACKAGE__.  (Unless that package was also internal to
 611 Perl.)
 612
 613 =head2 %Carp::CarpInternal
 614
 615 This says which packages are internal to Perl's warning system.  For
 616 generating a full stack backtrace this is the same as being internal
 617 to Perl, the stack backtrace will not start inside packages that are
 618 listed in C<%Carp::CarpInternal>.  But it is slightly different for
 619 the summary message generated by C<carp> or C<croak>.  There errors
 620 will not be reported on any lines that are calling packages in
 621 C<%Carp::CarpInternal>.
 622
 623 For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
 624 Therefore the full stack backtrace from C<confess> will not start
 625 inside of C<Carp>, and the short message from calling C<croak> is
 626 not placed on the line where C<croak> was called.
 627
 628 =head2 $Carp::CarpLevel
 629
 630 This variable determines how many additional call frames are to be
 631 skipped that would not otherwise be when reporting where an error
 632 occurred on a call to one of C<Carp>'s functions.  It is fairly easy
 633 to count these call frames on calls that generate a full stack
 634 backtrace.  However it is much harder to do this accounting for calls
 635 that generate a short message.  Usually people skip too many call
 636 frames.  If they are lucky they skip enough that C<Carp> goes all of
 637 the way through the call stack, realizes that something is wrong, and
 638 then generates a full stack backtrace.  If they are unlucky then the
 639 error is reported from somewhere misleading very high in the call
 640 stack.
 641
 642 Therefore it is best to avoid C<$Carp::CarpLevel>.  Instead use
 643 C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
 644
 645 Defaults to C<0>.
 646
 647 =head1 BUGS
 648
 649 The Carp routines don't handle exception objects currently.
 650 If called with a first argument that is a reference, they simply
 651 call die() or warn(), as appropriate.
 652
 653 =head1 SEE ALSO
 654
 655 L<Carp::Always>,
 656 L<Carp::Clan>
 657
 658 =head1 AUTHOR
 659
 660 The Carp module first appeared in Larry Wall's perl 5.000 distribution.
 661 Since then it has been modified by several of the perl 5 porters.
 662 Andrew Main (Zefram) <zefram@fysh.org> divested Carp into an independent
 663 distribution.
 664
 665 =head1 COPYRIGHT
 666
 667 Copyright (C) 1994-2012 Larry Wall
 668
 669 Copyright (C) 2011, 2012 Andrew Main (Zefram) <zefram@fysh.org>
 670
 671 =head1 LICENSE
 672
 673 This module is free software; you can redistribute it and/or modify it
 674 under the same terms as Perl itself.