package Hook::Modular::Walker; use warnings; use strict; use Carp; use Scalar::Util qw(blessed); use UNIVERSAL; our $VERSION = '0.06'; sub new { my $class = shift; my $self = @_ ? {@_} : {}; bless $self, $class; } *isa = \&UNIVERSAL::isa; sub decode_utf8 { my ($self, $stuff) = @_; $self = $self->new( apply_keys => 1 ) unless ref $self; $self->apply( sub { utf8::decode($_[0]) unless utf8::is_utf8($_[0]) } )->($stuff); } sub apply($&;@) { ## no critic my $self = shift; my $code = shift; my $keyapp = $self->{apply_keys} ? sub { $code->(shift) } : sub { shift }; my $curry; # recursive so can't init $curry = sub { my @retval; for my $arg (@_){ my $class = ref $arg; croak 'blessed reference forbidden' if !$self->{apply_blessed} and blessed $arg; my $val = !$class ? $code->($arg) : isa($arg, 'ARRAY') ? [ $curry->(@$arg) ] : isa($arg, 'HASH') ? { map { $keyapp->($_) => $curry->($arg->{$_}) } keys %$arg } : isa($arg, 'SCALAR') ? \do{ $curry->($$arg) } : isa($arg, 'REF') && $self->{apply_ref} ? \do{ $curry->($$arg) } : isa($arg, 'GLOB') ? *{ $curry->(*$arg) } : isa($arg, 'CODE') && $self->{apply_code} ? $code->($arg) : croak "I don't know how to apply to $class" ; bless $val, $class if blessed $arg; push @retval, $val; } return wantarray ? @retval : $retval[0]; }; @_ ? $curry->(@_) : $curry; } sub serialize { my ($class, $stuff) = @_; my $curry; $curry = sub { my @retval; for my $arg (@_) { my $class = ref $arg; my $val = blessed $arg && $arg->can('serialize') ? $arg->serialize : !$class ? $arg : isa($arg, 'ARRAY') ? [ $curry->(@$arg) ] : isa($arg, 'HASH') ? { map { $_ => $curry->($arg->{$_}) } keys %$arg } : isa($arg, 'SCALAR') ? \do{ $curry->($$arg) } : isa($arg, 'REF') ? \do{ $curry->($$arg) } : isa($arg, 'GLOB') ? *{ $curry->(*$arg) } : isa($arg, 'CODE') ? $arg : croak "I don't know how to apply to $class" ; push @retval, $val; } return wantarray ? @retval : $retval[0]; }; $curry->($stuff->clone); } 1;