1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
#! /usr/bin/perl
#
# Copyright 2003 by Stefan Hornburg (Racke) <racke@linuxia.de>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA.
use strict;
use warnings;
use Cwd;
use File::Find;
my (@files, @dirs, %fmap);
my $topdir = cwd();
my $command = shift || '';
if ($command eq 'cleanse') {
# read list of files to be preserved from stdin
while (<>) {
chomp();
$fmap{$_} = 1;
}
# call routine to remove files and symlinks, collects obsolete dirs too
find (\&cleanse_files, $topdir);
# the obsolete dirs are empty too, remove them
for (@dirs) {
next unless -d $_;
rmdir ($_)
|| die "Couldn't remove directory $_: $!\n";
}
} else {
# collect existing files and write them to stdou
find (\&collect_files, $topdir);
print join("\n", @files);
}
sub collect_files {
return if -d $_ && $_ eq '.';
my $f = substr($File::Find::name, length($topdir) + 1);
push (@files, $f);
}
sub cleanse_files {
return if -d $_ && $_ eq '.';
my $f = substr($File::Find::name, length($topdir) + 1);
unless (exists ($fmap{$f})) {
if (-f $_ || -l $_) {
unlink ($_)
|| die "couldn't remove file $File::Find::name: $!\n";
}
if (-d $_) {
push (@dirs, $f);
}
}
}
|
