home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / boss < prev    next >
Encoding:
Text File  |  1993-07-14  |  3.6 KB  |  188 lines
  1. #!/usr/bin/perl 
  2. #
  3. # boss, peon - who works for whom
  4. #
  5. # tom christiansen, 25 Oct
  6. #
  7. # given a data file with (peon boss) pairs, 
  8. # fetch peons of a given boss, or boss of a
  9. # given peon boss.  recurse all the way with -r,
  10. # limit depth with -2, -3, etc.  
  11.  
  12.  
  13. $DATA = "/usr/spool/globdata/etc/reports_to";
  14.  
  15. sub usage {
  16.     print STDERR <<EOM;
  17. usage: $0 [-$opts] [user ...]
  18.     -#    recursion depth
  19.     -r     recurse all the way
  20.     -b    boss
  21.     -e    empl (also -p)
  22.     -a    list all
  23.     -s    sort
  24.     -v    verbose
  25.     -d    debug
  26.     -B    rebuild databases
  27.     -F db    alternate database
  28. EOM
  29.     exit 2;
  30. } 
  31.  
  32. MAIN: {
  33.  
  34.     do 'getopts.pl' || die "can't do getopts.pl: " . ($@? $@ : $!); 
  35.     $opts = 'vasbBepdr123456789F:';
  36.     &Getopts($opts) || &usage;
  37.  
  38.     if ($opt_r) {
  39.     $maxdepth = 100;
  40.     } else {
  41.     for $i (reverse 1..9) {
  42.         if (eval "defined \$opt_$i") {
  43.         $maxdepth = $i;
  44.         last;
  45.         } 
  46.     } 
  47.     }
  48.  
  49.     $sort = $opt_s;
  50.     $debug = $opt_d;
  51.     $verbose = $opt_v;
  52.     $listall = $opt_a;
  53.  
  54.     $want = 'boss' if $opt_b;
  55.     $want = 'peon' if $opt_p || $opt_e; 
  56.     $rebuild = $opt_B;
  57.  
  58.     if ($0 =~ m#/?boss[^/]*$#) {
  59.     $want = 'boss';
  60.     } elsif ($0 =~ m#/?(empl|peon)[^/]*$#) {
  61.     $want = 'peon';
  62.     } elsif (!$want) {
  63.     warn "$0: neither boss nor empl specified\n";
  64.     &usage;
  65.     } 
  66.  
  67.     if ($listall && @ARGV) {
  68.     warn "$0: explicit list conflict with request to list all\n";
  69.     &usage;
  70.     } 
  71.  
  72.     $DATA = $opt_F || $ENV{'peersfile'} || $DATA;
  73.  
  74.     &init;
  75.  
  76.     *which = eval "*$want";    # create alias
  77.  
  78.     if ($listall) {
  79.     @ARGV = sort grep (!/ /,keys %which);
  80.     $verbose = 1;
  81.     } 
  82.  
  83.     for $target (@ARGV) {
  84.      local(%duplicate);
  85.      if (!defined $boss{$target} && !defined $peon{$target}) {
  86.         warn "$0: $target unknown\n";
  87.         next;
  88.      } 
  89.      @list = &traverse($target);
  90.      @list = sort @list if $sort;
  91.      print "$target: " if $verbose;
  92.      print join(' ',@list) if @list;
  93.      print "\n" if $verbose || @list;
  94.     } 
  95.  
  96.     exit 0;
  97. }; # end main
  98.  
  99. sub traverse {
  100.     local(%seen, @who, $user, @newlist, @tmplist);
  101.  
  102.     $depth++;
  103.  
  104.     @who = @_;
  105.  
  106.     foreach $user (@who) {
  107.     next if $duplicate{$user}++;
  108.  
  109.     @tmplist = split(' ',$which{$user});
  110.     print "$depth $want of $user is <@tmplist>\n"
  111.         if $debug && @tmplist;
  112.  
  113.     push (@tmplist, &traverse(@tmplist)) if $maxdepth > $depth;
  114.     push(@newlist,@tmplist);
  115.     } 
  116.  
  117.     print "$depth returning $want of <@who> as <@newlist>\n" 
  118.     if $debug && @newlist && @who == 1;
  119.  
  120.     $depth--;
  121.  
  122.     return grep(!$seen{$_}++,@newlist);
  123. } 
  124.  
  125. sub rebuild {
  126.     warn "$0: rebuilding DB from $DATA\n";
  127.     &opendb('writing');
  128.     %boss = %peon = ();
  129.     open DATA || die "can't open $DATA: $!";
  130.     while (<DATA>) {
  131.     split;
  132.     next if $#_ > 1;
  133.     ($peon, $boss) = @_;
  134.     $peon{$boss} .= ' ' . $peon;
  135.     $boss{$peon} .= ' ' . $boss;
  136.     } 
  137.     &closedb;
  138. }
  139.  
  140. sub init {
  141.  
  142.     local($data_age, $base, $page);
  143.     
  144.     $data_age = &age($DATA);
  145.     $bage     = &age("$DATA.boss.pag");
  146.     $page     = &age("$DATA.peon.pag");
  147.  
  148.     if ($rebuild || ($bage < $data_age) || ($page < $data_age)) {
  149.     &rebuild;
  150.     }
  151.     &opendb('reading');
  152. } 
  153.  
  154. sub closedb {
  155.     dbmclose(boss) || die "$0: can't dbmclose boss: $!\n";
  156.     dbmclose(peon) || die "$0: can't dbmclose peon: $!\n";
  157. } 
  158.  
  159. sub opendb {
  160.     local($mode) = @_;
  161.  
  162.     do _opendb('boss');
  163.     do _opendb('peon');
  164. } 
  165.  
  166. sub _opendb {
  167.     local($what) = @_;
  168.     local($file) = $DATA . '.' . $what;
  169.  
  170.     if ($mode eq 'writing') {
  171.     for $ext ('pag', 'dir') {
  172.         open(FILE, ">$file.$ext") || die "can't write $file.$ext\n";
  173.         close FILE;
  174.     }
  175.     } 
  176.  
  177.     eval <<EO_EVAL;
  178.     dbmopen($what, "$file", \$mode eq 'writing' ? 0644 : 0444) 
  179.         || die "$0: can't dbmopen $file for \$mode: \$!\n";
  180. EO_EVAL
  181.     die $@ if $@;
  182.  
  183. } 
  184.  
  185. sub age { 
  186.     return (stat($_[0]))[9];
  187. }
  188.