# ================================================================== # Gossamer Threads Module Library - http://gossamer-threads.com/ # # GT::Dumper # Author: Scott Beck # CVS Info : 087,071,086,086,085 # $Id: Dumper.pm,v 1.39 2007/02/10 15:59:02 sbeck Exp $ # # Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved. # ================================================================== # # Description: # Implements a data dumper, useful for converting complex Perl # data structures to strings, which can then be eval()ed back to # the original value. # package GT::Dumper; # =============================================================== use strict; use vars qw /$DEBUG $ATTRIBS $VERSION @EXPORT @ISA $EOL/; use GT::Base; use Exporter; use overload; $EOL = "\n"; $VERSION = sprintf "%d.%03d", q$Revision: 1.39 $ =~ /(\d+)\.(\d+)/; $ATTRIBS = { var => '$VAR', data => undef, sort => 1, order => undef, compress => undef, structure => undef, tab => ' ' }; @EXPORT = qw/Dumper/; @ISA = qw/Exporter GT::Base/; sub Dumper { # ----------------------------------------------------------- # Dumper acts similar to Dumper in Data::Dumper when called as a # class method. If called as a instance method it assumes you # have set the options for the dump and does not change them. # It only takes a single argument - the variable to dump. # my $self; if (@_ == 2 and UNIVERSAL::isa($_[0], __PACKAGE__)) { $self = shift; $self->{data} = shift; } elsif (@_ == 1) { $self = GT::Dumper->new(data => shift); } else { die "Bad args to Dumper()"; } return $self->dump; } sub dump { # ----------------------------------------------------------- # my $dump = $class->dump(%opts); # -------------------------------- # Returns the data structure specified in %opts flatened. # %opts is optional if you have created an object with the # options. # my $this = shift; # See if options were passed in my $self; if (!ref $this) { $self = $this->new(@_); } else { $self = $this; if (@_) { my $data = $self->common_param(@_) or return $self->fatal(BADARGS => '$dumper->dump(%opts)'); $self->set($data); } } my $level = 0; my $ret = ''; if ($self->{var} and not $self->{structure}) { $ret .= ($self->{compress} ? "$self->{var}=" : "$self->{var} = "); } $self->_dump_value($level + 1, $self->{data}, \$ret); $ret .= ';' unless $self->{structure}; $ret .= $EOL unless $self->{structure} or $self->{compress}; return $ret ? $ret : 1; } sub dump_structure { my ($self, $data) = @_; return $self->dump(structure => 1, data => $data); } sub _dump_value { # ----------------------------------------------------------- # Internal method to decide what to dump. # my ($self, $level, $val, $ret, $n) = @_; my $was; my $ref = ref $val; if ($ref and overload::StrVal($val) =~ /=/) { $self->_dump_obj( $level + 1, $val, $ret) } elsif ($ref eq 'HASH') { $self->_dump_hash( $level + 1, $val, $ret) } elsif ($ref eq 'ARRAY') { $self->_dump_array($level + 1, $val, $ret) } elsif ($ref eq 'SCALAR' or $ref eq 'REF' or $ref eq 'LVALUE') { $self->_dump_scalar($level, $val, $ret) } elsif ($ref eq 'CODE') { $$ret .= 'sub { () }' } else { $$ret .= _escape($val) } return 1; } sub _dump_scalar { # ----------------------------------------------------------- # Dump a scalar reference. # my ($self, $level, $val, $ret, $n) = @_; my $v = $$val; $$ret .= '\\'; $self->_dump_value($level, $v, $ret, 1); return 1; } sub _dump_hash { # ----------------------------------------------------------- # Internal method to for through a hash and dump it. # my ($self, $level, $hash_ref, $ret) = @_; $$ret .= '{'; my $lines; if ($self->{sort}) { for (sort { ref($self->{order}) eq 'CODE' ? $self->{order}->($a, $b, $hash_ref->{$a}, $hash_ref->{$b}) : $a cmp $b } keys %{$hash_ref}) { $$ret .= "," if $lines++; $$ret .= $EOL . ($self->{tab} x ($level / 2)) unless $self->{compress}; my $key = _escape($_); $$ret .= $self->{compress} ? "$key," : "$key => "; $self->_dump_value($level + 1, $hash_ref->{$_}, $ret, 1); } } else { for (keys %{$hash_ref}) { $$ret .= "," if $lines++; $$ret .= $EOL . ($self->{tab} x ($level / 2)) unless $self->{compress}; my $key = _escape($_); $$ret .= $self->{compress} ? "$key," : "$key => "; $self->_dump_value($level + 1, $hash_ref->{$_}, $ret, 1); } } $$ret .= $EOL if $lines and not $self->{compress}; $$ret .= ($lines and not $self->{compress}) ? (($self->{tab} x (($level - 1) / 2)) . "}") : "}"; return 1; } sub _dump_array { # ----------------------------------------------------------- # Internal method to for through an array and dump it. # my ($self, $level, $array_ref, $ret) = @_; $$ret .= "["; my $lines; for (@{$array_ref}) { $$ret .= "," if $lines++; $$ret .= $EOL.($self->{tab} x ($level / 2)) unless $self->{compress}; $self->_dump_value($level + 1, $_, $ret, 1); } $$ret .= ($lines and not $self->{compress}) ? $EOL.(($self->{tab} x (($level - 1) / 2)) . "]") : "]"; return 1; } sub _dump_obj { # ----------------------------------------------------------- # Internal method to dump an object. # my ($self, $level, $obj, $ret) = @_; my $class = ref $obj; $$ret .= "bless("; $$ret .= $EOL.($self->{tab} x ($level / 2)) unless $self->{compress}; my $strval = overload::StrVal($obj); if ($strval =~ /ARRAY\(/) { $self->_dump_array($level + 2, \@{$obj}, $ret) } elsif ($strval =~ /HASH\(/) { $self->_dump_hash( $level + 2, \%{$obj}, $ret) } elsif ($strval =~ /SCALAR\(/ or $obj =~ /REF\(/ or $obj =~ /LVALUE\(/) { $self->_dump_value($level + 2, $$obj, $ret) } $$ret .= ","; $$ret .= $EOL.($self->{tab} x ($level / 2)) unless $self->{compress}; $$ret .= _escape($class); $$ret .= $EOL.($self->{tab} x (($level - 1) / 2)) unless $self->{compress}; $$ret .= ")"; return 1; } sub _escape { # ----------------------------------------------------------- # Internal method to escape a dumped value. my ($val) = @_; defined($val) or return 'undef'; $val =~ s/('|\\(?=['\\]|$))/\\$1/g; return "'$val'"; } 1; __END__ =head1 NAME GT::Dumper - Convert Perl data structures into a string. =head1 SYNOPSIS use GT::Dumper; print Dumper($complex_var); print GT::Dumper->dump ( var => '$MYVAR', data => $complex_var); =head1 DESCRIPTION GT::Dumper by default exports a method Dumper() which will behave similar to Data::Dumper's Dumper(). It differs in that it will only take a single argument, and the variable dumped will be $VAR instead of $VAR1. Also, to provide easier control to change the variable name that gets dumped, you can use: GT::Dumper->dump ( var => string, data => yourdata ); and the dump will start with string = instead of $VAR = . =head1 EXAMPLE use GT::Dumper; my %foo; my @bar = (1, 2, 3); $foo{alpha} = \@bar; $foo{beta} = 'a string'; print Dumper(\%foo); This will print: $VAR = { 'beta' => 'a string', 'alpha' => [ '1', '2', '3', ], }; =head1 METHODS/FUNCTIONS =head2 Dumper Dumper() is exported by default when using GT::Dumper. It takes a single variable and returns a string representation of the variable. The string can then be eval()'ed back into the same data structure. It takes only one argument - the variable to dump. The return is a string of the form: $VAR = DATA where 'DATA' is the actual data structure of the variable. A more powerful and customizable dumping method is the L method. =head2 dump dump() provides a more customizable method to dumping a data structure. Through the various options available, listed below, the output of a data structure dump can be formatted in several different ways. The options are as follows. Only the L option is required. =over 4 =item * data The data option takes a data structure to dump. It is required. =item * var By default, a dump is output as an assignment to C<$VAR>. For example, dumping the string C would return: C<$VAR = 'foo'>. You can change and even omit the assignment using the C option. To specify a different variable, you simply specify it as the value here. To have 'foo' dump as just C<'foo'> instead of C<$VAR = 'foo'>, specify var as an empty string, or undef. =item * tab When indenting for complex data structures (array refs, hash refs, etc.) an indent is used. By default, the indent is 4 spaces, however you can change this by using the C option. =item * sort The C option enables hash key sorting. It is not on by default - to enable, simply specify the sort option with 1 as the value. The default sort method is case-sensitive alphabetical. See the L option for specifying your own sort order. =item * order When sorting, it is sometimes desirable to use a custom sort order rather than the default case-sensitive alphabetical sort. The C option takes a code reference and enables custom sort ordering. The code reference will be passed 4 variables. The first and second are the two items being compared - $a and $b in Perl's sort mechanism. The third and fourth are the values in the hash being sorted. The code reference, like a Perl sort routine, should return -1 if $a should come before $b, 0 if $a and $b are equivelant in your sort order, and 1 if $b should come before $a. Because of scoping and package issues in Perl, it is not possible to directly use $a and $b. =item * compress The default dump method is to use ' => ' between hash key and value, to use indenting, and to add a line break after each dumped element. You can turn all of these off by using the compress option. Compression removes all non-essential characters from the output, thus reducing data size, however also generally making the dump very difficult to read. If enabled, the dumping behaviour is changed as follows: =over 4 =item * assignment If using a var (ie. C<$VAR = DATA>), the spaces around the = will be stripped. The output will look like: C<$VAR=DATA> =item * hash keys Instead of placing the 4 characters ' => ' between hash keys and values, a single ',' will be used. =item * tabs Tabs will not be used. =item * newlines Normally, a newline character is added after each dumped element. Compress turns this off. =back =item * structure The structure option causes the dump to be a valid perl structure rather than a valid perl statement. This differs in two ways - for one, the C option is ignored - it is treated as if a blank C was entered, thereby not returning an assignment. The other difference is that an an ordinary dump adds a semicolon and newline at the end of the dump, but these are not added when the structure option is enabled. =back =head2 dump_structure This is a quick method to do a structure dump. It takes one argument - the data to dump. Calling: $class->dump_structure($DATA); is identical to calling: $class->dump(data => $DATA, structure => 1); See the L option. =head1 SEE ALSO L =head1 MAINTAINER Jason Rhinelander =head1 COPYRIGHT Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved. http://www.gossamer-threads.com/ =head1 VERSION Revision: $Id: Dumper.pm,v 1.39 2007/02/10 15:59:02 sbeck Exp $ =cut