326 lines
9.8 KiB
Perl
326 lines
9.8 KiB
Perl
#!perl
|
|
|
|
=head1 NAME
|
|
|
|
cpanel_json_xs - Cpanel::JSON::XS commandline utility
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
cpanel_json_xs [-v] [-f inputformat] [-t outputformat]
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
F<cpanel_json_xs> converts between some input and output formats (one of them is
|
|
JSON).
|
|
|
|
The default input format is C<json> and the default output format is
|
|
C<json-pretty>.
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 4
|
|
|
|
=item -v
|
|
|
|
Be slightly more verbose.
|
|
|
|
=item -f fromformat
|
|
|
|
Read a file in the given format from STDIN.
|
|
|
|
C<fromformat> can be one of:
|
|
|
|
=over 4
|
|
|
|
=item json - a json text encoded, either utf-8, utf16-be/le, utf32-be/le
|
|
|
|
=item json-nonref - json according to RFC 7159
|
|
|
|
=item json-relaxed - json with all relaxed options
|
|
|
|
=item json-unknown - json with allow_unknown
|
|
|
|
=item storable - a Storable frozen value
|
|
|
|
=item storable-file - a Storable file (Storable has two incompatible formats)
|
|
|
|
=item bencode - uses one of Net::BitTorrent::Protocol::BEP03::Bencode, Bencode or the broken Convert::Bencode, if available (used by torrent files, among others)
|
|
|
|
=item clzf - Compress::LZF format (requires that module to be installed)
|
|
|
|
=item eval - evaluate the given code as (non-utf-8) Perl, basically the reverse of "-t dump"
|
|
|
|
=item yaml - loose YAML (requires YAML)
|
|
|
|
=item yaml-tiny - loose YAML (requires YAML::Tiny or CPAN::Meta::YAML)
|
|
|
|
=item yaml-xs - strict YAML 1.2 (requires YAML::XS)
|
|
|
|
=item yaml-syck - YAML (requires YAML::Syck)
|
|
|
|
=item cbor - CBOR (via CBOR::XS)
|
|
|
|
=item string - do not attempt to decode the file data
|
|
|
|
=item sereal - Sereal (via Sereal::Decoder)
|
|
|
|
=item none - nothing is read, creates an C<undef> scalar - mainly useful with C<-e>
|
|
|
|
=back
|
|
|
|
=item -t toformat
|
|
|
|
Write the file in the given format to STDOUT.
|
|
|
|
C<toformat> can be one of:
|
|
|
|
=over 4
|
|
|
|
=item json, json-utf-8 - json, utf-8 encoded
|
|
|
|
=item json-pretty - as above, but pretty-printed with sorted object keys
|
|
|
|
=item json-stringify - as json-pretty with allow_stringify
|
|
|
|
=item json-relaxed - as json-pretty, but with the additional options
|
|
|
|
->allow_stringify->allow_blessed->convert_blessed->allow_unknown
|
|
->allow_tags->stringify_infnan(1)
|
|
|
|
=item json-utf-16le, json-utf-16be - little endian/big endian utf-16
|
|
|
|
=item json-utf-32le, json-utf-32be - little endian/big endian utf-32
|
|
|
|
=item storable - a Storable frozen value in network format
|
|
|
|
=item storable-file - a Storable file in network format (Storable has two incompatible formats)
|
|
|
|
=item bencode - uses one of Net::BitTorrent::Protocol::BEP03::Bencode, Bencode or the broken Convert::Bencode, if available (used by torrent files, among others)
|
|
|
|
=item clzf - Compress::LZF format
|
|
|
|
=item yaml - loose YAML (requires YAML)
|
|
|
|
=item yaml-tiny - loose YAML (requires YAML::Tiny or CPAN::Meta::YAML)
|
|
|
|
=item yaml-xs - strict YAML 1.2 (requires YAML::XS)
|
|
|
|
=item yaml-syck - YAML (requires YAML::Syck)
|
|
|
|
=item dump - Data::Dump
|
|
|
|
=item dumper - Data::Dumper
|
|
|
|
=item string - writes the data out as if it were a string
|
|
|
|
=item sereal - Sereal (via Sereal::Encoder)
|
|
|
|
=item none - nothing gets written, mainly useful together with C<-e>
|
|
|
|
Note that Data::Dumper doesn't handle self-referential data structures
|
|
correctly - use "dump" instead.
|
|
|
|
=back
|
|
|
|
=item -e code
|
|
|
|
Evaluate perl code after reading the data and before writing it out again
|
|
- can be used to filter, create or extract data. The data that has been
|
|
written is in C<$_>, and whatever is in there is written out afterwards.
|
|
|
|
=back
|
|
|
|
=head1 EXAMPLES
|
|
|
|
cpanel_json_xs -t none <isitreally.json
|
|
|
|
"JSON Lint" - tries to parse the file F<isitreally.json> as JSON - if it
|
|
is valid JSON, the command outputs nothing, otherwise it will print an
|
|
error message and exit with non-zero exit status.
|
|
|
|
<src.json cpanel_json_xs >pretty.json
|
|
|
|
Prettify the JSON file F<src.json> to F<dst.json>.
|
|
|
|
cpanel_json_xs -f storable-file <file
|
|
|
|
Read the serialized Storable file F<file> and print a human-readable JSON
|
|
version of it to STDOUT.
|
|
|
|
cpanel_json_xs -f storable-file -t yaml <file
|
|
|
|
Same as above, but write YAML instead (not using JSON at all :)
|
|
|
|
cpanel_json_xs -f none -e '$_ = [1, 2, 3]'
|
|
|
|
Dump the perl array as UTF-8 encoded JSON text.
|
|
|
|
<torrentfile cpanel_json_xs -f bencode -e '$_ = join "\n", map @$_, @{$_->{"announce-list"}}' -t string
|
|
|
|
Print the tracker list inside a torrent file.
|
|
|
|
lwp-request http://cpantesters.perl.org/show/Cpanel-JSON-XS.json | cpanel_json_xs
|
|
|
|
Fetch the cpan-testers result summary C<Cpanel::JSON::XS> and pretty-print it.
|
|
|
|
cpanel_json_xs -f yaml-xs -t yaml-tiny <META.yml >MYMETA.yml
|
|
cpanel_json_xs -f yaml-tiny -t yaml-xs <MYMETA.yml >XSMETA.yml
|
|
cpanel_json_xs -f yaml -t yaml <XSMETA.yml #BOOM!
|
|
Error: YAML_LOAD_ERR_BAD_MAP_ELEMENT
|
|
|
|
Compare YAML en- and decoders, and see that YAML::XS generates unparsable YAML
|
|
L<https://github.com/ingydotnet/yaml-libyaml-pm/issues/9>
|
|
|
|
=head1 AUTHOR
|
|
|
|
Copyright (C) 2008 Marc Lehmann <json@schmorp.de>
|
|
Copyright (C) 2016 Cpanel Inc
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
|
|
use Getopt::Long;
|
|
use Storable ();
|
|
use Encode;
|
|
|
|
use Cpanel::JSON::XS;
|
|
|
|
my $opt_verbose;
|
|
my $opt_from = "json";
|
|
my $opt_to = "json-pretty";
|
|
my $opt_eval;
|
|
|
|
Getopt::Long::Configure ("bundling", "no_ignore_case", "require_order");
|
|
|
|
GetOptions(
|
|
"v" => \$opt_verbose,
|
|
"f=s" => \$opt_from,
|
|
"t=s" => \$opt_to,
|
|
"e=s" => \$opt_eval,
|
|
) or die "Usage: $0 [-v] -f fromformat [-e code] [-t toformat]\n";
|
|
|
|
sub enc {
|
|
$_ = shift;
|
|
my $enc =
|
|
/^\x00\x00\x00/s ? "utf-32be"
|
|
: /^\x00.\x00/s ? "utf-16be"
|
|
: /^.\x00\x00\x00/s ? "utf-32le"
|
|
: /^.\x00.\x00/s ? "utf-16le"
|
|
: "utf-8";
|
|
warn "input text encoding is $enc\n" if $opt_verbose;
|
|
$enc;
|
|
}
|
|
|
|
my %F = (
|
|
"none" => sub { undef },
|
|
"string" => sub { $_ },
|
|
"json" => sub {
|
|
Cpanel::JSON::XS->new->decode (decode enc($_), $_)
|
|
},
|
|
"json-nonref" => sub {
|
|
Cpanel::JSON::XS->new->allow_nonref->decode (decode enc($_), $_)
|
|
},
|
|
"json-relaxed" => sub {
|
|
Cpanel::JSON::XS->new->relaxed->decode (decode enc($_), $_)
|
|
},
|
|
"json-unknown" => sub {
|
|
Cpanel::JSON::XS->new->allow_unknown->decode (decode enc($_), $_)
|
|
},
|
|
"storable" => sub { Storable::thaw $_ },
|
|
"storable-file" => sub { open my $fh, "<", \$_; Storable::fd_retrieve $fh },
|
|
"bencode" => sub {
|
|
if (eval {require Net::BitTorrent::Protocol::BEP03::Bencode }) {
|
|
return Net::BitTorrent::Protocol::BEP03::Bencode::bdecode ($_);
|
|
}
|
|
if (eval {require Bencode}) {
|
|
return Bencode::bdecode ($_);
|
|
}
|
|
require Convert::Bencode; return Convert::Bencode::bdecode ($_);
|
|
},
|
|
"clzf" => sub { require Compress::LZF; Compress::LZF::sthaw ($_) },
|
|
"yaml" => sub { require YAML; YAML::Load ($_) },
|
|
"yaml-tiny" => sub { require CPAN::Meta::YAML; CPAN::Meta::YAML::Load ($_) },
|
|
"yaml-xs" => sub { require YAML::XS; YAML::XS::Load ($_) },
|
|
"yaml-syck" => sub { require YAML::Syck; YAML::Syck::Load ($_) },
|
|
"cbor" => sub { require CBOR::XS; CBOR::XS::decode_cbor ($_) },
|
|
"sereal" => sub { require Sereal::Decoder; Sereal::Decoder::decode_sereal ($_) },
|
|
"eval" => sub { my $v = eval "no strict; no warnings; no utf8;\n#line 1 \"input\"\n$_"; die "$@" if $@; $v },
|
|
);
|
|
|
|
my %T = (
|
|
"none" => sub { "" },
|
|
"string" => sub { $_ },
|
|
"json" => sub { encode_json $_ },
|
|
"json-utf-8" => sub { encode_json $_ },
|
|
"json-pretty" => sub { Cpanel::JSON::XS->new->utf8->pretty->canonical->encode ($_) },
|
|
"json-stringify"=> sub { Cpanel::JSON::XS->new->utf8->pretty->canonical->allow_stringify->encode ($_) },
|
|
"json-relaxed" => sub { Cpanel::JSON::XS->new->utf8->pretty->canonical
|
|
->allow_stringify->allow_blessed->convert_blessed
|
|
->allow_unknown->allow_tags->stringify_infnan(1)
|
|
->encode ($_) },
|
|
"json-utf-16le" => sub { encode "utf-16le", Cpanel::JSON::XS->new->encode ($_) },
|
|
"json-utf-16be" => sub { encode "utf-16be", Cpanel::JSON::XS->new->encode ($_) },
|
|
"json-utf-32le" => sub { encode "utf-32le", Cpanel::JSON::XS->new->encode ($_) },
|
|
"json-utf-32be" => sub { encode "utf-32be", Cpanel::JSON::XS->new->encode ($_) },
|
|
|
|
"storable" => sub { Storable::nfreeze $_ },
|
|
"storable-file" => sub { open my $fh, ">", \my $buf; Storable::nstore_fd $_, $fh; $buf },
|
|
|
|
"bencode" => sub {
|
|
if (eval {require Net::BitTorrent::Protocol::BEP03::Bencode }) {
|
|
return Net::BitTorrent::Protocol::BEP03::Bencode::bencode ($_);
|
|
}
|
|
if (eval {require Bencode}) {
|
|
return Bencode::bencode ($_);
|
|
}
|
|
require Convert::Bencode; return Convert::Bencode::bencode ($_);
|
|
},
|
|
"clzf" => sub { require Compress::LZF; Compress::LZF::sfreeze_cr ($_) },
|
|
"yaml" => sub { require YAML; YAML::Dump ($_) },
|
|
"yaml-tiny" => sub { require CPAN::Meta::YAML; CPAN::Meta::YAML::Dump ($_) },
|
|
"yaml-xs" => sub { require YAML::XS; YAML::XS::Dump ($_) },
|
|
"yaml-syck" => sub { require YAML::Syck; YAML::Syck::Dump ($_) },
|
|
"dumper" => sub {
|
|
require Data::Dumper;
|
|
#local $Data::Dumper::Purity = 1; # hopeless case
|
|
local $Data::Dumper::Terse = 1;
|
|
local $Data::Dumper::Indent = 1;
|
|
local $Data::Dumper::Useqq = 1;
|
|
local $Data::Dumper::Quotekeys = 0;
|
|
local $Data::Dumper::Sortkeys = 1;
|
|
Data::Dumper::Dumper($_)
|
|
},
|
|
"dump" => sub {
|
|
require Data::Dump;
|
|
local $Data::Dump::TRY_BASE64 = 0;
|
|
Data::Dump::dump ($_) . "\n"
|
|
},
|
|
"sereal" => sub { require Sereal::Encoder; Sereal::Encoder::encode_sereal ($_) },
|
|
);
|
|
|
|
$F{$opt_from}
|
|
or die "$opt_from: not a valid fromformat\n";
|
|
|
|
$T{$opt_to}
|
|
or die "$opt_from: not a valid toformat\n";
|
|
|
|
if ($opt_from ne "none") {
|
|
local $/;
|
|
binmode STDIN; # stupid perl sometimes thinks its funny
|
|
$_ = <STDIN>;
|
|
}
|
|
|
|
$_ = $F{$opt_from}->();
|
|
|
|
eval $opt_eval;
|
|
die $@ if $@;
|
|
|
|
$_ = $T{$opt_to}->();
|
|
|
|
binmode STDOUT;
|
|
syswrite STDOUT, $_;
|
|
|
|
|
|
|