| Current File : //var/wcp4/mycath2o/public_html/file/private/lib/GT/Dumper.pm |
# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
# GT::Dumper
# Author : Scott Beck
# $Id: Dumper.pm,v 1.30 2002/04/05 02:45:13 jagerman Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
# ==================================================================
#
# Description:
# Implements a simple data dumper, useful for converting complex
# data structures to strings.
#
package GT::Dumper;
# ===============================================================
use strict;
use vars qw /$DEBUG $ATTRIBS $VERSION @EXPORT @ISA $TAB $EOL/;
use GT::Base;
use Exporter;
$TAB = ' ';
$EOL = "\n";
$VERSION = sprintf "%d.%03d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/;
$ATTRIBS = {
var => undef,
data => undef,
sort => undef,
order => undef,
compress => undef,
structure => undef
};
@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 (@_ == 1) {
if (ref $_[0] eq 'GT::Dumper') {
$self = shift;
}
else {
$self = GT::Dumper->new (
var => '$VAR',
data => shift
);
}
}
elsif (@_ == 2) {
if ($_[0] eq 'GT::Dumper') {
$self = GT::Dumper->new (
var => '$VAR',
data => $_[1]
);
}
else {
$self = shift;
$self->{data} = shift;
$self->{var} ||= '$VAR';
}
}
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 (@_);
}
elsif (@_ > 0) {
$self = $this;
$self->init (@_);
}
else {
$self = $this;
}
my $level = 0;
my $ret;
$ret .= "$self->{var} = " unless defined $self->{var} and $self->{var} eq '';
$self->_dump_value ($level + 1, $self->{data}, \$ret);
$ret .= ';'.$EOL unless $self->{structure};
return $ret ? $ret : 1;
}
sub dump_structure {
my ($self, $data) = @_;
return $self->dump(var => '', structure => 1, data => $data);
}
sub _dump_value {
# -----------------------------------------------------------
# Internal method to decide what to dump.
#
my ($self, $level, $val, $ret, $n) = @_;
my $was;
if (ref $val and $val =~ /=/) { $self->_dump_obj ($level + 1, $val, $ret) }
elsif (ref $val eq 'HASH') { $self->_dump_hash ($level + 1, $val, $ret) }
elsif (ref $val eq 'ARRAY') { $self->_dump_array ($level + 1, $val, $ret) }
elsif (ref $val eq 'SCALAR' or ref $val eq 'REF'
or ref $val eq 'LVALUE') { $self->_dump_scalar ($level + 1, $val, $ret) }
else {
$val = _escape ($val);
$$ret .= $val;
}
return 1;
}
sub _dump_scalar {
# -----------------------------------------------------------
# Dump a scalar reference.
#
my ($self, $level, $val, $ret, $n) = @_;
my $v = $$val;
$$ret .= '\\';
$self->_dump_value($level + 1, $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.($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.($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}) ? (($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.($TAB x ($level / 2)) unless $self->{compress};
$self->_dump_value ($level + 1, $_, $ret, 1);
}
$$ret .= ($lines and not $self->{compress}) ? $EOL.(($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.($TAB x ($level / 2)) unless $self->{compress};
if ($obj =~ /ARRAY\(/) { $self->_dump_array ($level + 2, \@{$obj}, $ret) }
elsif ($obj =~ /HASH\(/) { $self->_dump_hash ($level + 2, \%{$obj}, $ret) }
elsif ($obj =~ /SCALAR\(/ or $obj =~ /REF\(/ or $obj =~ /LVALUE\(/)
{ $self->_dump_value ($level + 2, $$obj, $ret) }
$$ret .= ",";
$$ret .= $EOL.($TAB x ($level / 2)) unless $self->{compress};
$$ret .= _escape($class);
$$ret .= $EOL.($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 - Implements a simple data dumper.
=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',
],
};
You may specify a blank variable name ('') and the variable
and = sign will be omitted from the output.
The "compress" option can be used to eliminate all whitespace.
=head1 COPYRIGHT
Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
http://www.gossamer-threads.com/
=head1 VERSION
Revision: $Id: Dumper.pm,v 1.30 2002/04/05 02:45:13 jagerman Exp $
=cut