File Coverage

blib/lib/KiokuDB/TypeMap/Entry/Callback.pm
Criterion Covered Total %
statement 51 60 85.0
branch 10 12 83.3
condition 3 3 100.0
subroutine 11 14 78.5
pod 0 4 0.0
total 75 93 80.6


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package KiokuDB::TypeMap::Entry::Callback;
4 15     15   113602 use Moose;
  15         1053598  
  15         107  
5              
6 15     15   79174 no warnings 'recursion';
  15         32  
  15         753  
7              
8 15     15   65 use Carp qw(croak);
  15         30  
  15         970  
9              
10 15     15   73 use namespace::clean -except => 'meta';
  15         23  
  15         135  
11              
12             with qw(KiokuDB::TypeMap::Entry::Std);
13              
14             has [qw(collapse expand)] => (
15             is => "ro",
16             isa => "Str|CodeRef",
17             required => 1,
18             );
19              
20             has [qw(id refresh)] => (
21             is => "ro",
22             isa => "Str|CodeRef",
23             );
24              
25             sub compile_collapse_body {
26 38     38 0 64 my ( $self, $class, @args ) = @_;
27              
28 38         1145 my $collapse_object = $self->collapse;
29              
30             return sub {
31 57     57   150 my ( $self, %args ) = @_;
32              
33 57         329 my @data = $args{object}->$collapse_object;
34              
35 57         1111 my $data;
36              
37 57 100 100     288 if ( @data == 1 and not ref $data[0] ) {
38 48         68 $data = $data[0];
39             } else {
40 9         27 $data = [ map { $self->visit($_) } @data ];
  18         223  
41             }
42              
43 57         305 return $self->make_entry(
44             %args,
45             data => $data,
46             );
47 38         264 };
48             }
49              
50             sub _entry_data_to_args {
51 55     55   77 my ( $self, $linker, $entry ) = @_;
52              
53 55         1424 my $data = $entry->data;
54              
55 55 100       121 if ( ref $data ) {
56 7         11 my @args;
57              
58 7         19 my $refs = 0;
59              
60 7         18 foreach my $value ( @$data ) {
61 12 100       25 if ( ref $value ) {
62 8         10 push @args, undef;
63 8         27 $linker->inflate_data($value, \$args[-1]);
64 8         16 $refs++;
65             } else {
66 4         9 push @args, $value;
67             }
68             }
69              
70 7 100       35 $linker->load_queue if $refs; # force @args to be fully vivified
71              
72 7         23 return @args;
73             } else {
74 48         137 return $data;
75             }
76             }
77              
78             sub compile_expand {
79 38     38 0 71 my ( $self, $class, @args ) =@_;
80              
81 38         1193 my $expand_object = $self->expand;
82              
83             return sub {
84 55     55   83 my ( $linker, $entry ) = @_;
85              
86 55         217 my @args = $self->_entry_data_to_args($linker, $entry);
87              
88             # does *NOT* support circular refs
89 55         1270 my $object = $entry->class->$expand_object(@args);
90              
91 55         4276 $linker->register_object( $entry => $object );
92              
93 55         150 return $object;
94 38         275 };
95             }
96              
97              
98             sub compile_refresh {
99 38     38 0 82 my ( $self, $class, @args ) = @_;
100              
101 38 50       1161 if ( my $refresh_object = $self->refresh ) {
102             return sub {
103 0     0   0 my ( $linker, $object, $entry ) = @_;
104              
105 0         0 my @args = $self->_entry_data_to_args($linker, $entry);
106              
107 0         0 $object->$refresh_object(@args);
108              
109 0         0 return $object;
110 0         0 };
111             } else {
112             return sub {
113 0     0   0 croak "No refresh method provided for $class by typemap entry $self";
114 38         272 };
115             }
116             }
117              
118             sub compile_id {
119 38     38 0 70 my ( $self, $class, @args ) = @_;
120              
121 38 50       1132 if ( my $get_id = $self->id ) {
122             return sub {
123 0     0   0 my ( $self, $object ) = @_;
124 0         0 $object->$get_id;
125 0         0 };
126             } else {
127 38         145 return "generate_uuid";
128             }
129             }
130              
131             __PACKAGE__->meta->make_immutable;
132              
133             __PACKAGE__
134              
135             __END__
136              
137             =pod
138              
139             =head1 NAME
140              
141             KiokuDB::TypeMap::Entry::Callback - Callback based inflation/deflation of objects
142              
143             =head1 SYNOPSIS
144              
145             KiokuDB::TypeMap->new(
146             entries => {
147             'My::Class' => KiokuDB::TypeMap::Entry::Callback->new(
148             expand => "new", # My::Class->new(%$self)
149             collapse => sub {
150             my $self = shift;
151             return %$self; # provide args to 'new' in this example
152             },
153             id => sub { "foo" }, # 'id' callback is optional
154             ),
155             },
156             );
157              
158             =head1 DESCRIPTION
159              
160             This L<KiokuDB::TypeMap> entry provides callback based inflation/deflation.
161              
162             The major limitation of this method is that it cannot be used for self
163             referential structures. This is because the object being inflated is only
164             constructed after all of its arguments are.
165              
166             For the overwhelming majority of the use cases this is good enough though.
167              
168             =head1 ATTRIBUTES
169              
170             =over 4
171              
172             =item collapse
173              
174             A method name or code reference invoked on the object during collapsing.
175              
176             This is evaluated in list context, and the list of values it returns will be
177             collapsed by the L<KiokuDB::Collapser> and then store.
178              
179             =item expand
180              
181             A method name or code reference invoked on the class of the object during loading.
182              
183             The arguments are as returned by the C<collapse> callback.
184              
185             =item id
186              
187             An optional method name or code reference invoked to get an ID for the object.
188              
189             If one is not provided the default (UUID based) generation is used.
190              
191             =item intrinsic
192              
193             A boolean denoting whether or not the object should be collapsed with no ID,
194             and serialized as part of its parent object.
195              
196             This is useful for value like objects, for whom the reference address makes no
197             difference (such as L<URI> objects).
198              
199             =back