File Coverage

blib/lib/JSON/ize.pm
Criterion Covered Total %
statement 46 52 88.4
branch 12 18 66.6
condition n/a
subroutine 14 16 87.5
pod 6 8 75.0
total 78 94 82.9


line stmt bran cond sub pod time code
1             package JSON::ize;
2 2     2   120846 use base Exporter;
  2         11  
  2         117  
3 2     2   781 use JSON::MaybeXS;
  2         28816  
  2         108  
4 2     2   682 use YAML::Any qw/Dump Load LoadFile DumpFile/;
  2         2014  
  2         7  
5 2     2   6073 use Try::Tiny;
  2         4216  
  2         94  
6 2     2   12 use strict;
  2         4  
  2         31  
7 2     2   9 use warnings;
  2         2  
  2         1901  
8              
9             our $JOBJ = JSON::MaybeXS->new();
10             our $YOBJ;
11             our $_last_out = "";
12              
13             our @EXPORT = qw/jsonize jsonise J parsej pretty_json ugly_json/;
14             our $VERSION = "0.200";
15              
16 11     11 0 127 sub jobj { $JOBJ }
17              
18             sub jsonize (;$) {
19 16     16 1 1297 my $inp = shift;
20 16 100       39 if (!defined $inp) {
21 4         23 return $_last_out;
22             }
23 12 50       49 if (ref $inp) { # encode perl object
24 0         0 return $_last_out = jobj()->encode($inp);
25             }
26             else { # scalar: decode if looks like json, or slurp if filename
27 12 100       24 if (looks_like_json($inp)) {
28 4         9 return $_last_out = jobj()->decode($inp);
29             }
30             else { # try as file
31 8         22 local $/;
32 8         13 my ($j,$f);
33 8 100       130 die "'$inp' is not a existing filename, json string, or a reference" unless (-e $inp);
34 7 50       341 if ( eval "require PerlIO::gzip; 1" ) {
35 7 50       322 open $f, "<:gzip(autopop)", $inp or die "Problem with file '$inp' : $!";
36             }
37             else {
38 0 0       0 open $f, "$inp" or die "Problem with file '$inp' : $!";
39             }
40 7         123 $j = <$f>;
41             try {
42 7     7   641 $_last_out = jobj()->decode($j);
43             } catch {
44 4 50   4   63 /at character offset/ && do { # JSON error
45 4         6 my $jerr = $_;
46 4 100       8 if (looks_like_json($j)) { # probably really was JSON
47 2         40 die "JSON decode barfed.\nJSON err: $jerr"
48             }
49             try { # might be YAML
50 2         171 $_last_out = Load($j);
51             } catch {
52 1         105 die "Both JSON and YAML decodes barfed.\nJSON err: $jerr\nYAML err: $_";
53 2         9 };
54             };
55 7         74 };
56 4         271 return $_last_out;
57             }
58             }
59             }
60              
61 1     1 1 3 sub jsonise (;$) { jsonize($_[0]) }
62 4     4 1 488 sub J (;$) { jsonize($_[0]) }
63              
64              
65             sub parsej () {
66 4     4 1 27 $_last_out = $JOBJ->incr_parse($_);
67             }
68              
69 0     0 1 0 sub pretty_json { jobj()->pretty; return; }
  0         0  
70 0     0 1 0 sub ugly_json { jobj()->pretty(0); return; }
  0         0  
71              
72             sub looks_like_json {
73 16     16 0 23 my $ck = $_[0];
74 16         64 return $ck =~ /^\s*[[{]/;
75             }
76              
77             =head1 NAME
78              
79             JSON::ize - Use JSON easily in one-liners - now with YAMLific action
80              
81             =head1 SYNOPSIS
82              
83             $ perl -MJSON::ize -le '$j=jsonize("my.json"); print $j->{thingy};'
84              
85             $ perl -MJSON::ize -le '$j=jsonize("my.yaml"); print $j->{thingy};'
86              
87             # plus yamls all the way down...
88              
89             # if you have PerlIO::gzip, this works
90              
91             $ perl -MJSON::ize -le '$j=jsonize("my.json.gz"); print $j->{thingy};'
92              
93             $ perl -MJSON::ize -le 'J("my.json"); print J->{thingy};' # short
94              
95             $ perl -MJSON::ize -le 'print J("my.json")->{thingy};' # shorter
96              
97             $ cat my.json | perl -MJSON::ize -lne 'parsej; END{ print J->{thingy}}' # another way
98              
99             $ perl -MJSON::ize -le '$j="{\"this\":\"also\",\"works\":[1,2,3]}"; print jsonize($j)->{"this"};' # also
100              
101             $ perl -MJSON::ize -e 'pretty_json(); $j=jsonize("ugly.json"); print jsonize($j);' # pretty!
102              
103             $ perl -MJSON::ize -e 'ugly_json; print J(J("indented.json"));' # strip whsp
104              
105              
106             =head1 DESCRIPTION
107              
108             JSON::ize exports a function, C, that will do what you mean with the argument.
109             If argument is a filename, it will try to read the file and decode it as JSON or YAML.
110             If argument is a string that looks like JSON, it will try to encode it.
111             If argument is a Perl hashref or arrayref, it will try to encode it as JSON.
112              
113             The underlying L object is
114              
115             $JSON::ize::JOBJ
116              
117             =head1 METHODS
118              
119             =over
120              
121             =item jsonize($j), jsonise($j), J($j)
122              
123             Try to DWYM.
124             If called without argument, return the last value returned. Use this to retrieve
125             after L.
126              
127             =item parsej
128              
129             Parse a piped-in stream of json. Use jsonize() (without arg) to retrieve the object.
130             (Uses L.)
131              
132             =item pretty_json()
133              
134             Output pretty (indented) json.
135              
136             =item ugly_json()
137              
138             Output json with no extra whitespace.
139              
140             =back
141              
142             =head1 SEE ALSO
143              
144             L, L.
145              
146             =head1 AUTHOR
147              
148             Mark A. Jensen
149             CPAN: MAJENSEN
150             mark -dot- jensen -at- nih -dot- gov
151              
152             =head1 LICENSE
153              
154             Copyright (c) 2018, 2019 Mark A. Jensen.
155              
156             Licensed under the Apache License, Version 2.0 (the "License");
157             you may not use this file except in compliance with the License.
158             You may obtain a copy of the License at
159              
160             L
161              
162             Unless required by applicable law or agreed to in writing, software
163             distributed under the License is distributed on an "AS IS" BASIS,
164             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
165             See the License for the specific language governing permissions and
166             limitations under the License.
167              
168              
169             =cut
170              
171             1;