On Wed, 07 Jan 2009 23:13:52 +0000, Lyle wrote:
> Requirements are pretty simple, just dump out a variable, following down
> the levels of anonymous storage just like Data::Dumper does. But rather
> than creating pretty dumps like:-
>
> $var = {
> array =>
> [
> {
> key => 'value',
> array2 =>
> [
> 'one', 'two', 'three'
> ]
> }
> ]
> };
>
> Creating nasty looking dumps like:-
>
> $var->{array}->[0]->{key} = 'value';
> $var->{array}->[0]->{array2}->[0] = 'one';
> $var->{array}->[0]->{array2}->[0] = 'two';
> $var->{array}->[0]->{array2}->[0] = 'three';
>
> or
>
> $var3->{array}[0]{key} = 'value';
> $var3->{array}[0]{array2}[0] = 'one';
> $var3->{array}[0]{array2}[1] = 'two';
> $var3->{array}[0]{array2}[2] = 'three';
Neither of which actually matches the first dump, which itself doesn't
match Data::Dumper's. I've attached a quick and dirty module, which just
parses Data::Dumper's output (I can't be arsed to reimplement the shared
reference detection), and produces the correct output for the case above.
It doesn't implement Data::Dumper's full API, though; just a single
scalar argument.
--
Peter Haworth [email protected]
"Because, uh, that's what's supposed to happen?
Well, not exactly *supposed* to, but that's what's going to happen."
-- Jarkko Hietaniemi#!/usr/bin/perl
package Data::DumpLines;
use Carp qw(croak);
use Data::Dumper ();
use Exporter qw(import);
use strict;
use warnings;
our @EXPORT=qw(Dumper);
my $re_num=qr/-?\d+(?:\.\d+)?/;
my $re_str=qr/'(?:\\.|[^\\'])*'/s;
my $re_empty=qr/\[\]|\{\}/;
my $re_ref=qr/\$\w+(?:(?:->)?(?:[\[\{](?:$re_num|$re_str)[\]\}]))*/;
my $re_val=qr/$re_num|$re_str|$re_empty|$re_ref/;
sub Dumper{
my($data)=...@_;
my $dumper=Data::Dumper::Dumper($data);
my($nasty,$vname,@stack);
local $.;
for my $line(split /\n/,$dumper){
++$.;
if(!$vname){
$line=~s/\A(\W\S+)\s*=//
or croak "$.: Can't parse variable name";
$vname=$1;
}
if($line=~/\A\s*\{\s*\z/){
if(@stack && $stack[-1][0] eq 'array'){
++$stack[-1][1];
}
push @stack,[hash =>];
}elsif($line=~/\A\s*\[\s*\z/){
if(@stack && $stack[-1][0] eq 'array'){
++$stack[-1][1];
}
push @stack,[array => -1];
}elsif($line=~s/\A\s*($re_val)//){
my $val=$1;
if($line=~s/\A\s*=>//){
@stack && $stack[-1][0] eq 'hash'
or croak "$.: hash entry outside hash";
$stack[-1][1]=$val;
redo;
}elsif(!...@stack){
$nasty.="$vname = $val;\n";
}else{
if($stack[-1][0] eq 'array'){
++$stack[-1][1];
}
$nasty.=$vname;
for(@stack){
my($type,$index)=...@$_;
if($type eq 'array'){
$nasty.="->[$index]";
}elsif($type eq 'hash'){
$nasty.="->{$index}";
}else{
croak "$.: Unknown link type: $type";
}
}
$nasty.=" = $val;\n";
}
}elsif($line=~/\A\s*[\]\}]\s*/){
pop @stack;
}else{
croak "$.: Can't parse line";
}
}
$nasty;
}
1;
_______________________________________________
BristolBathPM mailing list
[email protected]
http://mailman.bristolbath.org/mailman/listinfo/bristolbathpm
