#!/usr/local/bin/perl5 ########################################################################### # # clean_archives.pl # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 1999 New Zealand Digital Library Project # # 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., 675 Mass Ave, Cambridge, MA 02139, USA. # ########################################################################### # clean_archives.pl removes any doc.gml, doc.gml.gz, and empty # directories from the directory passed on the command line. BEGIN { die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'}; unshift (@INC, "$ENV{'GSDLHOME'}/perllib"); unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugins"); } use parsargv; use util; sub print_usage { print STDERR "\n usage: $0 [options] archive-dir\n\n"; print STDERR " oprions:\n"; print STDERR " -verbose\n\n"; } &main (); sub main { if (!parsargv::parse(\@ARGV, 'verbose', \$verbose)) { &print_usage(); die "\n"; } if (scalar (@ARGV) != 1) { &print_usage(); die "\n"; } my $dir = $ARGV[0]; if (!-d $dir) { &print_usage(); die "\n"; } &recurse_dir ($dir); } sub recurse_dir { my ($dir) = @_; opendir (DIR, $dir) || die; my @files = readdir DIR; closedir DIR; foreach $file (@files) { next if $file =~ /^\.+$/; my $filename = &util::filename_cat($dir, $file); if (-d $filename) { &recurse_dir ($filename); } elsif ($file =~ /^doc\.gml(\.gz)?$/) { unlink ($filename); print STDERR "removing $filename\n" if $verbose; } } # remove the directory if it's now empty opendir (DIR, $dir) || die; @files = readdir DIR; closedir DIR; if (scalar(@files) == 0) { rmdir ($dir); print STDERR "removing empty directory $dir\n" if $verbosity; } elsif (scalar(@files) == 2) { my $empty = 1; map { if ($_ !~ /^\.+$/) {$empty = 0;} } @files; if ($empty) { rmdir ($dir); print STDERR "removing empty directory $dir\n" if $verbosity; } } }