[MacPerl] A file search tool

[kpreid@attglobal.net (Kevin Reid)]

This droplet searches both forks of a file or files for a given pattern.
I have found it useful, and thought someone else might too.

#!perl -w

use strict;
use Mac::Resources;
use Mac::Memory;

use vars qw(
  $src_str
  $filename
  $rf
);

$src_str = MacPerl::Ask('Enter the search pattern:') or exit;

foreach $filename (@ARGV) {
  print "Searching data fork of $filename...\n";
  open FILE, $filename or die "Couldn't open data fork: $!";
  while (<FILE>) {
    while (/$src_str/ig) {
      my $match = substr($`, -20) . $& . substr($', 0, 20);
      $match =~ s/\n/\\n/;
      print "  Found on line $.: '$match'.\n";
    }
  }
  close FILE;

  print "Searching resource fork of $filename...\n";
  $rf = OpenResFile $filename
    or do {print "  Couldn't open resource fork.\n"; next};
  my $tcnt = Count1Types;
  # print "$tcnt types.\n";

  for (my $tind = 1; $tind <= $tcnt; $tind++) {
    my $type = Get1IndType $tind;
    my $rcnt = Count1Resources $type;
    # print "  $rcnt '${type}'@{[$rcnt - 1 ? 's' : '']}.\n";

    for (my $rind = 1; $rind <= $rcnt; $rind++) {
      my $rsrc = Get1IndResource $type, $rind;
      my $data = $rsrc->get;

      while ($data =~ /$src_str/ig) {
        my ($rid, $rtype, $rname) = GetResInfo $rsrc;
        my $match = substr($`, -20) . $& . substr($', 0, 20);
        $match =~ s/\n/\\n/;
        print "  Found in '${type}' resource @{[$rid]}: '$match'.\n";
      }
    }
  }
  CloseResFile($rf);
}
print "Done.\n";

__END__

-- 
 Kevin Reid: |    Macintosh:      
  "I'm me."  | Think different.

# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org