diff --git a/AUTHORS b/AUTHORS index 9589f8c3d262..3b4bd24e709a 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1143,6 +1143,7 @@ Philip Guenther Philip Hazel Philip M. Gollucci Philip Newton +Philipp Böschen Philippe Bruhat (BooK) Philippe M. Chiasson Pierre Bogossian diff --git a/embedvar.h b/embedvar.h index 085df4802814..f1e16d24772d 100644 --- a/embedvar.h +++ b/embedvar.h @@ -190,6 +190,7 @@ # define PL_minus_c (vTHX->Iminus_c) # define PL_minus_E (vTHX->Iminus_E) # define PL_minus_F (vTHX->Iminus_F) +# define PL_minus_j (vTHX->Iminus_j) # define PL_minus_l (vTHX->Iminus_l) # define PL_minus_n (vTHX->Iminus_n) # define PL_minus_p (vTHX->Iminus_p) diff --git a/intrpvar.h b/intrpvar.h index 921d15d38c95..bd3a7f1f3e33 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -510,6 +510,7 @@ PERLVAR(I, minus_n, bool) PERLVAR(I, minus_p, bool) PERLVAR(I, minus_l, bool) PERLVAR(I, minus_a, bool) +PERLVAR(I, minus_j, bool) PERLVAR(I, minus_F, bool) PERLVAR(I, doswitches, bool) PERLVAR(I, minus_E, bool) diff --git a/perl.c b/perl.c index cf137dc73136..b693afd930b8 100644 --- a/perl.c +++ b/perl.c @@ -1017,6 +1017,7 @@ perl_destruct(pTHXx) PL_minus_p = FALSE; PL_minus_l = FALSE; PL_minus_a = FALSE; + PL_minus_j = FALSE; PL_minus_F = FALSE; PL_doswitches = FALSE; PL_dowarn = G_WARN_OFF; @@ -2244,6 +2245,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) case 'h': case 'i': case 'l': + case 'j': case 'n': case 'p': case 's': @@ -3551,6 +3553,7 @@ S_usage(pTHX) /* XXX move this out into a module ? */ " -l[octnum] enable line ending processing, specifies line terminator\n" " -[mM][-]module execute \"use/no module...\" before executing program\n" " -n assume \"while (<>) { ... }\" loop around program\n" +" -j auto decode_json with -n or -p into $data" " -p assume loop like -n but print line also, like sed\n" " -s enable rudimentary parsing for switches after programfile\n" " -S look for programfile using PATH environment variable\n", @@ -3858,6 +3861,10 @@ Perl_moreswitches(pTHX_ const char *s) else croak("No directory specified for -I"); return s; + case 'j': + PL_minus_j = TRUE; + s++; + return s; case 'l': PL_minus_l = TRUE; s++; diff --git a/pod/perlrun.pod b/pod/perlrun.pod index e880d70d99c3..64b779fdf140 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -7,7 +7,7 @@ perlrun - how to execute the Perl interpreter B S<[ B<-gsTtuUWX> ]> S<[ B<-h?v> ] [ B<-V>[:I] ]> S<[ B<-cw> ] [ B<-d>[B][:I] ] [ B<-D>[I] ]> - S<[ B<-pna> ] [ B<-F>I ] [ B<-l>[I] ] [ B<-0>[I] ]> + S<[ B<-pnaj> ] [ B<-F>I ] [ B<-l>[I] ] [ B<-0>[I] ]> S<[ B<-I>I ] [ B<-m>[B<->]I ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]> S<[ B<-C [I] >]> S<[ B<-S> ]> @@ -663,6 +663,16 @@ X<-I> X<@INC> Directories specified by B<-I> are prepended to the search path for modules (C<@INC>). +=item B<-j> + +enables automatic JSON decoding when used with L and decode plus +printing when used with L. It basically automatically transforms +C<$_> into a hashref that has been parsed from the current input using +JSON::PP::decode_json. +When used with L it overwrites the final print statement to first +call JSON::PP::encode_json so whatever is in C<$_> will be JSON encoded +before printing. + =item B<-l>[I] X<-l> X<$/> X<$\> diff --git a/regen/embed.pl b/regen/embed.pl index abbee02401fe..5cee10229d9e 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl -W # # Regenerate (overwriting only if changed): # diff --git a/sv.c b/sv.c index 4cfcaa05ff68..085b6f06779d 100644 --- a/sv.c +++ b/sv.c @@ -15827,6 +15827,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_minus_p = proto_perl->Iminus_p; PL_minus_l = proto_perl->Iminus_l; PL_minus_a = proto_perl->Iminus_a; + PL_minus_j = proto_perl->Iminus_j; PL_minus_E = proto_perl->Iminus_E; PL_minus_F = proto_perl->Iminus_F; PL_doswitches = proto_perl->Idoswitches; diff --git a/t/run/switches.t b/t/run/switches.t index 210089bb0f22..d6353c1d7c63 100644 --- a/t/run/switches.t +++ b/t/run/switches.t @@ -332,7 +332,7 @@ is runperl(stderr => 1, prog => '#!perl -M'), # Tests for switches which do not exist -foreach my $switch (split //, "ABbGHJjKkLNOoPQqRrYyZz123456789_") +foreach my $switch (split //, "ABbGHJKkLNOoPQqRrYyZz123456789_") { local $TODO = ''; # these ones should work on VMS diff --git a/toke.c b/toke.c index 645df00fc4a5..37525a19f459 100644 --- a/toke.c +++ b/toke.c @@ -1527,8 +1527,13 @@ Perl_lex_next_chunk(pTHX_ U32 flags) PL_parser->rsfp = NULL; PL_parser->in_pod = PL_parser->filtered = 0; if (!PL_in_eval && PL_minus_p) { - sv_catpvs(linestr, - /*{*/";}continue{print or die qq(-p destination: $!\\n);}"); + if (PL_minus_j) { + sv_catpvs(linestr, + /*{*/";}continue{print JSON::PP::encode_json($_) or die qq(-p destination: $!\\n);}"); + } else { + sv_catpvs(linestr, + /*{*/";}continue{print or die qq(-p destination: $!\\n);}"); + }; PL_minus_n = PL_minus_p = 0; } else if (!PL_in_eval && PL_minus_n) { sv_catpvs(linestr, /*{*/";}"); @@ -9208,6 +9213,10 @@ yyl_try(pTHX_ char *s) sv_catpvs(PL_linestr, "LINE: while (<>) {"/*}*/); if (PL_minus_l) sv_catpvs(PL_linestr,"chomp;"); + if (PL_minus_j) { + sv_catpvs(PL_linestr,"use JSON::PP ();"); + sv_catpvs(PL_linestr,"$_ = JSON::PP::decode_json($_);"); + } if (PL_minus_a) { if (PL_minus_F) { if ( ( *PL_splitstr == '/'