File Coverage

lib/Perlmazing/Perlmazing/Precompile/sort_by_key.pm

Criterion	Covered	Total	%
statement	11	37	29.7
branch	2	20	10.0
condition			n/a
subroutine	3	5	60.0
pod			n/a
total	16	62	25.8

BEGIN {
	no warnings;
	eval 'sub test_prototype (+) { 1 }; test_prototype(1);';
	undef *test_prototype;
	if (my $e = $@) {
		if ($e =~ /Malformed prototype/) {
			eval 'sub main (;\[@%]) { main_code(@_) }';
			die $@ if $@;
		} else {
			die $e;
		}
	} else {
		eval 'sub main (+) { main_code(@_) }';
		die $@ if $@;
	}
}

use Perlmazing qw(isa_hash void_context isa_array numeric list_context scalar_context);

sub main_code {
	my $list = $_[0];
	if (isa_hash $list) {
		if (void_context()) {
			my @call = caller(0);
			warn "Useless call to sort_by_key for a hash in void context (keys won't remain sorted in a hash) at $call[1] line $call[2]\n";
			return;
		}
		$list = [%$list];
	} elsif (not isa_array $list) {
		return $_[0];
	}
	my @temp;
	for (my $i = 0; $i < @$list; $i += 2) {
		push @temp, {key => $list->[$i], value => $list->[$i + 1]};
	}
	@temp = map {$_->{key}, $_->{value}} sort {
		if (lc $a->{key} eq lc $b->{key}) {
			numeric ($a->{key}, $b->{key});
		} else {
			numeric (lc $a->{key}, lc $b->{key});
		}
	} @temp;
	if (list_context()) {
		@temp;
	} elsif (scalar_context()) {
		\@temp;
	} else {
		@{$_[0]} = @temp;
	}
}

1;