view release on metacpan or  search on metacpan

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

		return 0
	}
	if( ! write_to_filehandle($FH, $contents) ){ print STDERR "error, call to ".'write_to_filehandle()'." has failed"; close $FH; return 0 }
	close $FH;
	return 1;
}
# reads all content from filehandle and returns them on success
# or returns undef on failure
sub	read_from_filehandle {
	my $FH = $_[0];
	# you should open INFH as '<:encoding(UTF-8)'
	# or if it is STDIN, do binmode STDIN , ':encoding(UTF-8)';
	return do { local $/; <$FH> }
}
sub	write_to_filehandle {
	my $FH = $_[0];
	my $contents = $_[1];
	# you should open $OUTFH as >:encoding(UTF-8)'
	# or if it is STDOUT, do binmode STDOUT , ':encoding(UTF-8)';
	print $FH $contents;
	return 1;
}
# todo: change to utf8::is_utf8()
sub	_has_utf8 { return $_[0] =~ /[^\x00-\x7f]/ }
# Below code is by [Corion] @ Perlmonks and cpan
# see https://perlmonks.org/?node_id=11115271
# it's for redefining Data::Dumper::qquote
# (it must be accompanied by
#  $Data::Dumper::Useperl = 1;
#  $Data::Dumper::Useqq='utf8';
# HOWEVER, I discoverd that a redefined sub can not access packages private vars
sub	_qquote_redefinition_by_Corion {
  local($_) = shift;

  return qq("") unless defined $_;
  s/([\\\"\@\$])/\\$1/g;

  return qq("$_") unless /[[:^print:]]/;  # fast exit if only printables

  # Here, there is at least one non-printable to output.  First, translate the
  # escapes.
   s/([\a\b\t\n\f\r\e])/$Data_Dumper_esc{$1}/g;
  # this is the original but it does not work because it can't find %esc
  # which is a private var in Data::Dumper, so I copied those vars above
  # and access them as Data_Dumper_XYZ
  #s/([\a\b\t\n\f\r\e])/$Data::Dumper::esc{$1}/g;

  # no need for 3 digits in escape for octals not followed by a digit.
  s/($Data_Dumper_low_controls)(?!\d)/'\\'.sprintf('%o',ord($1))/eg;

  # But otherwise use 3 digits
  s/($Data_Dumper_low_controls)/'\\'.sprintf('%03o',ord($1))/eg;


    # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
  my $high = shift || "";
    if ($high eq "iso8859") {   # Doesn't escape the Latin1 printables
      if ($Data_Dumper_IS_ASCII) {
        s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
      }
      elsif ($] ge 5.007_003) {
        my $high_control = utf8::unicode_to_native(0x9F);
        s/$high_control/sprintf('\\%o',ord($1))/eg;
      }
    } elsif ($high eq "utf8") {
#     Some discussion of what to do here is in
#       https://rt.perl.org/Ticket/Display.html?id=113088
#     use utf8;
#     $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
    } elsif ($high eq "8bit") {
        # leave it as it is
    } else {
      s/([[:^ascii:]])/'\\'.sprintf('%03o',ord($1))/eg;
      #s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
    }
    return qq("$_");
}
# begin pod
=pod

=encoding utf8

=head1 NAME

Data::Roundtrip - convert between Perl data structures, YAML and JSON with unicode support (I believe ...)

=head1 VERSION

Version 0.31

=head1 SYNOPSIS

This module contains a collection of utilities for converting between
JSON, YAML, Perl variable and a Perl variable's string representation (aka dump).
Hopefully, all unicode content will be handled correctly between
the conversions and optionally escaped or un-escaped. Also JSON can
be presented in a pretty format or in a condensed, machine-readable
format (not spaces, indendation or line breaks).

    use Data::Roundtrip qw/:all/;
    #use Data::Roundtrip qw/json2yaml/;
    #use Data::Roundtrip qw/:json/; # see EXPORT

    $jsonstr = '{"Songname": "Απόκληρος της κοινωνίας",'
	       .'"Artist": "Καζαντζίδης Στέλιος/Βίρβος Κώστας"}'
    ;
    $yamlstr = json2yaml($jsonstr);
    print $yamlstr;
    # 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);