File Coverage

blib/lib/Data/Transform/ExplicitMetadata.pm
Criterion Covered Total %
statement 240 277 86.6
branch 115 164 70.1
condition 47 77 61.0
subroutine 34 38 89.4
pod 2 2 100.0
total 438 558 78.4


line stmt bran cond sub pod time code
1             package Data::Transform::ExplicitMetadata;
2              
3 5     5   2659 use strict;
  5         8  
  5         133  
4 5     5   19 use warnings;
  5         6  
  5         128  
5              
6 5     5   18 use Scalar::Util;
  5         8  
  5         271  
7 5     5   2532 use Symbol;
  5         3967  
  5         351  
8 5     5   27 use Carp;
  5         6  
  5         349  
9 5     5   23 use Fcntl qw(F_GETFL O_WRONLY O_RDWR O_APPEND);
  5         7  
  5         339  
10              
11             our $VERSION = "0.07";
12              
13 5     5   25 use base 'Exporter';
  5         10  
  5         8872  
14              
15             our @EXPORT_OK = qw( encode decode );
16              
17             our $HAS_FMODE;
18             BEGIN {
19 5   50 5   13 $HAS_FMODE = eval { require FileHandle::Fmode } || '';
20             }
21              
22             sub _get_open_mode_filehandle_fmode {
23 0     0   0 my $fh = shift;
24              
25 0 0       0 return unless FileHandle::Fmode::is_FH($fh);
26              
27 0         0 my $is_append = FileHandle::Fmode::is_A($fh);
28 0 0       0 if (FileHandle::Fmode::is_WO($fh)) {
    0          
29 0 0       0 return $is_append ? '>>' : '>';
30             } elsif (FileHandle::Fmode::is_RW($fh)) {
31 0 0       0 return $is_append ? '+>>' : '+<';
32             } else {
33 0         0 return '<';
34             }
35             }
36              
37             sub _get_open_mode_fcntl {
38 7     7   8 my $fh = shift;
39              
40 5     5   9306 my $flags = eval { no warnings 'uninitialized';
  5         8  
  5         7973  
  7         10  
41 7         44 fcntl($fh, F_GETFL, my $junk) };
42 7 50       15 return unless $flags;
43              
44 7         12 my $is_append = $flags & O_APPEND;
45 7 100       22 if ($flags & O_WRONLY) {
    100          
46 3 100       19 return $is_append ? '>>' : '>';
47             } elsif ($flags & O_RDWR) {
48 2 100       7 return $is_append ? '+>>' : '+<';
49             } else {
50 2         13 return '<';
51             }
52             }
53              
54             sub _get_open_mode {
55 7     7   8 my $fh = shift;
56              
57 7   33     16 return _get_open_mode_fcntl($fh)
58             ||
59             ($HAS_FMODE && _get_open_mode_filehandle_fmode($fh));
60             }
61              
62             sub encode {
63 111     111 1 22408 my $value = shift;
64 111         96 my $path_expr = shift;
65 111         96 my $seen = shift;
66              
67 111 100       204 if (!ref($value)) {
68 52         52 my $ref_to_value = \$value;
69 52         64 my $ref = ref($ref_to_value);
70 52         47 my $encoded_value = $value;
71             # perl 5.8 - ref() with a vstring returns SCALAR
72 52 50 33     324 if ($ref eq 'GLOB'
      33        
73             or
74             $ref eq 'VSTRING' or Scalar::Util::isvstring($value)
75             ) {
76 0         0 $encoded_value = encode($ref_to_value, $path_expr, $seen);
77 0         0 delete $encoded_value->{__refaddr};
78 0         0 delete $seen->{$ref_to_value};
79             }
80 52         145 return $encoded_value;
81             }
82              
83 59   100     162 $path_expr ||= '$VAR';
84 59   100     129 $seen ||= {};
85              
86 59         122 my $reftype = Scalar::Util::reftype($value);
87 59         86 my $refaddr = Scalar::Util::refaddr($value);
88 59         96 my $blesstype = Scalar::Util::blessed($value);
89              
90 59         58 my $encoded_value;
91              
92 59 100       148 if ($seen->{$value}) {
93             $encoded_value = { __reftype => $reftype,
94             __refaddr => $refaddr,
95             __recursive => 1,
96 7         23 __value => $seen->{$value} };
97 7 100       16 $encoded_value->{__blessed} = $blesstype if $blesstype;
98 7         21 return $encoded_value;
99             }
100 52         99 $seen->{$value} = $path_expr;
101              
102             # Build a new path string for recursive calls
103             my $_p = sub {
104 86 100 100 86   399 return join('', '${', $path_expr, '}') if ($reftype eq 'SCALAR' or $reftype eq 'REF');
105 64 100       175 return join('', '*{', $path_expr, '}') if ($reftype eq 'GLOB');
106              
107 42 100       100 my @bracket = $reftype eq 'ARRAY' ? ( '[', ']' ) : ( '{', '}' );
108 42         249 return sprintf('%s->%s%s%s', $path_expr, $bracket[0], $_, $bracket[1]);
109 52         187 };
110              
111 52 100       172 if (my $tied = _is_tied($value)) {
112 4         7 local $_ = 'tied'; # &$_p needs this
113 4         12 my $original = encode(_untie_and_get_original_value($value), &$_p, $seen);
114             $encoded_value = { __reftype => $reftype,
115             __refaddr => $refaddr,
116 4 100       20 __tied => ref($original) ? $original->{__value} : $original,
117             __value => encode($tied, &$_p, $seen) };
118 4         11 _retie($value, $tied);
119 4 50       11 $encoded_value->{__blessed} = $blesstype if $blesstype;
120 4         34 return $encoded_value;
121             }
122              
123 48 100 100     390 if ($reftype eq 'HASH') {
    100 66        
    100 33        
    50 66        
    100 33        
    100          
    50          
    50          
124 6         33 $encoded_value = { map { $_ => encode($value->{$_}, &$_p, $seen) } sort(keys %$value) };
  13         26  
125              
126             } elsif ($reftype eq 'ARRAY') {
127 12         38 $encoded_value = [ map { encode($value->[$_], &$_p, $seen) } (0 .. $#$value) ];
  25         56  
128              
129             } elsif ($reftype eq 'GLOB') {
130 12         15 my %encoded_value = map { $_ => encode(*{$value}{$_},
  12         31  
131             &$_p."{$_}",
132             $seen) }
133 9         17 grep { *{$value}{$_} }
  27         24  
  27         49  
134             qw(HASH ARRAY SCALAR);
135 9         13 @encoded_value{'NAME','PACKAGE'} = (*{$value}{NAME}, *{$value}{PACKAGE});
  9         18  
  9         26  
136 9 100       10 if (*{$value}{CODE}) {
  9         25  
137 1         2 $encoded_value{CODE} = encode(*{$value}{CODE}, &$_p, $seen);
  1         5  
138             }
139 9 100       8 if (*{$value}{IO}) {
  9         57  
140 7 50       43 if ( $encoded_value{IO} = encode(fileno(*{$value}{IO}), &$_p, $seen) )
  7         31  
141             {
142 7         8 $encoded_value{IOmode} = _get_open_mode(*{$value}{IO});
  7         17  
143 7         38 $encoded_value{IOseek} = sysseek($value, 0, 1);
144             }
145             }
146 9         19 $encoded_value = \%encoded_value;
147             } elsif (($reftype eq 'REGEXP')
148             or ($reftype eq 'SCALAR' and defined($blesstype) and $blesstype eq 'Regexp')
149             ) {
150 0         0 $reftype = 'REGEXP';
151 0 0       0 undef($blesstype) unless $blesstype ne 'Regexp';
152 0         0 my($pattern, $modifiers);
153 0 0       0 if ($^V ge v5.9.5) {
154 0         0 require re;
155             }
156 0 0       0 if (defined &re::regexp_pattern) {
157 0         0 ($pattern, $modifiers) = re::regexp_pattern($value);
158             } else {
159 0         0 my $value_as_str = "$value";
160 0         0 ($modifiers, $pattern) = $value_as_str =~ m/\(\?(\w*)-\w*:(.*)\)$/;
161             }
162 0         0 $encoded_value = [ $pattern, $modifiers ];
163             } elsif ($reftype eq 'CODE') {
164 1         3 (my $copy = $value.'') =~ s/^(\w+)\=//; # Hack to change CodeClass=CODE(0x123) to CODE=(0x123)
165 1         5 $encoded_value = $copy;
166             } elsif ($reftype eq 'REF') {
167 6         8 $encoded_value = encode($$value, &$_p, $seen );
168             } elsif (($reftype eq 'VSTRING') or (ref($value) eq 'SCALAR' and Scalar::Util::isvstring($$value))) {
169 0         0 $reftype = 'VSTRING';
170 0         0 $encoded_value = [ unpack('c*', $$value) ];
171             } elsif ($reftype eq 'SCALAR') {
172 14         28 $encoded_value = encode($$value, &$_p, $seen);
173             }
174              
175 48         134 $encoded_value = { __reftype => $reftype, __refaddr => $refaddr, __value => $encoded_value };
176 48 100       81 $encoded_value->{__blessed} = $blesstype if $blesstype;
177              
178 48         258 return $encoded_value;
179             }
180              
181             sub _is_tied {
182 56     56   55 my $ref = shift;
183              
184 56         108 my $reftype = Scalar::Util::reftype($ref);
185 56         39 my $tied;
186 56 100       198 if ($reftype eq 'HASH') { $tied = tied %$ref }
  8 100       16  
    100          
    100          
187 14         22 elsif ($reftype eq 'ARRAY') { $tied = tied @$ref }
188 16         19 elsif ($reftype eq 'SCALAR') { $tied = tied $$ref }
189 11         13 elsif ($reftype eq 'GLOB') { $tied = tied *$ref }
190              
191 56         155 return $tied;
192             }
193              
194             sub _untie_and_get_original_value {
195 4     4   6 my $ref = shift;
196              
197 4         10 my $tied_val = _is_tied($ref);
198 4         14 my $class = Scalar::Util::blessed($tied_val);
199 4         12 my $untie_function = join('::', $class, 'UNTIE');
200 5     5   303 no strict 'refs';
  5         61  
  5         273  
201 4     4   41 local *$untie_function = sub { };
202 5     5   21 use strict 'refs';
  5         6  
  5         1231  
203              
204 4         12 my $reftype = Scalar::Util::reftype($ref);
205 4         5 my $original;
206 4 50       32 if (!$reftype) {
    100          
    100          
    100          
    50          
207 0         0 untie $ref;
208 0         0 $original = $ref;
209             } elsif ($reftype eq 'SCALAR') {
210 1         4 untie $$ref;
211 1         2 $original = $$ref;
212             } elsif ($reftype eq 'ARRAY') {
213 1         4 untie @$ref;
214 1         5 $original = [ @$ref ];
215             } elsif ($reftype eq 'HASH') {
216 1         4 untie %$ref;
217 1         5 $original = { %$ref };
218             } elsif ($reftype eq 'GLOB') {
219 1         4 untie *$ref;
220 1         4 my $pkg = *$ref{PACKAGE};
221 1         4 my $name = *$ref{NAME};
222 1         4 $original = _create_anon_ref_of_type('GLOB', $pkg, $name);
223 1         5 *$original = *$ref;
224             } else {
225 0         0 Carp::croak("Cannot retrieve the original value of a tied $reftype");
226             }
227 4         24 return $original;
228             }
229              
230             sub _retie {
231 8     8   14 my($ref, $value) = @_;
232              
233 8         22 my $reftype = Scalar::Util::reftype($ref);
234 8         23 my $class = Scalar::Util::blessed($value);
235 5     5   26 no strict 'refs';
  5         7  
  5         155  
236 5     5   24 no warnings 'redefine';
  5         8  
  5         2222  
237 8 100       38 if ($reftype eq 'SCALAR') {
    100          
    100          
    50          
238 2         7 my $tiescalar = join('::',$class, 'TIESCALAR');
239 2     2   18 local *$tiescalar = sub { return $value };
  2         12  
240 2         10 tie $$ref, $class;
241              
242             } elsif ($reftype eq 'ARRAY') {
243 2         12 my $tiearray = join('::', $class, 'TIEARRAY');
244 2     2   15 local *$tiearray = sub { return $value };
  2         10  
245 2         8 tie @$ref, $class;
246              
247             } elsif ($reftype eq 'HASH') {
248 2         5 my $tiehash = join('::', $class, 'TIEHASH');
249 2     2   15 local *$tiehash = sub { return $value };
  2         11  
250 2         8 tie %$ref, $class;
251              
252             } elsif ($reftype eq 'GLOB') {
253 2         7 my $tiehandle = join('::', $class, 'TIEHANDLE');
254 2     2   14 local *$tiehandle = sub { return $value };
  2         10  
255 2         16 tie *$ref, $class;
256              
257             } else {
258 0         0 Carp::croak('Cannot recreate a tied '.scalar(ref $value));
259             }
260             }
261              
262             sub _create_anon_ref_of_type {
263 8     8   19 my($type, $package, $name) = @_;
264              
265 8 100       45 if ($type eq 'SCALAR') {
    100          
    100          
    50          
266 1         6 my $anon;
267 1         3 return \$anon;
268             } elsif ($type eq 'ARRAY') {
269 1         3 return [];
270             } elsif ($type eq 'HASH') {
271 1         4 return {};
272             } elsif ($type eq 'GLOB') {
273 5         6 my $rv;
274 5 100 66     66 if ($package and $name
      66        
      33        
275             and
276             $package ne 'Symbol'
277             and
278             $name !~ m/GEN\d/
279             ) {
280 4         10 my $globname = join('::',$package, $name);
281 5     5   29 $rv = do { no strict 'refs'; local *$globname; \*$globname; };
  5         13  
  5         7998  
  4         3  
  4         17  
  4         12  
282             } else {
283 1         6 $rv = Symbol::gensym();
284             }
285 5         30 return $rv;
286             }
287             }
288              
289             sub _recreate_fh {
290 1     1   2 my($fileno, $mode) = @_;
291              
292 1         1 my $fh;
293 1 50       3 if ($mode) {
294 0 0       0 open($fh, $mode . '&=', $fileno)
295             || Carp::carp("Couldn't open filehandle for descriptor $fileno with mode $mode: $!");
296              
297             } else {
298 1 50 33     16 open($fh, '>&=', $fileno)
299             || open($fh, '<&=', $fileno)
300             || Carp::carp("Couldn't open filehandle for descriptor $fileno: $!");
301             }
302 1         3 return $fh;
303             }
304              
305             sub decode {
306 71     71 1 19151 my($input, $recursive_queue, $recurse_fill) = @_;
307              
308 71 100       134 unless (ref $input) {
309 27         109 return $input;
310             }
311              
312 44         83 _validate_decode_structure($input);
313              
314 44         87 my($value, $reftype, $refaddr, $blessed) = @$input{'__value','__reftype','__refaddr','__blessed'};
315 44         36 my $rv;
316 44         47 my $is_first_invocation = ! $recursive_queue;
317 44   100     100 $recursive_queue ||= [];
318              
319 44 100       174 if ($input->{__recursive}) {
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    0          
    0          
320 7         8 my $path = $input->{__value};
321             push @$recursive_queue,
322             sub {
323 7     7   10 my $VAR = shift;
324 7         437 $recurse_fill->(eval $path);
325 7         17 };
326              
327             } elsif ($input->{__tied}) {
328 4         10 $rv = _create_anon_ref_of_type($reftype);
329 4         6 my $tied_value;
330 4     0   29 $tied_value = decode($value, $recursive_queue, sub { $tied_value });
  0         0  
331 4         17 _retie($rv, $tied_value);
332              
333             } elsif ($reftype eq 'SCALAR') {
334 8         12 $rv = \$value;
335              
336             } elsif ($reftype eq 'ARRAY') {
337 11         21 $rv = [];
338 11         40 for (my $i = 0; $i < @$value; $i++) {
339 23         20 my $idx = $i;
340 23     4   120 push @$rv, decode($value->[$i], $recursive_queue, sub { $rv->[$idx] = shift });
  4         15  
341             }
342              
343             } elsif ($reftype eq 'HASH') {
344 5         8 $rv = {};
345 5         20 foreach my $key ( sort keys %$value ) {
346 12         12 my $k = $key;
347 12     1   50 $rv->{$key} = decode($value->{$key}, $recursive_queue, sub { $rv->{$k} = shift });
  1         4  
348             }
349              
350             } elsif ($reftype eq 'GLOB') {
351             my $is_real_glob = ($value->{PACKAGE} ne 'Symbol'
352             and $value->{NAME} !~ m/^GEN\d+/
353 3   33     27 and $value->{NAME} =~ m/^\w/);
354 3         10 $rv = _create_anon_ref_of_type('GLOB', $value->{PACKAGE}, $value->{NAME});
355              
356 3         9 foreach my $type ( keys %$value ) {
357 14 50 100     85 next if ($type eq 'NAME' or $type eq 'PACKAGE' or $type eq 'IOseek' or $type eq 'IOmode');
      66        
      66        
358 8 100       22 if ($type eq 'IO') {
    100          
359 1 50       2 if (my $fileno = $value->{IO}) {
360 1         5 $rv = _recreate_fh($fileno, $value->{IOmode});
361             }
362             } elsif ($type eq 'CODE') {
363 1 50       2 *{$rv} = \&_dummy_sub unless ($is_real_glob);
  0         0  
364              
365             } else {
366 6     0   23 *{$rv} = decode($value->{$type}, $recursive_queue, sub { *{$rv} = shift });
  6         14  
  0         0  
  0         0  
367             }
368             }
369              
370 3 50       8 $rv = *$rv unless $refaddr;
371              
372             } elsif ($reftype eq 'CODE') {
373 0         0 $rv = \&_dummy_sub;
374              
375             } elsif ($reftype eq 'REF') {
376 6         4 my $ref;
377 6     2   22 $ref = decode($value, $recursive_queue, sub { $ref = shift });
  2         6  
378 6         8 $rv = \$ref;
379              
380             } elsif ($reftype eq 'REGEXP') {
381 0         0 my($pattern,$modifiers) = @$value[0,1];
382 0         0 $rv = eval "qr($pattern)$modifiers";
383              
384             } elsif ($reftype eq 'VSTRING') {
385 0         0 my $vstring = eval 'v' . join('.', @$value);
386 0 0       0 $rv = $refaddr ? \$vstring : $vstring;
387              
388             }
389              
390 44 100 100     112 bless $rv, $blessed if ($blessed and ! $input->{__recursive});
391              
392 44 100       75 if ($is_first_invocation) {
393 16         37 $_->($rv) foreach @$recursive_queue;
394             }
395              
396 44         102 return $rv;
397             }
398              
399             sub _dummy_sub {
400 0     0   0 'Put in place by ' . __PACKAGE__ . ' when it could not find the named sub';
401             }
402              
403             sub _validate_decode_structure {
404 44     44   42 my $input = shift;
405              
406 44 50       88 ref($input) eq 'HASH'
407             or Carp::croak('Invalid decode data: expected hashref but got '.ref($input));
408              
409             exists($input->{__value})
410 44 50       78 or Carp::croak('Invalid decode data: expected key __value');
411             exists($input->{__reftype})
412 44 50       76 or Carp::croak('Invalid decode data: expected key __reftype');
413              
414 44         77 my($reftype, $value, $blesstype) = @$input{'__reftype','__value','__blesstype'};
415             $reftype eq 'GLOB'
416             or $reftype eq 'VSTRING'
417             or exists($input->{__refaddr})
418 44 50 66     247 or Carp::croak('Invalid decode data: expected key __refaddr');
      66        
419              
420 44 50 33     180 ($blesstype and $reftype)
      33        
421             or !$blesstype
422             or Carp::croak('Invalid decode data: Cannot have __blesstype without __reftype');
423              
424             my $compatible_references =
425             ( ( $reftype eq 'SCALAR' and ! ref($value) )
426             or
427             ( $reftype eq ref($value) )
428             or
429             ( $reftype eq 'GLOB' and exists($value->{SCALAR}))
430             or
431             ( $reftype eq 'CODE' and $value and ref($value) eq '' )
432             or
433             ( $reftype eq 'REF' and ref($value) eq 'HASH' and exists($value->{__reftype}) )
434             or
435             ( $reftype eq 'REGEXP' and ref($value) eq 'ARRAY' )
436             or
437             ( $reftype eq 'VSTRING' and ref($value) eq 'ARRAY' )
438             or
439             ( $reftype and ! ref($input->{__value}) and $input->{__recursive} )
440             or
441             ( $input->{__tied} and ref($input->{__value}) and $input->{__value}->{__blessed} )
442 44   66     517 );
443             $compatible_references or Carp::croak('Invalid decode data: __reftype is '
444             . $input->{__reftype}
445             . ' but __value is a '
446 44 50       70 . ref($input->{__value}));
447 44         46 return 1;
448             }
449              
450             1;
451              
452             =pod
453              
454             =head1 NAME
455              
456             Data::Transform::ExplicitMetadata - Encode Perl values in a json-friendly way
457              
458             =head1 SYNOPSIS
459              
460             use Data::Transform::ExplicitMetadata qw(encode decode);
461             use JSON;
462              
463             my $val = encode($some_data_structure);
464             $io->print( JSON::encode_json( $val ));
465              
466             my $data_structure_copy = decode($val);
467              
468             =head1 DESCRIPTION
469              
470             Transforms an arbitrarily nested data structure into an analogous data
471             structure composed of only simple scalars, arrayrefs and hashrefs that may
472             be safely JSON-encoded, while retaining all the Perl-specific metadata
473             about typeglobs, blessed and tied references, self-referential data,
474             reference addresses, etc.
475              
476             With a few exceptions, a copy of the original data structure can be recreated
477             from the encoded version.
478              
479             =head2 Functions
480              
481             =over 4
482              
483             =item encode
484              
485             Accepts a single value and returns a value that may be safely passed to
486             JSON::encode_json(). encode_json() cannot handle Perl-specific data like
487             blessed references or typeglobs. Non-reference scalar values like numbers
488             and strings are returned unchanged. For all references, encode()
489             returns a hashref with these keys
490              
491             =over 4
492              
493             =item * __reftype
494              
495             String indicating the type of reference, as returned by Scalar::Util::reftype()
496              
497             =item * __refaddr
498              
499             Memory address of the reference, as returned by Scalar::Util::refaddr()
500              
501             =item * __blessed
502              
503             Package this reference is blessed into, as returned by Scalar::Util::blessed.
504              
505             =item * __value
506              
507             Reference to the unblessed data.
508              
509             =item * __tied
510              
511             The original value hidden by the tie() operation.
512              
513             =item * __recursive
514              
515             Flag indicating this reference was seen before
516              
517             =back
518              
519             If the reference was not blessed or tied, then the __blessed and/or __tied keys
520             will not be present.
521              
522             C<__value> is generally a copy of the underlying data. For example, if the input
523             value is an hashref, then __value will also be a hashref containing the input
524             value's kays and values. For typeblobs and glob refs, __value will be a
525             hashref with the keys NAME, PACKAGE, SCALAR, ARRAY, HASH, IO and CODE. For
526             compiled regexps, __value will be a 2-element arrayref of the pattern and
527             modifiers. For coderefs, __value will be the stringified reference, like
528             "CODE=(0x12345678)". For v-strings and v-string refs, __value will by an
529             arrayref containing the integers making up the v-string.
530              
531             For tied objects, C<__tied> will be contain the original value hidden by tie()
532             and __value will contain the tied data. The original data is retrieved by:
533              
534             =over 4
535              
536             =item *
537              
538             call tied() to get a copy of the tied data
539              
540             =item *
541              
542             localize the UNTIE method in the appropriate class
543              
544             =item *
545              
546             untie the variable
547              
548             =item *
549              
550             save a copy of the original value
551              
552             =item *
553              
554             localize the appropriate TIE* mythod to return the tied data
555              
556             =item *
557              
558             call tie() to retie the variable
559              
560             =back
561              
562             if C<__recursive> is true, then __value will contain a string representation
563             of the first place this reference was seen in the data structure.
564              
565             encode() handles arbitrarily nested data structures, meaning that
566             values in the __values slot may also be encoded this way.
567              
568             =item decode
569              
570             Accepts a single value and returns a copy of the data structure originally
571             passed to encode(). __refaddr information is discarded and new copies of
572             nested data structures is created. Self-referential data is re-linked to the
573             appropriate placxe in the new copy. Blessed references are re-bless into
574             the original packages.
575              
576             Tied variables are re-tied by localizing the appropriate TIE* method to return
577             the tied data. The variable's original data is filled in before calling tie().
578              
579             The IO slot of typeglobs is recreated by opening the handle with the same
580             descriptor number and open mode. It will first try fcntl() with F_GETFL
581             to determine the open mode, falling back to using FileHandle::Fmode if it's
582             available. Finally, it will first try re-opening the file descriptor in
583             read mode, then write mode.
584              
585             Coderefs cannot be decoded properly. They are recreated by returning a
586             reference to a dummy sub that returns a message explaning the situation.
587              
588             =back
589              
590             =head1 SEE ALSO
591              
592             L, L, L, L
593              
594             =head1 AUTHOR
595              
596             Anthony Brummett
597              
598             =head1 COPYRIGHT
599              
600             Copyright 2016, Anthony Brummett. This module is free software. It may
601             be used, redistributed and/or modified under the same terms as Perl itself.