Path: usenet.cis.ufl.edu!usenet.eel.ufl.edu!news.mathworks.com!news.kei.com!simtel!news.sprintlink.net!in1.uu.net!csnews!alumni.cs.colorado.edu!tchrist
From: Tom Christiansen <tchrist@mox.perl.com>
Newsgroups: comp.lang.perl.misc,comp.lang.perl.announce
Subject: PDSC Recipes for More Elaborate Structures (part 5 of 5)
Followup-To: comp.lang.perl.misc
Date: 2 Oct 1995 01:56:15 GMT
Organization: Perl Consulting and Training
Lines: 111
Approved: tchrist@perl.com
Message-ID: <44ngrv$ol8@csnews.cs.colorado.edu>
References: <44ngca$oiv@csnews.cs.colorado.edu>
Reply-To: tchrist@mox.perl.com (Tom Christiansen)
NNTP-Posting-Host: alumni.cs.colorado.edu
Originator: tchrist@alumni.cs.colorado.edu
Xref: usenet.cis.ufl.edu comp.lang.perl.misc:7633 comp.lang.perl.announce:137


	    PDSC: The Perl Data Structures Cookbook 
		    part 5 of 5: More Elaborate Structures
		    by Tom Christiansen 
		    <tchrist@perl.com>

		    release 0.1 (untested, may have typos)
		    Sunday, 1 October 1995

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:

    # 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->{name} = "flintstones";
    $rec->{nights} = [ find_days() ];

    @members = ();
    # assume this file in field=value syntax
    while (<FLINTSTONES>) {
	%fields = split /[\s=]+/;
	push @members, { %fields };
    }
    $rec->{members} = [ @members ];

    # now remember the whole thing
    $TV{ $rec->{name} } = $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
    ###########################################################
    @kids = ();
    for $person ( @members ) {
	if ($person->{role} =~ /kid|son|daughter/) {
	    push @kids, $person;
	}
    }
    $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

Access and Printing:

    # 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";
    }
}

.