home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 13 / AACD13.ISO / AACD / Online / wget / util / rmold.pl < prev    next >
Perl Script  |  1998-08-23  |  2KB  |  93 lines
  1. #! /usr/bin/perl -w
  2.  
  3. # Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
  4.  
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9.  
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14.  
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19.  
  20. # This script is a very lame hack to remove local files, until the
  21. # time when Wget proper will have this functionality.
  22. # Use with utmost care!
  23.  
  24. # If the remote server supports BSD-style listings, set this to 0.
  25. $sysvlisting = 1;
  26.  
  27. $verbose = 0;
  28.  
  29. if (@ARGV && ($ARGV[0] eq '-v')) {
  30.     shift;
  31.     $verbose = 1;
  32. }
  33.  
  34. defined($dirs[0] = shift) || ($dirs[0] = '.');
  35. while (defined($_ = shift)) {
  36.     @dirs = (@dirs, $_);
  37. }
  38.  
  39. foreach $_ (@dirs) {
  40.     &procdir($_);
  41. }
  42.  
  43. # End here
  44.  
  45. sub procdir
  46. {
  47.     local($dir = $_[0]);
  48.     local(@lcfiles, @lcdirs, %files, @fl);
  49.  
  50.     print STDERR "Processing directory '$dir':\n" if $verbose;
  51.     
  52.     opendir(DH, $dir) || die("Cannot open $dir: $!\n");
  53.     @lcfiles = ();
  54.     @lcdirs = ();
  55.     # Read local files and directories.
  56.     foreach $_ (readdir(DH)) {
  57.         /^(\.listing|\.\.?)$/ && next;
  58.         if (-d "$dir/$_" || -l "$dir/$_") {
  59.             @lcdirs = (@lcdirs, $_);
  60.         }
  61.         else {
  62.             @lcfiles = (@lcfiles, $_);
  63.         }
  64.     }
  65.     closedir(DH);
  66.     # Parse .listing
  67.     if (open(FD, "<$dir/.listing")) {
  68.         @files = ();
  69.         while (<FD>)
  70.         {
  71.             # Weed out the line beginning with 'total'
  72.             /^total/ && next;
  73.             # Weed out everything but plain files and symlinks.
  74.             /^[-l]/ || next;
  75.             @fl = split;
  76.             $files{$fl[7 + $sysvlisting]} = 1;
  77.         }
  78.         close FD;
  79.         foreach $_ (@lcfiles) {
  80.             if (!$files{$_}) {
  81.                 print "$dir/$_\n";
  82.             }
  83.         }
  84.     }
  85.     else {
  86.         print STDERR "Warning: $dir/.listing: $!\n";
  87.     }
  88.     foreach $_ (@lcdirs) {
  89.         &procdir("$dir/$_");
  90.     }
  91. }
  92.  
  93.