File Coverage

blib/lib/Data/Roundtrip.pm

Criterion	Covered	Total	%
statement	224	354	63.2
branch	85	172	49.4
condition	46	70	65.7
subroutine	36	44	81.8
pod	24	25	96.0
total	415	665	62.4

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