BEGIN {
$CHI::CacheObject::VERSION
=
'0.43'
;
}
my
$Metadata_Format
=
"LLLCC"
;
my
$Metadata_Length
= 14;
sub
key {
$_
[0]->[f_key] }
sub
created_at {
$_
[0]->[f_created_at] }
sub
early_expires_at {
$_
[0]->[f_early_expires_at] }
sub
expires_at {
$_
[0]->[f_expires_at] }
sub
serializer {
$_
[0]->[f_serializer] }
sub
_is_transformed {
$_
[0]->[f_is_transformed] }
sub
size {
$_
[0]->[f_size] }
sub
set_early_expires_at {
$_
[0]->[f_early_expires_at] =
$_
[1];
undef
$_
[0]->[f_packed_data];
}
sub
set_expires_at {
$_
[0]->[f_expires_at] =
$_
[1];
undef
$_
[0]->[f_packed_data];
}
sub
new {
my
(
$class
,
$key
,
$value
,
$created_at
,
$early_expires_at
,
$expires_at
,
$serializer
,
$compress_threshold
)
=
@_
;
my
$is_transformed
= 0;
my
$raw_value
=
$value
;
my
$size
;
if
(
$serializer
) {
if
(
ref
(
$raw_value
) ) {
$raw_value
=
$serializer
->serialize(
$raw_value
);
$is_transformed
|= T_SERIALIZED;
}
elsif
( Encode::is_utf8(
$raw_value
) ) {
$raw_value
= Encode::encode(
utf8
=>
$raw_value
);
$is_transformed
|= T_UTF8_ENCODED;
}
if
(
defined
(
$compress_threshold
)
&&
length
(
$raw_value
) >
$compress_threshold
)
{
$raw_value
= Compress::Zlib::memGzip(
$raw_value
);
$is_transformed
|= T_COMPRESSED;
}
$size
=
length
(
$raw_value
) +
$Metadata_Length
;
}
else
{
$size
= 1;
}
my
$cache_version
= 1;
return
bless
[
$key
,
$raw_value
,
$serializer
,
$created_at
,
$early_expires_at
,
$expires_at
,
$is_transformed
,
$cache_version
,
$value
,
undef
,
$size
],
$class
;
}
sub
unpack_from_data {
my
(
$class
,
$key
,
$data
,
$serializer
) =
@_
;
return
$data
if
!
$serializer
;
my
$metadata
=
substr
(
$data
, 0,
$Metadata_Length
);
my
$raw_value
=
substr
(
$data
,
$Metadata_Length
);
my
$obj
=
bless
[
$key
,
$raw_value
,
$serializer
,
unpack
(
$Metadata_Format
,
$metadata
)
],
$class
;
$obj
->[f_packed_data] =
$data
;
$obj
->[f_size] =
length
(
$data
);
return
$obj
;
}
sub
pack_to_data {
my
(
$self
) =
@_
;
return
$self
if
!
$self
->serializer;
if
( !
defined
(
$self
->[f_packed_data] ) ) {
my
$data
=
pack
(
$Metadata_Format
,
( @{
$self
} )[ f_created_at .. f_cache_version ] )
.
$self
->[f_raw_value];
$self
->[f_packed_data] =
$data
;
}
return
$self
->[f_packed_data];
}
sub
is_expired {
my
(
$self
) =
@_
;
my
$expires_at
=
$self
->[f_expires_at];
return
undef
if
$expires_at
== CHI_Max_Time;
my
$time
=
$CHI::Driver::Test_Time
||
time
();
my
$early_expires_at
=
$self
->[f_early_expires_at];
return
$time
>=
$early_expires_at
&& (
$time
>=
$expires_at
|| (
rand
() < (
(
$time
-
$early_expires_at
) /
(
$expires_at
-
$early_expires_at
)
)
)
);
}
sub
value {
my
(
$self
) =
@_
;
if
( !
defined
$self
->[f_value] ) {
my
$value
=
$self
->[f_raw_value];
my
$is_transformed
=
$self
->[f_is_transformed];
if
(
$is_transformed
& T_COMPRESSED ) {
$value
= Compress::Zlib::memGunzip(
$value
);
}
if
(
$is_transformed
& T_SERIALIZED ) {
$value
=
$self
->serializer->deserialize(
$value
);
}
elsif
(
$is_transformed
& T_UTF8_ENCODED ) {
$value
= Encode::decode(
utf8
=>
$value
);
}
$self
->[f_value] =
$value
;
}
return
$self
->[f_value];
}
*get_created_at
= \
&created_at
;
*get_expires_at
= \
&expires_at
;
1;