Recipes for PDSC #5: More Elaborate Structures

Declaration of MORE ELABORATE RECORDS:

    $rec = {        STRING  => $string,        LIST    => [ @old_values ],        LOOKUP  => { %some_table },        FUNC    => \&some_function,        FANON   => sub { $_[0] ** $_[1] },         FH      => \*STDOUT,    };    print $rec->{STRING};    print $rec->{LIST}[0];    $last = pop @ { $rec->{LIST} };    print $rec->{LOOKUP}{"key"};    ($first_k, $first_v) = each %{ $rec->{LOOKUP} };    $answer = &{ $rec->{FUNC} }($arg);    $answer = &{ $rec->{FANON} }($arg1, $arg2);    # careful of extra block braces on fh ref    print { $rec->{FH} } "a string\n";    use FileHandle;    $rec->{FH}->autoflush(1);    $rec->{FH}->print(" a string\n");

Declaration of a HASH OF COMPLEX RECORDS:

    %TV = (        "flintstones" => {	   series   => "flintstones",	   nights   => [ qw(monday thursday friday) ];	   members  => [	       { name => "fred",    role => "lead", age  => 36, },	       { name => "wilma",   role => "wife", age  => 31, },	       { name => "pebbles", role => "kid", age  =>  4, },	   ],       },       "jetsons"     => {	   series   => "jetsons",	   nights   => [ qw(wednesday saturday) ];	   members  => [	       { name => "george",  role => "lead", age  => 41, },	       { name => "jane",    role => "wife", age  => 39, },	       { name => "elroy",   role => "kid",  age  =>  9, },	   ],	},       "simpsons"    => { 	   series   => "simpsons",	   nights   => [ qw(monday) ];	   members  => [	       { name => "homer", role => "lead", age  => 34, },	       { name => "marge", role => "wife", age => 37, },	       { name => "bart",  role => "kid",  age  =>  11, },	   ],	},     );

Generation of a HASH OF COMPLEX RECORDS:

    # reading from file    # this is most easily done by having the file itself be     # in the raw data format as shown above.  perl is happy    # to parse complex datastructures if declared as data, so    # sometimes it's easiest to do that    # here's a piece by piece build up    $rec = {};    $rec->{series} = "flintstones";    $rec->{nights} = [ find_days() ];    @members = ();    # assume this file in field=value syntax    while () {	%fields = split /[\s=]+/;	push @members, { %fields };    }    $rec->{members} = [ @members ];    # now remember the whole thing    $TV{ $rec->{series} } = $rec;    ###########################################################    # now, you might want to make interesting extra fields that    # include pointers back into the same data structure so if    # change one piece, it changes everywhere, like for examples    # if you wanted a {kids} field that was an array reference    # to a list of the kids' records without having duplicate    # records and thus update problems.      ###########################################################    foreach $family (keys %TV) { 	$rec = $TV{$family}; # temp pointer 	@kids = ();	for $person ( @{$rec->{members}} ) {	    if ($person->{role} =~ /kid|son|daughter/) {		push @kids, $person;	    }	}	# REMEMBER: $rec and $TV{$family} point to same data!!	$rec->{kids} = [ @kids ];      }    # you copied the list, but the list itself contains pointers    # to uncopied objects. this means that if you make bart get     # older via    $TV{simpsons}{kids}[0]{age}++;    # then this would also change in     print $TV{simpsons}{members}[2]{age};    # because $TV{simpsons}{kids}[0] and $TV{simpsons}{members}[2]    # both point to the same underlying anonymous hash table    # print the whole thing     foreach $family ( keys %TV ) {	print "the $family";	print " is on during @{ $TV{$family}{nights} }\n";	print "its members are:\n";	for $who ( @{ $TV{$family}{members} } ) {	    print " $who->{name} ($who->{role}), age $who->{age}\n";	}	print "it turns out that $TV{$family}{'lead'} has ";	print scalar ( @{ $TV{$family}{kids} } ), " kids named ";	print join (", ", map { $_->{name} } @{ $TV{$family}{kids} } );	print "\n";    }