package Sort::Key;
our $VERSION = '1.28';
use 5.006;
use strict;
use warnings;
use Carp;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( nsort nsort_inplace
isort isort_inplace
usort usort_inplace
rsort rsort_inplace
rnsort rnsort_inplace
risort risort_inplace
rusort rusort_inplace
keysort keysort_inplace
rkeysort rkeysort_inplace
nkeysort nkeysort_inplace
rnkeysort rnkeysort_inplace
ikeysort ikeysort_inplace
rikeysort rikeysort_inplace
ukeysort ukeysort_inplace
rukeysort rukeysort_inplace
multikeysorter multikeysorter_inplace);
require XSLoader;
XSLoader::load('Sort::Key', $VERSION);
our $DEBUG;
$DEBUG ||= 0;
# this hash is also used from Sort::Key::Multi to find out which
# letters can be used as types:
our %mktypes = ( s => 0,
l => 1,
n => 2,
i => 3,
u => 4 );
sub _mks2n {
if (my ($rev, $key)=$_[0]=~/^([-+]?)(.)$/) {
exists $mktypes{$key}
or croak "invalid multikey type '$_[0]'";
my $n = $mktypes{$key};
$n+=128 if $rev eq '-';
return $n
}
die "internal error, bad key '$_[0]'";
}
our %mkmap = qw(str s
string s
locale l
loc l
lstr l
int i
integer i
uint u
unsigned_integer u
number n
num n);
$_ = [$_] for (values %mkmap);
our %mksub = map { $_ => undef } keys %mkmap;
sub _get_map {
my ($rev, $name) = $_[0]=~/^([+-]?)(.*)$/;
exists $mkmap{$name}
or croak "unknown key type '$name'\n";
if ($rev eq '-') {
return map { /^-(.*)$/ ? $1 : "-$_" } @{$mkmap{$name}}
}
@{$mkmap{$name}}
}
sub _get_sub {
$_[0]=~/^[+-]?(.*)$/;
exists $mksub{$1}
or croak "unknown key type '$1'\n";
return $mksub{$1}
}
sub _combine_map { map { _get_map $_ } @_ }
use constant _nl => "\n";
sub _combine_sub {
my $sub = shift;
my $for = shift;
$for = defined $for ? " for $for" : "";
my @subs = map { _get_sub $_ } @_;
if ($sub) {
my $code = 'sub { '._nl;
if (ref $sub eq 'CODE') {
unless (grep { defined $_ } @subs) {
return $sub
}
$code.= 'my @keys = &{$sub};'._nl;
}
else {
if ($sub eq '@_') {
return undef unless grep {defined $_} @subs;
}
$code.= 'my @keys = '.$sub.';'._nl;
}
$code.= 'print "in: |@keys|\n";'._nl if $DEBUG;
$code.= '@keys == '.scalar(@_)
. ' or croak "wrong number of keys generated$for '
. '(expected '.scalar(@_).', returned ".scalar(@keys).")";'._nl;
{ # new scope so @map doesn't get captured
my @map = _combine_map @_;
if (@map==@_) {
for my $i (0..$#_) {
if (defined $subs[$i]) {
$code.= '{ local $_ = $keys['.$i.']; ($keys['.$i.']) = &{$subs['.$i.']}() }'._nl;
}
}
$code.='print "out: |@keys|\n";'._nl if $DEBUG;
$code.='return @keys'._nl;
}
else {
$code.='my @keys1;'._nl;
for my $i (0..$#_) {
if (defined $subs[$i]) {
$code.= '{ local $_ = shift @keys; push @keys1, &{$subs['.$i.']}() }'._nl;
}
else {
$code.= 'push @keys1, shift @keys;'._nl;
}
}
$code.='print "out: |@keys1|\n";'._nl if $DEBUG;
$code.='return @keys1'._nl;
}
}
$code.='}'._nl;
print "CODE$for:\n$code----\n" if $DEBUG >= 2;
my $map = eval $code;
$@ and die "internal error: code generation failed ($@)";
return $map;
}
else {
@_==1 or croak "too many keys or keygen subroutine undefined$for";
return @subs;
}
}
sub register_type {
my $name = shift;
my $sub = shift;
$name=~/^\w+(?:::\w+)*$/
or croak "invalid type name '$name'";
@_ or
croak "too few keys";
(exists $mkmap{$name} or exists $mktypes{$name})
and croak "type '$name' already registered or reserved in ".__PACKAGE__;
$mkmap{$name} = [ _combine_map @_ ];
$mksub{$name} = _combine_sub $sub, $name, @_;
}
sub multikeysorter {
my @keys = @_;
if (ref $_[0] eq 'CODE') {
my $keygen = shift;
my $sub = _combine_sub($keygen, undef, @_);
@_ or croak "too few keys";
my $ptypes = pack('C*', (map { _mks2n $_ } _combine_map(@_)));
# print "type 1\n";
# return _multikeysorter($ptypes, $keygen);
return _multikeysorter($ptypes, $sub, undef);
}
else {
my $sub = _combine_sub('@_', undef, @_);
@_ or croak "too few keys";
my $ptypes = pack('C*', (map { _mks2n $_ } _combine_map(@_)));
return _multikeysorter($ptypes, undef, $sub)
}
}
sub multikeysorter_inplace {
if (ref $_[0] eq 'CODE') {
my $keygen = shift;
my $sub = _combine_sub($keygen, undef, @_);
@_ or croak "too few keys";
my $ptypes = pack('C*', (map { _mks2n $_ } _combine_map(@_)));
return _multikeysorter_inplace($ptypes, $sub, undef);
}
else {
my $sub = _combine_sub('@_', undef, @_);
@_ or croak "too few keys";
my $ptypes = pack('C*', (map { _mks2n $_ } _combine_map(@_)));
return _multikeysorter_inplace($ptypes, undef, $sub);
}
}
1;
__END__
=head1 NAME
Sort::Key - the fastest way to sort anything in Perl
=head1 SYNOPSIS
use Sort::Key qw(keysort nkeysort ikeysort);
@by_name = keysort { "$_->{surname} $_->{name}" } @people;
# sorting by a numeric key:
@by_age = nkeysort { $_->{age} } @people;
# sorting by a numeric integer key:
@by_sons = ikeysort { $_->{sons} } @people;
=head1 DESCRIPTION
Sort::Key provides a set of functions to sort lists of values by some
calculated key value.
It is faster (usually B<much faster>) and uses less memory than other
alternatives implemented around perl sort function (ST, GRT, etc.).
Multikey sorting functionality is also provided via the companion
modules L<Sort::Key::Multi>, L<Sort::Key::Maker> and
L<Sort::Key::Register>.
=head2 FUNCTIONS
This module provides a large number of sorting subroutines but
they are all variations off the C<keysort> one:
@sorted = keysort { CALC_KEY($_) } @data
that is conceptually equivalent to
@sorted = sort { CALC_KEY($a) cmp CALC_KEY($b) } @data
and where C<CALC_KEY($_)> can be any expresion to extract the key
value from C<$_> (not only a subroutine call).
For instance, some variations are C<nkeysort> that performs a numeric
comparison, C<rkeysort> that orders the data in descending order,
C<ikeysort> and C<ukeysort> that are optimized versions of C<nkeysort>
that can be used when the keys are integers or unsigned integers
respectively, etc.
Also, inplace versions of the sorters are provided. For instance
keysort_inplace { CALC_KEY($_) } @data
that is equivalent to
@data = keysort { CALC_KEY($_) } @data
but being (a bit) faster and using less memory.
The full list of subroutines that can be imported from this module
follows:
=over 4
=item keysort { CALC_KEY } @array
returns the elements on C<@array> sorted by the key calculated
applying C<{ CALC_KEY }> to them.
Inside C<{ CALC_KEY }>, the object is available as C<$_>.
For example:
@a=({name=>john, surname=>smith}, {name=>paul, surname=>belvedere});
@by_name=keysort {$_->{name}} @a;
This function honours the C<use locale> pragma.
=item nkeysort { CALC_KEY } @array
similar to keysort but compares the keys numerically instead of
as strings.
This function honours the C<use integer> pragma, i.e.:
use integer;
my @s=(2.4, 2.0, 1.6, 1.2, 0.8);
my @ns = nkeysort { $_ } @s;
print "@ns\n"
prints
0.8 1.6 1.2 2.4 2
=item rnkeysort { CALC_KEY } @array
works as nkeysort, comparing keys in reverse (or descending) numerical order.
=item ikeysort { CALC_KEY } @array
works as keysort but compares the keys as integers (32 bits or more,
no checking is performed for overflows).
=item rikeysort { CALC_KEY } @array
works as ikeysort, but in reverse (or descending) order.
=item ukeysort { CALC_KEY } @array
works as keysort but compares the keys as unsigned integers (32 bits
or more).
For instance, it can be used to efficiently sort IP4 addresses:
my @data = qw(1.2.3.4 4.3.2.1 11.1.111.1 222.12.1.34
0.0.0.0 255.255.255.0) 127.0.0.1);
my @sorted = ukeysort {
my @a = split /\./;
(((($a[0] << 8) + $a[1] << 8) + $a[2] << 8) + $a[3])
} @data;
=item rukeysort { CALC_KEY } @array
works as ukeysort, but in reverse (or descending) order.
=item keysort_inplace { CALC_KEY } @array
=item nkeysort_inplace { CALC_KEY } @array
=item ikeysort_inplace { CALC_KEY } @array
=item ukeysort_inplace { CALC_KEY } @array
=item rkeysort_inplace { CALC_KEY } @array
=item rnkeysort_inplace { CALC_KEY } @array
=item rikeysort_inplace { CALC_KEY } @array
=item rukeysort_inplace { CALC_KEY } @array
work as the corresponding keysort functions but sorting the array
inplace.
=item rsort @array
=item nsort @array
=item rnsort @array
=item isort @array
=item risort @array
=item usort @array
=item rusort @array
=item rsort_inplace @array
=item nsort_inplace @array
=item rnsort_inplace @array
=item isort_inplace @array
=item risort_inplace @array
=item usort_inplace @array
=item rusort_inplace @array
are simplified versions of its keysort cousins. They use the own
values as the sorting keys.
For instance those constructions are equivalent:
@sorted = nsort @foo;
@sorted = nkeysort { $_ } @foo;
@sorted = sort { $a <=> $b } @foo;
=item multikeysorter(@types)
=item multikeysorter_inplace(@types)
=item multikeysorter(\&genkeys, @types)
=item multikeysorter_inplace(\&genkeys, @types)
are the low level interface to the multikey sorting functionality
(normally, you should use L<Sort::Key::Maker> and
L<Sort::Key::Register> or L<Sort::Key::Multi> instead).
They get a list of keys descriptions and return a reference to a
multikey sorting subroutine.
Types accepted by default are:
string, str, locale, loc, integer, int,
unsigned_integer, uint, number, num
and support for additional types can be added via the non exportable
L<register_type> subroutine (see below) or the more friendly interface
available from L<Sort::Key::Register>.
Types can be preceded by a minus sign to indicate descending order.
If the first argument is a reference to a subroutine it is used as the
multikey extraction function. If not, the generated sorters
expect one as their first argument.
Example:
my $sorter1 = multikeysorter(sub {length $_, $_}, qw(int str));
my @sorted1 = &$sorter1(qw(foo fo o of oof));
my $sorter2 = multikeysorter(qw(int str));
my @sorted2 = &$sorter2(sub {length $_, $_}, qw(foo fo o of oof));
=item Sort::Key::register_type($name, \&gensubkeys, @subkeystypes)
registers a new datatype named C<$name> defining how to convert it to
a multikey.
C<&gensubkeys> should convert the object of type C<$name> passed on
C<$_> to a list of values composing the multikey.
C<@subkeystypes> is the list of types for the generated multikeys.
For instance:
Sort::Key::register_type Person =>
sub { $_->surname,
$_->name,
$_->middlename },
qw(str str str);
Sort::Key::register_type Color =>
sub { $_->R, $_->G, $_->B },
qw(int int int);
Once a datatype has been registered it can be used in the same way
as types supported natively, even for defining new types, i.e.:
Sort::Key::register_type Family =>
sub { $_->man, $_->woman },
qw(Person Person);
=back
=head1 SEE ALSO
perl L<sort> function, L<integer>, L<locale>.
Companion modules L<Sort::Key::Multi>, L<Sort::Key::Register>,
L<Sort::Key::Maker> and L<Sort::Key::Natural>.
Other interesting Perl sorting modules are L<Sort::Maker> and
L<Sort::Natural>.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005, 2006 by Salvador FandiE<ntilde>o,
E<lt>sfandino@yahoo.comE<gt>.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.
=cut
syntax highlighted by Code2HTML, v. 0.9.1