scripts/files/whackem.pl

   1 #!/usr/bin/perl
   2
   3 ###############################################################################
   4 #                                                                             #
   5 #  Name   : whack_forever                                                     #
   6 #  Author : Chris Koeritz                                                     #
   7 #  Rights : Copyright (C) 1992-$now by Author                                 #
   8 #                                                                             #
   9 #  Purpose:                                                                   #
  10 #                                                                             #
  11 #    Zaps a list of files.  This file exists since the default in the YETI    #
  12 #  shell environment is to compress files when deletion is attempted.  Only   #
  13 #  the whack_forever command actually deletes the files for real.             #
  14 #                                                                             #
  15 ###############################################################################
  16 # This program is free software; you can redistribute it and/or modify it     #
  17 # under the terms of the GNU General Public License as published by the Free  #
  18 # Software Foundation; either version 2 of the License, or (at your option)   #
  19 # any later version.  See: "http://www.gruntose.com/Info/GNU/GPL.html" for a  #
  20 # version of the License.  Please send any updates to "fred@gruntose.com".    #
  21 ###############################################################################
  22
  23 require "filename_helper.pl";
  24
  25 sub interrupt_handler {
  26     # skip doing any deletions.
  27     print "\nbailing out due to interrupt.  not doing any remaining deletions.\n";
  28     exit(0);
  29 }
  30
  31 $SIG{'INT'} = 'interrupt_handler';  # trigger our function instead of continuing.
  32
  33 local($flags) = "";
  34
  35 local(@whackers) = @ARGV;
  36
  37 while ($whackers[0] =~ /^-/) {
  38   # this one is a special flag to pass.  don't try to whack that.
  39   $flags = $flags . @whackers[0] . ' ';
  40   shift(@whackers);
  41 }
  42
  43 #print "flags are $flags\n";
  44
  45 @whackers = &glob_list(@whackers);
  46
  47 if (scalar(@whackers) > 0) {
  48   print "ZAPPING FOREVER! @whackers ...\n";
  49   system("sleep 4") == 0 || &interrupt_handler;
  50   print "\nNow really deleting files! => @whackers\n";
  51 }
  52
  53
  54 foreach $i (@whackers) {
  55   if (-l $i) {
  56     unlink($i) || print "failed to unlink $i\n";
  57   } elsif (-d $i) {
  58     system("rm $flags \"$i\"");
  59   } else {
  60     unlink($i) || print "failed to unlink $i\n";
  61   }
  62 }
  63