File Coverage

blib/lib/Data/Dumper/UnDumper.pm
Criterion Covered Total %
statement 32 37 86.4
branch 8 12 66.6
condition 2 3 66.6
subroutine 5 5 100.0
pod 1 1 100.0
total 48 58 82.7


line stmt bran cond sub pod time code
1             package Data::Dumper::UnDumper;
2             $Data::Dumper::UnDumper::VERSION = '0.02';
3             # ABSTRACT: load Data::Dumper output, including self-references
4              
5 2     2   310346 use 5.006;
  2         9  
6 2     2   11 use strict;
  2         4  
  2         90  
7 2     2   12 use warnings;
  2         4  
  2         1307  
8              
9             =head1 NAME
10              
11             Data::Dumper::UnDumper - load Dumper output including $VAR1 refs
12              
13              
14             =head1 SYNOPSIS
15              
16             Load in a L output via eval, including supporting C<$VAR1>
17             style references etc as emitted if you don't set the C option:
18              
19             use Data::Dumper::UnDumper;
20            
21             my $complex_ref = { ... };
22             my $dumped = Data::Dumper::Dumper($complex_ref);
23              
24             my $undumped = Data::Dumper::UnDumper::undumper($dumped);
25              
26             =head1 DESCRIPTION
27              
28             Firstly, a safety warning: loading L output, which is designed
29             to be Ced, is a big safety risk if the data comes from an untrusted
30             source. It's evaled as Perl code, so it can do anything you could write a
31             Perl program to. Future versions of this module may use L to mitigate
32             that risk somewhat, but it's still there - to support object references,
33             C would have to be allowed.
34              
35             So, given the choice, what should you use instead? Any of the many serialisation
36             options that don't serialise as code - for e.g. JSON, YAML, etc.
37              
38             I wrote this module, though, because I didn't have a choice - I was receiving
39             L output which had been written to a log in the past by some code,
40             without using the C<<$Data::Dumper::PURITY>> setting, so it included C<$VAR1>
41             references, including re-used L objects.
42              
43             This has been lightly tested with the default output from C.
44             It's quite likely that you could have L generate output this will
45             not handle by setting some of the dumping options.
46              
47             =head1 SUBROUTINES
48              
49             =head2 undumper
50              
51             Given the output of L's C / C method, "undump"
52             it, deserialising it back in to a Perl scalar/object, handling `$VAR1`
53             references.
54              
55             =cut
56              
57             sub undumper {
58 1     1 1 204028 my $dumper_in = shift;
59             # First, remove the leading $VAR1 assignment, we're going to assign to
60             # our own var.
61 1         11 $dumper_in =~ s{^\$VAR1 = }{};
62              
63             # Next, for all the VAR1 refs, turn them into a string we can eval later
64             # They'll turn into a quoted form of e.g. "DUMPERREF:$_->{'foo'}" or whatever
65 1         13 $dumper_in =~ s{\$VAR1->(.+)(,|$)}{
66 3         9 my $cap = $1;
67 3         8 my $end = $2;
68 3         12 $cap =~ s/\{/\\{/g;
69 3         10 $cap =~ s/\}/\\}/g;
70 3         20 "q{DUMPERREF:\$obj->$cap}".$end
71             }xge;
72              
73             # Right, now we can eval it (FIXME: do this as safely as an eval can be done,
74             # e.g. using Safe)
75 1         228 my $obj = eval $dumper_in;
76              
77             # Firstly, if the Data::Dumper-ed thing was just e.g. a plain scalar, we
78             # have no more work to do
79 1 50       34 if (!ref $obj) {
80 0         0 return $obj;
81             }
82              
83             # Start recursing (passing the ref as both args, this first call will
84             # then start walking and recursing
85 1         9 _recurse_resolve($obj, $obj);
86              
87 1         4 return $obj;
88              
89             }
90              
91             # Given a reference to the object we undumpered walk through its values
92             # (array / hash values), recursing whenever another level is encountered.
93             sub _recurse_resolve {
94 10     10   23 my ($value, $obj, $depth) = @_;
95              
96 10 50       27 if ($depth++ > 50) {
97 0         0 die "Too many levels of recursion resolving this dumper input "
98             . " - stopping at depth $depth on value $value";
99             }
100              
101 10 50       31 if (ref $value eq 'ARRAY') {
    100          
102 0         0 for (@$value) { _recurse_resolve($_, $obj, $depth); }
  0         0  
103             } elsif (ref $value eq 'HASH') {
104 4         13 for (values %$value) { _recurse_resolve($_, $obj, $depth); }
  9         28  
105             } else {
106             # A plain value, resolve it if it's a DUMPERREF
107 6 100 66     50 if ($value && $value =~ /^DUMPERREF:(.+)$/) {
108             # We need to unescape the escaped braces first, then what we're
109             # left with should be safe to eval (FIXME prob use Safe here?)
110 3         10 my $ref = $1;
111 3         7 $ref =~ s/\\\{/\{/g;
112 3         6 $ref =~ s/\\\}/\}/g;
113 3         261 $value = eval $ref;
114              
115             # If the value we get is a token, then this was a ref to another
116             # ref, and we need to resolve that too
117 3 50       18 if ($value =~ /^DUMPERREF:(.+)$/) {
118 0         0 _recurse_resolve($value, $obj, $depth);
119             }
120 3         10 $_[0] = $value;
121             }
122             }
123             }
124              
125              
126             =head1 SEE ALSO
127              
128             =over
129              
130             =item L
131              
132             Doesn't support cyclical references, blessed objects.
133              
134             =item L
135              
136             Safer as it uses PPI not C, but doesn't support blessed objects
137             or refs.
138              
139             =item plain old eval
140              
141             For simple Data::Dumper output you can of course just C it, but that
142             falls down when the output includes references to other parts of the object
143             e.g. C<< 'foo' => $VAR1->{'bar'} >>
144              
145             =back
146              
147              
148             =head1 AUTHOR
149              
150             David Precious (BIGPRESH), C<< >>
151              
152             =head1 COPYRIGHT AND LICENCE
153              
154             Copyright (C) 2023-2024 by David Precious
155              
156             This library is free software; you can redistribute it and/or modify
157             it under the same terms as Perl itself.
158              
159             =head1 ACKNOWLEDGEMENTS
160              
161             =cut
162              
163              
164             1; # End of Data::Dumper::UnDumper