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

package File::DataClass::Storage::JSON;

use boolean;
use namespace::autoclean;

use File::DataClass::Functions qw( extension_map throw );
use File::DataClass::Types     qw( Object );
use JSON::MaybeXS              qw( JSON );
use Try::Tiny;
use Moo;

extends q(File::DataClass::Storage);

extension_map 'JSON' => '.json';

# Private functions
my $_build_transcoder = sub {
   my $options = shift; my $json = JSON->new;

   for (grep { $_ ne 'reboolify' } keys %{ $options }) {
      $json = $json->$_( $options->{ $_ } );
   }

   return $json;
};

my $_reboolify; $_reboolify = sub {
   my $in = shift; my $ref = ref $in;

   if (not $ref) { return $in }
   elsif  ($ref eq 'HASH') {
      return { map { $_ => $_reboolify->( $in->{ $_ } ) } keys %{ $in } };
   }
   elsif  ($ref eq 'ARRAY') { return [ map { $_reboolify->( $_ ) } @{ $in } ] }
   elsif  ($ref =~ m{ ::Boolean \z }mx) { return ${ $in } ? true : false }

   return $in;
};

# Public attributes
has '+extn'          => default => '.json';

has '+read_options'  => builder => sub { { utf8 => false, } };

has '+write_options' => builder => sub { {
   canonical         => true, convert_blessed => true,
   pretty            => true, utf8            => false, } };

# Private attributes
has '_decoder'       => is => 'lazy', isa => Object,
   builder           => sub { $_build_transcoder->( $_[ 0 ]->read_options  ) };

has '_encoder'       => is => 'lazy', isa => Object,
   builder           => sub { $_build_transcoder->( $_[ 0 ]->write_options ) };

# Public methods
sub read_from_file {
   my ($self, $rdr) = @_; my $json = $self->_decoder; my $data;

   $self->encoding and $rdr->encoding( $self->encoding );
   $rdr->is_empty  and return {};

   try   {
      $data = $json->decode( $rdr->all );
      $self->read_options->{reboolify} and $data = $_reboolify->( $data );
   }
   catch { s{ at \s [^ ]+ \s line \s\d+\. }{}mx; throw "${_} in file ${rdr}" };

   return $data;
}

sub write_to_file {
   my ($self, $wtr, $data) = @_; my $json = $self->_encoder;

   $self->encoding and $wtr->encoding( $self->encoding );
   $wtr->print( $json->encode( $data ) );
   return $data;
}

1;

__END__