#!Perl
#--------------------------------------------------------------------------
# select_by_criterion.pl -- version 1.3 (1998-05-20)
# Author: Sean M. Burke (sburke@netadventure.net)
#
# Description:  select files in Finder by criterion
#
# Usage:
#  Drop onto me a file from the directory you want to
#    select items from, or drop the directory itself on me.
#  Then I'll select (in a Finder window) items from that
#    directory who ore true for a block of Perl code you provide.
#  If the file dropped contains "select" in its filename, its contents
#    will be read and used as the block of code to execute.
#  (Otherwise, you'll be prompted for the code).
#
#  If the code (whether from file or as prompted for) doesn't match
#  /\bsub\b/, it is eval'd in the context:
#       sub predicate {
#         local($_) = $_[0];
#         Your Code Here
#       }
#    This is mainly provided so you can write one-line predicates like
#      /foo/i and -f "\:$_" and -M < 4
#    or the like.
#  But if your code matches "/\bsub\b/, then it well simply be evalled,
#    and as such MUST declare a sub named "predicate" which will return
#    true for those files it wants selected.  It CAN change the value of
#    $base.
#    Read the source below to understand what this means.
#    (Note that both these evals happen in the package "main", safe from
#    all this script's variables, which are in package "selector".)
#  See the end of this file for example predicates.
#--------------------------------------------------------------------------
#
# Notes:
#  * The base directory will be in $base, and this will also be the pwd.
#  * This won't work for items on the Desktop.  Maybe in a later version.
#  * This assumes that you'll be dragging the selected item from a Finder
#     window.  Don't get creative with other kinds of windows, or
#     the AppleScript I run will be trying to select things in
#     the window for a folder that Finder doesn't have open --
#     or MacPerl may not be able to figure out what the hell you
#     dropped on it.
#  * I (or rather, Finder) can only work on one directory at a time.
#  * It takes a second or two for it to work.  (AppleScript == slow)
#  * If what you drop is an alias, it will (or may not?) resolve to
#     what it's an alias to, if you're using an old MacPerl.
#     Don't use an old MacPerl, OK?
#  * Refuses to work in the root directories of volumes, for many many
#     reasons.  Maybe in a later version.
#
# For me to be droppable-on, you need to open me in MacPerl and save me
#  as a droplet.
# 
#--------------------------------------------------------------------------
# Availability & Copying:
#
# select_by_criterion.pl is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation, version 2.
#
# select_by_criterion.pl is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# To see a copy of the GNU General Public License, see
# http://www.ling.nwu.edu/~sburke/gnu_release.html, or write to the
# Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#--------------------------------------------------------------------------
# Rev notes:
# 1998-04-22: Version 1 of select_by_regexp -- released.  Whee.
# 1998-05-14: version 1 of select_by-criterion -- released.
#   (adapted from select_by_regexp)
# 1998-05-20: version 1.3: new behavior for select.pl files.
#                        : started using packages

die "I need to be on a Mac.  Really.\n" unless $MacPerl::Version;

package selector; # so nothing walks on my variables

@never_see{ # Things I never want to see or try to select
  "Icon\cm",
  "Temporary Items",
  "Network Trash Folder",
} = ();

if(@ARGV == 0) {
  print
"Usage: drop onto me a file from the directory you want to
select items from, or drop the directory itself.
Then I'll ask for a bit of Perl code that returns true
for files you want to select.
I'll select (in a Finder window) those items.\n\n";
  exit;
}

exit unless @ARGV == 1;

$main::base = $ARGV[0];
$main::base =~ s/\:*$//s;

if(-d "$main::base\:") {
  # fine as is
} else {
  $main::base =~ s/\:[^\:]+$//;
}

if ($ARGV[0] =~ /select/i and -f $ARGV[0] and -s _) {
  open(INCODE, "$ARGV[0]") || die "Can't open $ARGV[0]\: $!\n";
  $filter = join('', <INCODE>);
  close(INCODE);
  unless($filter =~ /\S/) {
    print "$ARGV[0] is empty.  Aborting.\n";
    exit;
  }
  $from_file = $ARGV[0];
} else {
  $filter = MacPerl::Ask(
     'Criterion (with the filename in $_, dirname in $base)',
     'm/bar/ && -f "$base:$_"'
  );
  exit unless $filter =~ /\S/;
  $from_file = undef;
}


if($filter =~ /\bsub\b/i) { # It's not a shart-form
  # Meaning, it CAN set $base, and MUST define &predicate
  $is_pure_perl = 1;

  package main; # step into main...
  eval($selector::filter);
  die "Error: <$@> while compiling your code\n" if $@;
  package selector; #  ...aaand back

} else { # It needs a context
  $is_pure_perl = 0;

  package main; # step into main...
  eval(
"sub predicate {
local(\$_) = \$_[0];
$selector::filter
}");
  die "<$@> while compiling your code\n" if $@;
  package selector; #  ...aaand back

}
print "Eval OK\n" if $debug;

die "I don't work right in the root directory of volumes.  Aborting.\n"
  unless $main::base =~ /\:/ ;

die "$main::base does not exist!?!\n"
  unless -e "$main::base\:";

chdir("$main::base\:") || die "Couldn't chdir to $main::base\:\n";
die "Can't opendir $main::base\:\n" unless opendir(BASE, "$main::base\:");

@files = grep(
              (!exists($never_see{$_}))
                && &main::predicate($_), # It aaaall happens here.
              readdir(BASE)
             );
closedir(BASE);

unless(@files) {
  print "No items in $main::base\: meet your criterion.\n\n";
  exit;
}

print scalar(@files), " items in $main::base\: met ",
  defined($from_file) ?
     "code from $from_file" :
     "\" $filter \"",
  ":\n",
  map("  $main::base\:$_\n", @files), "\n\n"
;

&MacPerl::DoAppleScript(
"tell application \"Finder\"
activate
open folder \"$main::base\"
select { " .
  join(", ",
       map("item \"$_\" of window of folder \"$main::base\"", @files)
      )
 . " \}
end tell
"
);

exit;

__END__

#--------------------------------------------------------------------------

A sample selector file:

$base = "G3:Clients";
%done = ();
@done{ # sites already backed up
  'Foobarco',
  'Lucrodyne',
} = ();

sub predicate {
  return (
    (! (/back/s || /new/s || /old/s || /\d$/s )) and
    (! exists($done{$_})) and
    (! (-l "$base\:$_")) and
    (! (-e "$base\:site_backups\:$_.sit")) and

  );
}


Here's another.  This selects 20 (or $limit) of the files from $base:

$seen = 0;
$limit = 20;
sub predicate {
  return ( -f "\:$_" and $seen++ < $limit );
}

i.e., predicate is true for the first 20 files that readdir() sees.