home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
RPC
/
!Perl
/
scripts
/
recdel
< prev
next >
Wrap
Text File
|
1998-07-14
|
3KB
|
187 lines
#!perl -w
# Version 0.01
eval 'use RISCOS::Filespec' if $^O eq 'riscos';
# use RISCOS::File qw(globlist);
use File::Compare;
package file;
use strict;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
my $name = shift;
my $num = shift;
my $size = shift;
my $del = shift;
return undef unless defined $name;
$self->{'__NAME'} = $name;
$self->{'__NUM'} = $num;
$self->{'__SIZE'} = $size;
$self->{'__DEL'} = 0 + $del;
bless ($self, $class);
}
sub Name {
my $self = shift;
$self->{__NAME};
}
sub Number {
my $self = shift;
$self->{__NUM} = $_[0] if (defined $_[0]);
$self->{__NUM};
}
sub Del {
my $self = shift;
$self->{__DEL};
}
sub Size {
my $self = shift;
$self->{__SIZE};
}
package main;
use vars qw (@files);
sub pathname {
my $path = shift;
$path =~ s/\s+$//;
if ($^O eq 'riscos') {
$path .= '.' unless $path =~ /[:\.]$/;
} else {
$path .= '/' unless $path =~ /\/$/;
}
return $path . $_[0] unless wantarray;
my @result;
foreach (@_)
{
push @result, $path . $_;
warn $path . $_;
}
@result;
}
sub add {
my $count = shift;
my $del = shift;
foreach (@_)
{
if (-d $_) {
add ($count, $del, glob (pathname ($_, '*')))
} elsif (-f _) {
push @files, new file ($_, $count, -s _, $del);
} else {
warn "No such file '$_'\n";
}
}
}
sub dump_files {
foreach (@files)
{
printf "%d %8d %s %s\n", $_->Number, $_->Size, ($_->Del ? 'D' : ' '),
$_->Name;
}
}
sub unlink_one ($) {
my $file = shift;
if (unlink $file->Name) {
$file->Number (0);
print STDERR 'Deleted ' . $file->Name() . "\n"
} else {
warn "Could not delete '" . $file->Name() . "' - $!"
}
}
my $delnext = 0;
my $count = 1;
foreach (@ARGV)
{
if ($_ eq '-d' || $_ eq '-delete')
{
$delnext = 1;
next;
}
add ($count, $delnext, $_);
$delnext = 0;
$count++;
}
@files = sort {
my $s = $b->Size <=> $a->Size;
$s ? $s : ($b->Number <=> $a->Number);
} @files;
# dump_files();
my ($filea, $fileb);
# print 'There are ' . scalar (@files) . " file(s) to check\r";
my @zeros;
while (@files && !$files[0]->Size)
{
push @zeros, $files[0]->Name;
shift @files;
}
if (@zeros)
{
print join ("\n", 'Zero length files:', @zeros, "\n");
}
FILELOOP:
while (@files)
{
$filea = shift @files;
next FILELOOP unless $filea->Number;
# Bail out if it has been deleted
my $sizea = $filea->Size;
foreach $fileb (@files)
{
next unless $filea->Number;
if ($sizea != $fileb->Size)
{
# printf "Bailing out at %s\n", $fileb->Name;
next FILELOOP;
}
my $ans;
$ans = compare ($filea->Name, $fileb->Name);
if ($ans == 0)
{
printf " %s %s\n", $fileb->Name, $filea->Name;
if ($filea->Del) {
if ($fileb->Del) {
# The both of them
unlink_one (-M ($filea->Name) < -M ($fileb->Name)
? $filea : $fileb);
} else {
unlink_one ($filea)
}
} elsif ($fileb->Del) {
unlink_one ($filea)
}
}
elsif ($ans == -1)
{
printf STDERR "Error %s %s $!\n", $filea->Name, $fileb->Name;
}
# else
# {
# printf "Not %s %s $!\n", $filea->Name, $fileb->Name;
# }
}
}