File Coverage

blib/lib/JSON/Slurper.pm
Criterion Covered Total %
statement 40 92 43.4
branch 9 48 18.7
condition 8 33 24.2
subroutine 10 16 62.5
pod 3 3 100.0
total 70 192 36.4


line stmt bran cond sub pod time code
1             package JSON::Slurper;
2 1     1   63015 use strict;
  1         8  
  1         22  
3 1     1   4 use warnings;
  1         2  
  1         18  
4 1     1   4 use Carp ();
  1         1  
  1         15  
5 1     1   357 use Exporter::Shiny qw(slurp_json spurt_json);
  1         3329  
  1         6  
6 1     1   62 use File::Basename ();
  1         1  
  1         11  
7 1     1   378 use File::Slurper ();
  1         11167  
  1         18  
8 1     1   6 use Scalar::Util ();
  1         2  
  1         966  
9              
10             our $VERSION = '0.12';
11             our %EXPORT_TAGS = (
12             std => [qw(slurp_json spurt_json)],
13             std_auto => [qw(-auto_ext slurp_json spurt_json)],
14             slurp_auto => [qw(-auto_ext slurp_json)],
15             spurt_auto => [qw(-auto_ext spurt_json)],
16             );
17              
18             my $DEFAULT_ENCODER;
19             sub _build_default_encoder {
20 0         0 my $e_class = $ENV{JSON_SLURPER_NO_JSON_XS} ? do { require JSON::PP; 'JSON::PP' }
  0         0  
21 1         5 : eval { require Cpanel::JSON::XS; Cpanel::JSON::XS->VERSION('4.09'); 1 } ? 'Cpanel::JSON::XS'
  1         15  
  1         4  
22 1 50   1   4 : do { require JSON::PP; 'JSON::PP' };
  0 50       0  
  0         0  
23 1         12 my $encoder = $e_class->new
24             ->utf8
25             ->pretty
26             ->canonical
27             ->allow_nonref
28             ->allow_blessed
29             ->convert_blessed
30             ->escape_slash;
31 1 50       5 $encoder->stringify_infnan if $e_class eq 'Cpanel::JSON::XS';
32 1         5 return $encoder;
33             }
34              
35             sub new {
36 12     12 1 6406 my ($class, %args) = @_;
37              
38 12         16 my $encoder;
39 12 100       24 if (exists $args{encoder}) {
40 10         21 $encoder = _validate_encoder(delete $args{encoder});
41             } else {
42 2   66     8 $encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder);
43             }
44              
45 5         10 my $auto_ext = delete $args{auto_ext};
46              
47 5 100       18 Carp::croak "invalid constructor arguments provided: @{[join ',', keys %args]}" if %args;
  1         15  
48              
49 4         17 bless [$encoder, $auto_ext], $class;
50             }
51              
52             sub _generate_slurp_json {
53 0     0   0 my ($class) = @_;
54 0         0 my $auto_ext = exists $_[3]->{auto_ext};
55 0 0       0 my $imported_encoder = exists $_[3]->{encoder} ? _validate_encoder($_[3]->{encoder}) : undef;
56              
57             return sub ($;@) {
58 0     0   0 my ($filename, $encoder) = @_;
59              
60 0 0       0 if (defined $encoder) {
    0          
61 0         0 _validate_encoder($encoder);
62             } elsif ($imported_encoder) {
63 0         0 $encoder = $imported_encoder;
64             } else {
65 0   0     0 $encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder);
66             }
67              
68 0         0 my $wantarray = wantarray;
69 0 0       0 unless (defined wantarray) {
70 0         0 Carp::carp 'slurp_json requested without a used return value. Returning from slurp_json';
71 0         0 return;
72             }
73              
74 0 0 0     0 if ($auto_ext and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
75 0         0 $filename = "$filename.json";
76             }
77              
78 0         0 my $slurped = $encoder->decode(File::Slurper::read_binary($filename));
79              
80 0 0 0     0 if ($wantarray and my $ref = ref $slurped) {
81 0 0       0 return @$slurped if $ref eq 'ARRAY';
82 0 0       0 return %$slurped if $ref eq 'HASH';
83             }
84              
85 0         0 return $slurped;
86             }
87 0         0 }
88              
89             sub slurp {
90 0     0 1 0 my ($self, $filename) = @_;
91              
92 0         0 my $wantarray = wantarray;
93 0 0       0 unless (defined wantarray) {
94 0         0 Carp::carp 'slurp requested without a used return value. Returning from slurp';
95 0         0 return;
96             }
97              
98 0 0 0     0 if ($self->[1] and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
99 0         0 $filename = "$filename.json";
100             }
101              
102 0         0 my $slurped = $self->[0]->decode(File::Slurper::read_binary($filename));
103 0 0 0     0 if ($wantarray and my $ref = ref $slurped) {
104 0 0       0 return @$slurped if $ref eq 'ARRAY';
105 0 0       0 return %$slurped if $ref eq 'HASH';
106             }
107              
108 0         0 return $slurped;
109             }
110              
111             sub _generate_spurt_json {
112 0     0   0 my ($class) = @_;
113 0         0 my $auto_ext = exists $_[3]->{auto_ext};
114 0 0       0 my $imported_encoder = exists $_[3]->{encoder} ? _validate_encoder($_[3]->{encoder}) : undef;
115              
116             return sub ($$;@) {
117 0     0   0 my ($data, $filename, $encoder) = @_;
118              
119 0 0       0 if (defined $encoder) {
    0          
120 0         0 _validate_encoder($encoder);
121             } elsif ($imported_encoder) {
122 0         0 $encoder = $imported_encoder;
123             } else {
124 0   0     0 $encoder = ($DEFAULT_ENCODER ||= $class->_build_default_encoder);
125             }
126              
127 0 0 0     0 if ($auto_ext and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
128 0         0 $filename = "$filename.json";
129             }
130              
131 0         0 File::Slurper::write_binary($filename, $encoder->encode($data));
132             }
133 0         0 }
134              
135             sub spurt {
136 0     0 1 0 my ($self, $data, $filename) = @_;
137              
138 0 0 0     0 if ($self->[1] and not ((File::Basename::fileparse($filename, qr/\.[^.]*/xm))[2])) {
139 0         0 $filename = "$filename.json";
140             }
141              
142 0         0 File::Slurper::write_binary($filename, $self->[0]->encode($data));
143             }
144              
145             sub _validate_encoder {
146 10     10   16 my ($encoder) = @_;
147              
148 10 100 100     123 Carp::confess 'encoder must be an object that can encode and decode'
      100        
149             unless Scalar::Util::blessed($encoder) && $encoder->can('encode') && $encoder->can('decode');
150              
151 3         7 return $encoder;
152             }
153              
154             1;
155             __END__