home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / burstali < prev    next >
Encoding:
Text File  |  1989-08-13  |  3.0 KB  |  137 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # $Log
  4.  
  5. ($me = $0) =~ s,^.*/([^/]+)$,$1,;
  6. $v=1;
  7.  
  8. while (<>) {
  9.     chop;
  10.     unless ( /^[^#]/ && /^(\S+):(.*)/ ) {
  11.     print $_, "\n";
  12.     next;
  13.     }
  14.     $aliases{$alias = $1}++;
  15.     if (! ($rhs = $2)) {
  16.     print stderr "null rhs to $alias, assuming nobody\n";
  17.     print "$alias: nobody\n";
  18.     $errors++;
  19.     next;
  20.     } 
  21.     if ($aliases{$alias} > 1) {
  22.     $errors++;
  23.     if ($aliases{$alias} == 2) {
  24.         print stderr "skipping dup lhs: $_\n";
  25.     } else { 
  26.         $suppressed++;
  27.     } 
  28.     next;
  29.     } 
  30.     if ( /:include:(\S+)$/ ) {
  31.     $file = $1;
  32.     if ((($st_dev, $st_ino, $st_mode, $st_nlink, 
  33.           $st_uid, $st_gid, $st_rdev, $st_size, 
  34.           $st_atime, $st_mtime, $st_ctime, 
  35.           $st_blksize, $st_blocks) = stat($file)) != 13) {
  36.             print stderr "error expanding $alias: stat $file: $!\n";
  37.             $errors++;
  38.             next;
  39.            } ;
  40.     if ($st_size > 1024) { 
  41.           #printf stderr 
  42.         #"include file for \"%s\" too big (%d) -- expansion would break dbm\n",
  43.         #$alias, $st_size;
  44.         printf "%s\n", $_;
  45.         $count++;
  46.         $errors++;
  47.         $toobig++;
  48.         next;
  49.     } 
  50.     if (!open file) {
  51.         print stderr "error expanding $alias: open $file: $!\n";
  52.         $errors++;
  53.         next;
  54.     } 
  55.     $newalias = "";
  56.     $printed = 0;
  57.     reset 'n'; # clear name array of people seen on this alias
  58.     $len = length($alias) + 2;
  59.     while ($lhs = <file>) {
  60.         chop($lhs);
  61.         $lhs =~ s/#.*//;
  62.         next unless $lhs;
  63.         next if $name{$lhs}++;;
  64.         if (! $printed) {
  65.         $newalias .= "$alias: ";
  66.         }  else { # continuation
  67.         if ($len + length($lhs) > 77) {
  68.             $newalias .= ",\n\t";
  69.             $len = 8;
  70.         } else {
  71.             $newalias .= "," if $printed;
  72.             $len += 2;
  73.         }
  74.         }
  75.         $newalias .= $lhs;
  76.         $len += length($lhs);
  77.         $printed++;
  78.     } 
  79.     close file;
  80.     if (($alisize = length($newalias)) > 1024) {
  81.           #printf stderr 
  82.         #"post-burst alias \"%s\" too big (%d) -- expansion would break dbm\n",
  83.         #$alias, $alisize;
  84.         printf "%s\n", $_;
  85.         $count++;
  86.         $errors++;
  87.         $toobig++;
  88.         next;
  89.     }
  90.     printf "%s\n", $newalias;
  91.     if (!$printed) {
  92.         print stderr "null rhs to $alias, assuming nobody\n";
  93.         print "$alias: nobody\n";
  94.         $errors++;
  95.     } else {
  96.         print "\n";
  97.     } 
  98.     $count++;
  99.     next;
  100.     } 
  101.     if ( s/(\s+)$// ) {
  102.     print stderr "trimmed trailing whitespace on $alias\n";
  103.     $errors++;
  104.     }  
  105.     if ($rhs eq 'nonuser' || $rhs eq 'exuser') {
  106.     
  107.     } 
  108.     printf "%s\n", $_;
  109.     $count++;
  110. } 
  111.  
  112. printf stderr "%s: processed %d legit alias%s", 
  113.         $me, $count, ($count != 1) ? "es" : "";
  114.  
  115. if ($errors) { 
  116.     printf stderr ": %d problem%s", $errors, do S($errors);
  117.     if ($suppressed || $toobig) {
  118.     $serious = $errors - ($suppressed + $toobig);
  119.     printf stderr "\n\t%4d serious error%s",$serious,do S($serious);
  120.     $suppressed &&
  121.         (printf stderr "\n\t%4d dup%s not printed", 
  122.             $suppressed, do S($suppressed));
  123.     $toobig &&
  124.         printf stderr "\n\t%4d include%s too big for dbm to swallow", 
  125.             $toobig, do S($toobig);
  126.     }
  127. }
  128.  
  129. print stderr "\n";
  130.  
  131. exit ($errors != 0);
  132.  
  133. sub S {
  134.     local($count) = @_;
  135.     ($count == 1) ? "" : "s";
  136. } 
  137.