home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / scripts / recdel < prev    next >
Encoding:
Text File  |  1998-07-14  |  3.2 KB  |  187 lines
  1. #!perl -w
  2. # Version 0.01
  3. eval 'use RISCOS::Filespec' if $^O eq 'riscos';
  4. # use RISCOS::File qw(globlist);
  5. use File::Compare;
  6.  
  7. package file;
  8. use strict;
  9.  
  10. sub new {
  11.     my $proto = shift;
  12.     my $class = ref($proto) || $proto;
  13.     my $self  = {};
  14.     my $name  = shift;
  15.     my $num   = shift;
  16.     my $size  = shift;
  17.     my $del   = shift;
  18.  
  19.     return undef unless defined $name;
  20.  
  21.     $self->{'__NAME'} = $name;
  22.     $self->{'__NUM'} = $num;
  23.     $self->{'__SIZE'} = $size;
  24.     $self->{'__DEL'} = 0 + $del;
  25.     bless ($self, $class);
  26. }
  27.  
  28. sub Name {
  29.     my $self = shift;
  30.     $self->{__NAME};
  31. }
  32.  
  33. sub Number {
  34.     my $self = shift;
  35.     $self->{__NUM} = $_[0] if (defined $_[0]);
  36.     $self->{__NUM};
  37. }
  38.  
  39. sub Del {
  40.     my $self = shift;
  41.     $self->{__DEL};
  42. }
  43.  
  44. sub Size {
  45.     my $self = shift;
  46.     $self->{__SIZE};
  47. }
  48.  
  49. package main;
  50.  
  51. use vars qw (@files);
  52.  
  53. sub pathname {
  54.     my $path = shift;
  55.     $path =~ s/\s+$//;
  56.     if ($^O eq 'riscos') {
  57.     $path .= '.' unless $path =~ /[:\.]$/;
  58.     } else {
  59.     $path .= '/' unless $path =~ /\/$/;
  60.     }
  61.     return $path . $_[0] unless wantarray;
  62.  
  63.     my @result;
  64.     foreach (@_)
  65.     {
  66.     push @result, $path . $_;
  67.     warn $path . $_;
  68.     }
  69.  
  70.     @result;
  71. }
  72.  
  73. sub add {
  74.     my $count = shift;
  75.     my $del = shift;
  76.  
  77.     foreach (@_)
  78.     {
  79.     if (-d $_) {
  80.         add ($count, $del, glob (pathname ($_, '*')))
  81.     } elsif (-f _) {
  82.         push @files, new file ($_, $count, -s _, $del);
  83.     } else {
  84.         warn "No such file '$_'\n";
  85.     }
  86.     }
  87. }
  88.  
  89. sub dump_files {
  90.     foreach (@files)
  91.     {
  92.     printf "%d %8d %s %s\n", $_->Number, $_->Size, ($_->Del ? 'D' : ' '),
  93.       $_->Name;
  94.     }
  95. }
  96.  
  97. sub unlink_one ($) {
  98.     my $file = shift;
  99.     if (unlink $file->Name) {
  100.     $file->Number (0);
  101.     print STDERR 'Deleted ' . $file->Name() . "\n"
  102.     } else {
  103.     warn "Could not delete '" . $file->Name() . "' - $!"
  104.     }
  105. }
  106.  
  107. my $delnext = 0;
  108. my $count = 1;
  109. foreach (@ARGV)
  110. {
  111.     if ($_ eq '-d' || $_ eq '-delete')
  112.     {
  113.     $delnext = 1;
  114.     next;
  115.     }
  116.  
  117.     add ($count, $delnext, $_);
  118.     $delnext = 0;
  119.     $count++;
  120. }
  121.  
  122. @files = sort {
  123.     my $s = $b->Size <=> $a->Size;
  124.     $s ? $s : ($b->Number <=> $a->Number);
  125. } @files;
  126.  
  127. # dump_files();
  128.  
  129. my ($filea, $fileb);
  130.  
  131. # print 'There are ' . scalar (@files) . " file(s) to check\r";
  132.  
  133. my @zeros;
  134. while (@files && !$files[0]->Size)
  135. {
  136.     push @zeros, $files[0]->Name;
  137.     shift @files;
  138. }
  139.  
  140. if (@zeros)
  141. {
  142.     print join ("\n", 'Zero length files:', @zeros, "\n");
  143. }
  144.  
  145. FILELOOP:
  146. while (@files)
  147. {
  148.     $filea = shift @files;
  149.     next FILELOOP unless $filea->Number;
  150.     # Bail out if it has been deleted
  151.     my $sizea = $filea->Size;
  152.     foreach $fileb (@files)
  153.     {
  154.     next unless $filea->Number;
  155.     if ($sizea != $fileb->Size)
  156.     {
  157. #        printf "Bailing out at %s\n", $fileb->Name;
  158.         next FILELOOP;
  159.     }
  160.     my $ans;
  161.     $ans = compare ($filea->Name, $fileb->Name);
  162.     if ($ans == 0)
  163.     {
  164.         printf "  %s %s\n", $fileb->Name, $filea->Name;
  165.         if ($filea->Del) {
  166.         if ($fileb->Del) {
  167.             # The both of them
  168.             unlink_one (-M ($filea->Name) < -M ($fileb->Name)
  169.                 ? $filea : $fileb);
  170.         } else {
  171.             unlink_one ($filea)
  172.         }
  173.         } elsif ($fileb->Del) {
  174.         unlink_one ($filea)
  175.         }
  176.     }
  177.     elsif ($ans == -1)
  178.     {
  179.         printf STDERR "Error %s %s $!\n", $filea->Name, $fileb->Name;
  180.     }
  181. #    else
  182. #    {
  183. #        printf "Not %s %s $!\n", $filea->Name, $fileb->Name;
  184. #    }
  185.     }
  186. }
  187.