Category: Utility Script
Author/Contact Info Yves Orton 2001
demerphq@hotmail.com
demerphq
Description: Data::PrettySimple is as its name suggests intended for printing out simple data structures in a pretty way, for perhaps embedding in other code or the like.
Not intended as a drop in for Data::Dumper
Does not handle objects or cyclic structures or any of the funkyness that Data::Dumper does, it is strictly intended for formatting data structures in a relatively readable way.

Use it where you would prefer not to get Dumpers rather unelegant output like this 

$VAR1 = {
          'short' => {
                       'longer' => [
                                     'a',
                                     'b',
                                     'c',
                                     'd',
                                     'e',
                                     'f',
                                     'g',
                                     'h'
                                   ],
                       'long' => [
                                   [
                                     'a',
                                     'b',
                                     'c',
                                     'd',
                                     'e',
                                     'f',
                                     'g',
                                     'h'
                                   ],
                                   [
                                     'a',
                                     'b',
                                     'c',
                                     'd',
                                     'e',
                                     'f',
                                     'g',
                                     'h'
                                   ]
                                 ],
                       'med' => 'MED',
                       's' => 'LONG VALUE'
                     },
          'long___key' => {
                            'longer' => 'LONGER',
                            'long' => 'LONG',
                            'med' => 'MED',
                            's' => 'LONG VALUE'
                          }
        };

[download]
But instead would prefer this: 
my $VAR = {
           long___key => {
                          long   => "LONG",
                          longer => "LONGER",
                          med    => "MED",
                          s      => "LONG VALUE"
                         },
           short      => {
                          long   => [
                                      [ "a","b","c","d","e","f","g","h
+" ],
                                      [ "a","b","c","d","e","f","g","h
+" ]
                                    ],
                          longer => [ "a","b","c","d","e","f","g","h" 
+],
                          med    => "MED",
                          s      => "LONG VALUE"
                         }
          };

[download]
Keys and => lined up accros levels, arrays printed horizontal when it makes sense, stuff like that.

Here what it exports and how to use it (from the comments)

DumpLOL/DumpHOH [SCALAR][CODE]REFLIST
[SCALAR]:An optional new varname may be passed as the first param
[CODE]:An optional coderef may be passes as the first or second param
REFLIST :a list of refrences of the apropriate type
The coderef is used to format whatever data is held in the structure if it is provided then ALL data is passed to it in turn to be formatted this means quoting rules and etc must be obeyed by it. The codref should return the stringified form its input. If one isnt provided then formatter of my own will be used. Frankly some of mine are suspect so use at your own risk. (Although for simple data such as strings and numbers it should be ok. Interpolation is not being handled though. $ will get printed as '$' not escaped.

Sorry for the lack of POD, maybe on a repost.

Yves

 
package Data::PrettySimple;
use Carp;
use strict;
use warnings;
require Exporter;
our $VERSION=0.1;
our @ISA = qw(Exporter);
our @EXPORT = qw(DumpHOH DumpLOL);

## Copyright and Copyleft Yves J. Orton
## demerphq@hotmail.com
## Use at your own risk.
## released under the same terms as Perl itself.
##
## The author accepts no responsibility for it use or misuse.
##
## Data::Dumper::Dumper sortof replacement
##
## Basically it is meant for aesthetically printing out
## Hashes of Hashes and Arrays of Arrays
## While it can handle intermixtures of the two its
## **not** what is intended, use Data::Dumper if thats really
## what you want.  Where it excels is printing out
## hashes and arrays for use inside of source code.
##
## hashes are printed with all keys lined up with those of the
## same depth. Arrays and LOLs are printed out a bit more
## aesthetically than Data::Dumper with simple members being layed
## out horizontal with a right margin settable below.
##
## Calling conventions for both:
## DumpLOL/DumpHOH [SCALAR][CODE]REFLIST
## [SCALAR]:An optional new varname may be passed as the first param
## [CODE]  :An optional coderef may be passes as the first or second p
+aram
## REFLIST :a list of refrences of the apropriate type
##
## The coderef is used to format whatever data is held in the structur
+e
## if it is provided then ALL data is passed to it in turn to be forma
+tted
## this means quoting rules and etc must be obeyed by it. The codref s
+hould
## return the stringified form its input.  If one isnt provided then
## formatter of my own will be used.  Frankly some of them are suspect
## so use at your own risk. (Although for simple data such as strings
## and numbers it should be ok. Interpolation is not being handled tho
+ugh.
## $ will get printed as $.)
##
## If called in scalar context it returns the stringified form of all 
+of the
## refs passed. In list context it returns a list of strinigified form
+s of
## its input.
##
## example uses:
## print DumpLOL("MY_LOL=",[[qw[abc]],[qw[abc]]]);
## print DumpHOH(sub{return "'".shift."'"},{a=>1,be=>2,ced=>3});
## print DumpLOL([qw[Perl is very fun Its interesting and confusing an
+d wow im
##                   not very creative with this example am I?]]);
##
## TODO: -PODIFY
##       -DATA FORMATTER needs to be improved upon, quoting rules and
##        escaping rules are maybe not being observed correctly.
##       -DISPATCH function. Not sure if this should even be added.
##        this **is not** a drop in replacement for Data::Dumper!!
##       -SCALAR REFS are not handled currently.
##       -OBJECTS are not covered either
##       -CYCLIC structures... (what you think going reinvent GSARS wh
+eel?
##        not bloody likely.)
##
## Anyway outside of the caveats it does work and I routinely find use
+s for it

our $HBRACE_INDENT  = 1;        # how far in to move from a {
our $SBRACE_INDENT  = 2;        # how far in to move from a [
our $ASSOC_SYMBOL  = ' => ';    # how the assoc should look, padded or
+ what
our $INDENT_CHAR   = " ";       # what char to use to indent, dont mes
+s
our $BASE_INDENT   = 0;         # how far in the declaration should
our $DECL_TYPE     = "my ";     # trailing space is needed here if wan
+ted
our $VAR_NAME      = "VAR";     # Variable name to use
our $ASSIGN_SYMBOL = " = ";     # how padded should the = be?
our $USE_COMMA     = 0;         # put commas in the ends or not?
our $BARE_KEYS     = 1;         # quote only if necessary?
our $FORMAT_SUB    = undef;     # a callback to format the output with
our $BR_AT_WIDTH   = 70;        # arrays only
our $QUOTE         = '"';       # might have to change this

# Im not real sure on quoting rules here

sub ctrl_hex {
    my $str=shift;
    $str="undef" if !defined($str);
    $str=~s{([[:cntrl:]])}{sprintf("\\x%02x",ord($1))}sge;
    return $str;
}

sub fix_key {
    my $str=shift;
    # _ cant start for b/wards sppt
    # <chipmunk> be careful when using Data::Dumper with 5.005, though
+.
    #    perl5.005 thinks { _key => 'value' } is a bare block rather
    #    than an anonymous hash
    if ($str!~/^[[:alpha:]-]+[\w\d]*$/ || !$BARE_KEYS) {
        $str='"'.ctrl_hex($str).'"';
    }
    return $str;
}

sub fix_data {
    #this needs work. I'm not quite sure how to ake this bullet proof
    #for now its set $QUOTE as appropriate or use $FORMAT_SUB for some
+thing
    #better
    my $data=shift;
    return ($FORMAT_SUB)
                ? $FORMAT_SUB->($data)
                #thanks G. Sarathy in Data::Dumper....
                : (!defined($data))
                   ? "undef"
                   : ($data =~ /^-?[1-9]\d{0,8}$/)
                      ? $data
                      : $QUOTE.ctrl_hex($data).$QUOTE;
}

sub _calcwidthsHOH {
    # Dont call me directly, use calcwidths()
    my ($hash,$widths,$level)=@_;
    my @keys=keys %$hash;
    my $width=0;
    foreach my $key (@keys) {
        my $len=length(fix_key($key));
        $width=$len if $len>$width;
        if (UNIVERSAL::isa($hash->{$key},"HASH")) {
            _calcwidthsHOH($hash->{$key},$widths,$level+1)
        } elsif (ref($hash)) {
            # Maybe I should warn that things wont be
            # as pretty as liked?
        }
    }
    $widths->[$level]=$width
        if (!$widths->[$level] || $widths->[$level]<$width);
}

sub calcwidthsHOH {
    # resets the widths first
    my @widths=();
    _calcwidthsHOH(shift,\@widths,0);
    return \@widths;
}

sub _dumphash {
    my ($hash,$widths,$ofs,$level)=@_;
    my $width=$widths->[$level];
    my @keys=map  {$_->[0]}
             sort {
                   ($a->[1] || $b->[1])
                ? $a->[0] cmp $b->[0]
                : $a->[0] <=> $b->[0]
              }
         map {
             [$_,$_=~/[[:^digit:]]/]
             }
         keys %$hash;

    my $st="{\n";
    $ofs+=$HBRACE_INDENT;
    for my $i (0..$#keys) {
        my $key=$keys[$i];
        my $fixkey=fix_key($key);
        my $keystr=join("",$INDENT_CHAR x $ofs,
                           $fixkey,
                           $INDENT_CHAR x ($width - length($fixkey)),
                           , $ASSOC_SYMBOL);

        my $keylen=length($keystr);
        $st.=$keystr;
        if (UNIVERSAL::isa($hash->{$key},"HASH")) {#handle the sub has
+hes
            $st.=_dumphash($hash->{$key},$widths,$keylen,$level+1);

        } elsif(UNIVERSAL::isa($hash->{$key},"ARRAY")){
            $st.=_dumplol($hash->{$key},$ofs+$width+length($ASSOC_SYMB
+OL),$level)
        } elsif(ref($hash->{$key})) {
            croak "Sorry. Dont know what to do with a '".ref($hash->{$
+key})."'.\n".
                        "Try using Data::Dumper.\n";
        } else {    # its a scalar. What does it have in it.
            my $val=$hash->{$key};
            $st.=fix_data($hash->{$key});
        }
        $st.=($USE_COMMA || $i+1<@keys) ? ",\n" : "\n";
    }
    $ofs-=$HBRACE_INDENT;
    return $st.($INDENT_CHAR x $ofs)."}";
}

sub _DumpHOH {
    my ($hash,$ofs,$depth)=@_;
    return _dumphash($hash,calcwidthsHOH($hash),$ofs,$depth);
}

sub DumpHOH {
    my @rets;
    local $VAR_NAME  = shift if (!ref($_[0]));
    local $FORMAT_SUB= shift if (UNIVERSAL::isa($_[0],'CODE'));
    my $varnum=1;
    foreach my $hash (@_) {
        my $ret=($VAR_NAME)
                ? ($INDENT_CHAR x $BASE_INDENT).
                  $DECL_TYPE.
                  '$'.$VAR_NAME.
                  ((@_>1) ? $varnum : "").
                  $ASSIGN_SYMBOL
                : "";

        $ret.=_DumpHOH($hash,length($ret),0);
        $ret.=";\n" if $VAR_NAME || @_;
        push @rets,$ret;
    }
    return wantarray ? @rets : "@rets";
}


our $Array_Join=",";

sub _dumplol {
    # assumes values are either lists or stringifiable scalars.
    my $array=shift;
    my $ofs  =shift;
    my $depth=shift || 0;

    #try to build it simply
    my $multiline=0;
    my $result="";
    foreach my $i (0..$#$array) {
        my $val=$array->[$i];
        if (ref($val)) {
            $multiline=1;
            last;
        }
        $result.=fix_data($val);
        $result.="," if ($USE_COMMA || $i+1<@$array);
        if (length($result)>=$BR_AT_WIDTH) {
            $multiline=1;
            last;
        }
    }
    return '[ '.$result.' ]' unless $multiline;
    # so its either too long or its got refs in it.
    # either way its not gunna fit on one line
    $result="[\n";
    $ofs+=$SBRACE_INDENT;
    $result.=($INDENT_CHAR x $ofs);
    my $tmp="";
    for my $i (0..$#$array) {
         my $val=$array->[$i];
         if (ref($val)) {
            if ($tmp) {
                $result.=$tmp."\n".($INDENT_CHAR x $ofs);
                $tmp="";
             }
             if (UNIVERSAL::isa($val,"ARRAY")) {
                 $result.=_dumplol($val,$ofs,$depth+1);

            } elsif (UNIVERSAL::isa($val,"HASH")) {#handle the sub has
+hes
                $result.=_DumpHOH($val,$ofs,0); #dont pass our depth,
                # _DumpHOH uses it for a different purpose.
                # actually we dont use ours at all...
                # maybe it should be removed?
            } else {
                croak "Sorry. Dont know what to do with a '".ref($val)
+."'.\n".
                        "Try using Data::Dumper.\n";
                  }
        } else {
             $tmp.=fix_data($val);
         }
         if ($tmp) {
             $tmp.=$Array_Join if ($i<@$array-1 || $USE_COMMA);
             if (length($tmp)+$ofs >= $BR_AT_WIDTH) {
                 $result.=$tmp."\n".($INDENT_CHAR x $ofs);
                $tmp="";
             }
         }else{
             $result.=$Array_Join."\n".($INDENT_CHAR x $ofs)
                    if ($i<@$array-1 || $USE_COMMA);
         }
    }
    $result.=$tmp if ($tmp);
    $ofs-=$SBRACE_INDENT;
    $result.="\n".($INDENT_CHAR x $ofs)."]";
    return $result;
}

sub DumpLOL {
    my @rets;
    local $VAR_NAME  = shift if (!ref($_[0]));
    local $FORMAT_SUB= shift if (UNIVERSAL::isa($_[0],'CODE'));
    my $varnum=1;
    foreach my $array (@_) {

        my $ret=($VAR_NAME)
                ? ($INDENT_CHAR x $BASE_INDENT).
                  $DECL_TYPE.
                  '$'.$VAR_NAME.
                  ((@_>1) ? $varnum : "").
                  $ASSIGN_SYMBOL
                : "";
        $ret.=_dumplol($array,length($ret),0);
        $ret.=";\n" if $VAR_NAME || @_;
        push @rets,$ret;
    }
    return wantarray ? @rets : "@rets";
}


1;
package Data::PrettySimple::Tester;
use Data::Dumper;
print Data::PrettySimple::DumpHOH({long___key=>{s=>'LONG VALUE',
                                                med=>'MED',
                                                long=>'LONG',
                                                longer=>'LONGER'
                                               },
                                   short=>{s=>'LONG VALUE',
                                                med=>'MED',
                                                long=>[[qw(a b c d e f
+ g h)],
                                                       [qw(a b c d e f
+ g h)]],
                                                longer=>[qw(a b c d e 
+f g h)]
                                               }});
print Dumper({long___key=>{s=>'LONG VALUE',
                                                med=>'MED',
                                                long=>'LONG',
                                                longer=>'LONGER'
                                               },
                                   short=>{s=>'LONG VALUE',
                                                med=>'MED',
                                                long=>[[qw(a b c d e f
+ g h)],
                                                       [qw(a b c d e f
+ g h)]],
                                                longer=>[qw(a b c d e 
+f g h)]
                                               }});



my $list=[
            {key=>[qw(array array)]},
            [{key=>[[qw(array array)],[qw(array array)]]}],
            {key=>[{key=>[qw(array array)]}]},
                                       [
            {key=>[qw(array array)]},
            [{key=>[[qw(array array)],[qw(array array)]]}],
            {key=>[{key=>[qw(array array)]}]},

           ]
           ];
my $hash={array=>                                   [
                                    {key=>[qw(array array)]},
                                    [{key=>[[qw(array array)],[qw(arra
+y array)]]}],
                                    {key=>[{key=>[qw(array array)]}]},
                                                   [
                                    {key=>[qw(array array)]},
                                    [{key=>[[qw(array array)],[qw(arra
+y array)]]}],
                                    {key=>[{key=>[qw(array array)]}]},

                                   ]
                                   ]};


local $Data::PrettySimple::DECL_TYPE="";
my $LOL=Data::PrettySimple::DumpLOL('LOL_TEST',$list);
my $HOH=Data::PrettySimple::DumpHOH('HOH_TEST',$hash);
my $lol=Data::Dumper::Dumper($list);
my $hoh=Data::Dumper::Dumper($hash);
my $LOL_TEST;
my $HOH_TEST;
my $lolt;
my $hoht;
die "HOH:$@" if !eval $HOH;
die "LOL:$@" if !eval $LOL;
{no strict;
 $lolt=Data::Dumper::Dumper($LOL_TEST);
 $hoht=Data::Dumper::Dumper($HOH_TEST);
}
die "Failed LOL" if $lol ne $lolt;
die "Failed HOH" if $hoh ne $hoht;
print join ("\n",$LOL,$lol,$lolt,$HOH,$hoh,$hoht);

1;

Back to Code Catacombs