codekingpro/portable-devtools

1#!/usr/bin/perl2    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'3	if 0; # ^ Run only under a shell4#!/usr/bin/perl5 6BEGIN { pop @INC if $INC[-1] eq '.' }7use strict;8use Getopt::Long;9use Encode ();10 11use JSON::PP ();12 13# imported from JSON-XS/bin/json_xs14 15my %allow_json_opt = map { $_ => 1 } qw(16    ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref17    allow_singlequote allow_barekey allow_bignum loose escape_slash indent_length18);19 20 21GetOptions(22   'v'   => \( my $opt_verbose ),23   'f=s' => \( my $opt_from = 'json' ),24   't=s' => \( my $opt_to = 'json' ),25   'json_opt=s' => \( my $json_opt = 'pretty' ),26   'V'   => \( my $version ),27) or die "Usage: $0 [-V] [-f from_format] [-t to_format] [-json_opt options_to_json1[,options_to_json2[,...]]]\n";28 29 30if ( $version ) {31    print "$JSON::PP::VERSION\n";32    exit;33}34 35 36$json_opt = '' if $json_opt eq '-';37 38my %json_opt;39for my $opt (split /,/, $json_opt) {40    my ($key, $value) = split /=/, $opt, 2;41    $value = 1 unless defined $value;42    die "'$_' is not a valid json option" unless $allow_json_opt{$key};43    $json_opt{$key} = $value;44}45 46my %F = (47   'json' => sub {48      my $json = JSON::PP->new;49      my $enc =50         /^\x00\x00\x00/s  ? "utf-32be"51       : /^\x00.\x00/s     ? "utf-16be"52       : /^.\x00\x00\x00/s ? "utf-32le"53       : /^.\x00.\x00/s    ? "utf-16le"54       :                     "utf-8";55      for my $key (keys %json_opt) {56        next if $key eq 'utf8';57        $json->$key($json_opt{$key});58      }59      $json->decode( Encode::decode($enc, $_) );60   },61   'eval' => sub {62        my $v = eval "no strict;\n#line 1 \"input\"\n$_";63        die "$@" if $@;64        return $v;65    },66);67 68 69my %T = (70   'null' => sub { "" },71   'json' => sub {72      my $json = JSON::PP->new->utf8;73      for my $key (keys %json_opt) {74        $json->$key($json_opt{$key});75      }76      $json->canonical if $json_opt{pretty};77      $json->encode( $_ );78   },79   'dumper' => sub {80      require Data::Dumper;81      local $Data::Dumper::Terse     = 1;82      local $Data::Dumper::Indent    = 1;83      local $Data::Dumper::Useqq     = 1;84      local $Data::Dumper::Quotekeys = 0;85      local $Data::Dumper::Sortkeys  = 1;86      Data::Dumper::Dumper($_)87   },88);89 90 91 92$F{$opt_from}93   or die "$opt_from: not a valid fromformat\n";94 95$T{$opt_to}96   or die "$opt_from: not a valid toformat\n";97 98{99  local $/;100  binmode STDIN;101  $_ = <STDIN>;102}103 104$_ = $F{$opt_from}->();105$_ = $T{$opt_to}->();106 107print $_;108 109 110__END__111 112=pod113 114=encoding utf8115 116=head1 NAME117 118json_pp - JSON::PP command utility119 120=head1 SYNOPSIS121 122    json_pp [-v] [-f from_format] [-t to_format] [-json_opt options_to_json1[,options_to_json2[,...]]]123 124=head1 DESCRIPTION125 126json_pp converts between some input and output formats (one of them is JSON).127This program was copied from L<json_xs> and modified.128 129The default input format is json and the default output format is json with pretty option.130 131=head1 OPTIONS132 133=head2 -f134 135    -f from_format136 137Reads a data in the given format from STDIN.138 139Format types:140 141=over142 143=item json144 145as JSON146 147=item eval148 149as Perl code150 151=back152 153=head2 -t154 155Writes a data in the given format to STDOUT.156 157=over158 159=item null160 161no action.162 163=item json164 165as JSON166 167=item dumper168 169as Data::Dumper170 171=back172 173=head2 -json_opt174 175options to JSON::PP176 177Acceptable options are:178 179    ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref180    allow_singlequote allow_barekey allow_bignum loose escape_slash indent_length181 182Multiple options must be separated by commas:183 184    Right: -json_opt pretty,canonical185 186    Wrong: -json_opt pretty -json_opt canonical187 188=head2 -v189 190Verbose option, but currently no action in fact.191 192=head2 -V193 194Prints version and exits.195 196 197=head1 EXAMPLES198 199    $ perl -e'print q|{"foo":"あい","bar":1234567890000000000000000}|' |\200       json_pp -f json -t dumper -json_opt pretty,utf8,allow_bignum201    202    $VAR1 = {203              'bar' => bless( {204                                'value' => [205                                             '0000000',206                                             '0000000',207                                             '5678900',208                                             '1234'209                                           ],210                                'sign' => '+'211                              }, 'Math::BigInt' ),212              'foo' => "\x{3042}\x{3044}"213            };214 215    $ perl -e'print q|{"foo":"あい","bar":1234567890000000000000000}|' |\216       json_pp -f json -t dumper -json_opt pretty217    218    $VAR1 = {219              'bar' => '1234567890000000000000000',220              'foo' => "\x{e3}\x{81}\x{82}\x{e3}\x{81}\x{84}"221            };222 223=head1 SEE ALSO224 225L<JSON::PP>, L<json_xs>226 227=head1 AUTHOR228 229Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>230 231 232=head1 COPYRIGHT AND LICENSE233 234Copyright 2010 by Makamaka Hannyaharamitu235 236This library is free software; you can redistribute it and/or modify237it under the same terms as Perl itself. 238 239=cut240 241