# # Copyright 2006 NetMesh Inc. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. use overload; ##### # Convert a hierarchic data structure into a string. Does not detect loops. sub objectToString { my $obj = shift; # object to convert to string my $indent = shift; # indentation level. Defaults to 0. $indent = 0 unless( defined( $indent )); return 'undef' unless( defined( $obj )); my $ret = ''; my $strval = overload::StrVal( $obj ); my ($realpack, $realtype, $id) = ($strval =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/); $realpack = '' unless( $realpack ); $realtype = '' unless( $realtype ); $id = '' unless( $id ); if( $realpack eq "Math::BigInt" ) { $ret .= ref( $obj ) . " { "; $ret .= $obj->bstr; $ret .= " }"; } elsif( $realtype eq "ARRAY" ) { $ret .= ref( $obj ) . " {\n"; # check whether this is a pseudo-hash if( @{$obj} && overload::StrVal( @{$obj}[0] ) =~ m!^pseudohash=! ) { my $pseudo = @{$obj}[0]; foreach my $k ( keys %{$pseudo} ) { $ret .= indent( $indent+1 ); $ret .= sprintf( "%-32s => %s\n", $k, objectToString( @{$obj}[ $pseudo->{$k} ], $indent+1 )); } } else { foreach my $o ( @{$obj} ) { $ret .= indent( $indent+1 ); if( ref( $o ) eq "HASH" || ref( $o ) eq "ARRAY" ) { $ret .= objectToString( $o, $indent+1 ) . "\n"; } else { if( defined( $o )) { $ret .= objectToString( $o, $indent+1 ) . "\n"; } else { $ret .= "<>\n"; } } } } $ret .= indent( $indent ) . "}\n"; } elsif( $realtype eq "HASH" ) { $ret .= ref( $obj ) . " {\n"; foreach my $k ( keys %{$obj} ) { $ret .= indent( $indent+1 ); $ret .= sprintf( "%-32s => %s\n", $k, objectToString( $obj->{$k}, $indent+1 )); } $ret .= indent( $indent ) . "}"; } else { $ret .= $obj; } return $ret; } ##### # indent so many times sub indent { my $indent = shift; $indent = 0 unless( defined( $indent )); my $ret = ''; for( my $i=0 ; $i<$indent ; ++$i ) { $ret .= ' '; } return $ret; }