Re: [FWP] sifting

[Sean McAfee <mcafee@umich.edu>]

Jeff Pinyan <jeffp@crusoe.net> wrote:
>On DALnet #perl this morning, someone was asking how to use sort() to sort
>only so far as to get elements containing "gnome/" and "session" to the
>front, and such that "gnome/" elements preceed "session" elements.

>I said he wanted a sifting-like function, not a sorting one.

[snip]

I wrote a function like this for my Perl mailreader program.  It constructs
and returns an anonymous subroutine that sifts its arguments according to
the arguments passed to the constructing function.  Here it is, stripped
of all of its fancy extra features (and error checking):

sub group {
    my @test = @_;
    $sub  = 'sub { my @a; push @{ ';
    $sub .= "($test[$_]) ? \$a[$_] : " for 0 .. $#test;
    $sub .= '$a[' . @test . '] }, $_ foreach @_; ';
	$sub .= 'map @$_, @a; }';
    eval $sub or die;
}

Example:  Sort the words in /usr/dict/words in reverse alphabetical order
by their *last* letter:

$sub = group(map "/$_\$/i", reverse 'a'..'z');
open WORDS, '/usr/dict/words' or die;
print $sub->(<WORDS>);

If you can't tell at a glance what the subroutine that is being constructed
looks like, it's something like this:

sub {
    my @a;
    push @{ /z$/i ? $a[0] : /y$/i ? $a[1] : /x$/ ? $a[2] :
            # ...and so on...
            /b$/i ? $a[24] : /a$/i ? $a[25] : $a[26] }, $_ foreach @_;
	map @$_, @a;
}

Extra bells and whistles include a special DEFAULT tag and subsorting within
each sifted group.  I use the function to sort messages in my inbox something
like so:

$sortsub = group(
	-defaultsort => 'threaded',
	'Subject =~ /trouble ticket/i ==> CHRONO',
	'To =~ /\[mailing list foo]/',
	'DEFAULT ==> RCHRONO',
	'To =~ /\[mailing list bar]/',
	'To =~ /\[mailing list baz]/',
	'To =~ /\[mailing list quux]/'
);

If you want to check out the mailreader, it's at:

http://www-personal.umich.edu/~mcafee/perl/pmc/index.html

-- 
Sean McAfee | GCS d->-- s+++: a27 C++ US+++ P+++$ L++ E- W+ N++ |
            | K w--- O? M- V-- PS+ PE Y+ PGP?>++ t+() 5++ X R+  | mcafee@
            | tv+ b++ DI++ D+ G e++ h r---* y+>++               | umich.edu

==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe