File Coverage

blib/lib/Sort/XS.pm

Criterion	Covered	Total	%
statement	56	56	100.0
branch	15	18	83.3
condition	7	9	77.7
subroutine	12	12	100.0
pod	3	3	100.0
total	93	98	94.9

package Sort::XS;
use strict;
use warnings;
use base Exporter::;
our @EXPORT = qw(xsort ixsort sxsort);

our $VERSION = '0.30';
require XSLoader;
XSLoader::load( 'Sort::XS', $VERSION );
use Carp qw/croak/;

use constant ERR_MSG_NOLIST           => 'Need to provide a list';
use constant ERR_MSG_UNKNOWN_ALGO     => 'Unknown algorithm : ';
use constant ERR_MSG_NUMBER_ARGUMENTS => 'Bad number of arguments';
my $_mapping = {
    quick     => \&Sort::XS::quick_sort,
    heap      => \&Sort::XS::heap_sort,
    merge     => \&Sort::XS::merge_sort,
    insertion => \&Sort::XS::insertion_sort,
    perl      => \&_perl_sort,

    # string sorting
    quick_str     => \&Sort::XS::quick_sort_str,
    heap_str      => \&Sort::XS::heap_sort_str,
    merge_str     => \&Sort::XS::merge_sort_str,
    insertion_str => \&Sort::XS::insertion_sort_str,
    perl_str      => \&_perl_sort_str,
};

# API to call XS subs

sub xsort {

    # shortcut to speedup API usage, we first advantage preferred usage
    # ( we could avoid it... but we want to provide an api as fast as possible )
    my $argc = scalar @_;
    if ( $argc == 1 ) {
        croak ERR_MSG_NOLIST unless ref $_[0] eq ref [];
        return Sort::XS::quick_sort( $_[0] );
    }

    # default parameters
    my %params;
    $params{algorithm} = 'quick';

    # default list
    $params{list} = $_[0];

    croak ERR_MSG_NOLIST unless $params{list};
    my %args;
    unless ( ref $params{list} eq ref [] ) {

        # hash input
        croak ERR_MSG_NUMBER_ARGUMENTS if $argc % 2;
        (%args) = @_;
        croak ERR_MSG_NOLIST
          unless defined $args{list} && ref $args{list} eq ref [];
        $params{list} = $args{list};
    }
    else {

        # first element was the array, then hash option
        croak ERR_MSG_NUMBER_ARGUMENTS unless scalar @_ % 2;
        my $void;
        ( $void, %args ) = @_;
    }
    map { $params{$_} = $args{$_} || $params{$_}; } qw/algorithm type/;

    my $type =
      ( defined $params{type} && $params{type} eq 'string' ) ? '_str' : '';
    my $sub = $_mapping->{ $params{algorithm} . $type };
    croak( ERR_MSG_UNKNOWN_ALGO, $params{algorithm} ) unless defined $sub;

    return $sub->( $params{list} );
}

# shortcut to xsort with integers
sub ixsort {
    xsort(@_);
}

# shortcut to xsort with strings
sub sxsort {
    xsort( @_, type => 'string' );
}

sub _perl_sort {
    my $list = shift;
    my @sorted = sort { $a <=> $b } @{$list};
    return \@sorted;
}

sub _perl_sort_str {
    my $list = shift;
    my @sorted = sort { $a cmp $b } @{$list};
    return \@sorted;
}

1;

__END__