| File | /wise/base/deliv/dev/lib/perl/WISE/Dumper.pm | Statements Executed | 18 | Total Time | 0.00109 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine | |
|---|---|---|---|---|---|---|
| 0 | 0 | 0 | 0 | 0 | WISE::Dumper:: | BEGIN |
| 0 | 0 | 0 | 0 | 0 | WISE::Dumper:: | _print_ary |
| 0 | 0 | 0 | 0 | 0 | WISE::Dumper:: | _print_datum |
| 0 | 0 | 0 | 0 | 0 | WISE::Dumper:: | _print_hash |
| 0 | 0 | 0 | 0 | 0 | WISE::Dumper:: | add |
| 0 | 0 | 0 | 0 | 0 | WISE::Dumper:: | new |
| 0 | 0 | 0 | 0 | 0 | WISE::Dumper:: | print_tree |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package WISE::Dumper; | |||
| 2 | ||||
| 3 | 3 | 3.2e-5 | 1.1e-5 | use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); # spent 73µs making 1 call to vars::import |
| 4 | ||||
| 5 | 3 | 2.7e-5 | 9.0e-6 | use Exporter; # spent 34µs making 1 call to Exporter::import |
| 6 | 3 | 2.9e-5 | 9.7e-6 | use Carp; # spent 51µs making 1 call to Exporter::import |
| 7 | ||||
| 8 | 3 | 0.00098 | 0.00033 | use Data::Dumper; # spent 37µs making 1 call to Exporter::import |
| 9 | ||||
| 10 | 1 | 1.0e-6 | 1.0e-6 | $VERSION = 1.00; |
| 11 | ||||
| 12 | 1 | 9.0e-6 | 9.0e-6 | @ISA = qw(Data::Dumper); |
| 13 | 1 | 1.0e-6 | 1.0e-6 | @EXPORT = qw(Dumper print_tree); |
| 14 | 1 | 1.0e-6 | 1.0e-6 | @EXPORT_OK = qw(); |
| 15 | ||||
| 16 | 1 | 0 | 0 | $Data::Dumper::Sortkeys = 1; |
| 17 | ||||
| 18 | # Override the creator to allow option passing | |||
| 19 | sub new { | |||
| 20 | my $class = shift; | |||
| 21 | my $vars = shift; | |||
| 22 | my $what = shift; | |||
| 23 | my @allowed = qw/purity pad terse indent useqq freezer toaster deepcopy | |||
| 24 | quotekeys bless maxdepth varname/; | |||
| 25 | my ($new,$names,$opts,@got,@args); | |||
| 26 | if( ref($what) eq "ARRAY") { $names = $what; $opts = shift||{}; } | |||
| 27 | elsif(ref($what) eq "HASH") { $opts = $what; } | |||
| 28 | else { $opts = {}; } | |||
| 29 | $vars = [$vars] if ref($vars) !~ /array/i; | |||
| 30 | @args = ($vars); | |||
| 31 | push @args,$names if defined $names; | |||
| 32 | #print "@args\n"; | |||
| 33 | $new = $class->SUPER::new(@args) or return; | |||
| 34 | @got = grep defined $opts->{$_}, @allowed; | |||
| 35 | @{$new}{@got} = @{$opts}{@got}; | |||
| 36 | $new->{opts} = { %$opts }; | |||
| 37 | if (! $new->{indent}) { | |||
| 38 | $new->{xpad} = ""; | |||
| 39 | $new->{sep} = ""; | |||
| 40 | } | |||
| 41 | return bless $new,$class; | |||
| 42 | } | |||
| 43 | ||||
| 44 | # An add method | |||
| 45 | sub add { | |||
| 46 | my ($s,$v) = @_; | |||
| 47 | if (ref($v) eq 'ARRAY') { | |||
| 48 | $s->{todump} = [@{$s->{todump}||[]},@$v]; | |||
| 49 | return $s; | |||
| 50 | } | |||
| 51 | else { | |||
| 52 | return @{$s->{todump}}; | |||
| 53 | } | |||
| 54 | } | |||
| 55 | ||||
| 56 | # Print a compact data tree structure | |||
| 57 | ||||
| 58 | sub print_tree { | |||
| 59 | if( ref($_[0]) =~ /hash/i) { &_print_hash; } | |||
| 60 | elsif(ref($_[0]) =~ /array/i) { &_print_ary; } | |||
| 61 | else { &_print_datum; } | |||
| 62 | return; | |||
| 63 | } | |||
| 64 | ||||
| 65 | sub _print_hash { | |||
| 66 | my $r = shift; | |||
| 67 | my $full = shift; | |||
| 68 | my $keysort= shift; | |||
| 69 | my $indent = shift || ''; | |||
| 70 | my $level = shift || 0; | |||
| 71 | my @keys = keys %$r; | |||
| 72 | if( ref($keysort) =~ /array/i && @$keysort) { | |||
| 73 | my %there; | |||
| 74 | my @yes = grep {exists $r->{$_}} @$keysort; | |||
| 75 | @there{@yes} = (1) x @yes; | |||
| 76 | my @no = grep {! $there{$_}} @keys; | |||
| 77 | @keys = (@yes, @no); | |||
| 78 | } elsif(ref($keysort) =~ /hash/i && keys %$keysort) { | |||
| 79 | @keys = sort {$keysort->{$a} <=> $keysort->{$b}} @keys; | |||
| 80 | } elsif($keysort) { | |||
| 81 | @keys = sort @keys; | |||
| 82 | } | |||
| 83 | for my $k (@keys) { | |||
| 84 | my $last = $k eq $keys[-1]; | |||
| 85 | print +($level?"$indent".($last?"`":"|"):"")."- $k "; | |||
| 86 | _print_datum($r->{$k},$full,$keysort,$indent,$last,$level+1); | |||
| 87 | } | |||
| 88 | return; | |||
| 89 | } | |||
| 90 | ||||
| 91 | sub _print_ary { | |||
| 92 | my $r = shift; | |||
| 93 | my $full = shift; | |||
| 94 | my $keysort= shift; | |||
| 95 | my $indent = shift || ''; | |||
| 96 | my $level = shift || 0; | |||
| 97 | for my $k (0..$#{$r}) { | |||
| 98 | my $last = $k == $#{$r}; | |||
| 99 | print +($level?"$indent".($last?"`":"|"):"")."- $k "; | |||
| 100 | _print_datum($r->[$k],$full,$keysort,$indent,$last,$level+1); | |||
| 101 | } | |||
| 102 | return; | |||
| 103 | } | |||
| 104 | ||||
| 105 | sub _print_datum { | |||
| 106 | my $r = shift; | |||
| 107 | my $full = shift; | |||
| 108 | my $keysort= shift; | |||
| 109 | my $indent = shift || ''; | |||
| 110 | my $last = shift || 0; | |||
| 111 | my $level = shift || 0; | |||
| 112 | my $continue = $last ? " " : "|"; | |||
| 113 | my $intro = "$indent".$continue." \\_"; | |||
| 114 | $expand = $full && $level <= $full ? 1 : 0; | |||
| 115 | if(ref($r) =~ /hash/i) { | |||
| 116 | print("(empty)\n"),return if keys(%$r) == 0; | |||
| 117 | print "\n"; #print "\n$intro\n"; | |||
| 118 | _print_hash($r,$full,$keysort,$indent.$continue.' ',$level+1); | |||
| 119 | } elsif(ref($r) =~ /array/i) { | |||
| 120 | if(! $expand) { | |||
| 121 | while(ref($r) =~ /array/i) { print "[".@$r."]"; $r = $r->[0]; } | |||
| 122 | print " "; | |||
| 123 | _print_datum($r,$full,$keysort,$indent,$last,$level+1); | |||
| 124 | } else { | |||
| 125 | print "[".@$r."]"; | |||
| 126 | print("\n"),return if @$r == 0; | |||
| 127 | print "\n"; #print "\n$intro\n"; | |||
| 128 | _print_ary($r,$full,$keysort,$indent.$continue.' ',$level+1); | |||
| 129 | } | |||
| 130 | } else { | |||
| 131 | $r = '(undefined)' if ! defined $r; | |||
| 132 | (my $txt = substr("$r",0,64)) =~ s/\n+/ /g; | |||
| 133 | print "=> '$txt'\n"; | |||
| 134 | } | |||
| 135 | return; | |||
| 136 | } | |||
| 137 | ||||
| 138 | 1 | 7.0e-6 | 7.0e-6 | 1; |