File Coverage

lib/File/DataClass/Storage/Any.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	10	12	83.3
condition	2	2	100.0
subroutine	20	20	100.0
pod	13	13	100.0
total	96	98	97.9

package File::DataClass::Storage::Any;

use namespace::autoclean;

use File::Basename             qw( basename );
use File::DataClass::Constants qw( FALSE TRUE );
use File::DataClass::Functions qw( ensure_class_loaded first_char
                                   qualify_storage_class map_extension2class
                                   is_stale merge_file_data throw );
use File::DataClass::Storage;
use File::DataClass::Types     qw( Object HashRef );
use Moo;

has 'schema'  => is => 'ro', isa => Object,
   handles    => [ 'cache', 'storage_attributes', ],
   required   => TRUE, weak_ref => TRUE;


has '_stores' => is => 'ro', isa => HashRef, default => sub { {} };

# Private methods
my $_get_store_from_extension = sub {
   my ($self, $extn) = @_; my $stores = $self->_stores;

   exists $stores->{ $extn } and return $stores->{ $extn };

   my $list; ($list = map_extension2class( $extn ) and my $class = $list->[ 0 ])
      or throw 'Extension [_1] has no class', [ $extn ];

   if (first_char $class eq '+') { $class = substr $class, 1 }
   else { $class = qualify_storage_class $class }

   ensure_class_loaded $class;

   return $stores->{ $extn } = $class->new
      ( { %{ $self->storage_attributes }, schema => $self->schema } );
};

my $_get_store_from_path = sub {
   my ($self, $path) = @_; my $file = basename( "${path}" );

   my $extn = (split m{ \. }mx, $file)[ -1 ]
      or throw 'File [_1] has no extension', [ $file ];

   my $store = $self->$_get_store_from_extension( ".${extn}" )
      or throw 'Extension [_1] has no store', [ $extn ];

   return $store;
};

# Public methods
sub create_or_update {
   return shift->$_get_store_from_path( $_[ 0 ] )->create_or_update( @_ );
}

sub delete {
   return shift->$_get_store_from_path( $_[ 0 ] )->delete( @_ );
}

sub dump {
   return shift->$_get_store_from_path( $_[ 0 ] )->dump( @_ );
}

sub extn {
}

sub insert {
   return shift->$_get_store_from_path( $_[ 0 ] )->insert( @_ );
}

sub load {
   my ($self, @paths) = @_; $paths[ 0 ] or return {};

   scalar @paths == 1 and return ($self->read_file( $paths[ 0 ], FALSE ))[ 0 ];

   my ($loaded, $meta, $newest) = $self->cache->get_by_paths( \@paths );
   my $cache_mtime = $self->meta_unpack( $meta );

   not is_stale $loaded, $cache_mtime, $newest and return $loaded;

   $loaded = {}; $newest = 0;

   for my $path (@paths) { # Different storage classes by filename extension
      my ($red, $path_mtime) = $self->read_file( $path, FALSE );

      $path_mtime > $newest and $newest = $path_mtime;
      merge_file_data $loaded, $red;
   }

   $self->cache->set_by_paths( \@paths, $loaded, $self->meta_pack( $newest ) );
   return $loaded;
}

sub meta_pack {
   my ($self, $mtime) = @_; my $attr = $self->{_meta_cache} || {};

   defined $mtime and $attr->{mtime} = $mtime; return $attr;
}

sub meta_unpack {
   my ($self, $attr) = @_; $self->{_meta_cache} = $attr;

   return $attr ? $attr->{mtime} : undef;
};

sub read_file {
   return shift->$_get_store_from_path( $_[ 0 ] )->read_file( @_ );
}

sub select {
   return shift->$_get_store_from_path( $_[ 0 ] )->select( @_ );
}

sub txn_do {
   return shift->$_get_store_from_path( $_[ 0 ] )->txn_do( @_ );
}

sub update {
   return shift->$_get_store_from_path( $_[ 0 ] )->update( @_ );
}

sub validate_params {
   return shift->$_get_store_from_path( $_[ 0 ] )->validate_params( @_ );
}

1;

__END__