File Coverage

blib/lib/Sort/Half/Maker.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	12	12	100.0
condition	14	18	77.7
subroutine	5	5	100.0
pod	1	1	100.0
total	67	71	94.3

package Sort::Half::Maker;

use strict;
use warnings;

our $VERSION = '0.04';

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__