File Coverage

blib/lib/Data/Roundtrip.pm
Criterion Covered Total %
statement 274 375 73.0
branch 112 188 59.5
condition 52 92 56.5
subroutine 38 44 86.3
pod 25 25 100.0
total 501 724 69.2


line stmt bran cond sub pod time code
1             package Data::Roundtrip;
2              
3 25     25   1715843 use 5.008;
  25         131  
4 25     25   145 use strict;
  25         44  
  25         794  
5 25     25   173 use warnings;
  25         43  
  25         2067  
6              
7             our $VERSION = '0.31';
8              
9             # import params is just one 'no-unicode-escape-permanently'
10             # if set, then unicode escaping will not happen at
11             # all, even if 'dont-bloody-escape-unicode' is set.
12             # Dump's filter and Dumper's qquote overwrite will be permanent
13             # which is more efficient but removes the flexibility
14             # of having unicode escaped and rendered at will.
15              
16 25     25   19234 use Encode qw/encode_utf8 decode_utf8/;
  25         536843  
  25         3188  
17 25     25   19160 use JSON qw/decode_json encode_json/;
  25         345511  
  25         173  
18 25     25   17072 use Unicode::Escape qw/escape unescape/;
  25         156329  
  25         2211  
19             # YAML v1.30 fails for {"\"aaa'bbb" => "aaa","bbb" => 1,}
20             # while YAML::PP and YAML::XS both succeed
21             # YAML::PP is less restrictive so using this
22             # YAML v1.31 now behaves correctly, run 'make deficiencies' to see that
23             # but since YAML author urges not use this module, we will
24             # be using YAML::PP
25             #use YAML;
26 25     25   15862 use YAML::PP qw/Load Dump/;
  25         2154067  
  25         2378  
27             # this also works with the tricky cases but it needs compilation
28             # on M$ systems and that can be tricky :(
29             #use YAML::XS;
30              
31 25     25   266 use Data::Dumper qw/Dumper/;
  25         106  
  25         1579  
32 25     25   28634 use Data::Dump qw/pp/;
  25         171404  
  25         1967  
33 25     25   14210 use Data::Dump::Filtered;
  25         10651  
  25         1571  
34              
35             # There are cases where a malformed json causes an error (not a die)
36             # but I have no idea where it is so I thought,
37             # on the expense of adding one more dependency,
38             # to include this:
39 25     25   13721 use Devel::StackTrace;
  25         115442  
  25         1012  
40              
41 25     25   199 use Exporter;
  25         54  
  25         9017  
42             # the EXPORT_OK and EXPORT_TAGS is code by [kcott] @ Perlmongs.org, thanks!
43             # see https://perlmonks.org/?node_id=11115288
44             our (@EXPORT_OK, %EXPORT_TAGS);
45              
46             my $_permanent_override = 0;
47             my $_permanent_filter = 0;
48              
49             # THESE are taken verbatim from Data::Dumper (Data/Dumper.pm)
50             # they are required for _qquote_redefinition_by_Corion()
51             # which needed to access them as, e.g. %Data::Dumper::esc
52             # because they are private vars, they are not coming out!
53             # and so here they are:
54             my $Data_Dumper_IS_ASCII = ord 'A' == 65;
55             my %Data_Dumper_esc = (
56             "\a" => "\\a",
57             "\b" => "\\b",
58             "\t" => "\\t",
59             "\n" => "\\n",
60             "\f" => "\\f",
61             "\r" => "\\r",
62             "\e" => "\\e",
63             );
64             my $Data_Dumper_low_controls = ($Data_Dumper_IS_ASCII)
65              
66             # This includes \177, because traditionally it has been
67             # output as octal, even though it isn't really a "low"
68             # control
69             ? qr/[\0-\x1f\177]/
70              
71             # EBCDIC low controls.
72             : qr/[\0-\x3f]/;
73             # END verbatim from Data::Dumper (Data/Dumper.pm)
74              
75             BEGIN {
76 25     25   178 my @file = qw{read_from_file write_to_file};
77 25         62 my @fh = qw{read_from_filehandle write_to_filehandle};
78 25         72 my @io = (@file, @fh);
79 25         71 my @json = qw{perl2json json2perl json2dump json2yaml json2json jsonfile2perl};
80 25         72 my @yaml = qw{perl2yaml yaml2perl yaml2json yaml2dump yaml2yaml yamlfile2perl};
81 25         115 my @dump = qw{perl2dump perl2dump_filtered perl2dump_homebrew};
82             # these have now (v0.28) been removed from @dump: dump2perl dump2json dump2yaml dump2dump
83             # they need to be explicitly imported *individually*
84             # because of the danger that the eval() in dump2perl()
85             # poses. They can not be imported with any EXPORT_TAG
86 25         99 my @explicit = qw{dump2perl dump2json dump2yaml dump2dump};
87 25         161 my @all = (@io, @json, @yaml, @dump);
88 25         260 @EXPORT_OK = (@all, @explicit);
89 25         4377 %EXPORT_TAGS = (
90             file => [@file],
91             fh => [@fh],
92             io => [@io],
93             json => [@json],
94             yaml => [@yaml],
95             dump => [@dump],
96             all => [@all],
97             );
98             } # end BEGIN
99              
100             sub DESTROY {
101 0 0   0   0 Data::Dump::Filtered::remove_dump_filter( \& DataDumpFilterino )
102             if $_permanent_filter;
103             }
104              
105             sub import {
106             # what comes here is (package, param1, param2...) = @_
107             # for something like
108             # use Data::Roundtrip qw/param1 params2 .../;
109             # we are looking for a param, eq to 'no-unicode-escape-permanently'
110             # or 'unicode-escape-permanently'
111             # the rest we must pass to the Exporter::import() but in a tricky way
112             # so as it injects all these subs in the proper namespace.
113             # that call is at the end, but with our parameter removed from the list
114 29     29   247590 for(my $i=@_;$i-->1;){
115 21 100       117 if( $_[$i] eq 'no-unicode-escape-permanently' ){
    100          
116 1         3 splice @_, $i, 1; # remove it from the list
117 1         3 $Data::Dumper::Useperl = 1;
118 1         2 $Data::Dumper::Useqq='utf8';
119 25     25   216 no warnings 'redefine';
  25         89  
  25         100632  
120 1         6 *Data::Dumper::qquote = \& _qquote_redefinition_by_Corion;
121 1         2 $_permanent_override = 1;
122              
123             # add a filter to Data::Dump
124 1         7 Data::Dump::Filtered::add_dump_filter( \& DataDumpFilterino );
125 1         10 $_permanent_filter = 1;
126             } elsif( $_[$i] eq 'unicode-escape-permanently' ){
127 1         3 splice @_, $i, 1; # remove it from the list
128             # this is the case which we want to escape unicode permanently
129             # which is the default behaviour for Dump and Dumper
130 1         2 $_permanent_override = 2;
131 1         3 $_permanent_filter = 2;
132             }
133             }
134             # now let Exporter handle the rest of the params if any
135             # from ikegami at https://www.perlmonks.org/?node_id=1214104
136 29         203111 goto &Exporter::import;
137             }
138              
139             sub perl2json {
140 28     28 1 367140 my $pv = $_[0];
141 28 100       123 my $params = defined($_[1]) ? $_[1] : {};
142             my $pretty_printing = exists($params->{'pretty'}) && defined($params->{'pretty'})
143 28 100 66     191 ? $params->{'pretty'} : 0
144             ;
145             my $escape_unicode = exists($params->{'escape-unicode'}) && defined($params->{'escape-unicode'})
146 28 100 66     183 ? $params->{'escape-unicode'} : 0
147             ;
148             my $convert_blessed = exists($params->{'convert_blessed'}) && defined($params->{'convert_blessed'})
149 28 50 33     151 ? $params->{'convert_blessed'} : 0
150             ;
151 28         62 my $json_string;
152             # below we check $json_string after each time it is set because of eval{} and
153             # don't want to loose $@
154 28         408 my $encoder = JSON->new;
155 28 100       158 $encoder = $encoder->pretty if $pretty_printing;
156             # convert_blessed will allow when finding objects to
157             # ask them if they have a TO_JSON method which returns
158             # the object as a perl data structure which is then converted
159             # to JSON.
160             # for example if your object stores the important data you
161             # want to print in $self->{'data'}
162             # then sub TO_JSON { shift->{'data'} }
163             # see https://perldoc.perl.org/JSON::PP#2.-convert_blessed-is-enabled-and-the-object-has-a-TO_JSON-method.
164 28 50       116 $encoder = $encoder->convert_blessed if $convert_blessed;
165 28 100       101 if( $escape_unicode ){
166 8         21 $json_string = eval { $encoder->utf8(1)->encode($pv) };
  8         185  
167 8 0 0     40 if( ! defined($json_string) ){ print STDERR "error, call to ".'JSON->new->utf8(1)->encode()'." has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
  0 50       0  
  0         0  
168 8 100       36 if ( _has_utf8($json_string) ){
169 7         49 $json_string = Unicode::Escape::escape($json_string, 'utf8');
170 7 50       51980 if( ! defined($json_string) ){ print STDERR "error, call to ".'Unicode::Escape::escape()'." has failed.\n"; return undef }
  0         0  
  0         0  
171             }
172             } else {
173 20         52 $json_string = eval { $encoder->utf8(0)->encode($pv) };
  20         649  
174 20 0 0     109 if( ! defined($json_string) ){ print STDERR "error, call to ".'JSON->new->utf8(0)->pretty->encode()'." has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
  0 50       0  
  0         0  
175             }
176             # succeeded here
177 28         275 return $json_string
178             }
179             sub perl2yaml {
180 28     28 1 492457 my $pv = $_[0];
181 28 100       117 my $params = defined($_[1]) ? $_[1] : {};
182             my $pretty_printing = exists($params->{'pretty'}) && defined($params->{'pretty'})
183 28 100 66     222 ? $params->{'pretty'} : 0
184             ;
185 28 100 33     121 print STDERR "perl2yaml() : pretty-printing is not supported for YAML output\n" and $pretty_printing=0
186             if $pretty_printing;
187              
188             my $escape_unicode = exists($params->{'escape-unicode'}) && defined($params->{'escape-unicode'})
189 28 100 66     187 ? $params->{'escape-unicode'} : 0
190             ;
191 28         141 my ($yaml_string, $escaped);
192 28 100       93 if( $escape_unicode ){
193             #if( $pretty_printing ){
194             # it's here just for historic purposes, this is not supported and a warning is issued
195             #$yaml_string = eval { YAML::PP::Dump($pv) };
196             #if( ! defined $yaml_string ){ print STDERR "error, call to ".'YAML::PP::Dump()'." has failed with this exception:\n".$@."\n"; return undef }
197             # this does not work :( no pretty printing for yaml
198             #$yaml_string = Data::Format::Pretty::YAML::format_pretty($pv);
199             #} else {
200             # intercepting a die by wrapping in an eval
201 7         19 $yaml_string = eval { YAML::PP::Dump($pv) };
  7         42  
202 7 0 0     93885 if( ! defined($yaml_string) ){ print STDERR "error, call to ".'YAML::PP::Dump()'." has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
  0 50       0  
  0         0  
203             #}
204 7 50       30 if( ! $yaml_string ){ print STDERR "perl2yaml() : error, no yaml produced from perl variable.\n"; return undef }
  0         0  
  0         0  
205 7 100       32 if( _has_utf8($yaml_string) ){
206 6         28 utf8::encode($yaml_string);
207 6         42 $yaml_string = Unicode::Escape::escape($yaml_string, 'utf8');
208             }
209             } else {
210             #if( $pretty_printing ){
211             # it's here just for historic purposes, this is not supported and a warning is issued
212             #$yaml_string = Data::Format::Pretty::YAML::format_pretty($pv);
213             #} else {
214 21         47 $yaml_string = eval { YAML::PP::Dump($pv) };
  21         198  
215 21 0 0     374811 if( ! defined($yaml_string) ){ print STDERR "error, call to ".'YAML::PP::Dump()'." has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
  0 50       0  
  0         0  
216             #}
217 21 50       101 if( ! $yaml_string ){ print STDERR "perl2yaml() : error, no yaml produced from perl variable.\n"; return undef }
  0         0  
  0         0  
218             }
219 28         33528 return $yaml_string
220             }
221             sub yaml2perl {
222 31     31 1 12928 my $yaml_string = $_[0];
223             #my $params = defined($_[1]) ? $_[1] : {};
224             # intercepting a die by wrapping in an eval
225             # Untainting YAML::PP string input because of a bug that causes it to bomb
226             # see https://perlmonks.org/?node_id=11154911
227             # untaint recipe by ysth, see
228             # https://www.perlmonks.org/?node_id=516862
229             # but it gives a warning:
230             # each on anonymous hash will always start from the beginning
231             #($yaml_string) = each %{{$yaml_string,0}};
232             # and so we do this instead
233             # Also, there is a test which check yaml with tainted input (string)
234             # t/14-yaml-tainted-input.t
235 31         72 ($yaml_string) = keys %{{$yaml_string,0}};
  31         237  
236 31         101 my $pv = eval { YAML::PP::Load($yaml_string) };
  31         172  
237 31 50 33     937489 if( ! defined($pv) ){ print STDERR "yaml2perl() : error, call to YAML::PP::Load() has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
  2 100       43  
  2         12  
238 29         156 return $pv
239             }
240             sub yamlfile2perl {
241 4     4 1 12880 my $yaml_file = $_[0];
242             #my $params = defined($_[1]) ? $_[1] : {};
243 4         16 my $contents = read_from_file($yaml_file);
244 4 50       18 if( ! defined $contents ){ print STDERR "yamlfile2perl() : error, failed to read from file '${yaml_file}'.\n"; return undef }
  0         0  
  0         0  
245 4         16 my $pv = yaml2perl($contents);
246 4 50       12 if( ! defined $pv ){ print STDERR "yamlfile2perl() : error, call to yaml2perl() has failed after reading yaml string from file '${yaml_file}'.\n"; return undef }
  0         0  
  0         0  
247 4         49 return $pv;
248             }
249             # Optional input parameter following the required $json_string
250             # is a HASHREF:
251             # 'boolean_values' => [X, Y] : this is an ARRAYREF of 2 items json-false is mapped to X
252             # and json-true is mapped to Y, e.g. [0,1].
253             # JSON's default is JSON::PP::Boolean objects. Yikes
254             sub json2perl {
255 39     39 1 244663 my $json_string = $_[0];
256 39 100       149 my $params = defined($_[1]) ? $_[1] : {};
257 39         81 my $pv;
258              
259             # NOTE: the JSON OO interface has encode() and decode()
260             # whereas the function has encode_json() and decode_json()
261 39 100       161 if( _has_utf8($json_string) ){
262 25 100 66     180 if( exists($params->{'boolean_values'}) && defined($params->{'boolean_values'}) && ref($params->{'boolean_values'})eq'ARRAY' ){
      66        
263             # in OO it needs decode()
264             # boolean_values(x,y)
265 3         7 $pv = eval {
266             JSON->new()
267 3         18 ->boolean_values(@{ $params->{'boolean_values'} })
  3         57  
268             ->utf8(0)->decode($json_string)
269             };
270             } else {
271             # intercepting a die by wrapping in an eval
272 22         50 $pv = eval { JSON::decode_json(Encode::encode_utf8($json_string)) };
  22         449  
273             }
274 25 50 33     175 if( ! defined($pv) ){ print STDERR Devel::StackTrace->new->as_string . "\njson2perl() : error, call to json2perl() has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception: $@:":".")."\n"; return undef }
  3 100       26  
  3         1831  
275             } else {
276 14 100 66     119 if( exists($params->{'boolean_values'}) && defined($params->{'boolean_values'}) && ref($params->{'boolean_values'})eq'ARRAY' ){
      66        
277             # boolean_values(x,y)
278 3         7 $pv = eval {
279             JSON->new()
280 3         37 ->boolean_values(@{ $params->{'boolean_values'} })
  3         102  
281             ->decode($json_string)
282             };
283             } else {
284             # intercepting a damn die by wrapping it around an eval
285 11         26 $pv = eval { JSON::decode_json($json_string) };
  11         335  
286             }
287 14 0 0     104 if( ! defined($pv) ){ print STDERR Devel::StackTrace->new->as_string."\njson2perl() : error, call to json2perl() has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception: $@:":".")."\n"; return undef }
  0 50       0  
  0         0  
288             }
289 36         144 return $pv;
290             }
291             sub jsonfile2perl {
292 4     4 1 8951 my $json_file = $_[0];
293 4         21 my $contents = read_from_file($json_file);
294 4 50       18 if( ! defined $contents ){ print STDERR "jsonfile2perl() : error, failed to read from file '${json_file}'.\n"; return undef }
  0         0  
  0         0  
295 4         24 my $pv = json2perl($contents, $_[1]);
296 4 50       16 if( ! defined $pv ){ print STDERR "jsonfile2perl() : error, call to json2perl() has failed after reading json string from file '${json_file}'.\n"; return undef }
  0         0  
  0         0  
297 4         42 return $pv;
298             }
299             sub json2json {
300 2     2 1 3 my $json_string = $_[0];
301 2 50       8 my $params = defined($_[1]) ? $_[1] : {};
302              
303 2         7 my $pv = json2perl($json_string, $params);
304 2 100       6 if( ! defined $pv ){ print STDERR "json2perl() : error, call to json2perl() has failed.\n"; return undef }
  1         2  
  1         3  
305 1         5 $json_string = perl2json($pv, $params);
306 1 50       4 if( ! defined $json_string ){ print STDERR "json2perl() : error, call to perl2json() has failed.\n"; return undef }
  0         0  
  0         0  
307              
308 1         7 return $json_string;
309             }
310             sub yaml2yaml {
311 0     0 1 0 my $yaml_string = $_[0];
312 0 0       0 my $params = defined($_[1]) ? $_[1] : {};
313              
314 0         0 my $pv = yaml2perl($yaml_string, $params);
315 0 0       0 if( ! defined $pv ){ print STDERR "yaml2perl() : error, call to yaml2perl() has failed.\n"; return undef }
  0         0  
  0         0  
316 0         0 $yaml_string = perl2yaml($pv, $params);
317 0 0       0 if( ! defined $yaml_string ){ print STDERR "yaml2perl() : error, call to perl2yaml() has failed.\n"; return undef }
  0         0  
  0         0  
318              
319 0         0 return $yaml_string;
320             }
321             sub dump2dump {
322 0     0 1 0 my $dump_string = $_[0];
323 0 0       0 my $params = defined($_[1]) ? $_[1] : {};
324              
325 0         0 my $pv = dump2perl($dump_string, $params);
326 0 0       0 if( ! defined $pv ){ print STDERR "dump2perl() : error, call to dump2perl() has failed.\n"; return undef }
  0         0  
  0         0  
327 0         0 $dump_string = perl2dump($pv, $params);
328 0 0       0 if( ! defined $dump_string ){ print STDERR "dump2perl() : error, call to perl2dump() has failed.\n"; return undef }
  0         0  
  0         0  
329              
330 0         0 return $dump_string;
331             }
332             sub yaml2json {
333 14     14 1 10325 my $yaml_string = $_[0];
334 14 100       73 my $params = defined($_[1]) ? $_[1] : {};
335              
336             # is it escaped already?
337 14         111 $yaml_string =~ s/\\u([0-9a-fA-F]{4})/eval "\"\\x{$1}\""/ge;
  408         25990  
338 14         169 my $pv = yaml2perl($yaml_string, $params);
339 14 100       62 if( ! $pv ){ print STDERR "yaml2json() : error, call to yaml2perl() has failed.\n"; return undef }
  1         4  
  1         5  
340 13         67 my $json = perl2json($pv, $params);
341 13 50       89 if( ! $json ){ print STDERR "yaml2json() : error, call to perl2json() has failed.\n"; return undef }
  0         0  
  0         0  
342 13         107 return $json
343             }
344             sub yaml2dump {
345 2     2 1 4 my $yaml_string = $_[0];
346 2 50       6 my $params = defined($_[1]) ? $_[1] : {};
347              
348 2         10 my $pv = yaml2perl($yaml_string, $params);
349 2 100       9 if( ! $pv ){ print STDERR "yaml2json() : error, call to yaml2perl() has failed.\n"; return undef }
  1         4  
  1         5  
350 1         6 my $dump = perl2dump($pv, $params);
351 1 50       149 if( ! $dump ){ print STDERR "yaml2dump() : error, call to perl2dump() has failed.\n"; return undef }
  0         0  
  0         0  
352 1         10 return $dump
353             }
354             sub json2dump {
355 6     6 1 9877 my $json_string = $_[0];
356 6 50       25 my $params = defined($_[1]) ? $_[1] : {};
357              
358 6         28 my $pv = json2perl($json_string, $params);
359 6 100       23 if( ! $pv ){ print STDERR "json2json() : error, call to json2perl() has failed.\n"; return undef }
  1         4  
  1         4  
360 5         19 my $dump = perl2dump($pv, $params);
361 5 50       594 if( ! $dump ){ print STDERR "json2dump() : error, call to perl2dump() has failed.\n"; return undef }
  0         0  
  0         0  
362 5         32 return $dump
363             }
364             sub dump2json {
365 4     4 1 73 my $dump_string = $_[0];
366 4 50       15 my $params = defined($_[1]) ? $_[1] : {};
367              
368 4         19 my $pv = dump2perl($dump_string, $params);
369 4 100       15 if( ! $pv ){ print STDERR "dump2json() : error, call to dump2perl() has failed.\n"; return undef }
  1         3  
  1         4  
370 3         13 my $json_string = perl2json($pv, $params);
371 3 50       11 if( ! $json_string ){ print STDERR "dump2json() : error, call to perl2json() has failed.\n"; return undef }
  0         0  
  0         0  
372 3         17 return $json_string
373             }
374             sub dump2yaml {
375 0     0 1 0 my $dump_string = $_[0];
376 0 0       0 my $params = defined($_[1]) ? $_[1] : {};
377              
378 0         0 my $pv = dump2perl($dump_string, $params);
379 0 0       0 if( ! $pv ){ print STDERR "yaml2yaml() : error, call to yaml2perl() has failed.\n"; return undef }
  0         0  
  0         0  
380 0         0 my $yaml_string = perl2yaml($pv, $params);
381 0 0       0 if( ! $yaml_string ){ print STDERR "dump2yaml() : error, call to perl2yaml() has failed.\n"; return undef }
  0         0  
  0         0  
382 0         0 return $yaml_string
383             }
384             sub json2yaml {
385 14     14 1 234421 my $json_string = $_[0];
386 14 100       68 my $params = defined($_[1]) ? $_[1] : {};
387              
388 14         72 my $pv = json2perl($json_string, $params);
389 14 100       50 if( ! defined $pv ){ print STDERR "json2yaml() : error, call to json2perl() has failed.\n"; return undef }
  1         2  
  1         2  
390 13         53 my $yaml_string = perl2yaml($pv, $params);
391 13 50       60 if( ! defined $yaml_string ){ print STDERR "json2yaml() : error, call to perl2yaml() has failed.\n"; return undef }
  0         0  
  0         0  
392 13         181 return $yaml_string
393             }
394             sub dump2perl {
395             # WARNING: we eval() input string with alleged
396             # output from Data::Dump. Are you sure you trust
397             # the input string ($dump_string) for an eval() ?
398             # WARNING-2: I am considering removing this sub in future releases because of the eval()
399              
400             # VERSION 0.28: this now needs to be imported explicitly
401              
402 37     37 1 51086 my $dump_string = $_[0];
403             #my $params = defined($_[1]) ? $_[1] : {};
404              
405 37         262 $dump_string =~ s/^\$VAR1\s*=\s*//g;
406 37         527 print STDERR "dump2perl() : WARNING, eval()'ing input string, are you sure you did check its content ?\n";
407 37         180 print STDERR "dump2perl() : WARNING, this sub will be removed in future releases.\n";
408             # WARNING: eval() of unknown input:
409 37         6984 my $pv = eval($dump_string);
410 37 50 33     258 if( ! defined($pv) ){ print STDERR "input string:${dump_string}\nend input string.\ndump2perl() : error, eval() of input string (alledgedly a perl variable, see above) has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
  1 100       21  
  1         4  
411 36         128 return $pv
412             }
413             # this bypasses Data::Dumper's obsession with escaping
414             # non-ascii characters by redefining the qquote() sub
415             # The redefinition code is by [Corion] @ Perlmonks and cpan
416             # see https://perlmonks.org/?node_id=11115271
417             # So, it still uses Data::Dumper to dump the input perl var
418             # but with its qquote() sub redefined. See section CAVEATS
419             # for a wee problem that may appear in the future.
420             # The default behaviour is NOT to escape unicode
421             # (which is the opposite of what Data::Dumper is doing)
422             # see options, below, on how to change this.
423             # input is the perl variable (as a reference, e.g. scalar, hashref, arrayref)
424             # followed by optional hashref of options which can be
425             # terse
426             # indent
427             # dont-bloody-escape-unicode,
428             # escape-unicode,
429             # The last 2 control how unicode is printed, either escaped,
430             # like \x{3b1} or 'a' <<< which is unicoded greek alpha but did not want to pollute with unicode this file
431             # the former behaviour can be with dont-bloody-escape-unicode=>0 or escape-unicode=>1,
432             # the latter behaviour is the default. but setting the opposite of above will set it.
433             # NOTE: there are 2 alternatives to this
434             # perl2dump_filtered() which uses Data::Dump filters to control unicode escaping but
435             # lacks in aesthetics and functionality and handling all the cases Dump and Dumper
436             # do quite well.
437             # perl2dump_homebrew() uses the same dump-recursively engine but does not involve
438             # Data::Dump at all.
439             sub perl2dump {
440 36     36 1 1209773 my $pv = $_[0];
441 36 100       329 my $params = defined($_[1]) ? $_[1] : {};
442              
443             local $Data::Dumper::Terse = exists($params->{'terse'}) && defined($params->{'terse'})
444 36 100 66     379 ? $params->{'terse'} : 0
445             ;
446             local $Data::Dumper::Indent = exists($params->{'indent'}) && defined($params->{'indent'})
447 36 100 66     210 ? $params->{'indent'} : 1
448             ;
449              
450 36 50 100     462 if( ($_permanent_override == 0)
      100        
451             && ((
452             exists($params->{'dont-bloody-escape-unicode'}) && defined($params->{'dont-bloody-escape-unicode'})
453             && ($params->{'dont-bloody-escape-unicode'}==1)
454             ) || (
455             exists($params->{'escape-unicode'}) && defined($params->{'escape-unicode'})
456             && ($params->{'escape-unicode'}==0)
457             )
458             )
459             ){
460             # this is the case where no 'no-unicode-escape-permanently'
461             # was used at loading the module
462             # we have to use the special qquote each time caller
463             # sets 'dont-bloody-escape-unicode'=>1
464             # which will be replaced with the original sub
465             # once we exit this scope.
466             # make benchmarks will compare all cases if you ever
467             # want to get more efficiency out of this
468 20         52 local $Data::Dumper::Useperl = 1;
469 20         80 local $Data::Dumper::Useqq='utf8';
470 25     25   261 no warnings 'redefine';
  25         57  
  25         50575  
471 20         115 local *Data::Dumper::qquote = \& _qquote_redefinition_by_Corion;
472 20         122 return Data::Dumper::Dumper($pv);
473             # out of scope local's will be restored to original values
474             }
475 16         85 return Data::Dumper::Dumper($pv)
476             }
477             # This uses Data::Dump's filters
478             # The _qquote_redefinition_by_Corion() code is by [Corion] @ Perlmonks and cpan
479             # see https://perlmonks.org/?node_id=11115271
480             sub perl2dump_filtered {
481 14     14 1 14024 my $pv = $_[0];
482 14 100       59 my $params = defined($_[1]) ? $_[1] : {};
483              
484 14 50 100     204 if( ($_permanent_filter == 0)
      100        
485             && ((
486             exists($params->{'dont-bloody-escape-unicode'}) && defined($params->{'dont-bloody-escape-unicode'})
487             && ($params->{'dont-bloody-escape-unicode'}==1)
488             ) || (
489             exists($params->{'escape-unicode'}) && defined($params->{'escape-unicode'})
490             && ($params->{'escape-unicode'}==0)
491             )
492             )
493             ){
494 4         38 Data::Dump::Filtered::add_dump_filter( \& DataDumpFilterino );
495 4         68 my $ret = Data::Dump::pp($pv);
496 4         487 Data::Dump::Filtered::remove_dump_filter( \& DataDumpFilterino );
497 4         46 return $ret;
498             }
499 10         60 return Data::Dump::pp($pv);
500             }
501             sub perl2dump_homebrew {
502 5     5 1 4159 my $pv = $_[0];
503 5 100       23 my $params = defined($_[1]) ? $_[1] : {};
504              
505 5 50 66     78 if( ($_permanent_override == 1)
      100        
      66        
      66        
      66        
      100        
506             || (
507             exists($params->{'dont-bloody-escape-unicode'}) && defined($params->{'dont-bloody-escape-unicode'})
508             && ($params->{'dont-bloody-escape-unicode'}==1)
509             ) || (
510             exists($params->{'escape-unicode'}) && defined($params->{'escape-unicode'})
511             && ($params->{'escape-unicode'}==0)
512             )
513             ){
514 3         12 return dump_perl_var_recursively($pv);
515             }
516 2         12 return Data::Dumper::Dumper($pv);
517             }
518             # this will take a perl var (as a scalar or an arbitrarily nested data structure)
519             # and emulate a very very basic
520             # Dump/Dumper but with rendering unicode (for keys or values or array items)
521             # it returns a string representation of the input perl var
522             # There are 2 obvious limitations:
523             # 1) indentation is very basic,
524             # 2) it supports only scalars, hashes and arrays,
525             # (which will dive into them no problem)
526             # This sub can be used in conjuction with DataDumpFilterino()
527             # to create a Data::Dump filter like,
528             # Data::Dump::Filtered::add_dump_filter( \& DataDumpFilterino );
529             # or dumpf($perl_var, \& DataDumpFilterino);
530             # the input is a perl-var as a reference, so no %inp but $inp={} or $inp=[]
531             # the output is a, possibly multiline, string
532             sub dump_perl_var_recursively {
533 598     598 1 1081 my $inp = $_[0];
534 598 100       1256 my $depth = defined($_[1]) ? $_[1] : 0;
535 598         1192 my $aref = ref($inp);
536 598 100       2569 if( $aref eq '' ){
    50          
    100          
    50          
537             # scalar
538 588         1192 return _qquote_redefinition_by_Corion($inp);
539             } elsif( $aref eq 'SCALAR' ){
540             # scalar
541 0         0 return _qquote_redefinition_by_Corion($$inp);
542             } elsif( $aref eq 'HASH' ){
543 4         14 my $indent1 = ' 'x((2+$depth)*2);
544 4         11 my $indent2 = $indent1 x 2;
545 4         10 my $retdump= "\n".$indent1.'{'."\n";
546 4         13 for my $k (keys %$inp){
547             $retdump .= $indent2
548             . _qquote_redefinition_by_Corion($k)
549             ." => "
550 4         15 . dump_perl_var_recursively($inp->{$k}, $depth+1)
551             .",\n"
552             ;
553             }
554 4         27 return $retdump. $indent1 . '}'
555             } elsif( $aref eq 'ARRAY' ){
556 6         24 my $indent1 = ' ' x ((1+$depth)*2);
557 6         16 my $indent2 = $indent1 x 2;
558 6         17 my $retdump= "\n".$indent1.'['."\n";
559 6         17 for my $v (@$inp){
560 584         2772 $retdump .=
561             $indent2
562             . dump_perl_var_recursively($v, $depth+1)
563             .",\n"
564             ;
565             }
566 6         79 return $retdump. $indent1 . ']'
567             } else {
568 0         0 my $indent1 = ' ' x ((1+$depth)*2);
569 0         0 return $indent1 . $inp .",\n"
570             }
571             }
572             sub DataDumpFilterino {
573 7     7 1 5680 my($ctx, $object_ref) = @_;
574 7         38 my $aref = ref($object_ref);
575              
576             return {
577 7         34 'dump' => dump_perl_var_recursively($object_ref, $ctx->depth)
578             }
579             }
580             # opens file,
581             # reads all content of file and returns them on success
582             # or returns undef on failure
583             # the file is closed in either case
584             sub read_from_file {
585 20     20 1 96 my $infile = $_[0];
586 20         43 my $FH;
587 20 50       1197 if( ! open $FH, '<:encoding(UTF-8)', $infile ){
588 0         0 print STDERR "failed to open file '$infile' for reading, $!";
589 0         0 return undef;
590             }
591 20         1581 my $contents = read_from_filehandle($FH);
592 20         775 close $FH;
593 20         127 return $contents
594             }
595             # writes contents to file and returns 0 on failure, 1 on success
596             sub write_to_file {
597 0     0 1 0 my $outfile = $_[0];
598 0         0 my $contents = $_[1];
599 0         0 my $FH;
600 0 0       0 if( ! open $FH, '>:encoding(UTF-8)', $outfile ){
601 0         0 print STDERR "failed to open file '$outfile' for writing, $!";
602 0         0 return 0
603             }
604 0 0       0 if( ! write_to_filehandle($FH, $contents) ){ print STDERR "error, call to ".'write_to_filehandle()'." has failed"; close $FH; return 0 }
  0         0  
  0         0  
  0         0  
605 0         0 close $FH;
606 0         0 return 1;
607             }
608             # reads all content from filehandle and returns them on success
609             # or returns undef on failure
610             sub read_from_filehandle {
611 20     20 1 49 my $FH = $_[0];
612             # you should open INFH as '<:encoding(UTF-8)'
613             # or if it is STDIN, do binmode STDIN , ':encoding(UTF-8)';
614 20         42 return do { local $/; <$FH> }
  20         105  
  20         814  
615             }
616             sub write_to_filehandle {
617 0     0 1 0 my $FH = $_[0];
618 0         0 my $contents = $_[1];
619             # you should open $OUTFH as >:encoding(UTF-8)'
620             # or if it is STDOUT, do binmode STDOUT , ':encoding(UTF-8)';
621 0         0 print $FH $contents;
622 0         0 return 1;
623             }
624             # todo: change to utf8::is_utf8()
625 54     54   397 sub _has_utf8 { return $_[0] =~ /[^\x00-\x7f]/ }
626             # Below code is by [Corion] @ Perlmonks and cpan
627             # see https://perlmonks.org/?node_id=11115271
628             # it's for redefining Data::Dumper::qquote
629             # (it must be accompanied by
630             # $Data::Dumper::Useperl = 1;
631             # $Data::Dumper::Useqq='utf8';
632             # HOWEVER, I discoverd that a redefined sub can not access packages private vars
633             sub _qquote_redefinition_by_Corion {
634 828     828   34412 local($_) = shift;
635              
636 828 50       1950 return qq("") unless defined $_;
637 828         2841 s/([\\\"\@\$])/\\$1/g;
638              
639 828 100       4667 return qq("$_") unless /[[:^print:]]/; # fast exit if only printables
640              
641             # Here, there is at least one non-printable to output. First, translate the
642             # escapes.
643 2         28 s/([\a\b\t\n\f\r\e])/$Data_Dumper_esc{$1}/g;
644             # this is the original but it does not work because it can't find %esc
645             # which is a private var in Data::Dumper, so I copied those vars above
646             # and access them as Data_Dumper_XYZ
647             #s/([\a\b\t\n\f\r\e])/$Data::Dumper::esc{$1}/g;
648              
649             # no need for 3 digits in escape for octals not followed by a digit.
650 2         59 s/($Data_Dumper_low_controls)(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
  0         0  
651              
652             # But otherwise use 3 digits
653 2         36 s/($Data_Dumper_low_controls)/'\\'.sprintf('%03o',ord($1))/eg;
  0         0  
654              
655              
656             # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
657 2   50     12 my $high = shift || "";
658 2 50       13 if ($high eq "iso8859") { # Doesn't escape the Latin1 printables
    50          
    0          
659 0 0       0 if ($Data_Dumper_IS_ASCII) {
    0          
660 0         0 s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
  0         0  
661             }
662             elsif ($] ge 5.007_003) {
663 0         0 my $high_control = utf8::unicode_to_native(0x9F);
664 0         0 s/$high_control/sprintf('\\%o',ord($1))/eg;
  0         0  
665             }
666             } elsif ($high eq "utf8") {
667             # Some discussion of what to do here is in
668             # https://rt.perl.org/Ticket/Display.html?id=113088
669             # use utf8;
670             # $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
671             } elsif ($high eq "8bit") {
672             # leave it as it is
673             } else {
674 0         0 s/([[:^ascii:]])/'\\'.sprintf('%03o',ord($1))/eg;
  0         0  
675             #s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
676             }
677 2         17 return qq("$_");
678             }
679             # begin pod
680             =pod
681              
682             =encoding utf8
683              
684             =head1 NAME
685              
686             Data::Roundtrip - convert between Perl data structures, YAML and JSON with unicode support (I believe ...)
687              
688             =head1 VERSION
689              
690             Version 0.31
691              
692             =head1 SYNOPSIS
693              
694             This module contains a collection of utilities for converting between
695             JSON, YAML, Perl variable and a Perl variable's string representation (aka dump).
696             Hopefully, all unicode content will be handled correctly between
697             the conversions and optionally escaped or un-escaped. Also JSON can
698             be presented in a pretty format or in a condensed, machine-readable
699             format (not spaces, indendation or line breaks).
700              
701             use Data::Roundtrip qw/:all/;
702             #use Data::Roundtrip qw/json2yaml/;
703             #use Data::Roundtrip qw/:json/; # see EXPORT
704              
705             $jsonstr = '{"Songname": "Απόκληρος της κοινωνίας",'
706             .'"Artist": "Καζαντζίδης Στέλιος/Βίρβος Κώστας"}'
707             ;
708             $yamlstr = json2yaml($jsonstr);
709             print $yamlstr;
710             # NOTE: long strings have been broken into multilines
711             # and/or truncated (replaced with ...)
712             #---
713             #Artist: Καζαντζίδης Στέλιος/Βίρβος Κώστας
714             #Songname: Απόκληρος της κοινωνίας
715              
716             $yamlstr = json2yaml($jsonstr, {'escape-unicode'=>1});
717             print $yamlstr;
718             #---
719             #Artist: \u039a\u03b1\u03b6\u03b1 ...
720             #Songname: \u0391\u03c0\u03cc\u03ba ...
721              
722             $backtojson = yaml2json($yamlstr);
723             # $backtojson is a string representation
724             # of following JSON structure:
725             # {"Artist":"Καζαντζίδης Στέλιος/Βίρβος Κώστας",
726             # "Songname":"Απόκληρος της κοινωνίας"}
727              
728             # This is useful when sending JSON via
729             # a POST request and it needs unicode escaped:
730             $backtojson = yaml2json($yamlstr, {'escape-unicode'=>1});
731             # $backtojson is a string representation
732             # of following JSON structure:
733             # but this time with unicode escaped
734             # (pod content truncated for readbility)
735             # {"Artist":"\u039a\u03b1\u03b6 ...",
736             # "Songname":"\u0391\u03c0\u03cc ..."}
737             # this is the usual Data::Dumper dump:
738             print json2dump($jsonstr);
739             #$VAR1 = {
740             # 'Songname' => "\x{391}\x{3c0}\x{3cc} ...",
741             # 'Artist' => "\x{39a}\x{3b1}\x{3b6} ...",
742             #};
743              
744             # and this is a more human-readable version:
745             print json2dump($jsonstr, {'dont-bloody-escape-unicode'=>1});
746             # $VAR1 = {
747             # "Artist" => "Καζαντζίδης Στέλιος/Βίρβος Κώστας",
748             # "Songname" => "Απόκληρος της κοινωνίας"
749             # };
750              
751             # pass some parameters to Data::Dumper
752             # like: be terse (no $VAR1):
753             print json2dump($jsonstr,
754             {'dont-bloody-escape-unicode'=>0, 'terse'=>1}
755             #{'dont-bloody-escape-unicode'=>0, 'terse'=>1, 'indent'=>0}
756             );
757             # {
758             # "Artist" => "Καζαντζίδης Στέλιος/Βίρβος Κώστας",
759             # "Songname" => "Απόκληρος της κοινωνίας"
760             # }
761              
762             # this is how to reformat a JSON string to
763             # have its unicode content escaped:
764             my $json_with_unicode_escaped =
765             json2json($jsonstr, {'escape-unicode'=>1});
766              
767             # sometimes we want JSON's true and false values
768             # to be mapped to something other than JSON::PP::Boolean objects:
769             my $json_with_custom_boolean_mapping = json2perl($jsonstr,
770             {'boolean_values' => 'myfalse', 'mytrue'});
771             my $json_with_custom_boolean_mapping = json2perl($jsonstr,
772             {'boolean_values' => 0, 1});
773              
774             # With version 0.18 and up two more exported-on-demand
775             # subs were added to read JSON or YAML directly from a file:
776             # jsonfile2perl() and yamlfile2perl()
777             my $perldata = jsonfile2perl("file.json");
778             my $perldata = yamlfile2perl("file.yaml");
779             die "failed" unless defined $perldata;
780              
781             # For some of the above functions there exist command-line scripts:
782             perl2json.pl -i "perl-data-structure.pl" -o "output.json" --pretty
783             json2json.pl -i "with-unicode.json" -o "unicode-escaped.json" --escape-unicode
784             # etc.
785              
786             # only for *2dump: perl2dump, json2dump, yaml2dump
787             # and if no escape-unicode is required (i.e.
788             # setting 'dont-bloody-escape-unicode' => 1 permanently)
789             # and if efficiency is important,
790             # meaning that perl2dump is run in a loop thousand of times,
791             # then import the module like this:
792             use Data::Roundtrip qw/:all no-unicode-escape-permanently/;
793             # or like this
794             use Data::Roundtrip qw/:all unicode-escape-permanently/;
795              
796             # then perl2dump() is more efficient but unicode characters
797             # will be permanently not-escaped (1st case) or escaped (2nd case).
798              
799             =head1 EXPORT
800              
801             By default no symbols are exported. However, the following export tags are available (:all will export all of them):
802              
803             =over 4
804              
805             =item * C<:json> :
806             C,
807             C,
808             C,
809             C,
810             C,
811             C
812              
813             =item * C<:yaml> :
814             C,
815             C,
816             C,
817             C,
818             C,
819             C
820              
821             =item * C<:dump> :
822             C,
823             C,
824             C
825              
826             =item * C<:io> :
827             C, C,
828             C, C,
829              
830             =item * C<:all> : everything above.
831              
832             =item * Additionally, these four subs: C, C, C, C
833             do not belong to any export tag. However they can be imported explicitly by the caller
834             in the usual way (e.g. C).
835             Section CAVEATS, under L, describes how these
836             subs C a string possibly coming from user,
837             possibly being unchecked.
838              
839             =item * C : this is not an
840             export keyword/parameter but a parameter which affects
841             all the C<< *2dump* >> subs by setting unicode escaping
842             permanently to false. See L.
843              
844             =item * C : this is not an
845             export keyword/parameter but a parameter which affects
846             all the C<< *2dump* >> subs by setting unicode escaping
847             permanently to true. See L.
848              
849             =back
850              
851             =head1 EFFICIENCY
852              
853             The export keyword/parameter C<< no-unicode-escape-permanently >>
854             affects
855             all the C<< *2dump* >> subs by setting unicode escaping
856             permanently to false. This improves efficiency, although
857             one will ever need to
858             use this in extreme situations where a C<< *2dump* >>
859             sub is called repeatedly in a loop of
860             a few hundreds or thousands of iterations or more.
861              
862             Each time a C<< *2dump* >> is called, the
863             C<< dont-bloody-escape-unicode >> flag is checked
864             and if it is set, then L's C<< qquote() >>
865             is overriden with C<< _qquote_redefinition_by_Corion() >>
866             just for that instance and will be restored as soon as
867             the dump is finished. Similarly, a filter for
868             not escaping unicode is added to L
869             just for that particular call and is removed immediately
870             after. This has some computational cost and can be
871             avoided completely by overriding the sub
872             and adding the filter once, at loading (in C<< import() >>).
873              
874             The price to pay for this added efficiency is that
875             unicode in any dump will never be escaped (e.g. C<< \x{3b1}) >>,
876             but will be rendered (e.g. C<< α >>, a greek alpha). Always.
877             The option
878             C<< dont-bloody-escape-unicode >> will permanently be set to true.
879              
880             Similarly, the export keyword/parameter
881             C<< unicode-escape-permanently >>
882             affects
883             all the C<< *2dump* >> subs by setting unicode escaping
884             permanently to true. This improves efficiency as well.
885              
886             See L on how to find the fastest C<< *2dump* >>
887             sub.
888              
889             =head1 BENCHMARKS
890              
891             The special Makefile target C<< benchmarks >> will time
892             calls to each of the C<< *2dump* >> subs under
893              
894             use Data::Roundtrip;
895              
896             use Data::Roundtrip qw/no-unicode-escape-permanently/;
897              
898             use Data::Roundtrip qw/unicode-escape-permanently/;
899              
900             and for C<< 'dont-bloody-escape-unicode' => 0 >> and
901             C<< 'dont-bloody-escape-unicode' => 1 >>.
902              
903             In general, L is faster by 25% when one of the
904             permanent import parameters is used
905             (either of the last two cases above).
906              
907             =head1 SUBROUTINES
908              
909             =head2 C
910              
911             my $ret = perl2json($perlvar, $optional_paramshashref)
912              
913             Arguments:
914              
915             =over 4
916              
917             =item * C<$perlvar>
918              
919             =item * C<$optional_paramshashref>
920              
921             =back
922              
923             Return value:
924              
925             =over 4
926              
927             =item * C<$ret>
928              
929             =back
930              
931             Given an input C<$perlvar> (which can be a simple scalar or
932             a nested data structure, but not an object), it will return
933             the equivalent JSON string. In C<$optional_paramshashref>
934             one can specify whether to escape unicode with
935             C<< 'escape-unicode' => 1 >>
936             and/or prettify the returned result with C<< 'pretty' => 1 >>
937             and/or allow conversion of blessed objects with C<< 'convert_blessed' => 1 >>.
938              
939             The latter is useful when the input (Perl) data structure
940             contains Perl objects (blessed refs!). But in addition to
941             setting it, each of the Perl objects (their class) must
942             implement a C method which will simply convert
943             the object into a Perl data structure. For example, if
944             your object stores the important data in C<< $self->data >>
945             as a hash, then use this to return it
946              
947             sub TO_JSON { shift->data }
948              
949             the converter will replace what is returned with the blessed
950             object which does not know what to do with it.
951             See L
952             for more information.
953              
954             The output can be fed back to L
955             for getting the Perl variable back.
956              
957             It returns the JSON string on success or C on failure.
958              
959             =head2 C
960              
961             Arguments:
962              
963             =over 4
964              
965             =item * C<$jsonstring>
966              
967             =back
968              
969             Return value:
970              
971             =over 4
972              
973             =item * C<$ret>
974              
975             =back
976              
977             Given an input C<$jsonstring> as a string, it will return
978             the equivalent Perl data structure using
979             C.
980              
981             It returns the Perl data structure on success or C on failure.
982              
983             =head2 C
984              
985             my $ret = perl2yaml($perlvar, $optional_paramshashref)
986              
987             Arguments:
988              
989             =over 4
990              
991             =item * C<$perlvar>
992              
993             =item * C<$optional_paramshashref>
994              
995             =back
996              
997             Return value:
998              
999             =over 4
1000              
1001             =item * C<$ret>
1002              
1003             =back
1004              
1005             Given an input C<$perlvar> (which can be a simple scalar or
1006             a nested data structure, but not an object), it will return
1007             the equivalent YAML string. In C<$optional_paramshashref>
1008             one can specify whether to escape unicode with
1009             C<< 'escape-unicode' => 1 >>. Prettify is not supported yet.
1010             The output can be fed to L
1011             for getting the Perl variable back.
1012              
1013             It returns the YAML string on success or C on failure.
1014              
1015             =head2 C
1016              
1017             my $ret = yaml2perl($yamlstring);
1018              
1019             Arguments:
1020              
1021             =over 4
1022              
1023             =item * C<$yamlstring>
1024              
1025             =back
1026              
1027             Return value:
1028              
1029             =over 4
1030              
1031             =item * C<$ret>
1032              
1033             =back
1034              
1035             Given an input C<$yamlstring> as a string, it will return
1036             the equivalent Perl data structure using
1037             C
1038              
1039             It returns the Perl data structure on success or C on failure.
1040              
1041             =head2 C
1042              
1043             my $ret = yamlfile2perl($filename)
1044              
1045             Arguments:
1046              
1047             =over 4
1048              
1049             =item * C<$filename>
1050              
1051             =back
1052              
1053             Return value:
1054              
1055             =over 4
1056              
1057             =item * C<$ret>
1058              
1059             =back
1060              
1061             Given an input C<$filename> which points to a file containing YAML content,
1062             it will return the equivalent Perl data structure.
1063              
1064             It returns the Perl data structure on success or C on failure.
1065              
1066             =head2 C
1067              
1068             my $ret = perl2dump($perlvar, $optional_paramshashref)
1069              
1070             Arguments:
1071              
1072             =over 4
1073              
1074             =item * C<$perlvar>
1075              
1076             =item * C<$optional_paramshashref>
1077              
1078             =back
1079              
1080             Return value:
1081              
1082             =over 4
1083              
1084             =item * C<$ret>
1085              
1086             =back
1087              
1088             Given an input C<$perlvar> (which can be a simple scalar or
1089             a nested data structure, but not an object), it will return
1090             the equivalent string (via L).
1091             In C<$optional_paramshashref>
1092             one can specify whether to escape unicode with
1093             C<< 'dont-bloody-escape-unicode' => 0 >>,
1094             (or C<< 'escape-unicode' => 1 >>). The DEFAULT
1095             behaviour is to NOT ESCAPE unicode.
1096              
1097             Additionally, use terse output with C<< 'terse' => 1 >> and remove
1098             all the incessant indentation with C<< 'indent' => 1 >>
1099             which unfortunately goes to the other extreme of
1100             producing a space-less output, not fit for human consumption.
1101             The output can be fed to L
1102             for getting the Perl variable back.
1103              
1104             It returns the string representation of the input perl variable
1105             on success or C on failure.
1106              
1107             The output can be fed back to L.
1108              
1109             CAVEAT: when not escaping unicode (which is the default
1110             behaviour), each call to this sub will override L's
1111             C sub then
1112             call L's C and save its output to
1113             a temporary variable, restore C sub to its original
1114             code ref and return the
1115             contents. This exercise is done every time this C
1116             is called. It may be expensive. The alternative is
1117             to redefine C once, when the module is loaded, with
1118             all the side-effects this may cause.
1119              
1120             Note that there are two other alternative subs which offer more-or-less
1121             the same functionality and their output can be fed back to all the C<< dump2*() >>
1122             subs. These are
1123             L which uses L
1124             to add a filter to control unicode escaping but
1125             lacks in aesthetics and functionality and handling all the
1126             cases Dump and Dumper do quite well.
1127              
1128             There is also C<< perl2dump_homebrew() >> which
1129             uses the same dump-recursively engine as
1130             L
1131             but does not involve Data::Dump at all.
1132              
1133             =head2 C
1134              
1135             my $ret = perl2dump_filtered($perlvar, $optional_paramshashref)
1136              
1137             Arguments:
1138              
1139             =over 4
1140              
1141             =item * C<$perlvar>
1142              
1143             =item * C<$optional_paramshashref>
1144              
1145             =back
1146              
1147             Return value:
1148              
1149             =over 4
1150              
1151             =item * C<$ret>
1152              
1153             =back
1154              
1155             It does the same job as L which is
1156             to stringify a perl variable. And takes the same options.
1157              
1158             It returns the string representation of the input perl variable
1159             on success or C on failure.
1160              
1161             It uses L to add a filter to
1162             L.
1163              
1164              
1165             =head2 C
1166              
1167             my $ret = perl2dump_homebrew($perlvar, $optional_paramshashref)
1168              
1169             Arguments:
1170              
1171             =over 4
1172              
1173             =item * C<$perlvar>
1174              
1175             =item * C<$optional_paramshashref>
1176              
1177             =back
1178              
1179             Return value:
1180              
1181             =over 4
1182              
1183             =item * C<$ret>
1184              
1185             =back
1186              
1187             It does the same job as L which is
1188             to stringify a perl variable. And takes the same options.
1189              
1190             It returns the string representation of the input perl variable
1191             on success or C on failure.
1192              
1193             The output can be fed back to L.
1194              
1195             It uses its own basic dumper. Which is recursive.
1196             So, beware of extremely deep nested data structures.
1197             Deep not long! But it probably is as efficient as
1198             it can be but definetely lacks in aesthetics
1199             and functionality compared to Dump and Dumper.
1200              
1201              
1202             =head2 C
1203              
1204             my $ret = dump_perl_var_recursively($perl_var)
1205              
1206             Arguments:
1207              
1208             =over 4
1209              
1210             =item * C<$perl_var>, a Perl variable like
1211             a scalar or an arbitrarily nested data structure.
1212             For the latter, it requires references, e.g.
1213             hash-ref or arrayref.
1214              
1215             =back
1216              
1217             Return value:
1218              
1219             =over 4
1220              
1221             =item * C<$ret>, the stringified version of the input Perl variable.
1222              
1223             =back
1224              
1225             This sub will take a Perl var (as a scalar or an arbitrarily nested data structure)
1226             and emulate a very very basic
1227             Dump/Dumper but with enforced rendering unicode (for keys or values or array items),
1228             and not escaping unicode - this is not an option,
1229             it returns a string representation of the input perl var
1230              
1231             There are 2 obvious limitations:
1232              
1233             =over 4
1234              
1235             =item 1. indentation is very basic,
1236              
1237             =item 2. it supports only scalars, hashes and arrays,
1238             (which will dive into them no problem)
1239             This sub can be used in conjuction with DataDumpFilterino()
1240             to create a Data::Dump filter like,
1241              
1242             Data::Dump::Filtered::add_dump_filter( \& DataDumpFilterino );
1243             or
1244             dumpf($perl_var, \& DataDumpFilterino);
1245              
1246             the input is a Perl variable as a reference, so no C<< %inp >> but C<< $inp={} >>
1247             and C<< $inp=[] >>.
1248              
1249             This function is recursive.
1250             Beware of extremely deep nested data structures.
1251             Deep not long! But it probably is as efficient as
1252             it can be but definetely lacks in aesthetics
1253             and functionality compared to Dump and Dumper.
1254              
1255             The output is a, possibly multiline, string. Which it can
1256             then be fed back to L.
1257              
1258             =back
1259              
1260             =head2 C
1261              
1262             # CAVEAT: it will eval($dumpstring) internally, so
1263             # check $dumpstring for malicious code beforehand
1264             # it is a security risk if you don't.
1265             # Don't use it if $dumpstring comes from
1266             # untrusted sources (user input for example).
1267             my $ret = dump2perl($dumpstring)
1268              
1269             Arguments:
1270              
1271             =over 4
1272              
1273             =item * C<$dumpstring>, this comes from the output of L,
1274             L or our own L,
1275             L,
1276             L.
1277             Escaped, or unescaped.
1278              
1279             =back
1280              
1281             Return value:
1282              
1283             =over 4
1284              
1285             =item * C<$ret>, the Perl data structure on success or C on failure.
1286              
1287             =back
1288              
1289             CAVEAT: it B's the input C<$dumpstring> in order to create the Perl data structure.
1290             B'ing unknown or unchecked input is a security risk. Always check input to B
1291             which comes from untrusted sources, like user input, scraped documents, email content.
1292             Anything really.
1293              
1294             =head2 C
1295              
1296             my $ret = json2perl($jsonstring, $optional_paramshashref)
1297              
1298             Arguments:
1299              
1300             =over 4
1301              
1302             =item * C<$jsonstring>
1303              
1304             =item * C<$optional_paramshashref> is an optional hashref as it is blindingly obvious from
1305             the name. At the moment only one parameter is understood: C.
1306             It must be an ARRAYREF of 0 or 2 elements. If 0 elements, then it resets the boolean
1307             values mapping of the JSON converter to its default state (which is L objects.
1308             If it contains 2 elements, then the JSON converter will map a JSON C value to
1309             the first element of the ARRAYREF and a JSON C value to
1310             the second element of the ARRAYREF.
1311              
1312             =back
1313              
1314             Return value:
1315              
1316             =over 4
1317              
1318             =item * C<$ret>
1319              
1320             =back
1321              
1322             Given an input C<$jsonstring> as a string, it will return
1323             the equivalent Perl data structure using
1324             C.
1325              
1326             It returns the Perl data structure on success or C on failure.
1327              
1328             =head2 C
1329              
1330             my $ret = jsonfile2perl($filename)
1331              
1332             Arguments:
1333              
1334             =over 4
1335              
1336             =item * C<$filename>
1337              
1338             =back
1339              
1340             Return value:
1341              
1342             =over 4
1343              
1344             =item * C<$ret>
1345              
1346             =back
1347              
1348             Given an input C<$filename> which points to a file containing JSON content,
1349             it will return the equivalent Perl data structure.
1350              
1351             It returns the Perl data structure on success or C on failure.
1352              
1353             =head2 C
1354              
1355             my $ret = json2yaml($jsonstring, $optional_paramshashref)
1356              
1357             Arguments:
1358              
1359             =over 4
1360              
1361             =item * C<$jsonstring>
1362              
1363             =item * C<$optional_paramshashref>
1364              
1365             =back
1366              
1367             Return value:
1368              
1369             =over 4
1370              
1371             =item * C<$ret>
1372              
1373             =back
1374              
1375             Given an input JSON string C<$jsonstring>, it will return
1376             the equivalent YAML string L
1377             by first converting JSON to a Perl variable and then
1378             converting that variable to YAML using L.
1379             All the parameters supported by L
1380             are accepted.
1381              
1382             It returns the YAML string on success or C on failure.
1383              
1384             =head2 C
1385              
1386             my $ret = yaml2json($yamlstring, $optional_paramshashref)
1387              
1388             Arguments:
1389              
1390             =over 4
1391              
1392             =item * C<$yamlstring>
1393              
1394             =item * C<$optional_paramshashref>
1395              
1396             =back
1397              
1398             Return value:
1399              
1400             =over 4
1401              
1402             =item * C<$ret>
1403              
1404             =back
1405              
1406             Given an input YAML string C<$yamlstring>, it will return
1407             the equivalent YAML string L
1408             by first converting YAML to a Perl variable and then
1409             converting that variable to JSON using L.
1410             All the parameters supported by L
1411             are accepted.
1412              
1413             It returns the JSON string on success or C on failure.
1414              
1415             =head2 C C
1416              
1417             Transform a json or yaml string via pretty printing or via
1418             escaping unicode or via un-escaping unicode. Parameters
1419             like above will be accepted.
1420              
1421             =head2 C C C C
1422              
1423             These subs offer similar functionality as their counterparts
1424             described above.
1425              
1426             Section CAVEATS, under L, describes how
1427             C subs C a string possibly coming from user,
1428             possibly being unchecked.
1429              
1430             =head2 C
1431              
1432             my $ret = dump2dump($dumpstring, $optional_paramshashref)
1433              
1434             Arguments:
1435              
1436             =over 4
1437              
1438             =item * C<$dumpstring>
1439              
1440             =item * C<$optional_paramshashref>
1441              
1442             =back
1443              
1444             Return value:
1445              
1446             =over 4
1447              
1448             =item * C<$ret>
1449              
1450             Given an input string C<$dumpstring>, which can
1451             have been produced by e.g. C
1452             and is identical to L's C output,
1453             it will roundtrip back to the same string,
1454             possibly with altered format via the parameters in C<$optional_paramshashref>.
1455              
1456             For example:
1457              
1458             my $dumpstr = '...';
1459             my $newdumpstr = dump2dump(
1460             $dumpstr,
1461             {
1462             'dont-bloody-escape-unicode' => 1,
1463             'terse' => 0,
1464             }
1465             );
1466              
1467              
1468             It returns the a dump string similar to
1469              
1470             =back
1471              
1472             =head2 C
1473              
1474             my $contents = read_from_file($filename)
1475              
1476             Arguments:
1477              
1478             =over 4
1479              
1480             =item * C<$filename> : the input filename.
1481              
1482             =back
1483              
1484             Return value:
1485              
1486             =over 4
1487              
1488             =item * C<$contents>
1489              
1490             =back
1491              
1492             Given a filename, it opens it using C<< :encoding(UTF-8) >>, slurps its
1493             contents and closes it. It's a convenience sub which could have also
1494             been private. If you want to retain the filehandle, use
1495             L.
1496              
1497             It returns the file contents on success or C on failure.
1498              
1499             =head2 C
1500              
1501             my $contents = read_from_filehandle($filehandle)
1502              
1503             Arguments:
1504              
1505             =over 4
1506              
1507             =item * C<$filehandle> : the handle to an already opened file.
1508              
1509             =back
1510              
1511             Return value:
1512              
1513             =over 4
1514              
1515             =item * C<$contents> : the file contents slurped.
1516              
1517             =back
1518              
1519             It slurps all content from the specified input file handle. Upon return
1520             the file handle is still open.
1521             It returns the file contents on success or C on failure.
1522              
1523             =head2 C
1524              
1525             write_to_file($filename, $contents) or die
1526              
1527             Arguments:
1528              
1529             =over 4
1530              
1531             =item * C<$filename> : the output filename.
1532              
1533             =item * C<$contents> : any string to write it to file.
1534              
1535             =back
1536              
1537             Return value:
1538              
1539             =over 4
1540              
1541             =item * 1 on success, 0 on failure
1542              
1543             =back
1544              
1545             Given a filename, it opens it using C<< :encoding(UTF-8) >>,
1546             writes all specified content and closes the file.
1547             It's a convenience sub which could have also
1548             been private. If you want to retain the filehandle, use
1549             L.
1550              
1551             It returns 1 on success or 0 on failure.
1552              
1553             =head2 C
1554              
1555             write_to_filehandle($filehandle, $contents) or die
1556              
1557             Arguments:
1558              
1559             =over 4
1560              
1561             =item * C<$filehandle> : the handle to an already opened file (for writing).
1562              
1563             =back
1564              
1565             Return value:
1566              
1567             =over 4
1568              
1569             =item * 1 on success or 0 on failure.
1570              
1571             =back
1572              
1573             It writes content to the specified file handle. Upon return
1574             the file handle is still open.
1575              
1576             It returns 1 on success or 0 on failure.
1577              
1578             =head1 SCRIPTS
1579              
1580             A few scripts have been put together and offer the functionality of this
1581             module to the command line. They are part of this distribution and can
1582             be found in the C