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 ) ) ) )