Perl Guru Forums: Perl Programming Help: Advanced: Hot to create a hash out of this record....

Home: Perl Programming Help: Advanced:
Hot to create a hash out of this record....

Chetanmeda
New User

Feb 1, 2011, 2:37 AM

Post #1 of 5 (1826 views)

Hot to create a hash out of this record....	Can't Post

I have a sample record like this ...

101<seller_id,><bucket0,<bucket_id,100><cost,<amt,35.00><currency_code,USD>><counter_party,SFJCXFDLNFR5U>>

If you see this record I get Name value pairs inside < > and i get multiple name value pairs. 101 is the id of the record. I may get some more name value inside a name value pair. I want to create a nested hash out of this record. Can someone help me??

BillKSmith
Veteran

Feb 1, 2011, 9:24 AM

Post #2 of 5 (1818 views)

Re: [Chetanmeda] Hot to create a hash out of this record.... [In reply to]	Can't Post

I cannot parse your sample by hand. Would you please do it for us and post the desired hash (preferably in the format used by Data::Dumper).
Good Luck,
Bill

budman
User

Feb 9, 2011, 12:14 AM

Post #3 of 5 (1749 views)

Re: [Chetanmeda] Hot to create a hash out of this record.... [In reply to]	Can't Post

I dont have time now, but you will need to process the record using recursion and branching on each less than character, meanwhile keeping track of a key that you pass to each recursive level. The key will appear as a bread crumb trail ... bucket0:cost:amt = 35 bucket0:cost:currency_code = USD

once you have these keys, subst the colon / key separator with braces, then you can use eval to create the hash.

budman
User

Feb 9, 2011, 8:46 PM

Post #4 of 5 (1715 views)

Re: [budman] Hot to create a hash out of this record.... [In reply to]	Can't Post

Seeing that you have embedded tags, that makes recursion a little difficult. :)

So I tried to tokenize it this way - it works.
You may need to tweak it a little more, but I think it should solve it for you.

Code

#!/usr/bin/perl 
 
use strict; 
use Data::Dumper; 
 
my @lines = ( 
  "101<seller_id,><bucket0,<bucket_id,100><cost,<amt,35.00><currency_code,USD>><counter_party,SFJCXFDLNFR5U>>", 
  "102<seller_id,7783><bucket0,<bucket_id,107><cost,<amt,999.00><currency_code,USD><expiry,>><counter_party,SFJCXFDLNFR5U>><bucket1,<bucket_id,1000><cost,<amt,223.00><currency_code,USD>>>" 
  ); 
 
my %records; 
foreach my $line (@lines) { 
    my %rec = parseRecord($line); 
    print Dumper(\%rec); 
} 
 
sub parseRecord { 
    my ($rec) = @_; 
 
    my $count; 
    (my $t = $rec) =~ s/(<|>)/$count++/eg; 
    die "Error: uneven bracket count\n$rec\n" if $count % 2; 
 
    my ($id) = $rec =~ /^(.*?)</; 
 
    my ($r,@keypath,$field_name); 
    while ($rec) { 
        # check for end of field 
        if ( $rec =~ /^>/ ) { pop @keypath; $rec =~ s/^>//; } 
 
        # grab the field/column name 
        ($field_name,$rec) = $rec =~ /<(.*?),(.*)$/; 
        next unless $field_name; 
 
        # breadcrumb trail 
        my $keyname = join(":",@keypath).(@keypath?':':'').$field_name; 
 
        #print "$id: $keyname : $rec\n"; 
         
        if ( $rec =~ /^</ ) { 
            push @keypath, $field_name; 
        } 
        # assign the value 
        else { 
            my $value; 
            ($value,$rec) = $rec =~ /^(.*?)>(.*)$/; 
            $r->{$keyname} = $value || ''; 
        } 
    } 
     
    # convert trail to hash keys 
    my %Record; 
    foreach my $key (sort keys %$r) { 
        next if grep { /^$key:/ } keys %$r; 
        if ( $key =~ /:/ ) { 
            my $keyname = join("'}{'",split(/:/,$key)); 
            my $str = "\$Record{$id}{'$keyname'} = \$r->{'$key'}"; 
            eval $str;     
        } else { 
            $Record{$id}{$key} = $r->{$key}; 
        } 
    } 
 
    return %Record; 
}

some output

Code

 
$VAR1 = { 
          '101' => { 
                     'bucket0' => { 
                                    'cost' => { 
                                                'currency_code' => 'USD', 
                                                'amt' => '35.00' 
                                              }, 
                                    'counter_party' => 'SFJCXFDLNFR5U', 
                                    'bucket_id' => '100' 
                                  }, 
                     'seller_id' => '' 
                   } 
        }; 
$VAR1 = { 
          '102' => { 
                     'bucket0' => { 
                                    'cost' => { 
                                                'expiry' => '', 
                                                'currency_code' => 'USD', 
                                                'amt' => '999.00' 
                                              }, 
                                    'counter_party' => 'SFJCXFDLNFR5U', 
                                    'bucket_id' => '107' 
                                  }, 
                     'seller_id' => '7783', 
                     'bucket1' => { 
                                    'cost' => { 
                                                'currency_code' => 'USD', 
                                                'amt' => '223.00' 
                                              }, 
                                    'bucket_id' => '1000' 
                                  } 
                   } 
        };

Rich

(This post was edited by budman on Feb 9, 2011, 8:52 PM)

budman
User

Feb 10, 2011, 2:52 PM

Post #5 of 5 (1687 views)

Re: [Chetanmeda] Hot to create a hash out of this record.... [In reply to]	Can't Post

Another approach is to use a stack

Code

#!/ms/dist/perl5/bin/perl5.8 
 
use strict; 
 
 
use Data::Dumper; 
 
my @lines = ( 
    "101<seller_id,><bucket0,<bucket_id,100><cost,<amt,35.00><currency_code,USD>><counter_party,SFJCXFDLNFR5U>>", 
    "102<seller_id,><bucket0,<bucket_id,100><cost,<amt,95.00><currency_code,USD>><counter_party,SFSSDFDLNFR4X>>", 
    ); 
 
my %records; 
 
foreach my $line (@lines) { 
    my %rec = parseRecord($line); 
    $records{$_} = $rec{$_} for keys %rec; 
} 
print Dumper(\%records); 
 
 
 
sub parseRecord { 
    my ($rec) = @_; 
 
    my $count; 
    ( my $t = $rec ) =~ s/(<|>)/$count++/eg; 
    die "Error: unevenly matched brackets\n$rec\n" if $count % 2; 
 
    my ($id) = $rec =~ m/^(.*?)</; 
    print "id:$id\n"; 
 
 
    my ($r,@stack,$collect,$buffer); 
    my @chars = split(/|/,$rec); 
 
    foreach my $c (@chars) { 
        if ( $c eq '<' ) { $collect++ } 
        elsif ( $c eq '>' ) { 
            my $key = join(':',@stack); 
            pop(@stack); 
            $r->{$key} = $buffer; 
            print "$key = $buffer\n"; 
            $buffer = ''; 
            $collect = 0; 
        } 
        elsif ( $c eq ',' ) { push @stack, $buffer; $buffer = '' } 
        elsif ( $collect ) { $buffer .= $c } 
    } 
 
    # convert trail to hash keys 
    my %Record; 
    foreach my $key (sort keys %$r) { 
        next if grep { /^$key:/ } keys %$r; 
        if ( $key =~ /:/ ) { 
            my $keyname = join("'}{'",split(/:/,$key)); 
            my $str = "\$Record{$id}{'$keyname'} = \$r->{'$key'}"; 
            eval $str; 
        } else { 
            $Record{$id}{$key} = $r->{$key} 
        } 
    } 
 
    return %Record; 
 
 
}

Search for (options)

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives


	MAIN INDEX	SEARCH POSTS	WHO'S ONLINE	LOG IN