root/trunk/plagger/lib/Plagger/Walker.pm

Revision 1386 (checked in by miyagawa, 14 years ago)
  • Add Publish::JSON
  • Add Plagger::Walker to get serialized data
Line 
1 package Plagger::Walker;
2 use strict;
3 use Carp;
4 use Scalar::Util qw(blessed);
5 use UNIVERSAL;
6
7 sub new {
8     my $class = shift;
9     my $self  = @_ ? {@_} : {};
10     bless $self, $class;
11 }
12
13 *isa = \&UNIVERSAL::isa;
14
15 sub apply($&;@) {
16     my $self = shift;
17     my $code = shift;
18     my $keyapp = $self->{apply_keys} ?
19         sub { $code->(shift) } : sub { shift };
20     my $curry; # recursive so can't init
21     $curry = sub {
22         my @retval;
23         for my $arg (@_){
24             my $class = ref $arg;
25             croak 'blessed reference forbidden'
26                 if  !$self->{apply_blessed} and blessed $arg;
27             my $val =
28                 !$class ?
29                     $code->($arg) :
30                 isa($arg, 'ARRAY') ?
31                     [ $curry->(@$arg) ] :
32                 isa($arg, 'HASH') ?
33                     {
34                      map { $keyapp->($_)
35                                => $curry->($arg->{$_}) } keys %$arg
36                     } :
37                 isa($arg, 'SCALAR') ?
38                     \do{ $curry->($$arg) } :
39                 isa($arg, 'REF') && $self->{apply_ref} ?
40                     \do{ $curry->($$arg) } :
41                 isa($arg, 'GLOB')  ?
42                     *{ $curry->(*$arg) } :
43                 isa($arg, 'CODE') && $self->{apply_code} ?
44                     $code->($arg) :
45                 croak "I don't know how to apply to $class" ;
46             bless $val, $class if blessed $arg;
47             push @retval, $val;
48         }
49         return wantarray ? @retval : $retval[0];
50     };
51     @_ ? $curry->(@_) : $curry;
52 }
53
54 sub serialize {
55     my($class, $stuff) = @_;
56
57     my $curry;
58     $curry = sub {
59         my @retval;
60         for my $arg (@_) {
61             my $class = ref $arg;
62             my $val =
63                 blessed $arg && $arg->can('serialize') ?
64                     $arg->serialize :
65                 !$class ?
66                     $arg :
67                 isa($arg, 'ARRAY') ?
68                     [ $curry->(@$arg) ] :
69                 isa($arg, 'HASH') ?
70                     {
71                      map { $_ => $curry->($arg->{$_}) } keys %$arg
72                     } :
73                 isa($arg, 'SCALAR') ?
74                     \do{ $curry->($$arg) } :
75                 isa($arg, 'REF') ?
76                     \do{ $curry->($$arg) } :
77                 isa($arg, 'GLOB')  ?
78                     *{ $curry->(*$arg) } :
79                 isa($arg, 'CODE') ?
80                     $arg :
81                 croak "I don't know how to apply to $class" ;
82             push @retval, $val;
83         }
84         return wantarray ? @retval : $retval[0];
85     };
86     $curry->($stuff);
87 }
88
89 1;
90
Note: See TracBrowser for help on using the browser.