Beefy Boxes and Bandwidth Generously Provided by pair Networks Bob
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^2: sortkeys for Data::Dump

by Anonymous Monk
on Jul 22, 2013 at 00:27 UTC ( #1045553=note: print w/ replies, xml ) Need Help??


in reply to Re: sortkeys for Data::Dump
in thread sortkeys for Data::Dump

...

Thanks, I know :)

... hook ...

I don't think so, I think a patch is in order, but I give up

diff -ruN Data-Dump-1.22/lib/Data/Dump.pm Data-Dump-1.22-new/lib/Data/ +Dump.pm --- Data-Dump-1.22/lib/Data/Dump.pm 2013-05-10 03:32:23.000000000 - +0700 +++ Data-Dump-1.22-new/lib/Data/Dump.pm 2013-07-21 17:25:59.5625000 +00 -0700 @@ -124,6 +124,7 @@ my $out; my $comment; my $hide_keys; + my $da_keys; if (@FILTERS) { my $pself = ""; $pself = fullname("self", [@$idx[$pidx..(@$idx - 1)]]) if $pclass +; @@ -131,6 +132,9 @@ my @bless; for my $filter (@FILTERS) { if (my $f = $filter->($ctx, $rval)) { + if (my $v = $f->{da_keys}) { + warn "\ngrrrrrrr da_keys $v\n\n "; $da_keys = $v; + } if (my $v = $f->{object}) { local @FILTERS; $out = _dump($v, $name, $idx, 1); @@ -298,6 +302,23 @@ $text_keys++, last unless /^[-+]?(?:0|[1-9]\d*)(?:\.\d+)?\z/; } + if ( $da_keys ) { + warn "\ngrrrrrrrrr orig_keys @orig_keys\n\n "; + if( 'CODE' eq ref $da_keys){ + @orig_keys = $da_keys->( $text_keys, \@orig_keys ); + warn "\ngrrrrrrrrr orig_keys @orig_keys\n\n "; + } else { + #$da_keys->( $text_keys, \@orig_keys ); + } + } else { + if ($text_keys) { + @orig_keys = sort { lc($a) cmp lc($b) } @orig_keys; + } + else { + @orig_keys = sort { $a <=> $b } @orig_keys; + } + } + if ($text_keys) { @orig_keys = sort { lc($a) cmp lc($b) } @orig_keys; }


Comment on Re^2: sortkeys for Data::Dump
Download Code
Re^3: sortkeys for Data::Dump
by rjt (Chaplain) on Jul 22, 2013 at 02:30 UTC

    ... hook ...

    I don't think so

    Have a little faith. :-)

    Easily extendable to support arbitrary sort subs, or even context-sensitive sorts.

    my $dump = dumpf($data, sub { use List::Util qw/max/; my ($ctx, $obj) = @_; my %r; state %seen; if ('HASH' eq ref $obj and not $seen{$obj}++) { no warnings 'uninitialized'; # Unknown sort keys my $len = max map { length } keys $obj; # Keep results aligned my $sort_string = 'a' x max map { length } keys $obj; # Convert existing keys to ...aaaaa, ...aaaab, ...aaaac, etc., # so Data::Dump's lexical sort works. my %keymap = map { $sort_string++ => $_ } sort { $num{$a} <=> $num{$b} } keys $obj; $obj->{$_} = delete $obj->{$keymap{$_}} for keys %keymap; my $dump = Data::Dump::dump($obj); # Replace to get original keys back $dump =~ s/$_/sprintf "%-${len}s",$keymap{$_}/e for keys %keym +ap; $r{dump} = $dump; } return \%r; });

    Full example

    Output:

    { unknown => "unknown key", one => "first", two => { one => "the", six => "inner", seven => "hash", eight => "works", nine => "too", }, three => "third", }

    I think a patch is in order,

    Not a bad idea, either.

      Have a little faith. :-)

      Eeeew talk about twisted hooks :)

      But that's what I ended up doing (recurse my own specific dumper) , easier to laser-focus that way

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1045553]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2014-04-20 02:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (485 votes), past polls