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 24     24   1291941 use warnings;
  24         202  
  24         625  
3 24     24   101 use strict;
  24         36  
  24         1689  
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 24     24   176 use Carp;
  24         57  
  24         14459  
21             our $VERSION = '0.62';
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 1710 my $p;
38 4         5 eval {
39 4         29 $p = parse_json_safer (@_);
40             };
41 4 100       10 if ($@) {
42 1         2 my $error = $@;
43 1 50       4 if (ref $error eq 'HASH') {
44 1         1 my $error_as_string = $error->{"error as string"};
45 1         199 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         7 return undef;
52             }
53 3         6 return $p;
54             }
55              
56             # Old names of subroutines.
57              
58             sub json_to_perl
59             {
60 2     2 1 26 goto &parse_json;
61             }
62              
63             sub validate_json
64             {
65 57     57 1 644 goto &assert_valid_json;
66             }
67              
68             sub read_file
69             {
70 5     5 0 10 my ($file_name) = @_;
71 5 100       98 if (! -f $file_name) {
72             # Trap possible errors from "open" before getting there.
73 1         190 croak "File does not exist: '$file_name'";
74             }
75 4         11 my $json = '';
76 4 50       131 open my $in, "<:encoding(utf8)", $file_name
77             or croak "Error opening $file_name: $!";
78 4         338 while (<$in>) {
79 216         482 $json .= $_;
80             }
81 4 50       56 close $in or croak $!;
82 4         20 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 659 my ($file_name) = @_;
95 5         14 my $json = read_file ($file_name);
96 4         288 return parse_json ($json);
97             }
98              
99             sub valid_json
100             {
101 164     164 1 64212 my ($json) = @_;
102 164 100       366 if (! $json) {
103 2         11 return 0;
104             }
105 162         191 my $ok = eval {
106 162         1833 assert_valid_json (@_);
107 38         69 1;
108             };
109 162         644 return $ok;
110             }
111              
112             sub json_file_to_perl
113             {
114 1     1 1 71 goto &read_json;
115             }
116              
117             sub run
118             {
119 21     21 1 14065 my ($parser, $json) = @_;
120 21 100       78 if ($parser->get_warn_only ()) {
121 2         3 my $out;
122 2         3 eval {
123 2         31 $out = $parser->run_internal ($json);
124             };
125 2 100       7 if ($@) {
126 1         9 warn "$@";
127             }
128 2         11 return $out;
129             }
130             else {
131 19         181 return $parser->run_internal ($json);
132             }
133             }
134              
135             sub parse
136             {
137 1     1 1 116 goto &run;
138             }
139              
140             1;