File Coverage

blib/lib/Venus/Role/Serializable.pm
Criterion Covered Total %
statement 67 73 91.7
branch 25 30 83.3
condition 8 18 44.4
subroutine 8 9 88.8
pod 1 3 33.3
total 109 133 81.9


line stmt bran cond sub pod time code
1             package Venus::Role::Serializable;
2              
3 87     87   1575 use 5.018;
  87         305  
4              
5 87     87   508 use strict;
  87         210  
  87         2145  
6 87     87   502 use warnings;
  87         225  
  87         3716  
7              
8 87     87   561 use Venus::Role 'with';
  87         283  
  87         610  
9              
10             # METHODS
11              
12             sub serialize {
13 11     11 1 84 my ($self) = @_;
14              
15 11 100 33     150 if ( Scalar::Util::blessed($self)
      33        
      66        
16             && $self->isa('Venus::Core')
17             && $self->can('DOES')
18             && $self->DOES('Venus::Role::Valuable'))
19             {
20 3         9 return deconstruct($self, $self->value);
21             }
22              
23 8 100       34 if (UNIVERSAL::isa($self, 'ARRAY')) {
24 1         4 return deconstruct($self, [@{$self}]);
  1         4  
25             }
26              
27 7 100       25 if (UNIVERSAL::isa($self, 'CODE')) {
28 1     1   5 return sub{goto \&$self};
  1         376  
29             }
30              
31 6 100       18 if (UNIVERSAL::isa($self, 'HASH')) {
32 2         4 return deconstruct($self, {%{$self}});
  2         8  
33             }
34              
35 4 100       14 if (UNIVERSAL::isa($self, 'REF')) {
36 1         6 return deconstruct($self, ${$self});
  1         6  
37             }
38              
39 3 100       8 if (UNIVERSAL::isa($self, 'REGEXP')) {
40 1         10 return qr/$self/;
41             }
42              
43 2 100       15 if (UNIVERSAL::isa($self, 'SCALAR')) {
44 1         3 return deconstruct($self, ${$self});
  1         3  
45             }
46              
47 1         490 require Venus::Throw;
48 1         39 my $throw = Venus::Throw->new(join('::', map ucfirst, ref($self), 'error'));
49 1         12 $throw->name('on.serialize');
50 1         9 $throw->message("Can't serialize the object: $self");
51 1         7 $throw->stash(self => $self);
52 1         3 $throw->error;
53             }
54              
55             sub deconstruct {
56 19     19 0 34 my ($self, $value) = @_;
57              
58 19         63 require Scalar::Util;
59              
60 19 0 66     65 if ( Scalar::Util::blessed($value)
      33        
      33        
61             && $value->isa('Venus::Core')
62             && $value->can('DOES')
63             && $value->DOES('Venus::Role::Serializable'))
64             {
65 0         0 return $value->serialize;
66             }
67              
68 19 50       48 if (UNIVERSAL::isa($value, 'CODE')) {
69 0     0   0 return sub{goto \&$value};
  0         0  
70             }
71              
72 19 50       44 if (UNIVERSAL::isa($value, 'REF')) {
73 0         0 return deconstruct($self, ${$value});
  0         0  
74             }
75              
76 19 50       39 if (UNIVERSAL::isa($value, 'REGEXP')) {
77 0         0 return qr/$value/;
78             }
79              
80 19 100       53 if (UNIVERSAL::isa($value, 'SCALAR')) {
81 1         6 return deconstruct($self, ${$value});
  1         6  
82             }
83              
84 18 100       42 if (UNIVERSAL::isa($value, 'HASH')) {
85 2         5 my $result = {};
86 2         4 for my $key (keys %{$value}) {
  2         7  
87 2         10 $result->{$key} = deconstruct($self, $value->{$key});
88             }
89 1         18 return $result;
90             }
91              
92 16 100       36 if (UNIVERSAL::isa($value, 'ARRAY')) {
93 2         4 my $result = [];
94 2         3 for my $key (keys @{$value}) {
  2         9  
95 8         16 $result->[$key] = deconstruct($self, $value->[$key]);
96             }
97 2         14 return $result;
98             }
99              
100 14 100       41 if (Scalar::Util::blessed($value)) {
101 1         5 require Venus::Throw;
102 1         12 my $throw = Venus::Throw->new(join('::', map ucfirst, ref($self), 'error'));
103 1         10 $throw->name('on.serialize.deconstruct');
104 1         10 $throw->message("Can't serialize properties in the object: $self");
105 1         4 $throw->stash(self => $self);
106 1         7 $throw->error;
107             }
108              
109 13         48 return $value;
110             }
111              
112             # EXPORTS
113              
114             sub EXPORT {
115 96     96 0 396 ['serialize']
116             }
117              
118             1;
119              
120              
121              
122             =head1 NAME
123              
124             Venus::Role::Serializable - Serializable Role
125              
126             =cut
127              
128             =head1 ABSTRACT
129              
130             Serializable Role for Perl 5
131              
132             =cut
133              
134             =head1 SYNOPSIS
135              
136             package Example;
137              
138             use Venus::Class;
139              
140             with 'Venus::Role::Serializable';
141              
142             attr 'test';
143              
144             package main;
145              
146             my $example = Example->new(test => 123);
147              
148             # $example->serialize;
149              
150             # {test => 123}
151              
152             =cut
153              
154             =head1 DESCRIPTION
155              
156             This package provides a mechanism for serializing objects or the return value
157             of a dispatched method call.
158              
159             =cut
160              
161             =head1 METHODS
162              
163             This package provides the following methods:
164              
165             =cut
166              
167             =head2 serialize
168              
169             serialize(Str | CodeRef $code, Any @args) (Any)
170              
171             The serialize method serializes the invocant or the return value of a
172             dispatched method call, and returns the result.
173              
174             I>
175              
176             =over 4
177              
178             =item serialize example 1
179              
180             package Example1;
181              
182             use Venus::Class 'with';
183              
184             with 'Venus::Role::Serializable';
185              
186             sub ARGS {
187             (@_[1..$#_])
188             }
189              
190             sub DATA {
191             [@_[1..$#_]]
192             }
193              
194             package main;
195              
196             my $example1 = Example1->new(1..4);
197              
198             # bless([1..4], 'Example1')
199              
200             # my $result = $example1->serialize;
201              
202             # [1..4]
203              
204             =back
205              
206             =over 4
207              
208             =item serialize example 2
209              
210             package Example2;
211              
212             use Venus::Class 'with';
213              
214             with 'Venus::Role::Serializable';
215              
216             sub ARGS {
217             (@_[1..$#_])
218             }
219              
220             sub DATA {
221             sub{[@_[1..$#_]]}
222             }
223              
224             package main;
225              
226             my $example2 = Example2->new(1..4);
227              
228             # bless(sub{[1..4]}, 'Example2')
229              
230             # my $result = $example2->serialize;
231              
232             # sub{...}
233              
234             =back
235              
236             =over 4
237              
238             =item serialize example 3
239              
240             package Example3;
241              
242             use Venus::Class 'with';
243              
244             with 'Venus::Role::Serializable';
245              
246             sub ARGS {
247             (@_[1..$#_])
248             }
249              
250             sub DATA {
251             qr{@{[join '', @_[1..$#_]]}};
252             }
253              
254             package main;
255              
256             my $example3 = Example3->new(1..4);
257              
258             # bless(qr/1234/, 'Example3')
259              
260             # my $result = $example3->serialize;
261              
262             # qr/1234/u
263              
264             =back
265              
266             =over 4
267              
268             =item serialize example 4
269              
270             package Example4;
271              
272             use Venus::Class 'with';
273              
274             with 'Venus::Role::Serializable';
275              
276             sub ARGS {
277             (@_[1..$#_])
278             }
279              
280             sub DATA {
281             \join '', @_[1..$#_]
282             }
283              
284             package main;
285              
286             my $example4 = Example4->new(1..4);
287              
288             # bless(\'1234', 'Example4')
289              
290             # my $result = $example4->serialize;
291              
292             # "1234"
293              
294             =back
295              
296             =over 4
297              
298             =item serialize example 5
299              
300             package Example5;
301              
302             use Venus::Class 'with';
303              
304             with 'Venus::Role::Serializable';
305              
306             sub ARGS {
307             (@_[1..$#_])
308             }
309              
310             sub DATA {
311             \(my $ref = \join '', @_[1..$#_])
312             }
313              
314             package main;
315              
316             my $example5 = Example5->new(1..4);
317              
318             # bless(do{\(my $ref = \'1234')}, 'Example5')
319              
320             # my $result = $example5->serialize;
321              
322             # "1234"
323              
324             =back
325              
326             =over 4
327              
328             =item serialize example 6
329              
330             package Example6;
331              
332             use Venus::Class 'base';
333              
334             base 'Venus::Array';
335              
336             package main;
337              
338             my $example6 = Example6->new([1..4]);
339              
340             # bless(..., 'Example6')
341              
342             # my $result = $example6->serialize;
343              
344             # [1..4]
345              
346             =back
347              
348             =over 4
349              
350             =item serialize example 7
351              
352             package Example7;
353              
354             use Venus::Class 'base';
355              
356             base 'Venus::Path';
357              
358             package main;
359              
360             my $example7 = Example7->new('/path/to/somewhere');
361              
362             # bless(..., 'Example7')
363              
364             # my $result = $example7->serialize;
365              
366             # "/path/to/somewhere"
367              
368             =back
369              
370             =over 4
371              
372             =item serialize example 8
373              
374             package Example8;
375              
376             use Venus::Class 'with';
377              
378             with 'Venus::Role::Serializable';
379             with 'Venus::Role::Valuable';
380              
381             package main;
382              
383             my $example8 = Example8->new(value => 123);
384              
385             # bless(..., 'Example8')
386              
387             # my $result = $example8->serialize;
388              
389             # 123
390              
391             =back
392              
393             =over 4
394              
395             =item serialize example 9
396              
397             package Example9;
398              
399             use Venus::Class 'base', 'with';
400              
401             base 'IO::Handle';
402              
403             with 'Venus::Role::Serializable';
404              
405             package main;
406              
407             my $example9 = Example9->new;
408              
409             # bless(..., 'Example9')
410              
411             # my $result = $example9->serialize;
412              
413             # Exception! (isa Venus::Error) is "on.serialize"
414              
415             =back
416              
417             =over 4
418              
419             =item serialize example 10
420              
421             package Example10;
422              
423             use Venus::Class 'attr', 'with';
424              
425             with 'Venus::Role::Serializable';
426              
427             attr 'test';
428              
429             package main;
430              
431             use IO::Handle;
432              
433             my $example10 = Example10->new(test => IO::Handle->new);
434              
435             # bless(..., 'Example10')
436              
437             # my $result = $example10->serialize;
438              
439             # Exception! (isa Venus::Error) is "on.serialize.deconstruct"
440              
441             =back
442              
443             =cut
444              
445             =head1 AUTHORS
446              
447             Awncorp, C
448              
449             =cut
450              
451             =head1 LICENSE
452              
453             Copyright (C) 2000, Al Newkirk.
454              
455             This program is free software, you can redistribute it and/or modify it under
456             the terms of the Apache license version 2.0.
457              
458             =cut