File Coverage

blib/lib/Data/Roundtrip.pm

Criterion	Covered	Total	%
statement	229	367	62.4
branch	87	184	47.2
condition	48	79	60.7
subroutine	36	44	81.8
pod	24	25	96.0
total	424	699	60.6

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