File Coverage

blib/lib/JSON/Parse.pm
Criterion Covered Total %
statement 51 56 91.0
branch 13 16 81.2
condition n/a
subroutine 12 13 92.3
pod 9 10 90.0
total 85 95 89.4


line stmt bran cond sub pod time code
1             package JSON::Parse;
2 22     22   1676042 use warnings;
  22         251  
  22         813  
3 22     22   137 use strict;
  22         37  
  22         2102  
4             require Exporter;
5             our @ISA = qw(Exporter);
6             our @EXPORT_OK = qw/
7             assert_valid_json
8             json_file_to_perl
9             json_to_perl
10             parse_json
11             parse_json_safe
12             read_json
13             valid_json
14             validate_json
15             /;
16              
17             our %EXPORT_TAGS = (
18             all => \@EXPORT_OK,
19             );
20 22     22   161 use Carp;
  22         42  
  22         17142  
21             our $VERSION = '0.60_01';
22             require XSLoader;
23             XSLoader::load (__PACKAGE__, $VERSION);
24              
25             # Experimental, return a string of JSON as the error.
26              
27             our $json_diagnostics;
28              
29             # JSON "null" value. Although we're now using PL_sv_yes and PL_sv_no,
30             # we don't use PL_sv_undef, because perldoc perlguts says it's a bad
31             # idea.
32              
33             our $null;
34              
35             sub parse_json_safe
36             {
37 4     4 1 2600 my $p;
38 4         8 eval {
39 4         45 $p = parse_json_safer (@_);
40             };
41 4 100       17 if ($@) {
42 1         3 my $error = $@;
43 1 50       5 if (ref $error eq 'HASH') {
44 1         3 my $error_as_string = $error->{"error as string"};
45 1         299 carp "JSON::Parse::parse_json_safe: $error_as_string";
46             }
47             else {
48 0         0 $error =~ s/at\s\S+\.pm\s+line\s+[0-9]+\.\s*$//;
49 0         0 carp "JSON::Parse::parse_json_safe: $error";
50             }
51 1         10 return undef;
52             }
53 3         9 return $p;
54             }
55              
56             # Old names of subroutines.
57              
58             sub json_to_perl
59             {
60 2     2 1 28 goto &parse_json;
61             }
62              
63             sub validate_json
64             {
65 57     57 1 804 goto &assert_valid_json;
66             }
67              
68             sub read_file
69             {
70 5     5 0 14 my ($file_name) = @_;
71 5 100       136 if (! -f $file_name) {
72             # Trap possible errors from "open" before getting there.
73 1         289 croak "File does not exist: '$file_name'";
74             }
75 4         13 my $json = '';
76 4 50       173 open my $in, "<:encoding(utf8)", $file_name
77             or croak "Error opening $file_name: $!";
78 4         412 while (<$in>) {
79 216         576 $json .= $_;
80             }
81 4 50       67 close $in or croak $!;
82 4         27 return $json;
83             }
84              
85             sub JSON::Parse::read
86             {
87 0     0 1 0 my ($jp, $file_name) = @_;
88 0         0 my $json = read_file ($file_name);
89 0         0 return $jp->parse ($json);
90             }
91              
92             sub read_json
93             {
94 5     5 1 837 my ($file_name) = @_;
95 5         22 my $json = read_file ($file_name);
96 4         359 return parse_json ($json);
97             }
98              
99             sub valid_json
100             {
101 164     164 1 73273 my ($json) = @_;
102 164 100       445 if (! $json) {
103 2         10 return 0;
104             }
105 162         239 my $ok = eval {
106 162         2415 assert_valid_json (@_);
107 38         90 1;
108             };
109 162         784 return $ok;
110             }
111              
112             sub json_file_to_perl
113             {
114 1     1 1 105 goto &read_json;
115             }
116              
117             sub run
118             {
119 21     21 1 23073 my ($parser, $json) = @_;
120 21 100       102 if ($parser->get_warn_only ()) {
121 2         3 my $out;
122 2         5 eval {
123 2         41 $out = $parser->run_internal ($json);
124             };
125 2 100       10 if ($@) {
126 1         11 warn "$@";
127             }
128 2         13 return $out;
129             }
130             else {
131 19         203 return $parser->run_internal ($json);
132             }
133             }
134              
135             sub parse
136             {
137 1     1 1 133 goto &run;
138             }
139              
140             1;