ext/Data/Dumper/Dumper.pm

   1 #
   2 # Data/Dumper.pm
   3 #
   4 # convert perl data structures into perl syntax suitable for both printing
   5 # and eval
   6 #
   7 # Documentation at the __END__
   8 #
   9
  10 package Data::Dumper;
  11
  12 $VERSION = '2.121_10';
  13
  14 #$| = 1;
  15
  16 use 5.006_001;
  17 require Exporter;
  18 require overload;
  19
  20 use Carp;
  21
  22 BEGIN {
  23     @ISA = qw(Exporter);
  24     @EXPORT = qw(Dumper);
  25     @EXPORT_OK = qw(DumperX);
  26
  27     # if run under miniperl, or otherwise lacking dynamic loading,
  28     # XSLoader should be attempted to load, or the pure perl flag
  29     # toggled on load failure.
  30     eval {
  31         require XSLoader;
  32     };
  33     $Useperl = 1 if $@;
  34 }
  35
  36 XSLoader::load( 'Data::Dumper' ) unless $Useperl;
  37
  38 # module vars and their defaults
  39 $Indent     = 2         unless defined $Indent;
  40 $Purity     = 0         unless defined $Purity;
  41 $Pad        = ""        unless defined $Pad;
  42 $Varname    = "VAR"     unless defined $Varname;
  43 $Useqq      = 0         unless defined $Useqq;
  44 $Terse      = 0         unless defined $Terse;
  45 $Freezer    = ""        unless defined $Freezer;
  46 $Toaster    = ""        unless defined $Toaster;
  47 $Deepcopy   = 0         unless defined $Deepcopy;
  48 $Quotekeys  = 1         unless defined $Quotekeys;
  49 $Bless      = "bless"   unless defined $Bless;
  50 #$Expdepth   = 0         unless defined $Expdepth;
  51 $Maxdepth   = 0         unless defined $Maxdepth;
  52 $Pair       = ' => '    unless defined $Pair;
  53 $Useperl    = 0         unless defined $Useperl;
  54 $Sortkeys   = 0         unless defined $Sortkeys;
  55 $Deparse    = 0         unless defined $Deparse;
  56
  57 #
  58 # expects an arrayref of values to be dumped.
  59 # can optionally pass an arrayref of names for the values.
  60 # names must have leading $ sign stripped. begin the name with *
  61 # to cause output of arrays and hashes rather than refs.
  62 #
  63 sub new {
  64   my($c, $v, $n) = @_;
  65
  66   croak "Usage:  PACKAGE->new(ARRAYREF, [ARRAYREF])"
  67     unless (defined($v) && (ref($v) eq 'ARRAY'));
  68   $n = [] unless (defined($n) && (ref($v) eq 'ARRAY'));
  69
  70   my($s) = {
  71              level      => 0,           # current recursive depth
  72              indent     => $Indent,     # various styles of indenting
  73              pad        => $Pad,        # all lines prefixed by this string
  74              xpad       => "",          # padding-per-level
  75              apad       => "",          # added padding for hash keys n such
  76              sep        => "",          # list separator
  77              pair       => $Pair,       # hash key/value separator: defaults to ' => '
  78              seen       => {},          # local (nested) refs (id => [name, val])
  79              todump     => $v,          # values to dump []
  80              names      => $n,          # optional names for values []
  81              varname    => $Varname,    # prefix to use for tagging nameless ones
  82              purity     => $Purity,     # degree to which output is evalable
  83              useqq      => $Useqq,      # use "" for strings (backslashitis ensues)
  84              terse      => $Terse,      # avoid name output (where feasible)
  85              freezer    => $Freezer,    # name of Freezer method for objects
  86              toaster    => $Toaster,    # name of method to revive objects
  87              deepcopy   => $Deepcopy,   # dont cross-ref, except to stop recursion
  88              quotekeys  => $Quotekeys,  # quote hash keys
  89              'bless'    => $Bless,      # keyword to use for "bless"
  90 #            expdepth   => $Expdepth,   # cutoff depth for explicit dumping
  91              maxdepth   => $Maxdepth,   # depth beyond which we give up
  92              useperl    => $Useperl,    # use the pure Perl implementation
  93              sortkeys   => $Sortkeys,   # flag or filter for sorting hash keys
  94              deparse    => $Deparse,    # use B::Deparse for coderefs
  95            };
  96
  97   if ($Indent > 0) {
  98     $s->{xpad} = "  ";
  99     $s->{sep} = "\n";
 100   }
 101   return bless($s, $c);
 102 }
 103
 104 if ($] >= 5.006) {
 105   # Packed numeric addresses take less memory. Plus pack is faster than sprintf
 106   *init_refaddr_format = sub {};
 107
 108   *format_refaddr  = sub {
 109     require Scalar::Util;
 110     pack "J", Scalar::Util::refaddr(shift);
 111   };
 112 } else {
 113   *init_refaddr_format = sub {
 114     require Config;
 115     my $f = $Config::Config{uvxformat};
 116     $f =~ tr/"//d;
 117     our $refaddr_format = "0x%" . $f;
 118   };
 119
 120   *format_refaddr = sub {
 121     require Scalar::Util;
 122     sprintf our $refaddr_format, Scalar::Util::refaddr(shift);
 123   }
 124 }
 125
 126 #
 127 # add-to or query the table of already seen references
 128 #
 129 sub Seen {
 130   my($s, $g) = @_;
 131   if (defined($g) && (ref($g) eq 'HASH'))  {
 132     init_refaddr_format();
 133     my($k, $v, $id);
 134     while (($k, $v) = each %$g) {
 135       if (defined $v and ref $v) {
 136         $id = format_refaddr($v);
 137         if ($k =~ /^[*](.*)$/) {
 138           $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
 139                (ref $v eq 'HASH')  ? ( "\\\%" . $1 ) :
 140                (ref $v eq 'CODE')  ? ( "\\\&" . $1 ) :
 141                                      (   "\$" . $1 ) ;
 142         }
 143         elsif ($k !~ /^\$/) {
 144           $k = "\$" . $k;
 145         }
 146         $s->{seen}{$id} = [$k, $v];
 147       }
 148       else {
 149         carp "Only refs supported, ignoring non-ref item \$$k";
 150       }
 151     }
 152     return $s;
 153   }
 154   else {
 155     return map { @$_ } values %{$s->{seen}};
 156   }
 157 }
 158
 159 #
 160 # set or query the values to be dumped
 161 #
 162 sub Values {
 163   my($s, $v) = @_;
 164   if (defined($v) && (ref($v) eq 'ARRAY'))  {
 165     $s->{todump} = [@$v];        # make a copy
 166     return $s;
 167   }
 168   else {
 169     return @{$s->{todump}};
 170   }
 171 }
 172
 173 #
 174 # set or query the names of the values to be dumped
 175 #
 176 sub Names {
 177   my($s, $n) = @_;
 178   if (defined($n) && (ref($n) eq 'ARRAY'))  {
 179     $s->{names} = [@$n];         # make a copy
 180     return $s;
 181   }
 182   else {
 183     return @{$s->{names}};
 184   }
 185 }
 186
 187 sub DESTROY {}
 188
 189 sub Dump {
 190     return &Dumpxs
 191         unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) ||
 192                $Data::Dumper::Useqq   || (ref($_[0]) && $_[0]->{useqq}) ||
 193                $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse});
 194     return &Dumpperl;
 195 }
 196
 197 #
 198 # dump the refs in the current dumper object.
 199 # expects same args as new() if called via package name.
 200 #
 201 sub Dumpperl {
 202   my($s) = shift;
 203   my(@out, $val, $name);
 204   my($i) = 0;
 205   local(@post);
 206   init_refaddr_format();
 207
 208   $s = $s->new(@_) unless ref $s;
 209
 210   for $val (@{$s->{todump}}) {
 211     my $out = "";
 212     @post = ();
 213     $name = $s->{names}[$i++];
 214     if (defined $name) {
 215       if ($name =~ /^[*](.*)$/) {
 216         if (defined $val) {
 217           $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
 218                   (ref $val eq 'HASH')  ? ( "\%" . $1 ) :
 219                   (ref $val eq 'CODE')  ? ( "\*" . $1 ) :
 220                                           ( "\$" . $1 ) ;
 221         }
 222         else {
 223           $name = "\$" . $1;
 224         }
 225       }
 226       elsif ($name !~ /^\$/) {
 227         $name = "\$" . $name;
 228       }
 229     }
 230     else {
 231       $name = "\$" . $s->{varname} . $i;
 232     }
 233
 234     my $valstr;
 235     {
 236       local($s->{apad}) = $s->{apad};
 237       $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2;
 238       $valstr = $s->_dump($val, $name);
 239     }
 240
 241     $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse};
 242     $out .= $s->{pad} . $valstr . $s->{sep};
 243     $out .= $s->{pad} . join(';' . $s->{sep} . $s->{pad}, @post)
 244       . ';' . $s->{sep} if @post;
 245
 246     push @out, $out;
 247   }
 248   return wantarray ? @out : join('', @out);
 249 }
 250
 251 #
 252 # twist, toil and turn;
 253 # and recurse, of course.
 254 # sometimes sordidly;
 255 # and curse if no recourse.
 256 #
 257 sub _dump {
 258   my($s, $val, $name) = @_;
 259   my($sname);
 260   my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
 261
 262   $type = ref $val;
 263   $out = "";
 264
 265   if ($type) {
 266
 267     # Call the freezer method if it's specified and the object has the
 268     # method.  Trap errors and warn() instead of die()ing, like the XS
 269     # implementation.
 270     my $freezer = $s->{freezer};
 271     if ($freezer and UNIVERSAL::can($val, $freezer)) {
 272       eval { $val->$freezer() };
 273       warn "WARNING(Freezer method call failed): $@" if $@;
 274     }
 275
 276     require Scalar::Util;
 277     $realpack = Scalar::Util::blessed($val);
 278     $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val;
 279     $id = format_refaddr($val);
 280
 281     # if it has a name, we need to either look it up, or keep a tab
 282     # on it so we know when we hit it later
 283     if (defined($name) and length($name)) {
 284       # keep a tab on it so that we dont fall into recursive pit
 285       if (exists $s->{seen}{$id}) {
 286 #       if ($s->{expdepth} < $s->{level}) {
 287           if ($s->{purity} and $s->{level} > 0) {
 288             $out = ($realtype eq 'HASH')  ? '{}' :
 289               ($realtype eq 'ARRAY') ? '[]' :
 290                 'do{my $o}' ;
 291             push @post, $name . " = " . $s->{seen}{$id}[0];
 292           }
 293           else {
 294             $out = $s->{seen}{$id}[0];
 295             if ($name =~ /^([\@\%])/) {
 296               my $start = $1;
 297               if ($out =~ /^\\$start/) {
 298                 $out = substr($out, 1);
 299               }
 300               else {
 301                 $out = $start . '{' . $out . '}';
 302               }
 303             }
 304           }
 305           return $out;
 306 #        }
 307       }
 308       else {
 309         # store our name
 310         $s->{seen}{$id} = [ (($name =~ /^[@%]/)     ? ('\\' . $name ) :
 311                              ($realtype eq 'CODE' and
 312                               $name =~ /^[*](.*)$/) ? ('\\&' . $1 )   :
 313                              $name          ),
 314                             $val ];
 315       }
 316     }
 317
 318     if ($realpack and $realpack eq 'Regexp') {
 319         $out = "$val";
 320         $out =~ s,/,\\/,g;
 321         return "qr/$out/";
 322     }
 323
 324     # If purity is not set and maxdepth is set, then check depth:
 325     # if we have reached maximum depth, return the string
 326     # representation of the thing we are currently examining
 327     # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
 328     if (!$s->{purity}
 329         and $s->{maxdepth} > 0
 330         and $s->{level} >= $s->{maxdepth})
 331     {
 332       return qq['$val'];
 333     }
 334
 335     # we have a blessed ref
 336     if ($realpack) {
 337       $out = $s->{'bless'} . '( ';
 338       $blesspad = $s->{apad};
 339       $s->{apad} .= '       ' if ($s->{indent} >= 2);
 340     }
 341
 342     $s->{level}++;
 343     $ipad = $s->{xpad} x $s->{level};
 344
 345     if ($realtype eq 'SCALAR' || $realtype eq 'REF') {
 346       if ($realpack) {
 347         $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
 348       }
 349       else {
 350         $out .= '\\' . $s->_dump($$val, "\${$name}");
 351       }
 352     }
 353     elsif ($realtype eq 'GLOB') {
 354         $out .= '\\' . $s->_dump($$val, "*{$name}");
 355     }
 356     elsif ($realtype eq 'ARRAY') {
 357       my($v, $pad, $mname);
 358       my($i) = 0;
 359       $out .= ($name =~ /^\@/) ? '(' : '[';
 360       $pad = $s->{sep} . $s->{pad} . $s->{apad};
 361       ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) :
 362         # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
 363         ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
 364           ($mname = $name . '->');
 365       $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
 366       for $v (@$val) {
 367         $sname = $mname . '[' . $i . ']';
 368         $out .= $pad . $ipad . '#' . $i if $s->{indent} >= 3;
 369         $out .= $pad . $ipad . $s->_dump($v, $sname);
 370         $out .= "," if $i++ < $#$val;
 371       }
 372       $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
 373       $out .= ($name =~ /^\@/) ? ')' : ']';
 374     }
 375     elsif ($realtype eq 'HASH') {
 376       my($k, $v, $pad, $lpad, $mname, $pair);
 377       $out .= ($name =~ /^\%/) ? '(' : '{';
 378       $pad = $s->{sep} . $s->{pad} . $s->{apad};
 379       $lpad = $s->{apad};
 380       $pair = $s->{pair};
 381       ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
 382         # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
 383         ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
 384           ($mname = $name . '->');
 385       $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
 386       my ($sortkeys, $keys, $key) = ("$s->{sortkeys}");
 387       if ($sortkeys) {
 388         if (ref($s->{sortkeys}) eq 'CODE') {
 389           $keys = $s->{sortkeys}($val);
 390           unless (ref($keys) eq 'ARRAY') {
 391             carp "Sortkeys subroutine did not return ARRAYREF";
 392             $keys = [];
 393           }
 394         }
 395         else {
 396           $keys = [ sort keys %$val ];
 397         }
 398       }
 399       while (($k, $v) = ! $sortkeys ? (each %$val) :
 400              @$keys ? ($key = shift(@$keys), $val->{$key}) :
 401              () )
 402       {
 403         my $nk = $s->_dump($k, "");
 404         $nk = $1 if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/;
 405         $sname = $mname . '{' . $nk . '}';
 406         $out .= $pad . $ipad . $nk . $pair;
 407
 408         # temporarily alter apad
 409         $s->{apad} .= (" " x (length($nk) + 4)) if $s->{indent} >= 2;
 410         $out .= $s->_dump($val->{$k}, $sname) . ",";
 411         $s->{apad} = $lpad if $s->{indent} >= 2;
 412       }
 413       if (substr($out, -1) eq ',') {
 414         chop $out;
 415         $out .= $pad . ($s->{xpad} x ($s->{level} - 1));
 416       }
 417       $out .= ($name =~ /^\%/) ? ')' : '}';
 418     }
 419     elsif ($realtype eq 'CODE') {
 420       if ($s->{deparse}) {
 421         require B::Deparse;
 422         my $sub =  'sub ' . (B::Deparse->new)->coderef2text($val);
 423         $pad    =  $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1);
 424         $sub    =~ s/\n/$pad/gse;
 425         $out   .=  $sub;
 426       } else {
 427         $out .= 'sub { "DUMMY" }';
 428         carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
 429       }
 430     }
 431     else {
 432       croak "Can\'t handle $realtype type.";
 433     }
 434
 435     if ($realpack) { # we have a blessed ref
 436       $out .= ', \'' . $realpack . '\'' . ' )';
 437       $out .= '->' . $s->{toaster} . '()'  if $s->{toaster} ne '';
 438       $s->{apad} = $blesspad;
 439     }
 440     $s->{level}--;
 441
 442   }
 443   else {                                 # simple scalar
 444
 445     my $ref = \$_[1];
 446     # first, catalog the scalar
 447     if ($name ne '') {
 448       $id = format_refaddr($ref);
 449       if (exists $s->{seen}{$id}) {
 450         if ($s->{seen}{$id}[2]) {
 451           $out = $s->{seen}{$id}[0];
 452           #warn "[<$out]\n";
 453           return "\${$out}";
 454         }
 455       }
 456       else {
 457         #warn "[>\\$name]\n";
 458         $s->{seen}{$id} = ["\\$name", $ref];
 459       }
 460     }
 461     if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) {  # glob
 462       my $name = substr($val, 1);
 463       if ($name =~ /^[A-Za-z_][\w:]*$/) {
 464         $name =~ s/^main::/::/;
 465         $sname = $name;
 466       }
 467       else {
 468         $sname = $s->_dump($name, "");
 469         $sname = '{' . $sname . '}';
 470       }
 471       if ($s->{purity}) {
 472         my $k;
 473         local ($s->{level}) = 0;
 474         for $k (qw(SCALAR ARRAY HASH)) {
 475           my $gval = *$val{$k};
 476           next unless defined $gval;
 477           next if $k eq "SCALAR" && ! defined $$gval;  # always there
 478
 479           # _dump can push into @post, so we hold our place using $postlen
 480           my $postlen = scalar @post;
 481           $post[$postlen] = "\*$sname = ";
 482           local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
 483           $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}");
 484         }
 485       }
 486       $out .= '*' . $sname;
 487     }
 488     elsif (!defined($val)) {
 489       $out .= "undef";
 490     }
 491     elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number
 492       $out .= $val;
 493     }
 494     else {                               # string
 495       if ($s->{useqq} or $val =~ tr/\0-\377//c) {
 496         # Fall back to qq if there's unicode
 497         $out .= qquote($val, $s->{useqq});
 498       }
 499       else {
 500         $val =~ s/([\\\'])/\\$1/g;
 501         $out .= '\'' . $val .  '\'';
 502       }
 503     }
 504   }
 505   if ($id) {
 506     # if we made it this far, $id was added to seen list at current
 507     # level, so remove it to get deep copies
 508     if ($s->{deepcopy}) {
 509       delete($s->{seen}{$id});
 510     }
 511     elsif ($name) {
 512       $s->{seen}{$id}[2] = 1;
 513     }
 514   }
 515   return $out;
 516 }
 517
 518 #
 519 # non-OO style of earlier version
 520 #
 521 sub Dumper {
 522   return Data::Dumper->Dump([@_]);
 523 }
 524
 525 # compat stub
 526 sub DumperX {
 527   return Data::Dumper->Dumpxs([@_], []);
 528 }
 529
 530 sub Dumpf { return Data::Dumper->Dump(@_) }
 531
 532 sub Dumpp { print Data::Dumper->Dump(@_) }
 533
 534 #
 535 # reset the "seen" cache
 536 #
 537 sub Reset {
 538   my($s) = shift;
 539   $s->{seen} = {};
 540   return $s;
 541 }
 542
 543 sub Indent {
 544   my($s, $v) = @_;
 545   if (defined($v)) {
 546     if ($v == 0) {
 547       $s->{xpad} = "";
 548       $s->{sep} = "";
 549     }
 550     else {
 551       $s->{xpad} = "  ";
 552       $s->{sep} = "\n";
 553     }
 554     $s->{indent} = $v;
 555     return $s;
 556   }
 557   else {
 558     return $s->{indent};
 559   }
 560 }
 561
 562 sub Pair {
 563     my($s, $v) = @_;
 564     defined($v) ? (($s->{pair} = $v), return $s) : $s->{pair};
 565 }
 566
 567 sub Pad {
 568   my($s, $v) = @_;
 569   defined($v) ? (($s->{pad} = $v), return $s) : $s->{pad};
 570 }
 571
 572 sub Varname {
 573   my($s, $v) = @_;
 574   defined($v) ? (($s->{varname} = $v), return $s) : $s->{varname};
 575 }
 576
 577 sub Purity {
 578   my($s, $v) = @_;
 579   defined($v) ? (($s->{purity} = $v), return $s) : $s->{purity};
 580 }
 581
 582 sub Useqq {
 583   my($s, $v) = @_;
 584   defined($v) ? (($s->{useqq} = $v), return $s) : $s->{useqq};
 585 }
 586
 587 sub Terse {
 588   my($s, $v) = @_;
 589   defined($v) ? (($s->{terse} = $v), return $s) : $s->{terse};
 590 }
 591
 592 sub Freezer {
 593   my($s, $v) = @_;
 594   defined($v) ? (($s->{freezer} = $v), return $s) : $s->{freezer};
 595 }
 596
 597 sub Toaster {
 598   my($s, $v) = @_;
 599   defined($v) ? (($s->{toaster} = $v), return $s) : $s->{toaster};
 600 }
 601
 602 sub Deepcopy {
 603   my($s, $v) = @_;
 604   defined($v) ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
 605 }
 606
 607 sub Quotekeys {
 608   my($s, $v) = @_;
 609   defined($v) ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
 610 }
 611
 612 sub Bless {
 613   my($s, $v) = @_;
 614   defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
 615 }
 616
 617 sub Maxdepth {
 618   my($s, $v) = @_;
 619   defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
 620 }
 621
 622 sub Useperl {
 623   my($s, $v) = @_;
 624   defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
 625 }
 626
 627 sub Sortkeys {
 628   my($s, $v) = @_;
 629   defined($v) ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'};
 630 }
 631
 632 sub Deparse {
 633   my($s, $v) = @_;
 634   defined($v) ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
 635 }
 636
 637 # used by qquote below
 638 my %esc = (
 639     "\a" => "\\a",
 640     "\b" => "\\b",
 641     "\t" => "\\t",
 642     "\n" => "\\n",
 643     "\f" => "\\f",
 644     "\r" => "\\r",
 645     "\e" => "\\e",
 646 );
 647
 648 # put a string value in double quotes
 649 sub qquote {
 650   local($_) = shift;
 651   s/([\\\"\@\$])/\\$1/g;
 652   my $bytes; { use bytes; $bytes = length }
 653   s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
 654   return qq("$_") unless
 655     /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/;  # fast exit
 656
 657   my $high = shift || "";
 658   s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
 659
 660   if (ord('^')==94)  { # ascii
 661     # no need for 3 digits in escape for these
 662     s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
 663     s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
 664     # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
 665     if ($high eq "iso8859") {
 666       s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
 667     } elsif ($high eq "utf8") {
 668 #     use utf8;
 669 #     $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
 670     } elsif ($high eq "8bit") {
 671         # leave it as it is
 672     } else {
 673       s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
 674       s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
 675     }
 676   }
 677   else { # ebcdic
 678       s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)}
 679        {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg;
 680       s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])}
 681        {'\\'.sprintf('%03o',ord($1))}eg;
 682   }
 683
 684   return qq("$_");
 685 }
 686
 687 # helper sub to sort hash keys in Perl < 5.8.0 where we don't have
 688 # access to sortsv() from XS
 689 sub _sortkeys { [ sort keys %{$_[0]} ] }
 690
 691 1;
 692 __END__
 693
 694 =head1 NAME
 695
 696 Data::Dumper - stringified perl data structures, suitable for both printing and C<eval>
 697
 698 =head1 SYNOPSIS
 699
 700     use Data::Dumper;
 701
 702     # simple procedural interface
 703     print Dumper($foo, $bar);
 704
 705     # extended usage with names
 706     print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
 707
 708     # configuration variables
 709     {
 710       local $Data::Dumper::Purity = 1;
 711       eval Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
 712     }
 713
 714     # OO usage
 715     $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]);
 716        ...
 717     print $d->Dump;
 718        ...
 719     $d->Purity(1)->Terse(1)->Deepcopy(1);
 720     eval $d->Dump;
 721
 722
 723 =head1 DESCRIPTION
 724
 725 Given a list of scalars or reference variables, writes out their contents in
 726 perl syntax. The references can also be objects.  The contents of each
 727 variable is output in a single Perl statement.  Handles self-referential
 728 structures correctly.
 729
 730 The return value can be C<eval>ed to get back an identical copy of the
 731 original reference structure.
 732
 733 Any references that are the same as one of those passed in will be named
 734 C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references
 735 to substructures within C<$VAR>I<n> will be appropriately labeled using arrow
 736 notation.  You can specify names for individual values to be dumped if you
 737 use the C<Dump()> method, or you can change the default C<$VAR> prefix to
 738 something else.  See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse>
 739 below.
 740
 741 The default output of self-referential structures can be C<eval>ed, but the
 742 nested references to C<$VAR>I<n> will be undefined, since a recursive
 743 structure cannot be constructed using one Perl statement.  You should set the
 744 C<Purity> flag to 1 to get additional statements that will correctly fill in
 745 these references.  Moreover, if C<eval>ed when strictures are in effect,
 746 you need to ensure that any variables it accesses are previously declared.
 747
 748 In the extended usage form, the references to be dumped can be given
 749 user-specified names.  If a name begins with a C<*>, the output will
 750 describe the dereferenced type of the supplied reference for hashes and
 751 arrays, and coderefs.  Output of names will be avoided where possible if
 752 the C<Terse> flag is set.
 753
 754 In many cases, methods that are used to set the internal state of the
 755 object will return the object itself, so method calls can be conveniently
 756 chained together.
 757
 758 Several styles of output are possible, all controlled by setting
 759 the C<Indent> flag.  See L<Configuration Variables or Methods> below
 760 for details.
 761
 762
 763 =head2 Methods
 764
 765 =over 4
 766
 767 =item I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>)
 768
 769 Returns a newly created C<Data::Dumper> object.  The first argument is an
 770 anonymous array of values to be dumped.  The optional second argument is an
 771 anonymous array of names for the values.  The names need not have a leading
 772 C<$> sign, and must be comprised of alphanumeric characters.  You can begin
 773 a name with a C<*> to specify that the dereferenced type must be dumped
 774 instead of the reference itself, for ARRAY and HASH references.
 775
 776 The prefix specified by C<$Data::Dumper::Varname> will be used with a
 777 numeric suffix if the name for a value is undefined.
 778
 779 Data::Dumper will catalog all references encountered while dumping the
 780 values. Cross-references (in the form of names of substructures in perl
 781 syntax) will be inserted at all possible points, preserving any structural
 782 interdependencies in the original set of values.  Structure traversal is
 783 depth-first,  and proceeds in order from the first supplied value to
 784 the last.
 785
 786 =item I<$OBJ>->Dump  I<or>  I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>)
 787
 788 Returns the stringified form of the values stored in the object (preserving
 789 the order in which they were supplied to C<new>), subject to the
 790 configuration options below.  In a list context, it returns a list
 791 of strings corresponding to the supplied values.
 792
 793 The second form, for convenience, simply calls the C<new> method on its
 794 arguments before dumping the object immediately.
 795
 796 =item I<$OBJ>->Seen(I<[HASHREF]>)
 797
 798 Queries or adds to the internal table of already encountered references.
 799 You must use C<Reset> to explicitly clear the table if needed.  Such
 800 references are not dumped; instead, their names are inserted wherever they
 801 are encountered subsequently.  This is useful especially for properly
 802 dumping subroutine references.
 803
 804 Expects an anonymous hash of name => value pairs.  Same rules apply for names
 805 as in C<new>.  If no argument is supplied, will return the "seen" list of
 806 name => value pairs, in a list context.  Otherwise, returns the object
 807 itself.
 808
 809 =item I<$OBJ>->Values(I<[ARRAYREF]>)
 810
 811 Queries or replaces the internal array of values that will be dumped.
 812 When called without arguments, returns the values.  Otherwise, returns the
 813 object itself.
 814
 815 =item I<$OBJ>->Names(I<[ARRAYREF]>)
 816
 817 Queries or replaces the internal array of user supplied names for the values
 818 that will be dumped.  When called without arguments, returns the names.
 819 Otherwise, returns the object itself.
 820
 821 =item I<$OBJ>->Reset
 822
 823 Clears the internal table of "seen" references and returns the object
 824 itself.
 825
 826 =back
 827
 828 =head2 Functions
 829
 830 =over 4
 831
 832 =item Dumper(I<LIST>)
 833
 834 Returns the stringified form of the values in the list, subject to the
 835 configuration options below.  The values will be named C<$VAR>I<n> in the
 836 output, where I<n> is a numeric suffix.  Will return a list of strings
 837 in a list context.
 838
 839 =back
 840
 841 =head2 Configuration Variables or Methods
 842
 843 Several configuration variables can be used to control the kind of output
 844 generated when using the procedural interface.  These variables are usually
 845 C<local>ized in a block so that other parts of the code are not affected by
 846 the change.
 847
 848 These variables determine the default state of the object created by calling
 849 the C<new> method, but cannot be used to alter the state of the object
 850 thereafter.  The equivalent method names should be used instead to query
 851 or set the internal state of the object.
 852
 853 The method forms return the object itself when called with arguments,
 854 so that they can be chained together nicely.
 855
 856 =over 4
 857
 858 =item *
 859
 860 $Data::Dumper::Indent  I<or>  I<$OBJ>->Indent(I<[NEWVAL]>)
 861
 862 Controls the style of indentation.  It can be set to 0, 1, 2 or 3.  Style 0
 863 spews output without any newlines, indentation, or spaces between list
 864 items.  It is the most compact format possible that can still be called
 865 valid perl.  Style 1 outputs a readable form with newlines but no fancy
 866 indentation (each level in the structure is simply indented by a fixed
 867 amount of whitespace).  Style 2 (the default) outputs a very readable form
 868 which takes into account the length of hash keys (so the hash value lines
 869 up).  Style 3 is like style 2, but also annotates the elements of arrays
 870 with their index (but the comment is on its own line, so array output
 871 consumes twice the number of lines).  Style 2 is the default.
 872
 873 =item *
 874
 875 $Data::Dumper::Purity  I<or>  I<$OBJ>->Purity(I<[NEWVAL]>)
 876
 877 Controls the degree to which the output can be C<eval>ed to recreate the
 878 supplied reference structures.  Setting it to 1 will output additional perl
 879 statements that will correctly recreate nested references.  The default is
 880 0.
 881
 882 =item *
 883
 884 $Data::Dumper::Pad  I<or>  I<$OBJ>->Pad(I<[NEWVAL]>)
 885
 886 Specifies the string that will be prefixed to every line of the output.
 887 Empty string by default.
 888
 889 =item *
 890
 891 $Data::Dumper::Varname  I<or>  I<$OBJ>->Varname(I<[NEWVAL]>)
 892
 893 Contains the prefix to use for tagging variable names in the output. The
 894 default is "VAR".
 895
 896 =item *
 897
 898 $Data::Dumper::Useqq  I<or>  I<$OBJ>->Useqq(I<[NEWVAL]>)
 899
 900 When set, enables the use of double quotes for representing string values.
 901 Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe"
 902 characters will be backslashed, and unprintable characters will be output as
 903 quoted octal integers.  Since setting this variable imposes a performance
 904 penalty, the default is 0.  C<Dump()> will run slower if this flag is set,
 905 since the fast XSUB implementation doesn't support it yet.
 906
 907 =item *
 908
 909 $Data::Dumper::Terse  I<or>  I<$OBJ>->Terse(I<[NEWVAL]>)
 910
 911 When set, Data::Dumper will emit single, non-self-referential values as
 912 atoms/terms rather than statements.  This means that the C<$VAR>I<n> names
 913 will be avoided where possible, but be advised that such output may not
 914 always be parseable by C<eval>.
 915
 916 =item *
 917
 918 $Data::Dumper::Freezer  I<or>  $I<OBJ>->Freezer(I<[NEWVAL]>)
 919
 920 Can be set to a method name, or to an empty string to disable the feature.
 921 Data::Dumper will invoke that method via the object before attempting to
 922 stringify it.  This method can alter the contents of the object (if, for
 923 instance, it contains data allocated from C), and even rebless it in a
 924 different package.  The client is responsible for making sure the specified
 925 method can be called via the object, and that the object ends up containing
 926 only perl data types after the method has been called.  Defaults to an empty
 927 string.
 928
 929 If an object does not support the method specified (determined using
 930 UNIVERSAL::can()) then the call will be skipped.  If the method dies a
 931 warning will be generated.
 932
 933 =item *
 934
 935 $Data::Dumper::Toaster  I<or>  $I<OBJ>->Toaster(I<[NEWVAL]>)
 936
 937 Can be set to a method name, or to an empty string to disable the feature.
 938 Data::Dumper will emit a method call for any objects that are to be dumped
 939 using the syntax C<bless(DATA, CLASS)-E<gt>METHOD()>.  Note that this means that
 940 the method specified will have to perform any modifications required on the
 941 object (like creating new state within it, and/or reblessing it in a
 942 different package) and then return it.  The client is responsible for making
 943 sure the method can be called via the object, and that it returns a valid
 944 object.  Defaults to an empty string.
 945
 946 =item *
 947
 948 $Data::Dumper::Deepcopy  I<or>  $I<OBJ>->Deepcopy(I<[NEWVAL]>)
 949
 950 Can be set to a boolean value to enable deep copies of structures.
 951 Cross-referencing will then only be done when absolutely essential
 952 (i.e., to break reference cycles).  Default is 0.
 953
 954 =item *
 955
 956 $Data::Dumper::Quotekeys  I<or>  $I<OBJ>->Quotekeys(I<[NEWVAL]>)
 957
 958 Can be set to a boolean value to control whether hash keys are quoted.
 959 A false value will avoid quoting hash keys when it looks like a simple
 960 string.  Default is 1, which will always enclose hash keys in quotes.
 961
 962 =item *
 963
 964 $Data::Dumper::Bless  I<or>  $I<OBJ>->Bless(I<[NEWVAL]>)
 965
 966 Can be set to a string that specifies an alternative to the C<bless>
 967 builtin operator used to create objects.  A function with the specified
 968 name should exist, and should accept the same arguments as the builtin.
 969 Default is C<bless>.
 970
 971 =item *
 972
 973 $Data::Dumper::Pair  I<or>  $I<OBJ>->Pair(I<[NEWVAL]>)
 974
 975 Can be set to a string that specifies the separator between hash keys
 976 and values. To dump nested hash, array and scalar values to JavaScript,
 977 use: C<$Data::Dumper::Pair = ' : ';>. Implementing C<bless> in JavaScript
 978 is left as an exercise for the reader.
 979 A function with the specified name exists, and accepts the same arguments
 980 as the builtin.
 981
 982 Default is: C< =E<gt> >.
 983
 984 =item *
 985
 986 $Data::Dumper::Maxdepth  I<or>  $I<OBJ>->Maxdepth(I<[NEWVAL]>)
 987
 988 Can be set to a positive integer that specifies the depth beyond which
 989 which we don't venture into a structure.  Has no effect when
 990 C<Data::Dumper::Purity> is set.  (Useful in debugger when we often don't
 991 want to see more than enough).  Default is 0, which means there is
 992 no maximum depth.
 993
 994 =item *
 995
 996 $Data::Dumper::Useperl  I<or>  $I<OBJ>->Useperl(I<[NEWVAL]>)
 997
 998 Can be set to a boolean value which controls whether the pure Perl
 999 implementation of C<Data::Dumper> is used. The C<Data::Dumper> module is
1000 a dual implementation, with almost all functionality written in both
1001 pure Perl and also in XS ('C'). Since the XS version is much faster, it
1002 will always be used if possible. This option lets you override the
1003 default behavior, usually for testing purposes only. Default is 0, which
1004 means the XS implementation will be used if possible.
1005
1006 =item *
1007
1008 $Data::Dumper::Sortkeys  I<or>  $I<OBJ>->Sortkeys(I<[NEWVAL]>)
1009
1010 Can be set to a boolean value to control whether hash keys are dumped in
1011 sorted order. A true value will cause the keys of all hashes to be
1012 dumped in Perl's default sort order. Can also be set to a subroutine
1013 reference which will be called for each hash that is dumped. In this
1014 case C<Data::Dumper> will call the subroutine once for each hash,
1015 passing it the reference of the hash. The purpose of the subroutine is
1016 to return a reference to an array of the keys that will be dumped, in
1017 the order that they should be dumped. Using this feature, you can
1018 control both the order of the keys, and which keys are actually used. In
1019 other words, this subroutine acts as a filter by which you can exclude
1020 certain keys from being dumped. Default is 0, which means that hash keys
1021 are not sorted.
1022
1023 =item *
1024
1025 $Data::Dumper::Deparse  I<or>  $I<OBJ>->Deparse(I<[NEWVAL]>)
1026
1027 Can be set to a boolean value to control whether code references are
1028 turned into perl source code. If set to a true value, C<B::Deparse>
1029 will be used to get the source of the code reference. Using this option
1030 will force using the Perl implementation of the dumper, since the fast
1031 XSUB implementation doesn't support it.
1032
1033 Caution : use this option only if you know that your coderefs will be
1034 properly reconstructed by C<B::Deparse>.
1035
1036 =back
1037
1038 =head2 Exports
1039
1040 =over 4
1041
1042 =item Dumper
1043
1044 =back
1045
1046 =head1 EXAMPLES
1047
1048 Run these code snippets to get a quick feel for the behavior of this
1049 module.  When you are through with these examples, you may want to
1050 add or change the various configuration variables described above,
1051 to see their behavior.  (See the testsuite in the Data::Dumper
1052 distribution for more examples.)
1053
1054
1055     use Data::Dumper;
1056
1057     package Foo;
1058     sub new {bless {'a' => 1, 'b' => sub { return "foo" }}, $_[0]};
1059
1060     package Fuz;                       # a weird REF-REF-SCALAR object
1061     sub new {bless \($_ = \ 'fu\'z'), $_[0]};
1062
1063     package main;
1064     $foo = Foo->new;
1065     $fuz = Fuz->new;
1066     $boo = [ 1, [], "abcd", \*foo,
1067              {1 => 'a', 023 => 'b', 0x45 => 'c'},
1068              \\"p\q\'r", $foo, $fuz];
1069
1070     ########
1071     # simple usage
1072     ########
1073
1074     $bar = eval(Dumper($boo));
1075     print($@) if $@;
1076     print Dumper($boo), Dumper($bar);  # pretty print (no array indices)
1077
1078     $Data::Dumper::Terse = 1;          # don't output names where feasible
1079     $Data::Dumper::Indent = 0;         # turn off all pretty print
1080     print Dumper($boo), "\n";
1081
1082     $Data::Dumper::Indent = 1;         # mild pretty print
1083     print Dumper($boo);
1084
1085     $Data::Dumper::Indent = 3;         # pretty print with array indices
1086     print Dumper($boo);
1087
1088     $Data::Dumper::Useqq = 1;          # print strings in double quotes
1089     print Dumper($boo);
1090
1091     $Data::Dumper::Pair = " : ";       # specify hash key/value separator
1092     print Dumper($boo);
1093
1094
1095     ########
1096     # recursive structures
1097     ########
1098
1099     @c = ('c');
1100     $c = \@c;
1101     $b = {};
1102     $a = [1, $b, $c];
1103     $b->{a} = $a;
1104     $b->{b} = $a->[1];
1105     $b->{c} = $a->[2];
1106     print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]);
1107
1108
1109     $Data::Dumper::Purity = 1;         # fill in the holes for eval
1110     print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a
1111     print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b
1112
1113
1114     $Data::Dumper::Deepcopy = 1;       # avoid cross-refs
1115     print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
1116
1117
1118     $Data::Dumper::Purity = 0;         # avoid cross-refs
1119     print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
1120
1121     ########
1122     # deep structures
1123     ########
1124
1125     $a = "pearl";
1126     $b = [ $a ];
1127     $c = { 'b' => $b };
1128     $d = [ $c ];
1129     $e = { 'd' => $d };
1130     $f = { 'e' => $e };
1131     print Data::Dumper->Dump([$f], [qw(f)]);
1132
1133     $Data::Dumper::Maxdepth = 3;       # no deeper than 3 refs down
1134     print Data::Dumper->Dump([$f], [qw(f)]);
1135
1136
1137     ########
1138     # object-oriented usage
1139     ########
1140
1141     $d = Data::Dumper->new([$a,$b], [qw(a b)]);
1142     $d->Seen({'*c' => $c});            # stash a ref without printing it
1143     $d->Indent(3);
1144     print $d->Dump;
1145     $d->Reset->Purity(0);              # empty the seen cache
1146     print join "----\n", $d->Dump;
1147
1148
1149     ########
1150     # persistence
1151     ########
1152
1153     package Foo;
1154     sub new { bless { state => 'awake' }, shift }
1155     sub Freeze {
1156         my $s = shift;
1157         print STDERR "preparing to sleep\n";
1158         $s->{state} = 'asleep';
1159         return bless $s, 'Foo::ZZZ';
1160     }
1161
1162     package Foo::ZZZ;
1163     sub Thaw {
1164         my $s = shift;
1165         print STDERR "waking up\n";
1166         $s->{state} = 'awake';
1167         return bless $s, 'Foo';
1168     }
1169
1170     package Foo;
1171     use Data::Dumper;
1172     $a = Foo->new;
1173     $b = Data::Dumper->new([$a], ['c']);
1174     $b->Freezer('Freeze');
1175     $b->Toaster('Thaw');
1176     $c = $b->Dump;
1177     print $c;
1178     $d = eval $c;
1179     print Data::Dumper->Dump([$d], ['d']);
1180
1181
1182     ########
1183     # symbol substitution (useful for recreating CODE refs)
1184     ########
1185
1186     sub foo { print "foo speaking\n" }
1187     *other = \&foo;
1188     $bar = [ \&other ];
1189     $d = Data::Dumper->new([\&other,$bar],['*other','bar']);
1190     $d->Seen({ '*foo' => \&foo });
1191     print $d->Dump;
1192
1193
1194     ########
1195     # sorting and filtering hash keys
1196     ########
1197
1198     $Data::Dumper::Sortkeys = \&my_filter;
1199     my $foo = { map { (ord, "$_$_$_") } 'I'..'Q' };
1200     my $bar = { %$foo };
1201     my $baz = { reverse %$foo };
1202     print Dumper [ $foo, $bar, $baz ];
1203
1204     sub my_filter {
1205         my ($hash) = @_;
1206         # return an array ref containing the hash keys to dump
1207         # in the order that you want them to be dumped
1208         return [
1209           # Sort the keys of %$foo in reverse numeric order
1210             $hash eq $foo ? (sort {$b <=> $a} keys %$hash) :
1211           # Only dump the odd number keys of %$bar
1212             $hash eq $bar ? (grep {$_ % 2} keys %$hash) :
1213           # Sort keys in default order for all other hashes
1214             (sort keys %$hash)
1215         ];
1216     }
1217
1218 =head1 BUGS
1219
1220 Due to limitations of Perl subroutine call semantics, you cannot pass an
1221 array or hash.  Prepend it with a C<\> to pass its reference instead.  This
1222 will be remedied in time, now that Perl has subroutine prototypes.
1223 For now, you need to use the extended usage form, and prepend the
1224 name with a C<*> to output it as a hash or array.
1225
1226 C<Data::Dumper> cheats with CODE references.  If a code reference is
1227 encountered in the structure being processed (and if you haven't set
1228 the C<Deparse> flag), an anonymous subroutine that
1229 contains the string '"DUMMY"' will be inserted in its place, and a warning
1230 will be printed if C<Purity> is set.  You can C<eval> the result, but bear
1231 in mind that the anonymous sub that gets created is just a placeholder.
1232 Someday, perl will have a switch to cache-on-demand the string
1233 representation of a compiled piece of code, I hope.  If you have prior
1234 knowledge of all the code refs that your data structures are likely
1235 to have, you can use the C<Seen> method to pre-seed the internal reference
1236 table and make the dumped output point to them, instead.  See L</EXAMPLES>
1237 above.
1238
1239 The C<Useqq> and C<Deparse> flags makes Dump() run slower, since the
1240 XSUB implementation does not support them.
1241
1242 SCALAR objects have the weirdest looking C<bless> workaround.
1243
1244 Pure Perl version of C<Data::Dumper> escapes UTF-8 strings correctly
1245 only in Perl 5.8.0 and later.
1246
1247 =head2 NOTE
1248
1249 Starting from Perl 5.8.1 different runs of Perl will have different
1250 ordering of hash keys.  The change was done for greater security,
1251 see L<perlsec/"Algorithmic Complexity Attacks">.  This means that
1252 different runs of Perl will have different Data::Dumper outputs if
1253 the data contains hashes.  If you need to have identical Data::Dumper
1254 outputs from different runs of Perl, use the environment variable
1255 PERL_HASH_SEED, see L<perlrun/PERL_HASH_SEED>.  Using this restores
1256 the old (platform-specific) ordering: an even prettier solution might
1257 be to use the C<Sortkeys> filter of Data::Dumper.
1258
1259 =head1 AUTHOR
1260
1261 Gurusamy Sarathy        gsar@activestate.com
1262
1263 Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
1264 This program is free software; you can redistribute it and/or
1265 modify it under the same terms as Perl itself.
1266
1267 =head1 VERSION
1268
1269 Version 2.121  (Aug 24 2003)
1270
1271 =head1 SEE ALSO
1272
1273 perl(1)
1274
1275 =cut