Re: [MacPerl] can macperl do this?

[pudge@pobox.com (Chris Nandor)]

At 19.36 11/4/97, priscilla wrote:
>would any of you have a script which adds suffixes to filenames
>*based on "file type" or "file creator"* ?
>
>sorry if this sounds ignorant;
>i'm a bit new to development on the mac os side.
>
>if there is none out there,
>i'd appreciate any suggestions on how to write it
>or where to get a script.

Here is a script I made once, with all disclaimers firmly intact.  Make copies of your files before dropping them on this thing so you know what is going on.

It actually looks like I could've done it better ... but this was awhile ago that I did this.  Anyway, drag and drop a whole folder of files on it.  That's how it works.

#!perl
$dir = shift;
%types = (  'TEXT','txt',
      'FMP3','fp3',
      'WDBN','doc',
      'XLS4','xls',
      'XLS3','xls',
      'SLD3','ppt',
      'ALB5','pm5',
      'MPP ','mpp',
      'XDOC','qxd'
    );

print "\nBegin Processing\n----------------\n\n";
&doStart($dir);
print "End Processing\n--------------\n\n";

sub doStart {
  my($dir) = shift;
  opendir(D,$dir) || die "can't open $_: $!";
  foreach $file (readdir(D)) {
    if (-d "${dir}:${file}") {
      ($nfile = $file) =~ s/[^A-Za-z0-9_\/\\ -]//g;
      ($nfile = $file) =~ tr|/\\|-|;
      print "Bad directory name: ${dir}:${file}\n\n" if ($nfile ne $file);
      &doStart("${dir}:${file}");
    } else {
      my($yo) = '';
      ($crea,$type) = MacPerl::GetFileInfo("${dir}:${file}");
      foreach (keys %types) {
        $yo = 1 if ($file =~ /\.$types{$_}$/);
      }
      if ($yo) {
        ($nfile = $file) =~ s/(\..{3})$//;
        $ext = $1;
        $nfile =~ s/[^A-Za-z0-9_\/\\ -]//g;
        $nfile =~ tr|/\\|-|;
        $nfile = "${nfile}${ext}";
      } else {
        $nfile = &doStuff($file,$dir,$type);
      }
      if (rename "${dir}:${file}","${dir}:${nfile}") {
#comment out this next line to disable printing of changed filenames
        print "${dir}:${file} changed to:\n${dir}:${nfile}\n\n" unless ($file eq $nfile);
      } else {
#comment out this next line to disable printing of rename errors
        print "Error renaming ${dir}:${file} to ${dir}:${nfile}: $!\n";
      }
    }
  }
}
closedir(D);

sub doStuff {
  local($nfile,$dir,$type) = @_;
  $ext = $types{$type};
# $nfile = lc($nfile);
  $num = '';
# $nfile =~ s/[\\\/:\*"<>\|\?\.]//g;
  $nfile =~ s/[^A-Za-z0-9_\/\\ -]//g;
  $nfile =~ tr|/\\|-|;
  $tfile = "${nfile}${num}.${ext}";
  while ((-e "${dir}:$tfile") || (length($tfile) > 31)) {
    &doSame;
    &doLength;
    $tfile = "${nfile}${num}.${ext}";
  }
  return $tfile;
}

sub doSame {
  if (-e "${dir}:$tfile") {
    $num++;
  }
}

sub doLength {
  if (length($tfile) > 31) {
    chop($nfile);
  }
}
__END__

--
Chris Nandor               pudge@pobox.com           http://pudge.net/
%PGPKey=('B76E72AD',[1024,'0824 090B CE73 CA10  1FF7 7F13 8180 B6B6'])
#==                    MacPerl: Power and Ease                     ==#
#==    Publishing Date: Early 1998. http://www.ptf.com/macperl/    ==#



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