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 <[email protected]>
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: [email protected]
Message-ID: <[email protected]>
References: <[email protected]>
Reply-To: [email protected] (Tom Christiansen)
NNTP-Posting-Host: alumni.cs.colorado.edu
Originator: [email protected]
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
                   <[email protected]>

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