@new_list =
    map  { $_->[0] }
    sort { $a->[1] <=> $b->[1] }
    map  { [ $_, expensive_function( $_ ) ] }
    @old_list;

##</code><code>##

a_bunch_of_random_letters|19670620|and_some_more_random_letters

##</code><code>##

sub get_date_perl
{
    my $date = substr( $_[0], index( $_[0], '|' ) + 1, 8 );
    return join '', unpack( "A4A2A2",$date );
}

##</code><code>##

SV* get_date( char* str )
{
    /* some stuff goes here */
    return newSVpv(date,8);
}

##</code><code>##

#!/usr/bin/perl -w
use strict;

use Inline C =><<'END_OF_C_CODE';
#include <string.h>
SV* get_date( char* str )
{
    char date[9];     /* the date to return (with an extra byte for the NUL) */
    int  index  = 0;  /* index of character in string                        */

    /* note the lack of error checking. I have a guaranteed date format (in
       generated test data).  You wouldn't do this in the real world. */
    while ( str[index++] != '|' );
    strncpy( date, &str[index], 8);
    return newSVpv( date, 8 );
}
END_OF_C_CODE

##</code><code>##

my $date = get_date( $string );

##</code><code>##

sub get_date_perl
{
    my $date = substr( $_[0], index( $_[0], '|' ) + 1, 8 );
    # skipping the scalars and doing return join '', unpack...
    # did not result in a performance improvement.
    my ( $month, $day, $year ) = unpack( "A2A2A4",$date );
    return $year.$month.$day;
}

##</code><code>##

SV* get_date (char* str)
{
    char date[9];     /* the date to return                     */
    char new_date[9]; /* this will be the date after reordering */
    int  index  = 0;  /* index of character in string           */
    while ( str[index++] != '|' );
    strncpy( date, &str[index], 8);
    new_date[0] = date[4];
    new_date[1] = date[5];
    new_date[2] = date[6];
    new_date[3] = date[7];
    new_date[4] = date[0];
    new_date[5] = date[1];
    new_date[6] = date[2];
    new_date[7] = date[3];
    return newSVpv(new_date,8);
}

##</code><code>##

Benchmark: timing 50 iterations of Inline, Perl...
    Inline: 41 wallclock secs (40.72 usr +  0.00 sys = 40.72 CPU) @  1.23/s (n=50)
      Perl: 53 wallclock secs (53.21 usr +  0.00 sys = 53.21 CPU) @  0.94/s (n=50)

##</code><code>##

@new_list =
    map_sort { $a->[1] <=> $b->[1] }
    map      { [ $_, expensive_function( $_ ) ] }
    @old_list;

##</code><code>##

Benchmark: timing 50 iterations of Inline, Ovidian, Perl...
    Inline: 41 wallclock secs (40.72 usr +  0.00 sys = 40.72 CPU) @  1.23/s (n=50)
   Ovidian: 34 wallclock secs (34.71 usr +  0.00 sys = 34.71 CPU) @  1.44/s (n=50)
      Perl: 53 wallclock secs (53.21 usr +  0.00 sys = 53.21 CPU) @  0.94/s (n=50)

##</code><code>##

#!/usr/bin/perl -w
use strict;
use Inline 'C';
use Benchmark;
use vars qw/ $test_data @perl_data @inline_data @ovid_data /;

my $date   = 'abc|03152001|';
my $c_date = get_date( $date );
my $p_date = get_date_perl( $date );
if ( $c_date eq $p_date )
{
    print "Dates match: '$c_date'\n";
}
else
{
    print "Dates do not match.\nC: '$c_date'\nPerl: '$p_date'\nTerminating program.\n";
    exit;
}

print "Generating test data.\n";
$test_data = rand_data();


timethese(50, {
    'Perl' => '
    @main::perl_data =
        map  { $_->[0] }
        sort { $a->[1] <=> $b->[1] }
        map  { [ $_, main::get_date_perl( $_ ) ] }
        @$main::test_data;

',
    'Inline' => '
    @main::inline_data =
        map  { $_->[0] }
        sort { $a->[1] <=> $b->[1] }
        map  { [ $_, main::get_date( $_ ) ] }
        @$main::test_data;

',
    'Ovidian' => '
    @main::ovid_data =
        sort { $a+0 <=> $b+0 }
        map  { main::get_date_c( $_ ) }
        @$main::test_data;
'
});

# change to 1 if you want to print this to verify results
if ( 0 )
{
    open PERL,   "> perl.txt"   or die $!;
    open INLINE, "> inline.txt" or die $!;
    open OVID,   "> ovid.txt"   or die $!;

    print PERL   join "\n", @perl_data;
    print INLINE join "\n", @inline_data;
    print OVID   join "\n", @ovid_data;

    close OVID;
    close INLINE;
    close PERL;
}


sub get_date_c
{
    my $data = shift;
    my $date = get_date( $data );
    my $dual_var;
    set_both( $dual_var, $data, $date+0 );
    return $dual_var;
}


sub get_date_perl
{
    my $date = substr( $_[0], index( $_[0], '|' ) + 1, 8 );
    my ( $month, $day, $year ) = unpack( "A2A2A4",$date );
    return $year.$month.$day;
}

sub rand_data
{
    my @years  = qw/ 1999 2000 2001 /;
    my @months = ( '01' .. '12' );
    my @days   = ( '01' .. '28' ); # since this is just sample data,
                                   # I'm not too worried about getting
                                   # this perfect
    my @sample;
    for ( 1 .. 10000 )
    {
        my $garbage = rand_letters().'|';
        $garbage .= $months [ random( 12 ) ];
        $garbage .= $days   [ random( 28 ) ];
        $garbage .= $years  [ random( 3 )  ];
        $garbage .= '|'.rand_letters();
        push @sample, $garbage;
    }
    return \@sample;
}

sub rand_letters
{
    my $foo = '';
    for ( 1 .. int( 100 * rand ) + 1 )
    {
        $foo .= ( 'a'..'z' )[ random( 26 ) ];
    }
    return $foo;
}

sub random
{
    my $int = shift;
    return int ( $int * rand );
}

__END__
__C__
void set_both(SV* variable, SV* string, SV* numeric)
{
    SvPV(string, PL_na);
    if(!SvPOKp(string) || (!SvNOKp(numeric) && !SvIOKp(numeric)) )
    {
        croak("Usage: set_both variable,string,numeric");
    }

    sv_setsv(variable,string);
    if(SvNOKp(numeric))
    {
       sv_setnv(variable,SvNV(numeric));
    }
    else
    {
         sv_setiv(variable,SvIV(numeric));
    }
    SvPOK_on(variable);
}

SV* get_date (char* str)
{
    char date[9];     /* the date to return                     */
    char new_date[9]; /* this will be the date after reordering */
    int  index  = 0;  /* index of character in string           */
    while ( str[index++] != '|' );
    strncpy( date, &str[index], 8);
    new_date[0] = date[4];
    new_date[1] = date[5];
    new_date[2] = date[6];
    new_date[3] = date[7];
    new_date[4] = date[0];
    new_date[5] = date[1];
    new_date[6] = date[2];
    new_date[7] = date[3];
    return newSVpv(new_date,8);
}