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 / ch6 / cleanup < prev    next >
Encoding:
Text File  |  1992-10-18  |  2.9 KB  |  121 lines
  1. #!/usr/bin/perl
  2.  
  3. (chdir '/usr/spool/news') || die "Can't cd to /usr/spool/news";
  4. $now = time;
  5. $| = 1;
  6.  
  7. ($dev,$ino,$mode,$nlink) = stat('.');
  8.  
  9. &dodir('.',$nlink);
  10.  
  11. exit 0;
  12.  
  13. ###############################################################
  14.  
  15. sub dodir {
  16.     local($dir,$nlink) = @_;
  17.     local($dev,$ino,$mode,$time,$cutoff);
  18.  
  19.     $dir =~ s#^\./##;
  20.  
  21.     # Determine number of days to keep articles in group.
  22.  
  23.     $time = 14;
  24.     $time = 3   if $dir =~ /^(junk|control)/;
  25.     $time = 8   if $dir =~ /^talk/;
  26.     $time = 8   if $dir =~ /^rec/;
  27.     $time = 28  if $dir =~ /^comp/;
  28.     $time = 10  if $dir =~ /^sci/;
  29.     $time = 50  if $dir =~ /^comp\.sources\.(unix|misc|bugs)/;
  30.     $time = 50  if $dir =~ /^comp\.sys\.(sun|pyramid|amiga)/;
  31.     $time = 50  if $dir =~ /^comp\.windows\.x/;
  32.     $time = 50  if $dir =~ /^comp\.unix\.wizards/;
  33.     $time = 60  if $dir =~ /^comp\.lang\.perl/;
  34.     $time = 50  if $dir =~ /^comp\.bugs/;
  35.     $time = 50  if $dir =~ /^comp\.sources\.bugs/;
  36.     $time = 365 if $dir =~ /^proj/;
  37.     $cutoff = $now - $time * (60 * 60 * 24);
  38.  
  39.     # Get all the filenames in current directory handy.
  40.     # We use readdir() instead of <*> because it doesn't start
  41.     # a subshell and won't blow up on huge directories.
  42.  
  43.     opendir(DIR,'.') || die "Can't open $dir";
  44.     local(@filenames) = readdir(DIR);
  45.     closedir(DIR);
  46.  
  47.     # Separate the sheep from the goats.
  48.  
  49.     local(@subdirs);
  50.     local(@articles);
  51.     for (@filenames) {
  52.     if (/^\d+$/) {
  53.         push(@articles,$_); # Possibly a lie, but avoid stat.
  54.     }
  55.     else {
  56.         push(@subdirs,$_);
  57.     }
  58.     }
  59.  
  60.     # Look for articles to expire.
  61.  
  62.     if ($#articles >= 0) {
  63.     @articles = sort bynumber @articles;
  64.  
  65.     # Now the tricksy part.  Since the @articles array is
  66.     # now in age order, we binary search for articles to
  67.     # expire.  At the end of this loop, $min should be
  68.     # first non-expiring article
  69.  
  70.     $max = $#articles;
  71.     $min = 0;
  72.     while ($max - $min > 0) {
  73.         $mid = int(($max + $min) / 2);
  74.         ($dev,$ino,$mode,$nl,$uid,$gid,$rdev,$size,$atime,
  75.         $mtime,$ctime) = stat($articles[$mid]);
  76.         if ($dev == 0) {
  77.         $min = -1;
  78.         print STDERR "$dir changed--skipping!\n";
  79.         }
  80.         elsif (-d _) {
  81.         push(@subdirs, $mid);   # Oops, a directory.
  82.         $min = -1;             # Punt this time.
  83.         }
  84.         elsif ($mtime >= $cutoff) { # $mid is not expiring
  85.         $max = $mid;
  86.         }
  87.         else {                      # $mid is expiring
  88.         $min = $mid + 1;
  89.         }
  90.     }
  91.  
  92.     # Zap any expired articles.
  93.  
  94.     if ($min > 0) {
  95.         print "$dir: $articles[0] .. $articles[$min-1]\n";
  96.         unlink @articles[ 0 .. $min-1 ];
  97.     }
  98.     else {
  99.         print "$dir: (none)\n";
  100.     }
  101.     }
  102.     if ($nlink != 2) {          # This dir has subdirectories.
  103.     for (@subdirs) {
  104.         next if $_ eq '.';
  105.         next if $_ eq '..';
  106.         $name = "$dir/$_";
  107.  
  108.         ($dev,$ino,$mode,$nlink) = stat($_);
  109.         next unless -d _;
  110.  
  111.         chdir $_ || die "Can't cd to $name";
  112.         &dodir($name,$nlink);
  113.         chdir '..';
  114.     }
  115.     }
  116. }
  117.  
  118. sub bynumber {
  119.     $a <=> $b;
  120. }
  121.