#!/usr/bin/perl
#
# $Id: MacRename.pl,v 1.5 2002/11/17 23:00:41 jmates Exp $
#
# This MacPerl script implements Larry Wall's "rename" perl
# script on the Mac OS platform.
#
# Save it as a "Droplet" from MacPerl or BBEdit, then drag
# some files onto it, enter a perl expression, and see what
# happens. :)

use File::Copy;
use Mac::Windows;
use Mac::Events;
use Mac::Dialogs;

my $dialog_text;  # where text from dialog box is placed

# do the Mac stuff to get what should have come in on the
# command line, shamelessly stolen from the MacPerl book...
my $dlg = MacDialog->new(
  (
    Rect->new(50, 50, 450, 155),
    'MacRename',
    1,
    movableDBoxProc(),
    0,
    [kButtonDialogItem(), Rect->new(300, 30, 380, 50), 'cancel'],
    [kButtonDialogItem(), Rect->new(300, 70, 380, 90), 'OK'],
    [
      kStaticTextDialogItem(),
      Rect->new(10, 10, 220, 30),
      'Perl expression to eval:'
    ],
    [kEditTextDialogItem(), Rect->new(15, 50, 250, 65), ''],
  )
);

SetDialogCancelItem($dlg->window(),  1);
SetDialogDefaultItem($dlg->window(), 2);
SetDialogItemText($dlg->window(),    4);

$dlg->item_hit(1 => \&d1);
$dlg->item_hit(2 => \&d2);

while ($dlg->window()) {
  WaitNextEvent();
}

# manually set function to apply; could also be "copy"
my $fn = 'rename';

# now, we can get around to doing the real perl stuff :)
# loop over the files
for (@ARGV) {

  # Mac OS hack; split path/filename apart, chdir &
  # reassign $_ to $file to avoid annoying "cross-device
  # link error" otherwise...
  my ($path, $file);
  ($path, $file) = $_ =~ m/^(.*?)([^:]+)$/;

  # scoot over to that vicinity...
  chdir $path;

  $_ = $file;

  # record what the file was called
  my $was = $_;

  # evaluate the expression passed on the command line,
  # operating on $_ (by default)
  eval $dialog_text;

  # keel over if something went wrong with the evaluation...
  die $@ if $@;

  # skip out early if the filename didn't change
  next if $was eq $_;

  # with error checking, actually attempt the rename or
  # copy.
  unless (eval "$fn(\$was, \$_)") {
    warn "\U$fn\E ERROR $was -> $_ - $!\n";
    next;
  }
}

######################################################################
#
# SUBROUTINES

sub d1 {
  my $dlg = shift;
  $dlg->dispose;
  return 1;

  #exit;
}

sub d2 {
  my $dlg = shift;
  $dialog_text = $dlg->item_text(4);
  $dlg->dispose;
  return 1;
}

sub END {
  $dlg->dispose() if defined($dlg);
}