source: trunk/gsdl/bin/script/clean_archives.pl@ 946

#!/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;
    }
    }
}