package Sort::KeyExtract;
use strict;
use warnings;
use Carp qw(croak);
use Exporter qw(import);
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
use constant KEY => 0;
use constant ADDRESS => 1;

BEGIN {
    $VERSION = 0.51;
    @EXPORT = qw(sort_keys);
    @EXPORT_OK = @EXPORT;
}

sub sort_keys {
    # Collect the options.
    local $_;
    my $options = shift;
    my $array = shift;
    my $one = $options->{reverse} ? -1 : 1;
    croak("No key extraction code given") unless $options->{code};

    # Do a Schwartzian Transformation while calling the user's
    # code to do key extraction.
    my @xform;
    for (@$array) {
        push @xform, [ $options->{code}->(), \$_ ];
    }

    # Sort the transformed array;
    if (! defined $options->{numbers}) {
        @xform = sort { $one * ($a->[KEY()] cmp $b->[KEY()]) } @xform;
    } else {
        @xform = sort { $one * ($a->[KEY()] <=> $b->[KEY()]) } @xform;
    }

    # Finish up the transformed array and return a refererence to it.
    if (! defined $options->{keeprefs}) {
        @xform = map ${$_->[ADDRESS()]}, @xform;
    } else {
        @xform = map $_->[ADDRESS()], @xform;
    }
    \@xform;
}

# Author: Mumia Wotse (2006)
# LICENSE: GPL

1;