On Thu, 15 Jan 2009 23:24:22 +0000, Lyle wrote:
> That looks impressive and certainly puts you in the lead. Care to
> give us a version with lots of commenting?
I thought it was pretty straightforward, but here's a version with
comments. I also noticed that the simple scalar case didn't need
special treatment, so the code is actually slightly shorted this time.
--
Peter Haworth [email protected]
"Right--we don't want mere mortals to be able to get at continuations
quite that easily, whether they think they want them or not."
-- Larry Wall
package Data::DumpLines;
use Carp qw(croak);
use Data::Dumper ();
use Exporter qw(import);
use strict;
use warnings;
our @EXPORT=qw(Dumper);
# Regexen for matching Data::Dumper's output:
# Numbers; either integers or decimals (DD quotes floats)
my $re_num=qr/-?\d+(?:\.\d+)?/;
# Strings; single quotes containing zero or more escapes or normal characters
my $re_str=qr/'(?:\\.|[^\\'])*'/s;
# Empty hash/array refs
my $re_empty=qr/\[\]|\{\}/;
# References to earlier defined element; scalar var, with multiple indexes
my $re_ref=qr/\$\w+(?:(?:->)?(?:[\[\{](?:$re_num|$re_str)[\]\}]))*/;
# Any old value; one of the above
my $re_val=qr/$re_num|$re_str|$re_empty|$re_ref/;
sub Dumper{
# Start off by getting a dump from Data::Dumper;
my($data)=...@_;
my $dumper=Data::Dumper::Dumper($data);
my(
$lines, # The output we're building up
$vname, # The name of the variable holding the data structure
@stack, # The type and index of each element up to the current point
);
local $.; # Use perl's line number variable for error messages
# Process the DD output one line at a time
for my $line(split /\n/,$dumper){
# Increment the line counter
++$.;
# DD's first line has the name of the variable in it
# Strip it out, but keep going, as the rest of the line holds data
if(!$vname){
$line=~s/\A(\W\S+)\s*=//
or croak "$.: Can't parse variable name";
$vname=$1;
}
if($line=~/\A\s*\{\s*\z/){
# A line with a lone open brace; it's the start of a hash ref
# If we're currently reading an array, increment the index
if(@stack && $stack[-1][0] eq 'array'){
++$stack[-1][1];
}
# Push a "hash" node onto the stack
push @stack,[hash =>];
}elsif($line=~/\A\s*\[\s*\z/){
# A line with a lone open bracket is the start of an array ref
# If we're currently reading an array, increment the index
if(@stack && $stack[-1][0] eq 'array'){
++$stack[-1][1];
}
# Push an "array" node onto the stack, with the current index
# This is "-1", so the first real element gets "0" after incrementing
push @stack,[array => -1];
}elsif($line=~s/\A\s*($re_val)//){
# Some random value, which could be a couple of different things
my $val=$1;
if($line=~s/\A\s*=>//){
# It's followed by a fat comma, so it's a hash key
# Make sure that's what we're expecting
@stack && $stack[-1][0] eq 'hash'
or croak "$.: hash entry outside hash";
# Make a note of the key
$stack[-1][1]=$val;
# Jump back to the start of the loop to process the rest of the line
redo;
}else{
# Otherwise, it's a value to be added
# If we're currently reading an array, increment the index
if(@stack && $stack[-1][0] eq 'array'){
++$stack[-1][1];
}
# Start with the variable name
$lines.=$vname;
# Output the appropriate kind of dereference for each node in the stack
for(@stack){
my($type,$index)=...@$_;
if($type eq 'array'){
$lines.="->[$index]";
}elsif($type eq 'hash'){
$lines.="->{$index}";
}else{
croak "$.: Unknown link type: $type";
}
}
# Finally, output the value
$lines.=" = $val;\n";
}
}elsif($line=~/\A\s*[\]\}]\s*/){
# A close brace or bracket is the end of the current hash or array
# Just pop the top of the stack
pop @stack;
}else{
croak "$.: Can't parse line";
}
}
# Return the formatted output
$lines;
}
1;
_______________________________________________
BristolBathPM mailing list
[email protected]
http://mailman.bristolbath.org/mailman/listinfo/bristolbathpm
