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   4879 use boolean;
  4         2439  
  4         20  
4 4     4   317 use namespace::autoclean;
  4         9  
  4         29  
5              
6 4     4   308 use File::DataClass::Functions qw( extension_map throw );
  4         8  
  4         190  
7 4     4   21 use File::DataClass::Types qw( Object );
  4         10  
  4         39  
8 4     4   4823 use JSON::MaybeXS qw( JSON );
  4         19604  
  4         198  
9 4     4   29 use Try::Tiny;
  4         10  
  4         164  
10 4     4   22 use Moo;
  4         7  
  4         30  
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   1628 has '+read_options' => builder => sub { { utf8 => false, } };
44              
45             has '+write_options' => builder => sub { {
46 16     16   1067 canonical => true, convert_blessed => true,
47             pretty => true, utf8 => false, } };
48              
49             # Private attributes
50             has '_decoder' => is => 'lazy', isa => Object,
51 11     11   142 builder => sub { $_build_transcoder->( $_[ 0 ]->read_options ) };
52              
53             has '_encoder' => is => 'lazy', isa => Object,
54 10     10   160 builder => sub { $_build_transcoder->( $_[ 0 ]->write_options ) };
55              
56             # Public methods
57             sub read_from_file {
58 36     36 1 91 my ($self, $rdr) = @_; my $json = $self->_decoder; my $data;
  36         536  
  36         473  
59              
60 36 100       160 $self->encoding and $rdr->encoding( $self->encoding );
61 36 50       131 $rdr->is_empty and return {};
62              
63             try {
64 34     34   1564 $data = $json->decode( $rdr->all );
65 33 100       249 $self->read_options->{reboolify} and $data = $_reboolify->( $data );
66             }
67 34     1   291 catch { s{ at \s [^ ]+ \s line \s\d+\. }{}mx; throw "${_} in file ${rdr}" };
  1         24  
  1         8  
68              
69 33         607 return $data;
70             }
71              
72             sub write_to_file {
73 28     28 1 75 my ($self, $wtr, $data) = @_; my $json = $self->_encoder;
  28         513  
74              
75 28 100       448 $self->encoding and $wtr->encoding( $self->encoding );
76 28         824 $wtr->print( $json->encode( $data ) );
77 27         109 return $data;
78             }
79              
80             1;
81              
82             __END__