#!/usr/bin/perl

# Copyright 2002 Vlado Keselj www.cs.dal.ca/~vlado
#
# Linux rm command
#
# Justification: On some Unix systems `rm' command does not have a -v option,
# or -f option does not work, and similar.

use strict;
use vars qw($option_force $option_recursive $option_verbose);

$| = 1;
$option_force     = '';
$option_recursive = '';
$option_verbose   = '';

# analyze options
while ($#ARGV > -1 && $ARGV[0] =~ /^-/) {
    my $o = shift @ARGV;

    # To remove a file called `-f' in the current
    # directory, you could type either
    #          rm -- -f
    #   or
    #          rm ./-f
    last if $o eq '--';

    if ($o !~ /^--/ and length($o) > 2) {
	unshift @ARGV, ("-".substr($o,2));
	$o = substr($o,0,2);
    }

    #   -d, --directory
    #          unlink directory, even if non-empty (super-user only)
    if ($o eq '-d' or $o eq '--directory') { die "option not implemented" }

    #   -f, --force
    #          ignore nonexistent files, never prompt
    elsif ($o eq '-f' or $o eq '--force') { $option_force = 1 }
    
    #   -i, --interactive
    #          prompt before any removal
    elsif ($o eq '-i' or $o eq '--interactive') { $option_force = '' }

    #   -r, -R, --recursive
    #          remove the contents of directories recursively
    elsif ($o eq '-r' or $o eq '-R' or $o eq '--recursive') { $option_recursive = 1 }

    #   -v, --verbose
    #          explain what is being done
    elsif ($o eq '-v' or $o eq '--verbose') { $option_verbose = 1 }

    #   --help display this help and exit
    elsif ($o eq '--help') { print &help(); exit 0; }

    #   --version
    #          output version information and exit
    elsif ($o eq '--version') { print "rm in Perl, (c) Vlado Keselj, version 1.0"; exit 0; }

    else { die "$0: illegal option -- $o\nusage: rm [-fiRrv] file ...\n" }
}

if ($#ARGV==-1) { print "usage: rm [-fiRrv] file ...\n"; exit }

my (@args); @args = @ARGV; @ARGV = (); # so we can use <> for further input
&recursive_rm(@args);
exit 0;

sub recursive_rm {
    my $count = 0;
    while ($#_ > -1) {
	my $dir = shift;

        # symbolic link
	if (-l $dir) {
            if (&ask("remove `$dir'")) {
                &verbose_print("removing $dir");
		unlink($dir) or die $!;
		$count += 1;
	    }
	    next;
	}

	next if not -e $dir;

	# file
	if (not -d $dir) {
	    if (&ask("remove `$dir'") ) {
		&verbose_print("removing $dir");
		unlink($dir) or die $!;
		$count +=  1;
	    }
	    next;
	}

	if ($option_recursive and &ask("descend into directory `$dir'")) {
	    &verbose_print("removing all entries of directory $dir");
	    local ($_, *DIR);
	    opendir(DIR, $dir) || die "can't opendir $dir: $!";
	    map { /^\.\.?$/ ? '' : ($count += &recursive_rm("$dir/$_")) } readdir(DIR);
	    closedir(DIR);
	    
	    if (&ask("remove directory `$dir'")) {
		&verbose_print("removing the directory itself: $dir");
		rmdir $dir or die $!;
		$count += 1;
	    }
	}
    }
    return $count;
}

sub ask {
    return 1 if $option_force;
    print "rm: ", @_, "? ";
    my $a = <>;
    return ($a =~ /^[yY]/);
}

sub verbose_print {
    return unless $option_verbose;
    print @_, "\n";
}

sub help {
    return <<'EOT'

Linux rm command

Justification: On some Unix systems `rm' command does not have a -v option,
or -f option does not work, and similar...

To remove a file called `-f' in the current directory, you could type either
              rm -- -f
       or
              rm ./-f

OPTIONS

       -f, --force
              ignore nonexistent files, never prompt

       -i, --interactive
              prompt before any removal

       -r, -R, --recursive
              remove the contents of directories recursively

       -v, --verbose
              explain what is being done

       --help display this help and exit

       --version
              output version information and exit

Copyright 2002 Vlado Keselj www.cs.dal.ca/~vlado

Script is provided AS IS.  (I believe it works OK, but no garanties
This script is provided ``as is'' without expressed or implied warranty.
This is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
EOT
;
}