package Data::Dumper::InsideOut; use Data::Dumper(); require Exporter; @ISA = qw(Exporter Data::Dumper); @EXPORT = qw(Dumper); use strict; sub Dumper { # don't want Data::Dumper objects, want the subclass. return Data::Dumper::InsideOut->Dump([@_]); } sub Dump { # The XS routine doesnt know about us goto &Data::Dumper::InsideOut::Dumpperl; } sub new { # we need to add some attributes to the dumper object my $s=shift; my $obj=$s->SUPER::new(@_); @{$obj}{qw(frigid frozen freezer _freezer toaster)} =({},{},"__Inside_Out_Freezer__","__Freezer__","Toaster"); $obj; } sub Dumpperl { my $s=shift; $s = $s->new(@_) unless ref $s; my @out=$s->SUPER::Dumpperl(@_); foreach my $type (keys %{$s->{frigid}}) { # undo any blessing caused by freezing. foreach my $itm (@{$s->{frigid}{$type}}) { $itm=bless $itm,$type; } } wantarray ? @out : join('', @out); } sub _dump { my($s, $val, $name) = @_; my $type = ref $val; my $return; if ($type) { if ($s->{freezer} and UNIVERSAL::can($val,$s->{_freezer})) { my ($id)=overload::StrVal($val)=~/\((.*?)\)/; unless ($s->{frozen}{$id}++) { # store the class type of this guy so we can restore it later. push @{$s->{frigid}{$type}},$val; my $freezer=$s->{freezer}; return $s->SUPER::_dump($val->$freezer(),$name); } else { # already stored return $s->SUPER::_dump($val,$name); } } elsif ($s->{toaster}) { # remove the Toaster on objects that cant my $return=$s->SUPER::_dump($val,$name); $return=~s/->$s->{toaster}\(\)$//; return $return } } return $s->SUPER::_dump($val,$name); } 1; package UNIVERSAL; sub __Inside_Out_Freezer__ { my $self=shift; # prevent non toaster objects from screaming. $self->can("__Freezer__") ? $self->__Freezer__ : $self } 1; __END__ =head1 NAME Data::Dumper::InsideOut - Data::Dumper subclass that knows how to serialize "Inside-Out" objects created using L =head1 SYNOPSIS use Data::Dumper::InsideOut; print Dumper($inside_out_obj); =head1 DESCRITION See Data::Dumper. Ignore anything to do with Toaster or Freezer there and youll be fine. =head1 WARNING Using this module cause the method __Inside_Out_Freezer__ to be added to UNIVERSAL object. =head1 BUGS In code this funky almost certainly. YMMV. Patches welcome. =head1 AUTHOR and COPYRIGHT Copyright by demerphq - Yves Orton Dec 2002 Released under the Perl Artisitic License. =head1 SEE ALSO L, L =cut