home *** CD-ROM | disk | FTP | other *** search
/ ftp.cse.unsw.edu.au / 2014.06.ftp.cse.unsw.edu.au.tar / ftp.cse.unsw.edu.au / pub / doc / languages / perl / nutshell / ch2 / begat < prev    next >
Encoding:
Text File  |  1992-10-18  |  1.0 KB  |  57 lines
  1. #!/usr/bin/perl
  2.  
  3. open(DESC, "descendants") || die "without issue\n";
  4.  
  5. # Load the kids of Job.
  6.  
  7. &load_kids('');
  8.  
  9. sub load_kids {
  10.     local($parent) = @_;
  11.     local($name);
  12.  
  13.     # Process all the current parent's children.
  14.  
  15.     while (<DESC>) {
  16.     last if /}/;
  17.  
  18.     # Extract name from line with a regular expression.
  19.  
  20.     next unless /(\w.*\w)/;
  21.     $name = $1;
  22.  
  23.     # Use associative array to store a tree.
  24.  
  25.     $parent{$name} = $parent;
  26.  
  27.     # See if this kid has kids.
  28.  
  29.     if (/{/) {
  30.         &load_kids($name);
  31.     }
  32.     }
  33. }
  34.  
  35. # Now we ask which name to print the lineage of, and print it.
  36.  
  37. while (1) {
  38.     print "Who: ";
  39.     chop($who = <STDIN>);
  40.     last unless $who;
  41.     &do_a_begat($who);
  42. }
  43.  
  44. # Recursively follow the tree of parents up to Job, printing
  45. # "begat" lines on the way back down.  (We're really just
  46. # showing off, since we could just as easily have done this
  47. # linear traverse of the tree using an ordinary loop.)
  48.  
  49. sub do_a_begat {
  50.     local($name) = @_;
  51.  
  52.     if ($parent{$name}) {
  53.     &do_a_begat($parent{$name});
  54.     print "$parent{$name} begat $name\n";
  55.    }
  56. }
  57.