C:\test>874313
{
File => {
Header => {
Contents => { Dictionary => {}, Flags => {}, Properties => {} },
Key => { value => "physical" },
Precision => { Dec => { value => 1 }, Units => { value => "mil" } },
Revision => {
"log" => { value => 0 },
oth => { value => 0 },
phy => { value => 0 }
},
Version => { value => "1.0" },
},
value => "\"foo\"",
},
}
my $hash = {
File => {
Header => {
Contents => { Flags => {}, Dictionary => {}, Properties => {} },
Key => { value => "phy", },
Precision => { Units => { value => "mil" }, Dec => { value => 1 } }
Revision => {
log => { value => 0 },
phy => { value => 0 },
oth => { value => 0 }
},
Version => { value => 1.0, },
}
value => "foo",
}
};
####
{
File => {
Header => {
Contents => { Dictionary => {}, Flags => {}, Properties => {} },
Key => { physical => {} },
Precision => { Dec => { value => 1 }, Units => { value => "mil" } },
Revision => {
"log" => { value => 0 },
oth => { value => 0 },
phy => { value => 0 }
},
Version => { "1.0" => {} },
},
value => "\"foo\"",
},
}
####
#! perl -slw
use strict;
use Data::Dump qw[ pp ];
$|++;
sub seeNextToken {
my( $next ) = $_[0] =~ m[\s*(\S+)];
return $next;
}
sub getNextToken {
$_[0] =~ s[\s*(\S+)\s+][] or die;
return $1;
}
#my $depth = 0;
sub parse { local $^W;
## alias rather than copy the input, so that we can modify it
our $in; local *in = \$_[0];
my $ref = {};
my $token = getNextToken( $in );
die 'No open paren' unless $token eq '(';
my $name = getNextToken( $in );
my $value;
if( seeNextToken( $in ) !~ '[()]' ) {
$value = getNextToken( $in );
}
$ref->{ value } = $value if defined $value;
# printf "%s n:$name v:$value (next:%s) in:$in\n",
' .' x $depth++, seeNextToken( $in );
while( seeNextToken( $in ) eq '(' ) {
my( $name, $value ) = parse( $in );
$ref->{ $name } = $value;
}
die 'Missing close paren' unless getNextToken( $in ) eq ')';
## fix up the single, single anomaly
if( keys( %$ref ) == 1 ) {
my( $key, $value ) = each %$ref;
if( ref $value eq 'HASH' and keys( %$value ) == 0 ) {
delete $ref->{ $key };
$ref->{ value } = $key;
}
}
# --$depth;
return $name, $ref;
}
my $input = do{ local $/; };
$input =~ s[\s+][ ]gsm;
my $ref = { parse( $input ) };
pp $ref;
__DATA__
( File "foo"
( Header
( Key
( physical )
)
( Version
( 1.0 )
)
( Revision
( log 0 )
( phy 0 )
( oth 0 )
)
( Contents
( Flags )
( Dictionary )
( Properties )
)
( Precision
( Units mil )
( Dec 1 )
)
)
)