I have reworked the construct as discussed earlier. I include a minimal test suite here to demonstrate the expected behavior.
#!perl
use strict;
use warnings;
use Test::More tests =>
13;
use Case;
my $case = Case::switch(
'foo' => sub {5}
);
ok($case, 'create switch');
is($case->('foo'), 5, 'found');
is($case->('bar'), undef, 'default default');
$case = Case::switch(
Case::default => sub { 'given' }
);
is($case->('foo'), 'given', 'supplied default');
$case = Case::switch(
qw(foo bar baz) => sub {'fell thru'},
Case::default => sub {'too far'}
);
is($case->('foo'), 'fell thru', 'normal fall-thru');
$case = Case::switch(
qw(foo bar) => sub {'one ' . $Case::action->('baz')},
sorbet => sub {'to cleanse the palate'},
baz => sub {'chain'}
);
is($case->('foo'), 'one chain', 'chaining');
$case = Case::switch(
qw(foo bar) => sub {"got $_"},
qw(baz) => sub {$Case::action->('foo')},
'roy' => sub { 'special '. $Case::action->('foo')},
Case::default => sub { 'Just wasting space' }
);
is($case->('foo'), 'got foo', 'arg is $_');
is($case->('baz'), 'got baz', 'arg is $_ when chained');
is($case->('roy'), 'special got roy', 'cat chained return');
# Weird ones
ok(Case::switch(), 'completely empty');
ok(Case::switch(sub{}), 'default only');
ok(Case::switch('foo'), 'term, no sub');
diag("Should get a malformed switch warning");
ok(Case::switch(sub{}, sub{}), 'malformed switch warning');
and the module itself, which is more lightweight and (I think) elegant than before:
package Case;
use Carp;
use Exporter;
@ISA=(Exporter);
@EXPORT_OK=qw(switch default);
use strict;
use warnings;
sub default {}
sub switch {
my %swash;
my $default = \&default;
my $code;
my $assigned_code;
# Handle degenerate case
return $default if (@_ == 0);
# Handle default
if ((ref $_[-1]) eq 'CODE' and (@_ ==1 or ref $_[-2] eq 'CODE')) {
$default = pop(@_);
}
for my $item (reverse @_) {
if ((my $reftype = ref $item) eq 'CODE') {
carp "Malformed switch: action with no terms"
if $code and ! $assigned_code;
$code = $item;
$assigned_code = 0;
}
elsif ($reftype) {
croak "switch cannot handle $reftype-ref arguments";
}
else {
$swash{$item} = $code;
++$assigned_code;
}
}
carp "Malformed switch: action with no terms"
if $code and ! $assigned_code;
return sub {
local($_) = @_;
local $Case::action = sub { ($swash{$_[0]} || $default)->() };
&$Case::action;
};
}
1;