Hashes of Arrays - Relationship 1

[Extension]

Hi,

I trying to build hashes of arrays in order to populate a recursive relationship structure based on two flat files. (See expected results at the bottom)
The first flat file contains the "Parents" data and the second flat file contains the "Childs" data. (See below for data)

I'm currently using multiple arrays to populate this structure, so as you may already know this takes alot of time to generate.

So will an hash of arrays be a good solution for this. Any guidance or help would be appreciated.


DATA

__GROUPDATA__
ID|ABBR|ALTERNATE|ADDRESS|CITY|PARENT_ID|ACTIVE
12|ITT|IIT Alternate|390 Long View|Lisbon|36|1
14|ABG|ABG Alternate|22009 Routa Technica|Citoplo|12|1
16|FFQ|FFQ Alternate|230 River Road|River City|12|1
18|LPP|LPP Alternate|90293 Tera Nosta Mud Road|Mud City|36|1
20|GKQ|GKQ Alternate|232 Portee Road|Potish|16|1
22|TIO|TIO Alternate|454 Looish|Sustone|18|1
24|TRP|TRP Alternate|333 Nesbitt Road|Grey City|18|1
26|REE|REE Alternate|923 Hunty Avenue|Hungstead|18|1
28|TLP|TLP Alternate|730 Lumberg|Houstonish|22|1
30|TAA|TAA Alternate|40222 Laponte|Loomis|22|1
32|TRR|TRR Alternate|2290 Rescto|Ohia|26|1
36|QWE|QWE Alternate|2090 Bolton Road|Redmond| |1


___SUBGROUPDATA__
ID|NAME|JOB|PARENT_ID|ACTIVE
120|Terry Turbo|Stapler Expect|14|1
122|Bobby George|Stapler Expect|20|1
124|Paul Danan|Stapler Expect|20|1
126|Barry Castagnola|Stapler Expect|22|1
128|Jordan Long|Stapler Expect|22|1
130|Norris Windross|Stapler Expect|28|1
132|Adam Saint|Stapler Expect|28|1
134|Adam Peacoc|Stapler Expect|26|1
136|Myfanwy Waring|Stapler Expect|26|1
138|Alexander Newland|Stapler Expect|32|1

Expected output
In bold is GROUP DATA (Parents)
In non-bold is SUB GROUP DATA (Childs)

[b]- [36] QWE / QWE Alternate (2090 Bolton Road, Redmond)[/b]

	[b]- [12] ITT / IIT Alternate (390 Long View, Lisbon)[/b]
		[b]- [14] ABG / ABG Alternate (22009 Routa Technica, Citoplo)[/b]
		  + [120] Terry Turbo (Stapler Expect)
		[b]- [16] FFQ / FFQ Alternate (230 River Road, River City)[/b]
			[b]- [20] GKQ /GKQ Alternate (232 Portee Road, Potish)
			  + [122] Bobby George (Stapler Expect)
			  + [124] Paul Danan (Stapler Expect)
		
	[b]- [18] LPP / LPP Alternate (90293 Tera Nosta Mud Road, Mud City)[/b]
		[b]- [22] TIO /TIO Alternate (454 Looish, Sustone)[/b]
		  + [126] Barry Castagnola (Stapler Expect)
		  + [128] Jordan Long (Stapler Expect)
			[b]- [28] TLP / TLP Alternate (730 Lumberg, Houstonish)[/b]
			  + [130] Norris Windross (Stapler Expect)
			  + [132] Adam Saint (Stapler Expect)
			[b]- [30] TAA / TAA Alternate (40222 Laponte, Loomis)[/b]
		[b]- [24] TRP / TRP Alternate (333 Nesbitt Road, Grey City)[/b]
		[b]- [26] REE / REE Alternate (923 Hunty Avenue, Hungstead)[/b]
		  + [134] Adam Peacoc (Stapler Expect)
		  + [136] Myfanwy Waring (Stapler Expect)
			[b]- [32] TRR / TRR Alternate (2290 Rescto, Ohia)[/b]
			  + [138] Alexander Newland (Stapler Expect)

Thank you in advance

 

[jonadab]

I have taken the liberty of refactoring this a bit...

#!/usr/bin/perl -wT
# -*- cperl -*-
use strict; use warnings; use Data::Dumper;

my %data;

# First, describe the data:
my %rectype =
  (
   group => +{
              # Change * to + if fields are not allowed to be empty:
              regex  => qr/(\d+)[|]([^|]*)[|]([^|]*)[|]([^|]*)[|]([^|]*)[|]([^|]*)[|]([^|])/,
              fields => [qw(ID ABBR ALTERNATE ADDRESS CITY PARENT ACTIVE)],
              file   => 'group.dat',
              order  => 2,
              prefix => '- ',
              print  => sub {
                my ($node) = @_;
                return '['.$data{$node}{ID}.'] '
                  . $data{$node}{ABBR}
                  . ($data{$node}{ALTERNATE} ? ' / '. $data{$node}{ALTERNATE} : '')
                  . ' ('.$data{$node}{ADDRESS}.','.$data{$node}{CITY}.')'
              },
             },
   subgroup => +{
                 regex  => qr/(\d+)[|]([^|]*)[|]([^|]*)[|]([^|]*)[|]([^|]*)/,
                 fields => [qw(ID NAME JOB PARENT ACTIVE)],
                 file   => 'subgroup.dat',
                 order  => 1,
                 prefix => '+ ',
                 print  => sub {
                   my ($node) = @_;
                   return '['.$data{$node}{ID}.'] '
                     . $data{$node}{NAME}
                     . ' ('.$data{$node}{JOB}.')'
                 },
                },
  );

# Now actually read them:
for my $type (keys %rectype) {
  open FILE, $rectype{$type}{file};
  while ((<FILE>)) { parse($_, $type); }
}

# Now, organise them into a tree:
my @root; # holds top-level nodes.
for my $k (grep {$data{$_}{ID}} keys %data) {
  if ($data{$k}{PARENT} =~ /\d+/) {
    # It is a branch or leaf.
    # Add it to the children list for its parent:
    push @{$data{$data{$k}{PARENT}}{CHILDREN}}, $k;
  } else {
    # Nodes with no parent are top-level:
    push @root, $k;
  }}

# Print out the results:

for (@root) {
  print_tree($_, '');
}

exit 0; # Subroutines follow:

sub print_tree {
  my ($node, $indent) = @_;
  print $indent
    . $rectype{$data{$node}{RECTYPE}}{prefix}
    . $rectype{$data{$node}{RECTYPE}}{print}->($node)
    . "\n";
  for my $child (sort
                 {
                   ($data{$a}{NAME} || $data{$a}{ABBR})
               cmp ($data{$b}{NAME} || $data{$b}{ABBR})
             } @{$data{$node}{CHILDREN}}) {
    print_tree($child, '   |' . $indent);
  }
}

sub parse {
  my ($line, $type) = @_; chomp $line;
  my %record;
  ((@record{@{$rectype{$type}{fields}}}) = $line =~ $rectype{$type}{regex})
    or warn "parse failed for $type: $line";
  $record{RECTYPE} = $type;
  $record{CHILDREN} ||= [];
  $data{$record{ID}} = \%record;
}
__END__

 

[jonadab]

Output:

- [119] TEST 119 / TEST 119 (PPR119A,PPR119B)
   |- [121] TEST 121 / TEST 121 (PPR121A,PPR121B)
   |   |- [14] TEST 14 / TEST 14 (PPR14A,PPR14B)
   |   |   |- [113] TEST 113 / TEST 113 (PPR113A,PPR113B)
   |   |   |   |+ [220] TT (TT-A)
   |   |   |- [114] TEST 114 / TEST 114 (PPR114A,PPR114B)
   |   |   |   |+ [222] BG (BG-A)
   |   |   |- [115] TEST 115 / TEST 115 (PPR115A,PPR115B)
   |   |   |- [123] TEST 123 / TEST 123 (PPR123A,PPR123B)
   |- [122] TEST 122 / TEST 122 (PPR122A,PPR122B)
   |   |- [11] TEST 11 / TEST 11 (PPR11A,PPR11B)
   |   |   |- [118] TEST 118 / TEST 118 (PPR118A,PPR118B)
   |   |   |   |+ [236] MW (MW-A)
   |   |- [13] TEST 13 / TEST 13 (PPR13A,PPR13B)
   |   |- [15] TEST 15 / TEST 15 (PPR15A,PPR15B)
   |   |   |+ [234] AP (AP-A)
   |   |- [16] TEST 16 / TEST 16 (PPR16A,PPR16B)
   |   |   |+ [232] AS (AS-A)
   |   |   |+ [230] NW (NW-A)
   |   |- [17] TEST 17 / TEST 17 (PPR17A,PPR17B)
   |   |   |+ [226] BC (BC-A)
   |   |   |+ [228] JL (JL-A)
   |- [126] TEST 126 / TEST 126 (PPR126A,PPR126B)
   |   |- [139] TEST 139 / TEST 139 (PPR139A,PPR139B)
   |   |   |- [147] TEST 147 / TEST 147 (PPR147A,PPR147B)
   |   |   |   |+ [224] PD (PD-A)

 

[KevinADC]

Hi jonadab,

Impressive bit of code.

 

[dmazzini]

It's a nice code jonadab.

First time that I see regex inside hashes.

Amazing !

dmazzini
GSM System and Telecomm Consultant