#!/usr/bin/perl
#
# $Id: rmdoc.pl,v 1.1 1997/05/14 09:47:58 gnats Exp $
#
#
# DESCRIPTION: rmdoc.pl - a tool to remove documents from a solution database
#
# URL: none yet
#
# AUTHOR: Cord Beermann (cord@Wunder-Nett.org)
#
# Thanks to: Ralf Begemann (begemann@cc.fh-lippe.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., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
# A Perl script is "correct" if it gets the job done before your boss fires
# you.
# ('Programming Perl Second Edition' by Larry Wall, Tom Christiansen
#   & Randal. L. Schwartz)
#
# Bugs and shortcomings
# none yet
#

# include perl-modules
use POSIX;
use File::Copy;
use File::Basename;

# print usage statement if no files given
unless ($#ARGV > -1) {
    print("Usage: $0 file [file ...]\n");
    exit(0);
}

# Run this loop once for each given file
foreach $file (@ARGV) {
    # check if the RCS-dir is still there and create it if not    
    unless (-d dirname($file) . '/RCS') {
	mkdir(dirname($file) . '/RCS', 0755) or
	    &error('mkdir ' . dirname($file) . "/RCS: $!\n");
    }
    # check if the given file exists or not and print an appropriate message.
    if (-e $file) {
	print "$file existiert. Wirklich loeschen? (j/n)\n";
    } else {
	print "$file existiert nicht\n";
	next;
    }
    # wait for user input and skip file with a message if the user won't proceed
    $_ = <STDIN> or &error("STDIN not found: $!");
    unless ($_ =~ /^[jJ]/) {
	print "$file wurde nicht geloescht.\n";
	next;
    }
    # check for a lockfile and skip file with a message if it exists
    if (-e $file . '.lock') {
	print "$file wird bearbeitet. $file wurde nicht geloescht.\n";
	next;
    }

    # remove file and RCS-file
    @cannot = grep {not unlink} $file, dirname($file) . '/RCS/' . basename($file) . ',v';
    &error("unlink @cannot") if @cannot;    
    print "$file wurde geloescht.\n";
}

# Subprogram if something fails.
# print an errormessage and exit
sub error {
    my $error = shift(@_);
    print("$error\n");
    exit(1);
}