File Coverage

blib/lib/Sort/Half/Maker.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	12	12	100.0
condition	16	18	88.8
subroutine	5	5	100.0
pod	1	1	100.0
total	69	71	97.1

package Sort::Half::Maker;

use strict;
use warnings;

our $VERSION = '0.03';

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(make_halfsorter make_halfsort);

sub make_halfsort {
    my %args = @_;
    my $sort_sub = $args{fallback} || sub ($$) { $_[0] cmp $_[1] };
    my %start_hash;
    if ($args{start}) {
        my @start = @{$args{start}};
        #@start_hash{@start} = (1..@start);
        my $idx = 1;
        for (@start) { $start_hash{$_} = $idx unless exists $start_hash{$_}; $idx++ };
    }
    my %end_hash;
    if ($args{end}) {
        my @end = @{$args{end}};
        #@end_hash{@end} = (1..@end);
        my $idx = 1; # the same as "@end_hash{@end} = (1..@end)" but keeps the first occurrence
        for (@end) { $end_hash{$_} = $idx unless exists $end_hash{$_}; $idx++ };
    }
    return sub ($$) {
               my ($left, $right) = @_;
               if ($start_hash{$left} || $start_hash{$right}) {
                   my $ia = $start_hash{$left} || keys(%start_hash)+1;
                   my $ib = $start_hash{$right} || keys(%start_hash)+1;
                   return $ia <=> $ib;
               } elsif ($end_hash{$left} || $end_hash{$right}) {
                   my $ia = $end_hash{$left} || 0;
                   my $ib = $end_hash{$right} || 0;
                   return $ia <=> $ib;
               } else {
                   return $sort_sub->($left, $right);
               }
    }

}

#sub make_halfsorter {
#    my %args = @_;
#    my $sort_sub = $args{any} || sub { $_[0] cmp $_[1] };
#    my %pre_hash;
#    if ($args{pre}) {
#        my @pre = @{$args{pre}};
#        @pre_hash{@pre} = (1..@pre);
#    }
#    my %post_hash;
#    if ($args{post}) {
#        my @post = @{$args{post}};
#        @post_hash{@post} = (1..@post);
#    }
#    return sub {
#        sort {
#               my ($left, $right) = map { $_ } $a, $b;
#               #my ($left, $right) = map { $_ } @_;
#               if ($pre_hash{$left} || $pre_hash{$right}) {
#                   my $ia = $pre_hash{$left} || keys(%pre_hash)+1;
#                   my $ib = $pre_hash{$right} || keys(%pre_hash)+1;
#                   return $ia <=> $ib;
#               } elsif ($post_hash{$left} || $post_hash{$right}) {
#                   my $ia = $post_hash{$left} || 0;
#                   my $ib = $post_hash{$right} || 0;
#                   return $ia <=> $ib;
#               } else {
#                   return $sort_sub->($left, $right);
#               }
#        } @_
#    }
#
#}

1;

__END__