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   1729 use namespace::autoclean;
  3         6  
  3         26  
4              
5 3     3   247 use File::Basename qw( basename );
  3         8  
  3         204  
6 3     3   19 use File::DataClass::Constants qw( FALSE TRUE );
  3         9  
  3         149  
7 3         170 use File::DataClass::Functions qw( ensure_class_loaded first_char
8             qualify_storage_class map_extension2class
9 3     3   18 is_stale merge_file_data throw );
  3         7  
10 3     3   15 use File::DataClass::Storage;
  3         6  
  3         71  
11 3     3   14 use File::DataClass::Types qw( Object HashRef );
  3         6  
  3         24  
12 3     3   2586 use Moo;
  3         7  
  3         20  
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 4 return shift->$_get_store_from_path( $_[ 0 ] )->create_or_update( @_ );
54             }
55              
56             sub delete {
57 2     2 1 304 return shift->$_get_store_from_path( $_[ 0 ] )->delete( @_ );
58             }
59              
60             sub dump {
61 5     5 1 130 return shift->$_get_store_from_path( $_[ 0 ] )->dump( @_ );
62             }
63              
64       1 1   sub extn {
65             }
66              
67             sub insert {
68 1     1 1 188 return shift->$_get_store_from_path( $_[ 0 ] )->insert( @_ );
69             }
70              
71             sub load {
72 8 100   8 1 34 my ($self, @paths) = @_; $paths[ 0 ] or return {};
  8         38  
73              
74 7 100       93 scalar @paths == 1 and return ($self->read_file( $paths[ 0 ], FALSE ))[ 0 ];
75              
76 1         19 my ($loaded, $meta, $newest) = $self->cache->get_by_paths( \@paths );
77 1         5 my $cache_mtime = $self->meta_unpack( $meta );
78              
79 1 50       5 not is_stale $loaded, $cache_mtime, $newest and return $loaded;
80              
81 1         2 $loaded = {}; $newest = 0;
  1         2  
82              
83 1         3 for my $path (@paths) { # Different storage classes by filename extension
84 2         8 my ($red, $path_mtime) = $self->read_file( $path, FALSE );
85              
86 2 100       9 $path_mtime > $newest and $newest = $path_mtime;
87 2         9 merge_file_data $loaded, $red;
88             }
89              
90 1         18 $self->cache->set_by_paths( \@paths, $loaded, $self->meta_pack( $newest ) );
91 1         24 return $loaded;
92             }
93              
94             sub meta_pack {
95 3   100 3 1 61 my ($self, $mtime) = @_; my $attr = $self->{_meta_cache} || {};
  3         15  
96              
97 3 100       13 defined $mtime and $attr->{mtime} = $mtime; return $attr;
  3         18  
98             }
99              
100             sub meta_unpack {
101 2     2 1 13 my ($self, $attr) = @_; $self->{_meta_cache} = $attr;
  2         5  
102              
103 2 50       11 return $attr ? $attr->{mtime} : undef;
104             };
105              
106             sub read_file {
107 8     8 1 33 return shift->$_get_store_from_path( $_[ 0 ] )->read_file( @_ );
108             }
109              
110             sub select {
111 8     8 1 1121 return shift->$_get_store_from_path( $_[ 0 ] )->select( @_ );
112             }
113              
114             sub txn_do {
115 8     8 1 1276 return shift->$_get_store_from_path( $_[ 0 ] )->txn_do( @_ );
116             }
117              
118             sub update {
119 2     2 1 305 return shift->$_get_store_from_path( $_[ 0 ] )->update( @_ );
120             }
121              
122             sub validate_params {
123 2     2 1 6 return shift->$_get_store_from_path( $_[ 0 ] )->validate_params( @_ );
124             }
125              
126             1;
127              
128             __END__