File Coverage

lib/File/DataClass/Storage/JSON.pm
Criterion Covered Total %
statement 41 41 100.0
branch 7 8 87.5
condition n/a
subroutine 15 15 100.0
pod 2 2 100.0
total 65 66 98.4


line stmt bran cond sub pod time code
1             package File::DataClass::Storage::JSON;
2              
3 4     4   4891 use boolean;
  4         2309  
  4         21  
4 4     4   269 use namespace::autoclean;
  4         6  
  4         32  
5              
6 4     4   249 use File::DataClass::Functions qw( extension_map throw );
  4         6  
  4         170  
7 4     4   17 use File::DataClass::Types qw( Object );
  4         11  
  4         40  
8 4     4   3974 use JSON::MaybeXS qw( JSON );
  4         16417  
  4         209  
9 4     4   28 use Try::Tiny;
  4         7  
  4         199  
10 4     4   19 use Moo;
  4         5  
  4         33  
11              
12             extends q(File::DataClass::Storage);
13              
14             extension_map 'JSON' => '.json';
15              
16             # Private functions
17             my $_build_transcoder = sub {
18             my $options = shift; my $json = JSON->new;
19              
20             for (grep { $_ ne 'reboolify' } keys %{ $options }) {
21             $json = $json->$_( $options->{ $_ } );
22             }
23              
24             return $json;
25             };
26              
27             my $_reboolify; $_reboolify = sub {
28             my $in = shift; my $ref = ref $in;
29              
30             if (not $ref) { return $in }
31             elsif ($ref eq 'HASH') {
32             return { map { $_ => $_reboolify->( $in->{ $_ } ) } keys %{ $in } };
33             }
34             elsif ($ref eq 'ARRAY') { return [ map { $_reboolify->( $_ ) } @{ $in } ] }
35             elsif ($ref =~ m{ ::Boolean \z }mx) { return ${ $in } ? true : false }
36              
37             return $in;
38             };
39              
40             # Public attributes
41             has '+extn' => default => '.json';
42              
43 15     15   1163 has '+read_options' => builder => sub { { utf8 => false, } };
44              
45             has '+write_options' => builder => sub { {
46 16     16   959 canonical => true, convert_blessed => true,
47             pretty => true, utf8 => false, } };
48              
49             # Private attributes
50             has '_decoder' => is => 'lazy', isa => Object,
51 11     11   1641 builder => sub { $_build_transcoder->( $_[ 0 ]->read_options ) };
52              
53             has '_encoder' => is => 'lazy', isa => Object,
54 10     10   1586 builder => sub { $_build_transcoder->( $_[ 0 ]->write_options ) };
55              
56             # Public methods
57             sub read_from_file {
58 36     36 1 53 my ($self, $rdr) = @_; my $json = $self->_decoder; my $data;
  36         587  
  36         358  
59              
60 36 100       138 $self->encoding and $rdr->encoding( $self->encoding );
61 36 50       119 $rdr->is_empty and return {};
62              
63             try {
64 34     34   982 $data = $json->decode( $rdr->all );
65 33 100       184 $self->read_options->{reboolify} and $data = $_reboolify->( $data );
66             }
67 34     1   277 catch { s{ at \s [^ ]+ \s line \s\d+\. }{}mx; throw "${_} in file ${rdr}" };
  1         14  
  1         4  
68              
69 33         567 return $data;
70             }
71              
72             sub write_to_file {
73 28     28 1 44 my ($self, $wtr, $data) = @_; my $json = $self->_encoder;
  28         415  
74              
75 28 100       404 $self->encoding and $wtr->encoding( $self->encoding );
76 28         851 $wtr->print( $json->encode( $data ) );
77 27         102 return $data;
78             }
79              
80             1;
81              
82             __END__