home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 November / PCWorld_2004-11_cd.bin / software / topware / activeperl / ActivePerl-5.8.4.810-MSWin32-x86.exe / ActivePerl-5.8.4.810 / Perl / lib / Dumpvalue.pm < prev    next >
Text File  |  2004-06-01  |  18KB  |  649 lines
  1. use 5.006_001;            # for (defined ref) and $#$v and our
  2. package Dumpvalue;
  3. use strict;
  4. our $VERSION = '1.11';
  5. our(%address, $stab, @stab, %stab, %subs);
  6.  
  7. # documentation nits, handle complex data structures better by chromatic
  8. # translate control chars to ^X - Randal Schwartz
  9. # Modifications to print types by Peter Gordon v1.0
  10.  
  11. # Ilya Zakharevich -- patches after 5.001 (and some before ;-)
  12.  
  13. # Won't dump symbol tables and contents of debugged files by default
  14.  
  15. # (IZ) changes for objectification:
  16. #   c) quote() renamed to method set_quote();
  17. #   d) unctrlSet() renamed to method set_unctrl();
  18. #   f) Compiles with `use strict', but in two places no strict refs is needed:
  19. #      maybe more problems are waiting...
  20.  
  21. my %defaults = (
  22.         globPrint          => 0,
  23.         printUndef          => 1,
  24.         tick              => "auto",
  25.         unctrl              => 'quote',
  26.         subdump              => 1,
  27.         dumpReused          => 0,
  28.         bareStringify          => 1,
  29.         hashDepth          => '',
  30.         arrayDepth          => '',
  31.         dumpDBFiles          => '',
  32.         dumpPackages          => '',
  33.         quoteHighBit          => '',
  34.         usageOnly          => '',
  35.         compactDump          => '',
  36.         veryCompact          => '',
  37.         stopDbSignal          => '',
  38.            );
  39.  
  40. sub new {
  41.   my $class = shift;
  42.   my %opt = (%defaults, @_);
  43.   bless \%opt, $class;
  44. }
  45.  
  46. sub set {
  47.   my $self = shift;
  48.   my %opt = @_;
  49.   @$self{keys %opt} = values %opt;
  50. }
  51.  
  52. sub get {
  53.   my $self = shift;
  54.   wantarray ? @$self{@_} : $$self{pop @_};
  55. }
  56.  
  57. sub dumpValue {
  58.   my $self = shift;
  59.   die "usage: \$dumper->dumpValue(value)" unless @_ == 1;
  60.   local %address;
  61.   local $^W=0;
  62.   (print "undef\n"), return unless defined $_[0];
  63.   (print $self->stringify($_[0]), "\n"), return unless ref $_[0];
  64.   $self->unwrap($_[0],0);
  65. }
  66.  
  67. sub dumpValues {
  68.   my $self = shift;
  69.   local %address;
  70.   local $^W=0;
  71.   (print "undef\n"), return unless defined $_[0];
  72.   $self->unwrap(\@_,0);
  73. }
  74.  
  75. # This one is good for variable names:
  76.  
  77. sub unctrl {
  78.   local($_) = @_;
  79.  
  80.   return \$_ if ref \$_ eq "GLOB";
  81.   s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
  82.   $_;
  83. }
  84.  
  85. sub stringify {
  86.   my $self = shift;
  87.   local $_ = shift;
  88.   my $noticks = shift;
  89.   my $tick = $self->{tick};
  90.  
  91.   return 'undef' unless defined $_ or not $self->{printUndef};
  92.   return $_ . "" if ref \$_ eq 'GLOB';
  93.   { no strict 'refs';
  94.     $_ = &{'overload::StrVal'}($_)
  95.       if $self->{bareStringify} and ref $_
  96.     and %overload:: and defined &{'overload::StrVal'};
  97.   }
  98.  
  99.   if ($tick eq 'auto') {
  100.     if (/[\000-\011\013-\037\177]/) {
  101.       $tick = '"';
  102.     } else {
  103.       $tick = "'";
  104.     }
  105.   }
  106.   if ($tick eq "'") {
  107.     s/([\'\\])/\\$1/g;
  108.   } elsif ($self->{unctrl} eq 'unctrl') {
  109.     s/([\"\\])/\\$1/g ;
  110.     s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg;
  111.     s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg
  112.       if $self->{quoteHighBit};
  113.   } elsif ($self->{unctrl} eq 'quote') {
  114.     s/([\"\\\$\@])/\\$1/g if $tick eq '"';
  115.     s/\033/\\e/g;
  116.     s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg;
  117.   }
  118.   s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $self->{quoteHighBit};
  119.   ($noticks || /^\d+(\.\d*)?\Z/)
  120.     ? $_
  121.       : $tick . $_ . $tick;
  122. }
  123.  
  124. sub DumpElem {
  125.   my ($self, $v) = (shift, shift);
  126.   my $short = $self->stringify($v, ref $v);
  127.   my $shortmore = '';
  128.   if ($self->{veryCompact} && ref $v
  129.       && (ref $v eq 'ARRAY' and !grep(ref $_, @$v) )) {
  130.     my $depth = $#$v;
  131.     ($shortmore, $depth) = (' ...', $self->{arrayDepth} - 1)
  132.       if $self->{arrayDepth} and $depth >= $self->{arrayDepth};
  133.     my @a = map $self->stringify($_), @$v[0..$depth];
  134.     print "0..$#{$v}  @a$shortmore\n";
  135.   } elsif ($self->{veryCompact} && ref $v
  136.        && (ref $v eq 'HASH') and !grep(ref $_, values %$v)) {
  137.     my @a = sort keys %$v;
  138.     my $depth = $#a;
  139.     ($shortmore, $depth) = (' ...', $self->{hashDepth} - 1)
  140.       if $self->{hashDepth} and $depth >= $self->{hashDepth};
  141.     my @b = map {$self->stringify($_) . " => " . $self->stringify($$v{$_})}
  142.       @a[0..$depth];
  143.     local $" = ', ';
  144.     print "@b$shortmore\n";
  145.   } else {
  146.     print "$short\n";
  147.     $self->unwrap($v,shift);
  148.   }
  149. }
  150.  
  151. sub unwrap {
  152.   my $self = shift;
  153.   return if $DB::signal and $self->{stopDbSignal};
  154.   my ($v) = shift ;
  155.   my ($s) = shift ;        # extra no of spaces
  156.   my $sp;
  157.   my (%v,@v,$address,$short,$fileno);
  158.  
  159.   $sp = " " x $s ;
  160.   $s += 3 ;
  161.  
  162.   # Check for reused addresses
  163.   if (ref $v) {
  164.     my $val = $v;
  165.     { no strict 'refs';
  166.       $val = &{'overload::StrVal'}($v)
  167.     if %overload:: and defined &{'overload::StrVal'};
  168.     }
  169.     ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ;
  170.     if (!$self->{dumpReused} && defined $address) {
  171.       $address{$address}++ ;
  172.       if ( $address{$address} > 1 ) {
  173.     print "${sp}-> REUSED_ADDRESS\n" ;
  174.     return ;
  175.       }
  176.     }
  177.   } elsif (ref \$v eq 'GLOB') {
  178.     $address = "$v" . "";    # To avoid a bug with globs
  179.     $address{$address}++ ;
  180.     if ( $address{$address} > 1 ) {
  181.       print "${sp}*DUMPED_GLOB*\n" ;
  182.       return ;
  183.     }
  184.   }
  185.  
  186.   if (ref $v eq 'Regexp') {
  187.     my $re = "$v";
  188.     $re =~ s,/,\\/,g;
  189.     print "$sp-> qr/$re/\n";
  190.     return;
  191.   }
  192.  
  193.   if ( UNIVERSAL::isa($v, 'HASH') ) {
  194.     my @sortKeys = sort keys(%$v) ;
  195.     my $more;
  196.     my $tHashDepth = $#sortKeys ;
  197.     $tHashDepth = $#sortKeys < $self->{hashDepth}-1 ? $#sortKeys : $self->{hashDepth}-1
  198.       unless $self->{hashDepth} eq '' ;
  199.     $more = "....\n" if $tHashDepth < $#sortKeys ;
  200.     my $shortmore = "";
  201.     $shortmore = ", ..." if $tHashDepth < $#sortKeys ;
  202.     $#sortKeys = $tHashDepth ;
  203.     if ($self->{compactDump} && !grep(ref $_, values %{$v})) {
  204.       $short = $sp;
  205.       my @keys;
  206.       for (@sortKeys) {
  207.     push @keys, $self->stringify($_) . " => " . $self->stringify($v->{$_});
  208.       }
  209.       $short .= join ', ', @keys;
  210.       $short .= $shortmore;
  211.       (print "$short\n"), return if length $short <= $self->{compactDump};
  212.     }
  213.     for my $key (@sortKeys) {
  214.       return if $DB::signal and $self->{stopDbSignal};
  215.       my $value = $ {$v}{$key} ;
  216.       print $sp, $self->stringify($key), " => ";
  217.       $self->DumpElem($value, $s);
  218.     }
  219.     print "$sp  empty hash\n" unless @sortKeys;
  220.     print "$sp$more" if defined $more ;
  221.   } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) {
  222.     my $tArrayDepth = $#{$v} ;
  223.     my $more ;
  224.     $tArrayDepth = $#$v < $self->{arrayDepth}-1 ? $#$v : $self->{arrayDepth}-1
  225.       unless  $self->{arrayDepth} eq '' ;
  226.     $more = "....\n" if $tArrayDepth < $#{$v} ;
  227.     my $shortmore = "";
  228.     $shortmore = " ..." if $tArrayDepth < $#{$v} ;
  229.     if ($self->{compactDump} && !grep(ref $_, @{$v})) {
  230.       if ($#$v >= 0) {
  231.     $short = $sp . "0..$#{$v}  " .
  232.       join(" ", 
  233.            map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} ($[..$tArrayDepth)
  234.           ) . "$shortmore";
  235.       } else {
  236.     $short = $sp . "empty array";
  237.       }
  238.       (print "$short\n"), return if length $short <= $self->{compactDump};
  239.     }
  240.     for my $num ($[ .. $tArrayDepth) {
  241.       return if $DB::signal and $self->{stopDbSignal};
  242.       print "$sp$num  ";
  243.       if (exists $v->[$num]) {
  244.         $self->DumpElem($v->[$num], $s);
  245.       } else {
  246.     print "empty slot\n";
  247.       }
  248.     }
  249.     print "$sp  empty array\n" unless @$v;
  250.     print "$sp$more" if defined $more ;
  251.   } elsif (  UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) {
  252.     print "$sp-> ";
  253.     $self->DumpElem($$v, $s);
  254.   } elsif ( UNIVERSAL::isa($v, 'CODE') ) {
  255.     print "$sp-> ";
  256.     $self->dumpsub(0, $v);
  257.   } elsif ( UNIVERSAL::isa($v, 'GLOB') ) {
  258.     print "$sp-> ",$self->stringify($$v,1),"\n";
  259.     if ($self->{globPrint}) {
  260.       $s += 3;
  261.       $self->dumpglob('', $s, "{$$v}", $$v, 1);
  262.     } elsif (defined ($fileno = fileno($v))) {
  263.       print( (' ' x ($s+3)) .  "FileHandle({$$v}) => fileno($fileno)\n" );
  264.     }
  265.   } elsif (ref \$v eq 'GLOB') {
  266.     if ($self->{globPrint}) {
  267.       $self->dumpglob('', $s, "{$v}", $v, 1);
  268.     } elsif (defined ($fileno = fileno(\$v))) {
  269.       print( (' ' x $s) .  "FileHandle({$v}) => fileno($fileno)\n" );
  270.     }
  271.   }
  272. }
  273.  
  274. sub matchvar {
  275.   $_[0] eq $_[1] or
  276.     ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and
  277.       ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
  278. }
  279.  
  280. sub compactDump {
  281.   my $self = shift;
  282.   $self->{compactDump} = shift if @_;
  283.   $self->{compactDump} = 6*80-1 
  284.     if $self->{compactDump} and $self->{compactDump} < 2;
  285.   $self->{compactDump};
  286. }
  287.  
  288. sub veryCompact {
  289.   my $self = shift;
  290.   $self->{veryCompact} = shift if @_;
  291.   $self->compactDump(1) if !$self->{compactDump} and $self->{veryCompact};
  292.   $self->{veryCompact};
  293. }
  294.  
  295. sub set_unctrl {
  296.   my $self = shift;
  297.   if (@_) {
  298.     my $in = shift;
  299.     if ($in eq 'unctrl' or $in eq 'quote') {
  300.       $self->{unctrl} = $in;
  301.     } else {
  302.       print "Unknown value for `unctrl'.\n";
  303.     }
  304.   }
  305.   $self->{unctrl};
  306. }
  307.  
  308. sub set_quote {
  309.   my $self = shift;
  310.   if (@_ and $_[0] eq '"') {
  311.     $self->{tick} = '"';
  312.     $self->{unctrl} = 'quote';
  313.   } elsif (@_ and $_[0] eq 'auto') {
  314.     $self->{tick} = 'auto';
  315.     $self->{unctrl} = 'quote';
  316.   } elsif (@_) {        # Need to set
  317.     $self->{tick} = "'";
  318.     $self->{unctrl} = 'unctrl';
  319.   }
  320.   $self->{tick};
  321. }
  322.  
  323. sub dumpglob {
  324.   my $self = shift;
  325.   return if $DB::signal and $self->{stopDbSignal};
  326.   my ($package, $off, $key, $val, $all) = @_;
  327.   local(*stab) = $val;
  328.   my $fileno;
  329.   if (($key !~ /^_</ or $self->{dumpDBFiles}) and defined $stab) {
  330.     print( (' ' x $off) . "\$", &unctrl($key), " = " );
  331.     $self->DumpElem($stab, 3+$off);
  332.   }
  333.   if (($key !~ /^_</ or $self->{dumpDBFiles}) and @stab) {
  334.     print( (' ' x $off) . "\@$key = (\n" );
  335.     $self->unwrap(\@stab,3+$off) ;
  336.     print( (' ' x $off) .  ")\n" );
  337.   }
  338.   if ($key ne "main::" && $key ne "DB::" && %stab
  339.       && ($self->{dumpPackages} or $key !~ /::$/)
  340.       && ($key !~ /^_</ or $self->{dumpDBFiles})
  341.       && !($package eq "Dumpvalue" and $key eq "stab")) {
  342.     print( (' ' x $off) . "\%$key = (\n" );
  343.     $self->unwrap(\%stab,3+$off) ;
  344.     print( (' ' x $off) .  ")\n" );
  345.   }
  346.   if (defined ($fileno = fileno(*stab))) {
  347.     print( (' ' x $off) .  "FileHandle($key) => fileno($fileno)\n" );
  348.   }
  349.   if ($all) {
  350.     if (defined &stab) {
  351.       $self->dumpsub($off, $key);
  352.     }
  353.   }
  354. }
  355.  
  356. sub CvGV_name {
  357.   my $self = shift;
  358.   my $in = shift;
  359.   return if $self->{skipCvGV};    # Backdoor to avoid problems if XS broken...
  360.   $in = \&$in;            # Hard reference...
  361.   eval {require Devel::Peek; 1} or return;
  362.   my $gv = Devel::Peek::CvGV($in) or return;
  363.   *$gv{PACKAGE} . '::' . *$gv{NAME};
  364. }
  365.  
  366. sub dumpsub {
  367.   my $self = shift;
  368.   my ($off,$sub) = @_;
  369.   my $ini = $sub;
  370.   my $s;
  371.   $sub = $1 if $sub =~ /^\{\*(.*)\}$/;
  372.   my $subref = defined $1 ? \&$sub : \&$ini;
  373.   my $place = $DB::sub{$sub} || (($s = $subs{"$subref"}) && $DB::sub{$s})
  374.     || (($s = $self->CvGV_name($subref)) && $DB::sub{$s})
  375.     || ($self->{subdump} && ($s = $self->findsubs("$subref"))
  376.     && $DB::sub{$s});
  377.   $s = $sub unless defined $s;
  378.   $place = '???' unless defined $place;
  379.   print( (' ' x $off) .  "&$s in $place\n" );
  380. }
  381.  
  382. sub findsubs {
  383.   my $self = shift;
  384.   return undef unless %DB::sub;
  385.   my ($addr, $name, $loc);
  386.   while (($name, $loc) = each %DB::sub) {
  387.     $addr = \&$name;
  388.     $subs{"$addr"} = $name;
  389.   }
  390.   $self->{subdump} = 0;
  391.   $subs{ shift() };
  392. }
  393.  
  394. sub dumpvars {
  395.   my $self = shift;
  396.   my ($package,@vars) = @_;
  397.   local(%address,$^W);
  398.   my ($key,$val);
  399.   $package .= "::" unless $package =~ /::$/;
  400.   *stab = *main::;
  401.  
  402.   while ($package =~ /(\w+?::)/g) {
  403.     *stab = $ {stab}{$1};
  404.   }
  405.   $self->{TotalStrings} = 0;
  406.   $self->{Strings} = 0;
  407.   $self->{CompleteTotal} = 0;
  408.   while (($key,$val) = each(%stab)) {
  409.     return if $DB::signal and $self->{stopDbSignal};
  410.     next if @vars && !grep( matchvar($key, $_), @vars );
  411.     if ($self->{usageOnly}) {
  412.       $self->globUsage(\$val, $key)
  413.     if ($package ne 'Dumpvalue' or $key ne 'stab')
  414.        and ref(\$val) eq 'GLOB';
  415.     } else {
  416.       $self->dumpglob($package, 0,$key, $val);
  417.     }
  418.   }
  419.   if ($self->{usageOnly}) {
  420.     print <<EOP;
  421. String space: $self->{TotalStrings} bytes in $self->{Strings} strings.
  422. EOP
  423.     $self->{CompleteTotal} += $self->{TotalStrings};
  424.     print <<EOP;
  425. Grand total = $self->{CompleteTotal} bytes (1 level deep) + overhead.
  426. EOP
  427.   }
  428. }
  429.  
  430. sub scalarUsage {
  431.   my $self = shift;
  432.   my $size;
  433.   if (UNIVERSAL::isa($_[0], 'ARRAY')) {
  434.     $size = $self->arrayUsage($_[0]);
  435.   } elsif (UNIVERSAL::isa($_[0], 'HASH')) {
  436.     $size = $self->hashUsage($_[0]);
  437.   } elsif (!ref($_[0])) {
  438.     $size = length($_[0]);
  439.   }
  440.   $self->{TotalStrings} += $size;
  441.   $self->{Strings}++;
  442.   $size;
  443. }
  444.  
  445. sub arrayUsage {        # array ref, name
  446.   my $self = shift;
  447.   my $size = 0;
  448.   map {$size += $self->scalarUsage($_)} @{$_[0]};
  449.   my $len = @{$_[0]};
  450.   print "\@$_[1] = $len item", ($len > 1 ? "s" : ""), " (data: $size bytes)\n"
  451.       if defined $_[1];
  452.   $self->{CompleteTotal} +=  $size;
  453.   $size;
  454. }
  455.  
  456. sub hashUsage {            # hash ref, name
  457.   my $self = shift;
  458.   my @keys = keys %{$_[0]};
  459.   my @values = values %{$_[0]};
  460.   my $keys = $self->arrayUsage(\@keys);
  461.   my $values = $self->arrayUsage(\@values);
  462.   my $len = @keys;
  463.   my $total = $keys + $values;
  464.   print "\%$_[1] = $len item", ($len > 1 ? "s" : ""),
  465.     " (keys: $keys; values: $values; total: $total bytes)\n"
  466.       if defined $_[1];
  467.   $total;
  468. }
  469.  
  470. sub globUsage {            # glob ref, name
  471.   my $self = shift;
  472.   local *stab = *{$_[0]};
  473.   my $total = 0;
  474.   $total += $self->scalarUsage($stab) if defined $stab;
  475.   $total += $self->arrayUsage(\@stab, $_[1]) if @stab;
  476.   $total += $self->hashUsage(\%stab, $_[1]) 
  477.     if %stab and $_[1] ne "main::" and $_[1] ne "DB::";    
  478.   #and !($package eq "Dumpvalue" and $key eq "stab"));
  479.   $total;
  480. }
  481.  
  482. 1;
  483.  
  484. =head1 NAME
  485.  
  486. Dumpvalue - provides screen dump of Perl data.
  487.  
  488. =head1 SYNOPSIS
  489.  
  490.   use Dumpvalue;
  491.   my $dumper = new Dumpvalue;
  492.   $dumper->set(globPrint => 1);
  493.   $dumper->dumpValue(\*::);
  494.   $dumper->dumpvars('main');
  495.   my $dump = $dumper->stringify($some_value);
  496.  
  497. =head1 DESCRIPTION
  498.  
  499. =head2 Creation
  500.  
  501. A new dumper is created by a call
  502.  
  503.   $d = new Dumpvalue(option1 => value1, option2 => value2)
  504.  
  505. Recognized options:
  506.  
  507. =over 4
  508.  
  509. =item C<arrayDepth>, C<hashDepth>
  510.  
  511. Print only first N elements of arrays and hashes.  If false, prints all the
  512. elements.
  513.  
  514. =item C<compactDump>, C<veryCompact>
  515.  
  516. Change style of array and hash dump.  If true, short array
  517. may be printed on one line.
  518.  
  519. =item C<globPrint>
  520.  
  521. Whether to print contents of globs.
  522.  
  523. =item C<dumpDBFiles>
  524.  
  525. Dump arrays holding contents of debugged files.
  526.  
  527. =item C<dumpPackages>
  528.  
  529. Dump symbol tables of packages.
  530.  
  531. =item C<dumpReused>
  532.  
  533. Dump contents of "reused" addresses.
  534.  
  535. =item C<tick>, C<quoteHighBit>, C<printUndef>
  536.  
  537. Change style of string dump.  Default value of C<tick> is C<auto>, one
  538. can enable either double-quotish dump, or single-quotish by setting it
  539. to C<"> or C<'>.  By default, characters with high bit set are printed
  540. I<as is>.  If C<quoteHighBit> is set, they will be quoted.
  541.  
  542. =item C<usageOnly>
  543.  
  544. rudimentally per-package memory usage dump.  If set,
  545. C<dumpvars> calculates total size of strings in variables in the package.
  546.  
  547. =item unctrl
  548.  
  549. Changes the style of printout of strings.  Possible values are
  550. C<unctrl> and C<quote>.
  551.  
  552. =item subdump
  553.  
  554. Whether to try to find the subroutine name given the reference.
  555.  
  556. =item bareStringify
  557.  
  558. Whether to write the non-overloaded form of the stringify-overloaded objects.
  559.  
  560. =item quoteHighBit
  561.  
  562. Whether to print chars with high bit set in binary or "as is".
  563.  
  564. =item stopDbSignal
  565.  
  566. Whether to abort printing if debugger signal flag is raised.
  567.  
  568. =back
  569.  
  570. Later in the life of the object the methods may be queries with get()
  571. method and set() method (which accept multiple arguments).
  572.  
  573. =head2 Methods
  574.  
  575. =over 4
  576.  
  577. =item dumpValue
  578.  
  579.   $dumper->dumpValue($value);
  580.   $dumper->dumpValue([$value1, $value2]);
  581.  
  582. Prints a dump to the currently selected filehandle.
  583.  
  584. =item dumpValues
  585.  
  586.   $dumper->dumpValues($value1, $value2);
  587.  
  588. Same as C< $dumper->dumpValue([$value1, $value2]); >.
  589.  
  590. =item stringify
  591.  
  592.   my $dump = $dumper->stringify($value [,$noticks] );
  593.  
  594. Returns the dump of a single scalar without printing. If the second
  595. argument is true, the return value does not contain enclosing ticks.
  596. Does not handle data structures.
  597.  
  598. =item dumpvars
  599.  
  600.   $dumper->dumpvars('my_package');
  601.   $dumper->dumpvars('my_package', 'foo', '~bar$', '!......');
  602.  
  603. The optional arguments are considered as literal strings unless they
  604. start with C<~> or C<!>, in which case they are interpreted as regular
  605. expressions (possibly negated).
  606.  
  607. The second example prints entries with names C<foo>, and also entries
  608. with names which ends on C<bar>, or are shorter than 5 chars.
  609.  
  610. =item set_quote
  611.  
  612.   $d->set_quote('"');
  613.  
  614. Sets C<tick> and C<unctrl> options to suitable values for printout with the
  615. given quote char.  Possible values are C<auto>, C<'> and C<">.
  616.  
  617. =item set_unctrl
  618.  
  619.   $d->set_unctrl('"');
  620.  
  621. Sets C<unctrl> option with checking for an invalid argument.
  622. Possible values are C<unctrl> and C<quote>.
  623.  
  624. =item compactDump
  625.  
  626.   $d->compactDump(1);
  627.  
  628. Sets C<compactDump> option.  If the value is 1, sets to a reasonable
  629. big number.
  630.  
  631. =item veryCompact
  632.  
  633.   $d->veryCompact(1);
  634.  
  635. Sets C<compactDump> and C<veryCompact> options simultaneously.
  636.  
  637. =item set
  638.  
  639.   $d->set(option1 => value1, option2 => value2);
  640.  
  641. =item get
  642.  
  643.   @values = $d->get('option1', 'option2');
  644.  
  645. =back
  646.  
  647. =cut
  648.  
  649.