boolean_values results from the CPAN

Data-Roundtrip

	my ($yaml_string, $escaped);
	if( $escape_unicode ){
		#if( $pretty_printing ){
			# it's here just for historic purposes, this is not supported and a warning is issued
			#$yaml_string = eval { YAML::PP::Dump($pv) };
			#if( ! defined $yaml_string ){ print STDERR "error, call to ".'YAML::PP::Dump()'." has failed with this exception:\n".$@."\n"; return undef }
			# this does not work :( no pretty printing for yaml
			#$yaml_string = Data::Format::Pretty::YAML::format_pretty($pv);
		#} else {
			# intercepting a die by wrapping in an eval
			$yaml_string = eval { YAML::PP::Dump($pv) };
			if( ! defined($yaml_string) ){ print STDERR "error, call to ".'YAML::PP::Dump()'." has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
		#}
		if( ! $yaml_string ){ print STDERR "perl2yaml() : error, no yaml produced from perl variable.\n"; return undef }
		if( _has_utf8($yaml_string) ){
			utf8::encode($yaml_string);
			$yaml_string = Unicode::Escape::escape($yaml_string, 'utf8');
		}
	} else {
		#if( $pretty_printing ){
			# it's here just for historic purposes, this is not supported and a warning is issued
			#$yaml_string = Data::Format::Pretty::YAML::format_pretty($pv);
		#} else {
			$yaml_string = eval { YAML::PP::Dump($pv) };
			if( ! defined($yaml_string) ){ print STDERR "error, call to ".'YAML::PP::Dump()'." has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
		#}
		if( ! $yaml_string ){ print STDERR "perl2yaml() : error, no yaml produced from perl variable.\n"; return undef }
	}
	return $yaml_string
}
sub	yaml2perl {
	my $yaml_string = $_[0];
	#my $params = defined($_[1]) ? $_[1] : {};
	# intercepting a die by wrapping in an eval
	# Untainting YAML::PP string input because of a bug that causes it to bomb
	# see https://perlmonks.org/?node_id=11154911
	# untaint recipe by ysth, see
	#    https://www.perlmonks.org/?node_id=516862
	# but it  gives a warning:
	#    each on anonymous hash will always start from the beginning
	#($yaml_string) = each %{{$yaml_string,0}};
	# and so we do this instead
	# Also, there is a test which check yaml with tainted input (string)
	#    t/14-yaml-tainted-input.t
	($yaml_string) = keys %{{$yaml_string,0}};
	my $pv = eval { YAML::PP::Load($yaml_string) };
	if( ! defined($pv) ){ print STDERR "yaml2perl() : error, call to YAML::PP::Load() has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception:\n".$@:".")."\n"; return undef }
	return $pv
}
sub	yamlfile2perl {
	my $yaml_file = $_[0];
	#my $params = defined($_[1]) ? $_[1] : {};
	my $contents = read_from_file($yaml_file);
	if( ! defined $contents ){ print STDERR "yamlfile2perl() : error, failed to read from file '${yaml_file}'.\n"; return undef }
	my $pv = yaml2perl($contents);
	if( ! defined $pv ){ print STDERR "yamlfile2perl() : error, call to yaml2perl() has failed after reading yaml string from file '${yaml_file}'.\n"; return undef }
	return $pv;
}
# Optional input parameter following the required $json_string
# is a HASHREF:
#   'boolean_values' => [X, Y] : this is an ARRAYREF of 2 items json-false is mapped to X
#                                and json-true is mapped to Y, e.g. [0,1].
#                                JSON's default is JSON::PP::Boolean objects. Yikes
sub	json2perl {
	my $json_string = $_[0];
	my $params = defined($_[1]) ? $_[1] : {};
	my $pv;

	# NOTE: the JSON OO interface has encode() and decode()
	# whereas the function has encode_json() and decode_json()
	if( _has_utf8($json_string) ){
		if( exists($params->{'boolean_values'}) && defined($params->{'boolean_values'}) && ref($params->{'boolean_values'})eq'ARRAY' ){
			# in OO it needs decode()
			# boolean_values(x,y)
			$pv = eval {
			  JSON->new()
			      ->boolean_values(@{ $params->{'boolean_values'} })
			      ->utf8(0)->decode($json_string)
			};
		} else {
			# intercepting a die by wrapping in an eval
			$pv = eval { JSON::decode_json(Encode::encode_utf8($json_string)) };
		}
		if( ! defined($pv) ){ print STDERR Devel::StackTrace->new->as_string . "\njson2perl() :  error, call to json2perl() has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception: $@:":".")."\n"; return undef }
	} else {
		if( exists($params->{'boolean_values'}) && defined($params->{'boolean_values'}) && ref($params->{'boolean_values'})eq'ARRAY' ){
			# boolean_values(x,y)
			$pv = eval {
			  JSON->new()
			      ->boolean_values(@{ $params->{'boolean_values'} })
			      ->decode($json_string)
			};
		} else {
			# intercepting a damn die by wrapping it around an eval
			$pv = eval { JSON::decode_json($json_string) };
		}
		if( ! defined($pv) ){ print STDERR Devel::StackTrace->new->as_string."\njson2perl() :  error, call to json2perl() has failed".((defined($@)&&($@!~/^\s*$/))?" with this exception: $@:":".")."\n"; return undef }
	}
	return $pv;
}
sub	jsonfile2perl {
	my $json_file = $_[0];
	my $contents = read_from_file($json_file);
	if( ! defined $contents ){ print STDERR "jsonfile2perl() : error, failed to read from file '${json_file}'.\n"; return undef }
	my $pv = json2perl($contents, $_[1]);
	if( ! defined $pv ){ print STDERR "jsonfile2perl() : error, call to json2perl() has failed after reading json string from file '${json_file}'.\n"; return undef }
	return $pv;
}
sub	json2json {
	my $json_string = $_[0];
	my $params = defined($_[1]) ? $_[1] : {};

	my $pv = json2perl($json_string, $params);
	if( ! defined $pv ){ print STDERR "json2perl() :  error, call to json2perl() has failed.\n"; return undef }
	$json_string = perl2json($pv, $params);
	if( ! defined $json_string ){ print STDERR "json2perl() :  error, call to perl2json() has failed.\n"; return undef }

	return $json_string;
}
sub	yaml2yaml {
	my $yaml_string = $_[0];
	my $params = defined($_[1]) ? $_[1] : {};

	my $pv = yaml2perl($yaml_string, $params);
	if( ! defined $pv ){ print STDERR "yaml2perl() :  error, call to yaml2perl() has failed.\n"; return undef }
	$yaml_string = perl2yaml($pv, $params);
	if( ! defined $yaml_string ){ print STDERR "yaml2perl() :  error, call to perl2yaml() has failed.\n"; return undef }

	return $yaml_string;
}
sub	dump2dump {
	my $dump_string = $_[0];
	my $params = defined($_[1]) ? $_[1] : {};

	my $pv = dump2perl($dump_string, $params);
	if( ! defined $pv ){ print STDERR "dump2perl() :  error, call to dump2perl() has failed.\n"; return undef }
	$dump_string = perl2dump($pv, $params);
	if( ! defined $dump_string ){ print STDERR "dump2perl() :  error, call to perl2dump() has failed.\n"; return undef }

	return $dump_string;
}
sub	yaml2json {
	my $yaml_string = $_[0];
	my $params = defined($_[1]) ? $_[1] : {};

	# is it escaped already?
	$yaml_string =~ s/\\u([0-9a-fA-F]{4})/eval "\"\\x{$1}\""/ge;
	my $pv = yaml2perl($yaml_string, $params);
	if( ! $pv ){ print STDERR "yaml2json() : error, call to yaml2perl() has failed.\n"; return undef }
	my $json = perl2json($pv, $params);

lib/Data/Roundtrip.pm view on Meta::CPAN

    # NOTE: long strings have been broken into multilines
    # and/or truncated (replaced with ...)
    #---
    #Artist: ÎšÎ±Î¶Î±Î½Ï„Î¶Î¯Î´Î·Ï‚ Î£Ï„ÎÎ»Î¹Î¿Ï‚/Î’Î¯ÏÎ²Î¿Ï‚ ÎšÏŽÏƒÏ„Î±Ï‚
    #Songname: Î‘Ï€ÏŒÎºÎ»Î·ÏÎ¿Ï‚ Ï„Î·Ï‚ ÎºÎ¿Î¹Î½Ï‰Î½Î¯Î±Ï‚

    $yamlstr = json2yaml($jsonstr, {'escape-unicode'=>1});
    print $yamlstr;
    #---
    #Artist: \u039a\u03b1\u03b6\u03b1 ...
    #Songname: \u0391\u03c0\u03cc\u03ba ...

    $backtojson = yaml2json($yamlstr);
    # $backtojson is a string representation
    # of following JSON structure:
    # {"Artist":"ÎšÎ±Î¶Î±Î½Ï„Î¶Î¯Î´Î·Ï‚ Î£Ï„ÎÎ»Î¹Î¿Ï‚/Î’Î¯ÏÎ²Î¿Ï‚ ÎšÏŽÏƒÏ„Î±Ï‚",
    #  "Songname":"Î‘Ï€ÏŒÎºÎ»Î·ÏÎ¿Ï‚ Ï„Î·Ï‚ ÎºÎ¿Î¹Î½Ï‰Î½Î¯Î±Ï‚"}

    # This is useful when sending JSON via
    # a POST request and it needs unicode escaped:
    $backtojson = yaml2json($yamlstr, {'escape-unicode'=>1});
    # $backtojson is a string representation
    # of following JSON structure:
    # but this time with unicode escaped
    # (pod content truncated for readbility)
    # {"Artist":"\u039a\u03b1\u03b6 ...",
    #  "Songname":"\u0391\u03c0\u03cc ..."}
    # this is the usual Data::Dumper dump:
    print json2dump($jsonstr);
    #$VAR1 = {
    #  'Songname' => "\x{391}\x{3c0}\x{3cc} ...",
    #  'Artist' => "\x{39a}\x{3b1}\x{3b6} ...",
    #};

    # and this is a more human-readable version:
    print json2dump($jsonstr, {'dont-bloody-escape-unicode'=>1});
    # $VAR1 = {
    #   "Artist" => "ÎšÎ±Î¶Î±Î½Ï„Î¶Î¯Î´Î·Ï‚ Î£Ï„ÎÎ»Î¹Î¿Ï‚/Î’Î¯ÏÎ²Î¿Ï‚ ÎšÏŽÏƒÏ„Î±Ï‚",
    #   "Songname" => "Î‘Ï€ÏŒÎºÎ»Î·ÏÎ¿Ï‚ Ï„Î·Ï‚ ÎºÎ¿Î¹Î½Ï‰Î½Î¯Î±Ï‚"
    # };

    # pass some parameters to Data::Dumper
    # like: be terse (no $VAR1):
    print json2dump($jsonstr,
      {'dont-bloody-escape-unicode'=>0, 'terse'=>1}
     #{'dont-bloody-escape-unicode'=>0, 'terse'=>1, 'indent'=>0}
    );
    # {
    #  "Artist" => "ÎšÎ±Î¶Î±Î½Ï„Î¶Î¯Î´Î·Ï‚ Î£Ï„ÎÎ»Î¹Î¿Ï‚/Î’Î¯ÏÎ²Î¿Ï‚ ÎšÏŽÏƒÏ„Î±Ï‚",
    #  "Songname" => "Î‘Ï€ÏŒÎºÎ»Î·ÏÎ¿Ï‚ Ï„Î·Ï‚ ÎºÎ¿Î¹Î½Ï‰Î½Î¯Î±Ï‚"
    # }

    # this is how to reformat a JSON string to
    # have its unicode content escaped:
    my $json_with_unicode_escaped =
          json2json($jsonstr, {'escape-unicode'=>1});

    # sometimes we want JSON's true and false values
    # to be mapped to something other than JSON::PP::Boolean objects:
    my $json_with_custom_boolean_mapping = json2perl($jsonstr,
	{'boolean_values' => 'myfalse', 'mytrue'});
    my $json_with_custom_boolean_mapping = json2perl($jsonstr,
	{'boolean_values' => 0, 1});

    # With version 0.18 and up two more exported-on-demand
    # subs were added to read JSON or YAML directly from a file:
    # jsonfile2perl() and yamlfile2perl()
    my $perldata = jsonfile2perl("file.json");
    my $perldata = yamlfile2perl("file.yaml");
    die "failed" unless defined $perldata;

    # For some of the above functions there exist command-line scripts:
    perl2json.pl -i "perl-data-structure.pl" -o "output.json" --pretty
    json2json.pl -i "with-unicode.json" -o "unicode-escaped.json" --escape-unicode
    # etc.

    # only for *2dump: perl2dump, json2dump, yaml2dump
    # and if no escape-unicode is required (i.e.
    # setting 'dont-bloody-escape-unicode' => 1 permanently)
    # and if efficiency is important,
    # meaning that perl2dump is run in a loop thousand of times,
    # then import the module like this:
    use Data::Roundtrip qw/:all no-unicode-escape-permanently/;
    # or like this
    use Data::Roundtrip qw/:all unicode-escape-permanently/;

    # then perl2dump() is more efficient but unicode characters
    # will be permanently not-escaped (1st case) or escaped (2nd case).

=head1 EXPORT

By default no symbols are exported. However, the following export tags are available (:all will export all of them):

=over 4

=item * C<:json> :
C<perl2json()>,
C<json2perl()>,
C<json2dump()>,
C<json2yaml()>,
C<json2json()>,
C<jsonfile2perl()>

=item * C<:yaml> :
C<perl2yaml()>,
C<yaml2perl()>,
C<yaml2dump()>,
C<yaml2yaml()>,
C<yaml2json()>,
C<yamlfile2perl()>

=item * C<:dump> :
C<perl2dump()>,
C<perl2dump_filtered()>,
C<perl2dump_homebrew()>

=item * C<:io> :
C<read_from_file()>, C<write_to_file()>,
C<read_from_filehandle()>, C<write_to_filehandle()>,

=item * C<:all> : everything above.

=item * Additionally, these four subs: C<dump2perl()>, C<dump2json()>, C<dump2yaml()>, C<dump2dump()>

lib/Data/Roundtrip.pm view on Meta::CPAN


the input is a Perl variable as a reference, so no C<< %inp >> but C<< $inp={} >> 
and C<< $inp=[] >>. 

This function is recursive.
Beware of extremely deep nested data structures.
Deep not long! But it probably is as efficient as
it can be but definetely lacks in aesthetics
and functionality compared to Dump and Dumper.

The output is a, possibly multiline, string. Which it can
then be fed back to L</dump2perl>.

=back

=head2 C<dump2perl>

    # CAVEAT: it will eval($dumpstring) internally, so
    #         check $dumpstring for malicious code beforehand
    #         it is a security risk if you don't.
    #         Don't use it if $dumpstring comes from
    #         untrusted sources (user input for example).
    my $ret = dump2perl($dumpstring)

Arguments:

=over 4

=item * C<$dumpstring>, this comes from the output of L<Data::Dump>,
L<Data::Dumper> or our own L</perl2dump>,
L</perl2dump_filtered>,
L</perl2dump_homebrew>.
Escaped, or unescaped.

=back

Return value:

=over 4

=item * C<$ret>, the Perl data structure on success or C<undef> on failure.

=back

CAVEAT: it B<eval()>'s the input C<$dumpstring> in order to create the Perl data structure.
B<eval()>'ing unknown or unchecked input is a security risk. Always check input to B<eval()>
which comes from untrusted sources, like user input, scraped documents, email content.
Anything really.

=head2 C<json2perl>

    my $ret = json2perl($jsonstring, $optional_paramshashref)

Arguments:

=over 4

=item * C<$jsonstring>

=item * C<$optional_paramshashref> is an optional hashref as it is blindingly obvious from
the name. At the moment only one parameter is understood: C<boolean_values>.
It must be an ARRAYREF of 0 or 2 elements. If 0 elements, then it resets the boolean
values mapping of the JSON converter to its default state (which is L<JSON::PP::Boolean> objects.
If it contains 2 elements, then the JSON converter will map a JSON C<false> value to
the first element of the ARRAYREF and a JSON C<true> value to
the second element of the ARRAYREF.

=back

Return value:

=over 4

=item * C<$ret>

=back

Given an input C<$jsonstring> as a string, it will return
the equivalent Perl data structure using
C<JSON::decode_json(Encode::encode_utf8($jsonstring))>.

It returns the Perl data structure on success or C<undef> on failure.

=head2 C<jsonfile2perl>

    my $ret = jsonfile2perl($filename)

Arguments:

=over 4

=item * C<$filename>

=back

Return value:

=over 4

=item * C<$ret>

=back

Given an input C<$filename> which points to a file containing JSON content,
it will return the equivalent Perl data structure.

It returns the Perl data structure on success or C<undef> on failure.

=head2 C<json2yaml>

  my $ret = json2yaml($jsonstring, $optional_paramshashref)

Arguments:

=over 4

=item * C<$jsonstring>

=item * C<$optional_paramshashref>

=back

( run in 0.872 second using v1.01-cache-2.11-cpan-9581c071862 )