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


line stmt bran cond sub pod time code
1             package File::DataClass::Storage::Any;
2              
3 3     3   2043 use namespace::autoclean;
  3         4  
  3         23  
4              
5 3     3   211 use File::Basename qw( basename );
  3         4  
  3         190  
6 3     3   12 use File::DataClass::Constants qw( FALSE TRUE );
  3         3  
  3         148  
7 3         197 use File::DataClass::Functions qw( ensure_class_loaded first_char
8             qualify_storage_class map_extension2class
9 3     3   14 is_stale merge_file_data throw );
  3         4  
10 3     3   11 use File::DataClass::Storage;
  3         2  
  3         68  
11 3     3   9 use File::DataClass::Types qw( Object HashRef );
  3         4  
  3         29  
12 3     3   1663 use Moo;
  3         5  
  3         17  
13              
14             has 'schema' => is => 'ro', isa => Object,
15             handles => [ 'cache', 'storage_attributes', ],
16             required => TRUE, weak_ref => TRUE;
17              
18              
19             has '_stores' => is => 'ro', isa => HashRef, default => sub { {} };
20              
21             # Private methods
22             my $_get_store_from_extension = sub {
23             my ($self, $extn) = @_; my $stores = $self->_stores;
24              
25             exists $stores->{ $extn } and return $stores->{ $extn };
26              
27             my $list; ($list = map_extension2class( $extn ) and my $class = $list->[ 0 ])
28             or throw 'Extension [_1] has no class', [ $extn ];
29              
30             if (first_char $class eq '+') { $class = substr $class, 1 }
31             else { $class = qualify_storage_class $class }
32              
33             ensure_class_loaded $class;
34              
35             return $stores->{ $extn } = $class->new
36             ( { %{ $self->storage_attributes }, schema => $self->schema } );
37             };
38              
39             my $_get_store_from_path = sub {
40             my ($self, $path) = @_; my $file = basename( "${path}" );
41              
42             my $extn = (split m{ \. }mx, $file)[ -1 ]
43             or throw 'File [_1] has no extension', [ $file ];
44              
45             my $store = $self->$_get_store_from_extension( ".${extn}" )
46             or throw 'Extension [_1] has no store', [ $extn ];
47              
48             return $store;
49             };
50              
51             # Public methods
52             sub create_or_update {
53 1     1 1 11 return shift->$_get_store_from_path( $_[ 0 ] )->create_or_update( @_ );
54             }
55              
56             sub delete {
57 2     2 1 248 return shift->$_get_store_from_path( $_[ 0 ] )->delete( @_ );
58             }
59              
60             sub dump {
61 5     5 1 94 return shift->$_get_store_from_path( $_[ 0 ] )->dump( @_ );
62             }
63              
64       1 1   sub extn {
65             }
66              
67             sub insert {
68 1     1 1 968 return shift->$_get_store_from_path( $_[ 0 ] )->insert( @_ );
69             }
70              
71             sub load {
72 8 100   8 1 29 my ($self, @paths) = @_; $paths[ 0 ] or return {};
  8         33  
73              
74 7 100       65 scalar @paths == 1 and return ($self->read_file( $paths[ 0 ], FALSE ))[ 0 ];
75              
76 1         6 my ($loaded, $meta, $newest) = $self->cache->get_by_paths( \@paths );
77 1         5 my $cache_mtime = $self->meta_unpack( $meta );
78              
79 1 50       4 not is_stale $loaded, $cache_mtime, $newest and return $loaded;
80              
81 1         1 $loaded = {}; $newest = 0;
  1         3  
82              
83 1         2 for my $path (@paths) { # Different storage classes by filename extension
84 2         5 my ($red, $path_mtime) = $self->read_file( $path, FALSE );
85              
86 2 100       6 $path_mtime > $newest and $newest = $path_mtime;
87 2         6 merge_file_data $loaded, $red;
88             }
89              
90 1         15 $self->cache->set_by_paths( \@paths, $loaded, $self->meta_pack( $newest ) );
91 1         4 return $loaded;
92             }
93              
94             sub meta_pack {
95 3   100 3 1 45 my ($self, $mtime) = @_; my $attr = $self->{_meta_cache} || {};
  3         11  
96              
97 3 100       9 defined $mtime and $attr->{mtime} = $mtime; return $attr;
  3         11  
98             }
99              
100             sub meta_unpack {
101 2     2 1 7 my ($self, $attr) = @_; $self->{_meta_cache} = $attr;
  2         4  
102              
103 2 50       6 return $attr ? $attr->{mtime} : undef;
104             };
105              
106             sub read_file {
107 8     8 1 20 return shift->$_get_store_from_path( $_[ 0 ] )->read_file( @_ );
108             }
109              
110             sub select {
111 8     8 1 953 return shift->$_get_store_from_path( $_[ 0 ] )->select( @_ );
112             }
113              
114             sub txn_do {
115 8     8 1 2646 return shift->$_get_store_from_path( $_[ 0 ] )->txn_do( @_ );
116             }
117              
118             sub update {
119 2     2 1 251 return shift->$_get_store_from_path( $_[ 0 ] )->update( @_ );
120             }
121              
122             sub validate_params {
123 2     2 1 12 return shift->$_get_store_from_path( $_[ 0 ] )->validate_params( @_ );
124             }
125              
126             1;
127              
128             __END__