in reply to Getting hash key tree
Something like this?
#!/usr/bin/perl # https://perlmonks.org/?node_id=1226425 use strict; use warnings; my %hash; my ($header, @rules) = grep /\w/, <DATA>; my (undef, @fieldnames) = $header =~ /\w+/g; findnext(\%hash, 1, 'A', '00'); use Data::Dump 'dd'; dd \%hash; sub findnext { my ($refh, $rule, $stage1, $stage2) = @_; for my $row (@rules) { if($row =~ /^\W+(\w+)\W+$rule\W+$stage1\W+$stage2\W+(\w+)\W+(\w+)\ +W+(\w+)/) { my ($return, $nextrule, $nextstage1, $nextstage2) = ($1, $2, $3, + $4); my %values; @values{@fieldnames} = ($rule, $stage1, $stage2, $nextrule, $nextstage1, $nextstage2) +; $refh->{$return}{ROWDATA} = \%values; findnext($refh->{$return}, $nextrule, $nextstage1, $nextstage2); } } } __DATA__ * return * rule * stage1 * stage2 * next_rule * next_stage1 * next_sta +ge2 * ********************************************************************** +***** * ret1 * 1 * A * 00 * 2 * B * + 10 * * ret2 * 1 * A * 00 * 5 * D * + 23 * * bob1 * 2 * B * 10 * 5 * D * + 23 * * bob2 * 2 * B * 10 * 6 * E * + 44 * * dog1 * 3 * B * 10 * 6 * E * + 44 * * dog2 * 4 * C * 10 * 6 * E * + 44 * * cat1 * 5 * D * 23 * 7 * F * + 55 * * cat2 * 5 * D * 23 * 7 * F * + 56 * * cat3 * 5 * D * 23 * 7 * F * + 57 * * hit1 * 6 * E * 44 * 7 * G * + 55 * * hit1 * 6 * K * 14 * 7 * H * + 55 * * hit2 * 6 * E * 44 * 7 * G * + 56 * ********************************************************************** +*****
Outputs:
{ ret1 => { bob1 => { cat1 => { ROWDATA => { next_rule => 7, next_stage1 => "F", next_stage2 => 55, rule => 5, stage1 => "D", stage2 => 23, }, }, cat2 => { ROWDATA => { next_rule => 7, next_stage1 => "F", next_stage2 => 56, rule => 5, stage1 => "D", stage2 => 23, }, }, cat3 => { ROWDATA => { next_rule => 7, next_stage1 => "F", next_stage2 => 57, rule => 5, stage1 => "D", stage2 => 23, }, }, ROWDATA => { next_rule => 5, next_stage1 => "D", next_stage2 => 23, rule => 2, stage1 => "B", stage2 => 10, }, }, bob2 => { hit1 => { ROWDATA => { next_rule => 7, next_stage1 => "G", next_stage2 => 55, rule => 6, stage1 => "E", stage2 => 44, }, }, hit2 => { ROWDATA => { next_rule => 7, next_stage1 => "G", next_stage2 => 56, rule => 6, stage1 => "E", stage2 => 44, }, }, ROWDATA => { next_rule => 6, next_stage1 => "E", next_stage2 => 44, rule => 2, stage1 => "B", stage2 => 10, }, }, ROWDATA => { next_rule => 2, next_stage1 => "B", next_stage2 => 10, rule => 1, stage1 => "A", stage2 => "00", }, }, ret2 => { cat1 => { ROWDATA => { next_rule => 7, next_stage1 => "F", next_stage2 => 55, rule => 5, stage1 => "D", stage2 => 23, }, }, cat2 => { ROWDATA => { next_rule => 7, next_stage1 => "F", next_stage2 => 56, rule => 5, stage1 => "D", stage2 => 23, }, }, cat3 => { ROWDATA => { next_rule => 7, next_stage1 => "F", next_stage2 => 57, rule => 5, stage1 => "D", stage2 => 23, }, }, ROWDATA => { next_rule => 5, next_stage1 => "D", next_stage2 => 23, rule => 1, stage1 => "A", stage2 => "00", }, }, }
|
|---|