use
version;
our
$VERSION
= qv(
sprintf
'0.13.%d'
,
q$Rev: 416 $
=~ /\d+/gmx );
throw)
;
has
'schema'
=>
is
=>
'ro'
,
isa
=>
'Object'
,
required
=> TRUE,
weak_ref
=> TRUE,
handles
=> [
qw(cache storage_attributes storage_base)
, ];
has
'stores'
=>
is
=>
'ro'
,
isa
=>
'HashRef'
,
lazy
=> TRUE,
builder
=>
'_build_stores'
;
sub
create_or_update {
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->create_or_update(
@_
);
}
sub
delete
{
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->
delete
(
@_
);
}
sub
dump
{
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->
dump
(
@_
);
}
sub
extn {
return
sub
{
my
$path
=
shift
|| NUL;
my
(
$extn
) =
$path
=~ m{ \. ([^\.]+) \z }mx;
return
$extn
?
q(.)
.
$extn
: NUL;
};
}
sub
insert {
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->insert(
@_
);
}
sub
load {
my
(
$self
,
@paths
) =
@_
;
$paths
[ 0 ] or
return
{};
my
(
$data
,
$meta
,
$newest
) =
$self
->cache->get_by_paths( \
@paths
);
my
$cache_mtime
=
$self
->meta_unpack(
$meta
);
not is_stale
$data
,
$cache_mtime
,
$newest
and
return
$data
;
$data
= {};
$newest
= 0;
for
my
$path
(
@paths
) {
my
$store
=
$self
->_get_store_from_extension(
$path
);
my
(
$red
,
$path_mtime
) =
$store
->read_file(
$path
, FALSE );
$red
or
next
;
$path_mtime
>
$newest
and
$newest
=
$path_mtime
;
merge_hash_data
$data
,
$red
;
}
$self
->cache->set_by_paths( \
@paths
,
$data
,
$self
->meta_pack(
$newest
) );
return
$data
;
}
sub
meta_pack {
my
(
$self
,
$mtime
) =
@_
;
my
$attr
=
$self
->{_meta_cache} || {};
$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_extension(
$_
[ 0 ] )->read_file(
@_
);
}
sub
select
{
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->
select
(
@_
);
}
sub
txn_do {
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->txn_do(
@_
);
}
sub
update {
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->update(
@_
);
}
sub
validate_params {
return
shift
->_get_store_from_extension(
$_
[ 0 ] )->validate_params(
@_
);
}
sub
_build_stores {
my
$self
=
shift
;
my
$stores
= {};
for
my
$extn
(
keys
%{ EXTENSIONS() }) {
my
$class
= EXTENSIONS()->{
$extn
}->[ 0 ];
if
(
q(+)
eq
substr
$class
, 0, 1) {
$class
=
substr
$class
, 1 }
else
{
$class
=
$self
->storage_base.
q(::)
.
$class
}
ensure_class_loaded
$class
;
$stores
->{
$extn
} =
$class
->new( { %{
$self
->storage_attributes },
schema
=>
$self
->schema } );
}
return
$stores
;
}
sub
_get_store_from_extension {
my
(
$self
,
$path
) =
@_
;
my
$file
= basename( NUL.
$path
);
my
$extn
= (
split
m{ \. }mx,
$file
)[ -1 ]
or throw
error
=>
'File [_1] has no extension'
,
args
=> [
$file
];
my
$store
=
$self
->stores->{
q(.)
.
$extn
}
or throw
error
=>
'Extension [_1] has no store'
,
args
=> [
$extn
];
return
$store
;
}
__PACKAGE__->meta->make_immutable;
no
Moose;
1;