view release on metacpan or  search on metacpan

script/sereal2sexp  view on Meta::CPAN

#!perl

## no critic: InputOutput::ProhibitInteractiveTest

use 5.010001;
use strict;
use warnings;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-03-20'; # DATE
our $DIST = 'App-SerializeUtils'; # DIST
our $VERSION = '0.165'; # VERSION

my ($from, $to) = $0 =~ /(\w+)2(\w+)\z/;
$from //= "";
$to   //= "";

my %Opts;

GET_OPTIONS: {
    $Opts{compact} //= (-t STDOUT) ? 0:1;
    $Opts{safe} //= 0;

    my %go_spec = (
        "help|h|?"  => sub {
            print "Please see manpage for more information\n\n";
            exit 0;
        },
        "version|v" => sub {
            no warnings 'once';
            print "serializeutils-convert version ". ($main::VERSION // "dev") .
                ($main::DATE ? " ($main::DATE)" : "") . "\n";
            exit 0;
        },
        "from=s"    => \$from,
        "to=s"      => \$to,
        "color!"    => \$Opts{color},
        "compact!"  => \$Opts{compact},
        "safe!"     => \$Opts{safe},
        "dumper=s"  => \$Opts{dumper},
    );
    require Getopt::Long::Complete;
    my $res = Getopt::Long::Complete::GetOptions(%go_spec);
    die "serializeutils-convert: There are errors in processing options\n"
        unless $res;

    $Opts{color} //= $ENV{COLOR} // (-t STDOUT) //
        ($to eq 'perlcolor' || $to eq 'json' ? 1:0);
    $Opts{dumper} //=
        $Opts{compact} ? 'Data::Dmp' :
        $to eq 'perlcolor' || $Opts{color} ? 'Data::Dump::Color' :
        'Data::Dump';
    #use DD; print "to=$to\n"; dd \%Opts;

} # GET_OPTIONS

my $code_from;
PARSE_INPUT: {
    undef $/;
    if ($from =~ /\A(perl|perlcolor)\z/) {
        if ($Opts{safe}) {
            require Data::Undump;
            $code_from = 'Data::Undump::undump(scalar <>)';
        } else {
            $code_from = 'eval scalar <>';
        }
    } elsif ($from eq 'json') {
        require JSON::MaybeXS;
        $code_from = 'JSON::MaybeXS->new->allow_nonref->decode(scalar <>)';
    } elsif ($from eq 'phpser') {
        require PHP::Serialization;
        $code_from = 'PHP::Serialization::unserialize(scalar <>)';
    } elsif ($from eq 'sereal') {
        require Sereal::Decoder;
        $code_from = 'Sereal::Decoder::decode_sereal(scalar <>)';
    } elsif ($from eq 'sexp') {
        require SExpression::Decode::Marpa;
        $code_from = 'SExpression::Decode::Marpa::from_sexp(scalar <>)';
    } elsif ($from eq 'storable') {
        require Storable;
        $code_from = 'Storable::thaw(scalar <>)';
    } elsif ($from eq 'yaml') {
        no warnings 'once';
        require YAML::Syck; $YAML::Syck::ImplicitTyping = 1;
        $code_from = 'YAML::Syck::Load(scalar <>)';
    } else {
        die "serializeutils-convert: Can't convert from '$from'\n";
    }
} # PARSE_INPUT

my $code_to;
OUTPUT: {
    if ($to =~ /\A(perl|perlcolor)\z/) {
        if ($Opts{dumper} eq 'Data::Dump::Color') {
            require Data::Dump::Color;
            $code_to = "Data::Dump::Color::dump($code_from)";
        } elsif ($Opts{dumper} eq 'Data::Dump') {
            require Data::Dump;
            $code_to = "Data::Dump::dump($code_from)";
        # commented out, not released yet
        #} elsif ($Opts{dumper} eq 'Data::Bahe') {
        #    require Data::Bahe;
        #    $code_to = "Data::Bahe::dump($code_from)";
        } elsif ($Opts{dumper} eq 'Data::Dmp') {
            require Data::Dmp;
            $code_to = "Data::Dmp::dmp($code_from)";
        } elsif ($Opts{dumper} eq 'Data::Dumper::Compact') {
            require Data::Dumper::Compact;
            $code_to = "Data::Dumper::Compact->dump($code_from)";
        } elsif ($Opts{dumper} eq 'Data::Dumper') {
            require Data::Dumper;
            $code_to = "Data::Dumper->new([$code_from], ['data'])->".
                "Purity(1)->Indent(1)->Terse(1)->Dump";
        } else {
            die "serializeutils-convert: Unknown dumper '$Opts{dumper}'\n";
        }
    } elsif ($to eq 'json') {
        if ($Opts{color}) {
            require JSON::Color;
            $code_to = "JSON::Color::encode_json($code_from)";
        } else {
            require JSON::MaybeXS;
            $code_to = "JSON::MaybeXS->new->allow_nonref->encode($code_from)";
        }
    } elsif ($to eq 'phpser') {
        require PHP::Serialization;
        $code_to = "PHP::Serialization::serialize($code_from)";
    } elsif ($to eq 'sereal') {
        require Sereal::Encoder;
        $code_to = "Sereal::Encoder::encode_sereal($code_from)";
    } elsif ($to eq 'sexp') {
        require Data::Dump::SExpression;
        $code_to = "Data::Dump::SExpression::dump_sexp($code_from)";
    } elsif ($to eq 'storable') {
        require Storable;
        $code_to = "Storable::freeze($code_from)";
    } elsif ($to eq 'yaml') {
        if ($Opts{color}) {
            require YAML::Tiny::Color;
            $code_to = "YAML::Tiny::Color::Dump($code_from)";
        } else {
            no warnings 'once';
            require YAML::Syck; $YAML::Syck::ImplicitTyping = 1;
            $code_to = "YAML::Syck::Dump($code_from)";
        }
    } else {
        die "serializeutils-convert: Can't convert to '$to'\n";
    }

    eval "print $code_to"; ## no critic: BuiltinFunctions::ProhibitStringyEval
    die if $@;
} # OUTPUT

# ABSTRACT: Convert between serialization formats
# PODNAME: sereal2sexp

__END__

=pod

=encoding UTF-8

=head1 NAME

sereal2sexp - Convert between serialization formats

=head1 VERSION

This document describes version 0.165 of sereal2sexp (from Perl distribution App-SerializeUtils), released on 2022-03-20.

=head1 SYNOPSIS

Usage:

 % serializeutils-convert [OPTIONS] < INPUT-FILE

For example, when called as C<json2yaml>:

 % script-that-outputs-json | json2yaml

=head1 DESCRIPTION

This script can be called as various names to convert between serialization
formats.

"perl" refers to Perl format, generated using L<Data::Dump> or L<Data::Dumper>
and parsed using Perl's C<eval()> or L<Data::Undump>.

"perlcolor" refers to colored Perl format, generated using L<Data::Dump::Color>.

"json" is of course the popular JavaScript Object Notation described in
L<https://www.json.org>.

"phpser" refers to PHP serialization format. This document describes the format
in more details:
L<http://www.phpinternalsbook.com/classes_objects/serialization.html>. To
serialize/deserialize this format, the script uses L<PHP::Serialization>.

"sereal" refers to the Sereal format, described in
L<https://github.com/Sereal/Sereal/blob/master/sereal_spec.pod>.

"storable" refers to the L<Storable> format.

"yaml" is the Yet Another Markup Language format specified in
L<https://www.yaml.org>.

The script are installed as the following names for convenience:

 perl2perlcolor
 perl2json
 perl2phpser
 perl2sereal
 perl2storable
 perl2yaml

 json2perl
 json2perlcolor
 json2phpser
 json2sereal
 json2storable
 json2yaml

 phpser2perl
 phpser2perlcolor
 phpser2json
 phpser2sereal
 phpser2storable
 phpser2yaml

 sereal2perl
 sereal2perlcolor
 sereal2json
 sereal2phpser
 sereal2storable
 sereal2yaml