root/branches/hackathon-summary/plagger/lib/Plagger/Walker.pm

package Plagger::Walker;
use strict;
use Carp;
use Scalar::Util qw(blessed);
use UNIVERSAL;

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;