[MacPerl] A simple utility for Mac/UNIX folks

[joshg@ola.bc.ca (Josh Gemmell)]

If you're like me, you find Mac's tendency to create "GIF" files instead of
"gif" files really quite annoying - especially when you have to go through a
bunch of them and change the case by hand. Well, I've ended all that on the
UNIX end anyway. The program that should follow this text (unless I do
something stupid and foget to add it) is the code for a utility that lowercases
any filenames that have uppercase in them. It has a number of nifty features
and a wish list - feel free to add stuff or make suggestions.

Actually, now I'm wondering why I haven't made a Mac version... Maybe because
I'm very unfamiliar with Mac interfacing. UNIX is simple - just add some
'-a'rguments to the end of the command. Anybody know how to make a nice
interface with multiple choice questions, text entry boxes, folder selection
options, etc.?

A special thanks to Jeffrey Friedl, who taught me how to handle arguments - and
he doesn't even know!

The reason that I'm posting this here is that MacPerl users are more likely to
use Mac & UNIX than UNIX Perl users are (at least that's what I think).

#!/usr/bin/perl

# make executable and type "cdp -?" for instructions (or "./cdp -?")

###############################################################################
#    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\
#    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO
#####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/
#
# cdp - short for "Case Da Place" - Ha ha ha!
#       Changes filenames that have upper-case characters to all-lowercase
#
# Goldarn Macintoshes and their stupid .GIFs!
#
# written by Josh Gemmell, December 1997, for my pal Pete
# some code/style lifted from Jeffrey Friedl's "search" (highly recommended)
# Christmasy design ("dopey elves") inspired by a remarkable sense of ennui
# License: do what you want, but don't blame me!
# Any suggestions etc. send to joshg@rogers.wave.ca or joshg@ola.bc.ca
#
# Version .01a
# December 16, 1997
# First draft, parameter handling only
#
# Version .01b
# December 18, 1997
# Second draft, primitive file tests
#
# Version .01c
# December 19, 1997
# Now we're mungin' stuff real good
# Added .dotfile handling
# Changed default to "mouthy" and added -quiet arg
#
# Version .10a
# December 19, 1997
# Considered blank-removal, but decided against it
# All features working (limited testing)
# Added -test arg
#
# WISH-LIST:
# Blank removal machine (at least it _tells_ ya!)
# Undo feature ('Oh, Damn! I cased da place without specifying extensions!')
# Comfirm (You really wanna do this to /path/FILE? Didn't think so.)
###############################################################################
#    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\    /\
#    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO    oO
#####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/####\/
#                                MerRy cHRisTmaS!!
use Cwd;
use subs qw(GetParms Init DieMessage Messages);
$version = ".10a";

Init;
GetParms;

if ( $testMode ) {
   print "   TEST MODE______________________________\n";
   print "   $0: $version\n";
   print "   Start: $startDir\n";
   print "   Recurse: ", ($printMe = $reCurse ? "ON" : "OFF"), "\n";
   print "   Like: ", ($printme = @fileTypes ? join("-", @fileTypes) : "ALL"),
"\n";
   print "   Dotfiles: ", ($printme = $dotFiles ? "YES" : "NO"), "\n";
   print "   Noise: ", 
      ($junk=($noiseLevel) ? 
      ($morejunk=($noiseLevel > 1) ? "VERY MOUTHY" : "MOUTHY") : 
      "QUIET"), "\n";
   print "   TEST MODE______________________________\n";

}

# check to see if we can start at the start!
DieMessage("invalid starting directory [$startDir]") unless -d $startDir;

@dirs = ($startDir);
foreach $dir (@dirs) {

   # test a few things about this directory
   Messages("$dir not readable","skipping $dir"), next unless -r $dir;
   
   # open directory and look inside
   opendir(HERE, $dir) || { Messages("cannot open $dir","$!"), next };

   Messages("opening $dir");

   if ($dotFiles) {
      @list = grep !/^\.(\.)?$/, readdir(HERE);
   } else {
      @list = grep !/^\./, readdir(HERE);
   }

   closedir(HERE);
   
   foreach $item (@list) {
      if (-d $item) {
         push (@dirs, $dir . "/" . $item) if $reCurse;
         next;
      }
      
      # warn about spaces in filenames
      Messages("$item has spaces in it!") if ($item =~ /\s+/) && $noiseLevel >
1;
      
      # skip for files that are all lowercase
      next unless $item =~ /[A-Z]/;
      # if we're type-matching, skip for no-match
      next if @fileTypes && !(grep {$item =~ /\.$_$/i} @fileTypes);
      
      # now we're left with a file that needs changin'!
      Messages("cannot write to $item","$!"), next unless -w $dir."/".$item;
      
      $old = $dir."/".$item;
      $new = $dir."/".lc($item);
      
      unless ($testMode) {
         rename ($old,$new) || { Messages("failed to rename $item","$!"), next
};
      }
      
      Messages ("$old -> $new");
   }
   
}


#-------------------------------------------------------------------------------
sub DieMessage {
   my($circumstance) = @_;
   print "$0: $circumstance\nerr:$!\n";
   $!=2;
   die "$0: dead\n";
}

sub Messages {
   my(@messages) = @_;
   return if $noiseLevel == 0;
   print shift @messages, "\n";
   if ($noiseLevel > 1) {
      foreach $msg (@messages) {
         print "$msg\n";
      }
   }
}

sub Init {
   $startDir   = cwd;        # -start -s
   $reCurse    = 0;          # -recurse -r
   $noiseLevel = 1;          # -mouthy -m -verymouthy -vm -q -quiet
   @fileTypes  = ();         # -like -l
   $dotFiles   = 0;          # -dot -d
   $testMode   = 0;          # -test -t

   
   $0 =~ s,.*/,,;            # clean up $0 for any diagnostics we'll be
printing

$helpMessage = << "END";
$0 $version

-ARGS:
    ?,h,help        this help message
    d,dot           include .dotfiles in search
    l,like          like *.this
    m,mouthy        verbose (default)
    q,quiet         quiet
    r,recurse       recurse directories
    s,start         start at /this/dir/here
    t,test          test mode (just shows what it _would_ do)
    v,version       display version number
    vm,verymouthy   really quite verbose (warns you about blank spaces!)

-DEFAULT VALUES FOR $0:
Lowercase every file (except .dotfiles) in the working directory,
displaying general info.
   
-HOW TO CHANGE THAT:
To RECURSE through subdirectories: -r(ecurse) "$0 -r"
To start ELSEWHERE: -s(tart) [/path/for/elsewhere] "$0 -s /usr" <- DON'T!

To include .DOT files: -d(ot) "$0 -d" <- NOT recommended
To specify file TYPES: -l(ike) ['list of types'] "$0 -l 'gif jpg'"

To SHUT it up: -q(uiet) "$0 -q"
To increase MOUTHINESS: -v(ery)m(outhy) "$0 -vm"

To display VERSION info: -v(ersion) "$0 -v"
To display HELP info: -?/-h(elp) "$0 -?"
To run in TEST mode: -t(est) "$0 -t"

END

}

sub GetParms {
   while (@ARGV && $ARGV[0] =~ m/^-/) {
      $arg = shift(@ARGV);

      print($helpMessage),    exit(0) if $arg =~ /^-\?|-h(elp)?$/;
      print("$0 $version\n"), exit(0) if $arg =~ /^-v(ersion)?$/;

      $reCurse   =1,          next    if $arg =~ /^-r(ecurse)?$/;
      $noiseLevel=0,          next    if $arg =~ /^-q(uiet)?$/;
      $dotFiles  =1,          next    if $arg =~ /^-d(ot)?$/;
      $testMode  =1,          next    if $arg =~ /^-t(est)?$/;

      if ($arg =~ /^-s(tart)?$/) {
         $! = 2, die qq/$0: expecting path arg to -$arg\n/ unless @ARGV;
         $startDir = shift @ARGV;
         next;
      }

      if ($arg =~ /^-l(ike)?$/) {
         $! = 2, die qq/$0: expecting glob arg to -$arg\n/ unless @ARGV;
         push (@fileTypes, split( /\s+/, shift @ARGV ) );
         next;
      }
      
      if ($arg =~ /^-(v(ery)?)?m(outhy)?$/) {
         if ($1 =~ /^v/) {$noiseLevel = 2} else {$noiseLevel = 1}
         next;
      }
      
      $! = 2, die "$0: unknown arg [$arg]\n";
   }
}

-----------------------------------------------------------------
                       Open Learning Agency
4355 Mathissi Place, Burnaby, B.C. Canada, V5G 4S8 (604) 431-3000


***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch