CHI-Cascade
view release on metacpan or search on metacpan
- Imroved the documentation for CHI::Cascade::rule/code
- Added the documentation of CHI::Cascade::Value
0.17 2011-12-13
- Added a callback function in rule as 'recomputed'
0.16 2011-12-13
- Changed API for coderef's subroutines in 'depends' of rules. Now first
parameter is reference to CHI::Cascade::Rule object and other are
'qr_params'
- CHI::Cascade::Rule object now has a method 'cascade' which returns a
CHI::Cascade instance for this rule. You can use it in 'depends'
subroutines
0.15 2011-12-07
- Corrections if cascade rules have a 'depends' option as coderef. Backward
compatible. Now coderef can return arrayref of dependencies. Before it
could return only one dependence as plain text. No tests yet for this
- Tests are rewritten and optimised
- Added a FastMmap driver's tests
- Added tests when dependencies are coderef (t/lib/test_02.pm)
0.14 2011-11-29
- Improved tests in accordance with reports version 0.13
- Fixed few misprints in Changes & TODO files
NAME
CHI::Cascade - a cache dependencies (cache and like 'make' utility
concept)
SYNOPSIS
use CHI;
use CHI::Cascade;
$cascade = CHI::Cascade->new(chi => CHI->new(...));
$cascade->rule(
target => 'unique_name',
depends => ['unique_name_other1', 'unique_name_other2'],
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
# $values_of_depends == {
# unique_name_other1 => $value_1,
# unique_name_other2 => $value_2
# }
# $rule->target eq $target_name
# $rule->depends === ['unique_name_other1', 'unique_name_other2']
# $rule->dep_values == $values_of_depends
# $rule->params == { a => 1, b => 2 }
# Now we can calcualte $value
return $value;
},
params => { a => 1, b => 2 }
);
$cascade->rule(
target => 'unique_name_other1',
depends => 'unique_name_other3',
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
# $values_of_depends == {
# unique_name_other3 => $value_3
# }
# computing here
return $value;
}
);
$value_of_this_target = $cascade->run('unique_name');
DESCRIPTION
This module is the attempt to use a benefits of caching and 'make'
concept. If we have many an expensive tasks (a *computations* or
sometimes here used term as a *recomputing*) and want to cache it we can
split its to small expsnsive tasks and to describe dependencies for
cache items.
This module is experimental yet. I plan to improve it near time but some
things already work. You can take a look for t/* tests as examples.
CONSTRUCTOR
$cascade = CHI::Cascade->new( %options )
This method constructs a new "CHI::Cascade" object and returns it.
Key/value pair arguments may be provided to set up the initial state.
Options are:
chi Required. Instance of CHI object. The CHI::Cascade doesn't construct
this object for you. Please create instance of "CHI" yourself.
busy_lock
Optional. Default is *never*. *This is not "busy_lock" option of
exactly as described for *scalar* in this paragraph. If the
returned value is *arrayref* it will be considered as list
of dependencies for this target and the behavior will be
exactly as described for *arrayref* in this paragraph.
depends_catch
Optional. This is coderef for dependence exceptions. If any
dependence from list of "depends"'s option throws an exception
of type CHI::Cascade::Value by "die" (for example like this
code: "die CHI::Cascade::Value->new->value( { i_have_problem =>
1 } )" ) then the $cascade will execute this code as
"$rule->{depends_catch}->( $this_rule_obj,
$exception_of_dependence, $rule_obj_of_dependence,
$plain_text_target_of_dependence )" and you can do into inside a
following:
re-"die" new exception of any type
If your new exception will be type of CHI::Cascade::Value
you will get the value of this object from "run" method
immediately (please to see "code" below) without saving in
cache.
If exception will be other type this will be propogated
onward beyond the "run" method
to do something
You can make something in this code. After execution of your
code the cascade re-throws original exception of dependence
like described above in "re-"die"" section.
But please notice that original exception has a status of
"thrown from code" so it can be catched later by other
"depends_catch" callback from other rule located closer to
the call hierarchy of "run".
Please notice that there no way to continue a "code" of current
rule if any dependence throws an exception!. It because that the
main concept of execution code of rules is to have all valid
CHI. A coderef should return value in same format.
ttl Optional. An arrayref for min & max intervals of TTL. Example:
"[ 60, 3600 ]" - where the minimum ttl is seconds and the
maximum is 3600 seconds. Targets of this rule will be recomputed
during from 60 up to 3600 seconds from touched time of any
dependence this rule. Please read "CASCADE_TTL_INVOLVED" in
CHI::Cascade::Value too.
run( $target, %options )
This method makes a cascade computation if need and returns value
(value is cleaned value not CHI::Cascade::Value object!) for this
target If any dependence of this target of any dependencies of
dependencies were (re)computed this target will be (re)computed too.
The run method of instance of cascade can be called from other run
method of same instance and from "callref" function inside "depends"
rule's option. This was made possible by creating a separate data
instance for each root call of run method. This can come in handy
when you compute dependencies on the go, which are computed by the
same object (instance) of "cascade".
$target
Required. Plain text string of target.
%options
Optional. And all options are optional too A hash of options.
Valid keys and values are:
state
A scalarref of variable where will be stored a state of
defined as 2.5 this will mean to check a dependencies only
every 2.5 seconds. So recomputing in this example can be
recomputed only one time in every 2.5 seconds (even if one
from dependencies will be updated). But if value of $target
is missing in cache a recomputing can be run regardless of
this option.
ttl A scalarref for getting current TTL for value of 'run'
target. The TTL is "time to live" as TTL in DNS. If any rule
in a path of following to dependencies has ttl parameter
then the cascade will do there:
1. will look up a time of this retouched dependence;
2. if rule's target marker already has a upper time and
this time in future the target will be recomputed in
this time in future and before this moment you will get
a old data from cache for 'run' target. If this time is
there and has elapsed cascade will use a standard
algorithm.
3. will look up the rule's ttl parameter (min & max ttl
values) and will generate upper time of computation of
this rule's target and will return from "run" method old
data of 'run' target. Next "run"s executions will return
old values of any targets where this TTL-marked target
is as dependence.
4. In any case if old value misses in cache the cascade
will recompute codes.
This feature was made for *reset* situation. For example if
we have 'reset' rule and all rules depend from this one rule
the better way will be to have 'ttl' parameter in every rule
except 'reset' rule. So if rule 'reset' will be retouched
(or deleted) other targets will be recomputed during time
from 'min' and 'max' intervals from 'reset' touched time. It
reduce a server's load. Later i will add examples for this
and will document this feature more details. Please read
touch( $target )
This method refreshes the time of this target. Here is analogy with
touch utility of Unix and behaviour as make(1) after it. After
"touch" all targets are dependent from this target will be
recomputed at next "run" with an appropriate ones.
target_remove ( $target )
It's like a removing of target file in make. You can force to
recompute target by this method. It will remove target marker if one
exists and once when cascade will need target value it will be
recomputed. In a during recomputing of course cascade will return an
old value if one exists in cache.
stash()
Deprecated! It returns *hashref* to a stash. A stash is hash for
temporary data between rule's codes. It can be used only from inside
"run". Example:
$cascade->run( 'target', stash => { key1 => value1 } )
and into rule's code:
# DEPRECATED - OLD METHOD! It's supported and works but please don't use it
$rule->cascade->stash->{key1}
# NEW METHOD:
$rule->stash->{key1}
If a "run" method didn't get stash hashref the default stash will be
as empty hash. You can pass a data between rule's codes but it's
recommended only in special cases. For example when run's target
cannot get a full data from its target's name.
STATUS
If unique_name_other1 and/or unique_name_other2 are(is) more newer than
unique_name the unique_name will be recomputed. If in this example
unique_name_other1 and unique_name_other2 are older than unique_name but
the unique_name_other3 is newer than unique_name_other1 then
unique_name_other1 will be recomputed and after the unique_name will be
recomputed.
And even we can have a same rule:
$cascade->rule(
target => qr/^unique_name_(.*)$/,
depends => sub { 'unique_name_other_' . $_[1] },
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
# $rule->qr_params === ( 3 )
# $target_name == 'unique_name_3' if $cascade->run('unique_name_3') was
# $values_of_depends == {
# unique_name_other_3 => $value_ref_3
# }
}
);
$cascade->rule(
target => qr/unique_name_other_(.*)/,
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
...
}
);
When we will do:
$cascade->run('unique_name_52');
$cascade will find rule with qr/^unique_name_(.*)$/, will make =~ and
will find a depend as unique_name_other_52
AUTHOR
This module has been written by Perlover <perlover@perlover.com>
LICENSE
This module is free software and is published under the same terms as
Perl itself.
SEE ALSO
lib/CHI/Cascade.pm view on Meta::CPAN
}, ref($class) || $class;
$self->{target_chi} ||= $self->{chi};
$self;
}
sub rule {
my ($self, %opts) = @_;
my $rule = CHI::Cascade::Rule->new( cascade => $self, %opts );
if (ref($rule->{target}) eq 'Regexp') {
push @{ $self->{qr_targets} }, $rule;
}
elsif (! ref($rule->{target})) {
$self->{plain_targets}{$rule->{target}} = $rule;
}
else {
croak qq{The rule's target "$rule->{target}" is unknown type};
}
lib/CHI/Cascade.pm view on Meta::CPAN
=head1 NAME
CHI::Cascade - a cache dependencies (cache and like 'make' utility concept)
=head1 SYNOPSIS
use CHI;
use CHI::Cascade;
$cascade = CHI::Cascade->new(chi => CHI->new(...));
$cascade->rule(
target => 'unique_name',
depends => ['unique_name_other1', 'unique_name_other2'],
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
# $values_of_depends == {
# unique_name_other1 => $value_1,
# unique_name_other2 => $value_2
# }
# $rule->target eq $target_name
# $rule->depends === ['unique_name_other1', 'unique_name_other2']
# $rule->dep_values == $values_of_depends
# $rule->params == { a => 1, b => 2 }
# Now we can calcualte $value
return $value;
},
params => { a => 1, b => 2 }
);
$cascade->rule(
target => 'unique_name_other1',
depends => 'unique_name_other3',
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
# $values_of_depends == {
# unique_name_other3 => $value_3
# }
# computing here
return $value;
}
);
$value_of_this_target = $cascade->run('unique_name');
=head1 DESCRIPTION
This module is the attempt to use a benefits of caching and 'make' concept.
If we have many an expensive tasks (a I<computations> or sometimes here used
term as a I<recomputing>) and want to cache it we can split its to small
expsnsive tasks and to describe dependencies for cache items.
This module is experimental yet. I plan to improve it near time but some things
already work. You can take a look for t/* tests as examples.
=head1 CONSTRUCTOR
$cascade = CHI::Cascade->new( %options )
This method constructs a new C<CHI::Cascade> object and returns it.
Key/value pair arguments may be provided to set up the initial state.
Options are:
=over
=item chi
B<Required>. Instance of L<CHI> object. The L<CHI::Cascade> doesn't construct this
lib/CHI/Cascade.pm view on Meta::CPAN
I<arrayref> in this paragraph.
=back
=item depends_catch
B<Optional>. This is B<coderef> for dependence exceptions. If any dependence
from list of L</depends>'s option throws an exception of type
CHI::Cascade::Value by C<die> (for example like this code: C<< die
CHI::Cascade::Value->new->value( { i_have_problem => 1 } ) >> ) then the
C<$cascade> will execute this code as C<< $rule->{depends_catch}->(
$this_rule_obj, $exception_of_dependence, $rule_obj_of_dependence,
$plain_text_target_of_dependence ) >> and you can do into inside a following:
=over
=item re-C<die> new exception of any type
If your new exception will be type of L<CHI::Cascade::Value> you will get the
value of this object from L</run> method immediately (please to see L</code>
below) without saving in cache.
If exception will be other type this will be propogated onward beyond the
L</run> method
=item to do something
You can make something in this code. After execution of your code the cascade
re-throws original exception of dependence like described above in L<<
/"re-C<die>" >> section.
But please notice that original exception has a status of "thrown from code" so
it can be catched later by other L</depends_catch> callback from other rule
located closer to the call hierarchy of L</run>.
=back
Please notice that there no way to continue a L</code> of current rule if any
lib/CHI/Cascade.pm view on Meta::CPAN
An arrayref for min & max intervals of TTL. Example: C<[ 60, 3600 ]> - where the
minimum ttl is seconds and the maximum is 3600 seconds. Targets of this rule
will be recomputed during from 60 up to 3600 seconds from touched time of any
dependence this rule. Please read L<CHI::Cascade::Value/CASCADE_TTL_INVOLVED>
too.
=back
=item run( $target, %options )
This method makes a cascade computation if need and returns value (value is
cleaned value not L<CHI::Cascade::Value> object!) for this target If any
dependence of this target of any dependencies of dependencies were
(re)computed this target will be (re)computed too.
The run method of instance of cascade can be called from other run method of
same instance and from C<callref> function inside C<depends> rule's option. This
was made possible by creating a separate data instance for each root call of run
method. This can come in handy when you compute dependencies on the go, which
are computed by the same object (instance) of C<cascade>.
=over
=item $target
B<Required.> Plain text string of target.
=item %options
B<Optional.> And B<all options> are B<optional> too A hash of options. Valid keys and values are:
lib/CHI/Cascade.pm view on Meta::CPAN
C<actual_term> will be defined as C<2.5> this will mean to check a dependencies
only every 2.5 seconds. So recomputing in this example can be recomputed only
one time in every 2.5 seconds (even if one from dependencies will be updated).
But if value of $target is missing in cache a recomputing can be
run regardless of this option.
=item ttl
A B<scalarref> for getting current TTL for value of 'run' target. The TTL is
"time to live" as TTL in DNS. If any rule in a path of following to dependencies
has ttl parameter then the cascade will do there:
=over
=item 1.
will look up a time of this retouched dependence;
=item 2.
if rule's target marker already has a upper time and this time in future
the target will be recomputed in this time in future and before this moment you
will get a old data from cache for 'run' target. If this time is there and has
elapsed cascade will use a standard algorithm.
=item 3.
will look up the rule's ttl parameter (min & max ttl values) and will generate
upper time of computation of this rule's target and will return from L</run>
method old data of 'run' target. Next L</run>s executions will return old values
of any targets where this TTL-marked target is as dependence.
=item 4.
In any case if old value misses in cache the cascade will recompute codes.
=back
This feature was made for I<reset> situation. For example if we have 'reset'
rule and all rules depend from this one rule the better way will be to have
'ttl' parameter in every rule except 'reset' rule. So if rule 'reset' will be
retouched (or deleted) other targets will be recomputed during time from 'min'
and 'max' intervals from 'reset' touched time. It reduce a server's load. Later
i will add examples for this and will document this feature more details. Please
read L<CHI::Cascade::Value/CASCADE_TTL_INVOLVED> too.
lib/CHI/Cascade.pm view on Meta::CPAN
=item touch( $target )
This method refreshes the time of this target. Here is analogy with L<touch>
utility of Unix and behaviour as L<make(1)> after it. After L</touch> all targets
are dependent from this target will be recomputed at next L</run> with an
appropriate ones.
=item target_remove ( $target )
It's like a removing of target file in make. You can force to recompute target
by this method. It will remove target marker if one exists and once when cascade
will need target value it will be recomputed. In a during recomputing of course
cascade will return an old value if one exists in cache.
=item stash()
B<Deprecated!> It returns I<hashref> to a stash. A stash is hash for temporary data between
rule's codes. It can be used only from inside L</run>. Example:
$cascade->run( 'target', stash => { key1 => value1 } )
and into rule's code:
# DEPRECATED - OLD METHOD! It's supported and works but please don't use it
$rule->cascade->stash->{key1}
# NEW METHOD:
$rule->stash->{key1}
If a L</run> method didn't get stash hashref the default stash will be as empty
hash. You can pass a data between rule's codes but it's recommended only in
special cases. For example when run's target cannot get a full data from its
target's name.
=back
lib/CHI/Cascade.pm view on Meta::CPAN
If unique_name_other1 and/or unique_name_other2 are(is) more newer than
unique_name the unique_name will be recomputed.
If in this example unique_name_other1 and unique_name_other2 are older than
unique_name but the unique_name_other3 is newer than unique_name_other1 then
unique_name_other1 will be recomputed and after the unique_name will be
recomputed.
And even we can have a same rule:
$cascade->rule(
target => qr/^unique_name_(.*)$/,
depends => sub { 'unique_name_other_' . $_[1] },
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
# $rule->qr_params === ( 3 )
# $target_name == 'unique_name_3' if $cascade->run('unique_name_3') was
# $values_of_depends == {
# unique_name_other_3 => $value_ref_3
# }
}
);
$cascade->rule(
target => qr/unique_name_other_(.*)/,
code => sub {
my ($rule, $target_name, $values_of_depends) = @_;
...
}
);
When we will do:
$cascade->run('unique_name_52');
$cascade will find rule with qr/^unique_name_(.*)$/, will make =~ and will find
a depend as unique_name_other_52
=head1 AUTHOR
This module has been written by Perlover <perlover@perlover.com>
=head1 LICENSE
This module is free software and is published under the same terms as Perl
itself.
lib/CHI/Cascade/Rule.pm view on Meta::CPAN
my $from = ref($class) ? $class : \%opts;
$opts{depends} = [ defined( $opts{depends} ) ? ( $opts{depends} ) : () ]
unless ref( $opts{depends} );
# To do clone or new object
my $self = bless {
map( { $_ => $from->{$_} }
grep { exists $from->{$_} }
qw( target depends depends_catch code params busy_lock cascade recomputed actual_term ttl value_expires ) ),
qr_params => [],
matched_target => undef
}, ref($class) || $class;
if ( $opts{run_instance} ) {
$self->{run_instance} = $opts{run_instance};
weaken $self->{run_instance}; # It is against memory leaks
}
weaken $self->{cascade}; # It is against memory leaks
$self->{resolved_depends} = undef;
$self;
}
sub qr_params {
my $self = shift;
if (@_) {
$self->{qr_params} = [ @_ ];
lib/CHI/Cascade/Rule.pm view on Meta::CPAN
return $self;
}
( ref $self->{value_expires} eq 'CODE' ? $self->{value_expires}->( $self ) : $self->{value_expires} ) // 'never';
}
sub target_expires {
my ( $self, $trg_obj ) = @_;
$trg_obj->locked
?
$self->{busy_lock} || $self->{cascade}{busy_lock} || 'never'
:
$trg_obj->expires // $trg_obj->expires( $self->value_expires );
}
sub ttl {
my $self = shift;
return undef
unless exists $self->{ttl};
lib/CHI/Cascade/Rule.pm view on Meta::CPAN
}
elsif ( ref $self->{ttl} eq 'CODE' ) {
return $self->{ttl_time} = $self->{ttl}->( $self, $self->qr_params );
}
return undef;
}
sub target { shift->{matched_target} }
sub params { shift->{params} }
sub cascade { shift->{cascade} }
sub dep_values { shift->{dep_values} }
sub stash { $_[0]->{run_instance} && $_[0]->{run_instance}{stash} || die "The run_instance is not defined!" }
1;
__END__
=head1 NAME
CHI::Cascade::Rule - a rule class
=head1 SYNOPSIS
$cascade->rule(
target => qr/^target_(\d+)$/,
depends => 'base_target',
code => sub {
my ( $rule, $target, $dep_values ) = @_;
# An execution of $cascade->run('target_12') will pass in code a $rule as:
#
# $rule->target eq $target
# $rule->depends === [ 'base_target' ]
# $rule->qr_params === ( 12 )
# $rule->params == [ 1, 2, 3 ]
},
params => [ 1, 2, 3 ]
);
$cascade->run('target_12');
=head1 CONSTRUCTOR
An instance of this object is created by L<CHI::Cascade> in L<CHI::Cascade/rule>
as a following:
$rule = CHI::Cascade::Rule->new( %options )
The list of options please see in L<CHI::Cascade/"rule( %options )"> method.
lib/CHI/Cascade/Rule.pm view on Meta::CPAN
see more details in L<CHI::Cascade/depends>.
=item target()
returns current target as plain text after matching.
=item params()
returns any data of any type what were passed to L<CHI::Cascade/params>
=item cascade()
returns reference to L<CHI::Cascade> instance object for this rule.
=item stash()
It returns I<hashref> to a stash. A stash is hash for temporary data between
rule's codes. It can be used only from inside call stack of L<CHI::Cascade/run>. Example:
$cascade->run( 'target', stash => { key1 => value1 } )
and into rule's code:
$rule->stash->{key1}
If a L<CHI::Cascade/run> method didn't get stash hashref the default stash will be as empty
hash. You can pass a data between rule's codes but it's recommended only in
special cases. For example when run's target cannot get a full data from its
target's name.
lib/CHI/Cascade/Value.pm view on Meta::CPAN
=item state
use CHI::Cascade::Value ':state';
$state_bits = $value->state;
$value = $value->state( CASCADE_* );
A getting or setting of state bits of value object.
=item state_as_str
my $value = $cascade->run( 'my_target', state => \$state );
my $str = CHI::Cascade::Value->state_as_str( $state );
Returns a string presentation of state bits (see below L</"STATE BITS">).
Strings of bits are ordered by alphabetical before concatenation. Here some
examples:
# It means you get actual value and this was recomputed right now
CASCADE_ACTUAL_VALUE | CASCADE_RECOMPUTED
# It happens when returned value of CHI::Cascade::run is undef and here is reason why:
t/01_fast_mmap_actual_term.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/02_memcached_actual_term.t view on Meta::CPAN
sleep 1;
if ( $? || ! (-f $pid_file )) {
( defined($out) && chomp($out) ) || ( $out = '' );
plan skip_all => "Cannot start the memcached for this test ($out)";
}
else {
plan tests => 32;
}
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'Memcached::Fast',
servers => [$socket_file],
namespace => 'CHI::Cascade::tests'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/03_file_cache_actual_term.t view on Meta::CPAN
plan tests => 32;
$SIG{__DIE__} = sub {
`{ rm -rf t/file_cache; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
`{ rm -rf t/file_cache; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'File',
root_dir => 't/file_cache'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/04_memcached_multi.t view on Meta::CPAN
print CHILD_SLOW_WTR "exit\n" or die $!;
print CHILD_QUICK_WTR "exit\n" or die $!;
$SIG{__DIE__}->();
}
sub run_slow_process {
my $line;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'Memcached::Fast',
servers => [$socket_file],
namespace => 'CHI::Cascade::tests'
)
);
set_cascade_rules($cascade, DELAY);
my $out;
while ($line = <PARENT_SLOW_RDR>) {
chomp $line;
if ($line eq 'save1') {
$out = {};
$out->{time1} = time;
$out->{value} = $cascade->run('one_page_0');
$out->{time2} = time;
store_fd $out, \*PARENT_SLOW_WTR;
}
elsif ($line eq 'save2') {
$out = {};
$big_array_type = 1;
$cascade->touch('big_array_trigger');
$out->{time1} = time;
$out->{value} = $cascade->run('one_page_0');
$out->{time2} = time;
store_fd $out, \*PARENT_SLOW_WTR;
}
elsif ($line eq 'exit') {
exit 0;
}
}
}
sub run_quick_process {
my $line;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'Memcached::Fast',
servers => [$socket_file],
namespace => 'CHI::Cascade::tests'
)
);
set_cascade_rules($cascade, 0);
my $out;
while ($line = <PARENT_QUICK_RDR>) {
chomp $line;
if ($line eq 'read1') {
$out = {};
$out->{time1} = time;
$out->{value} = $cascade->run('one_page_0');
$out->{time2} = time;
store_fd $out, \*PARENT_QUICK_WTR;
}
elsif ($line eq 'exit') {
exit 0;
}
}
}
sub setup_for_slow_process {
t/04_memcached_multi.t view on Meta::CPAN
sub setup_slow_child {
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { exit 1 };
close CHILD_SLOW_RDR; close CHILD_SLOW_WTR;
}
sub setup_quick_child {
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { exit 1 };
close CHILD_QUICK_RDR; close CHILD_QUICK_WTR;
}
sub set_cascade_rules {
my ($cascade, $delay) = @_;
$cascade->rule(
target => 'big_array_trigger',
code => sub {
return [];
}
);
$cascade->rule(
target => 'big_array',
depends => 'big_array_trigger',
code => sub {
select( undef, undef, undef, $delay )
if ($delay);
return $big_array_type ? [ 101 .. 1000 ] : [ 1 .. 1000 ];
}
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ($rule, $target, $values) = @_;
my ($page) = $target =~ /^one_page_(\d+)$/;
select( undef, undef, undef, $delay )
if ($delay);
t/05_fast_mmap_touch.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
done_testing;
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/06_fast_mmap_depends_catch.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/07_fast_mmap_recompute.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/08_fast_mmap_expires.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/09_fast_mmap_ttl.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/10_fast_mmap_deprecated_stash.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/10_fast_mmap_nested_run_methods.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/10_fast_mmap_stash.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/11_fast_mmap_actual_term_expires.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/12_fast_mmap_expires_cb.t view on Meta::CPAN
$SIG{__DIE__} = sub {
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
$SIG{__DIE__} = 'IGNORE';
};
$SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { die "Terminated by signal " . shift };
`{ rm -rf t/fast_mmap; } >/dev/null 2>&1`;
my $cascade = CHI::Cascade->new(
chi => CHI->new(
driver => 'FastMmap',
root_dir => 't/fast_mmap'
)
);
test_cascade($cascade);
$SIG{__DIE__} eq 'IGNORE' || $SIG{__DIE__}->();
t/lib/test_01_actual_term.pm view on Meta::CPAN
package test_01_actual_term;
use strict;
use Test::More;
use CHI::Cascade::Value ':state';
use parent 'Exporter';
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
isa_ok( $cascade, 'CHI::Cascade');
$cascade->rule(
target => 'big_array',
code => sub {
return [ 1 .. 1000 ];
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => 'actual_test',
actual_term => 2.0,
depends => 'one_page_0',
code => sub {
$_[2]->{one_page_0}
}
);
ok( $cascade->{stats}{recompute} == 0, 'recompute stats - 1');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
ok( $cascade->{stats}{recompute} == 2 && $recomputed == 2, 'recompute stats - 2');
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 3, 'recompute stats - 3');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 3, 'recompute stats - 4');
select( undef, undef, undef, 0.5 );
# To force recalculate dependencied
$cascade->touch('big_array');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 4, 'recompute stats - 5');
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 5, 'recompute stats - 6');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 5, 'recompute stats - 7');
ok( $cascade->{stats}{recompute} == $recomputed, 'recompute stats - 8');
# To checking of actual_term option
my $state = 0;
is_deeply( $cascade->run( 'actual_test', state => \$state ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'actual_test');
ok( $cascade->{stats}{recompute} == 6 );
$cascade->touch('big_array');
my $dependencies_lookup = $cascade->{stats}{dependencies_lookup};
is_deeply( $cascade->run( 'one_page_0', state => \$state, actual_term => 2.0 ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache after touching');
ok( $state & CASCADE_ACTUAL_TERM );
is_deeply( $cascade->run( 'actual_test', state => \$state ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'actual_test');
ok( $state & CASCADE_ACTUAL_TERM );
is_deeply( $cascade->run('one_page_1', state => \$state, actual_term => 2.0), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ] );
ok( $cascade->{stats}{recompute} == 6 );
ok( $state & CASCADE_ACTUAL_TERM );
ok( $cascade->{stats}{dependencies_lookup} == $dependencies_lookup );
select( undef, undef, undef, 2.5 );
is_deeply( $cascade->run( 'one_page_0', state => \$state, actual_term => 2.0 ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache after touching');
ok( $cascade->{stats}{recompute} == 7 );
ok( not $state & CASCADE_ACTUAL_TERM );
ok( $cascade->{stats}{dependencies_lookup} > $dependencies_lookup );
$dependencies_lookup = $cascade->{stats}{dependencies_lookup};
is_deeply( $cascade->run( 'actual_test', state => \$state ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'actual_test');
ok( $cascade->{stats}{dependencies_lookup} > $dependencies_lookup );
ok( $cascade->{stats}{recompute} == 8 );
}
1;
t/lib/test_02_touch.pm view on Meta::CPAN
package test_02_touch;
use strict;
use Test::More;
use parent 'Exporter';
our @EXPORT = qw(test_cascade);
sub test_cascade {
my $cascade = shift;
isa_ok( $cascade, 'CHI::Cascade');
$cascade->rule(
target => 'big_array',
code => sub {
return [ 1 .. 1000 ];
}
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => sub { isa_ok( $_[0], 'CHI::Cascade::Rule' ); ok( $_[1] =~ /^\d+$/o); [ 'big_array' ] },
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
}
);
$cascade->rule(
target => 'one_page_1',
depends => [ sub { isa_ok( $_[0], 'CHI::Cascade::Rule' ); 'big_array' } ],
code => sub {
my ($rule) = @_;
my $page = 1;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
}
);
ok( $cascade->{stats}{recompute} == 0, 'recompute stats - 1');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 2 );
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 3 );
is_deeply( $cascade->run('one_page_2'), [ 21, 22, 23, 24, 25, 26, 27, 28, 29, 30 ], '2th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 4 );
sleep 1;
# To force recalculate dependencied
$cascade->touch('big_array');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 5 );
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 6 );
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 6 );
}
1;
t/lib/test_03_depends_catch.pm view on Meta::CPAN
package test_03_depends_catch;
use strict;
use Test::More;
use parent 'Exporter';
use CHI::Cascade::Value;
our @EXPORT = qw(test_cascade);
my $test_mask = '';
sub test_cascade {
my $cascade = shift;
plan tests => 7;
$cascade->rule(
target => 'throw_exception',
code => sub {
$test_mask .= 'a';
die CHI::Cascade::Value->new->value( { exception => 1 } );
}
);
$cascade->rule(
target => 'test_exception',
depends => 'throw_exception',
depends_catch => sub {
isa_ok( $_[0], 'CHI::Cascade::Rule' );
isa_ok( $_[1], 'CHI::Cascade::Value' );
isa_ok( $_[2], 'CHI::Cascade::Rule' );
ok( $_[3] eq 'throw_exception' );
$test_mask .= 'b';
},
code => sub {
# should not be executed
$test_mask .= 'c';
}
);
my $ret = $cascade->run('test_exception');
ok( ref $ret eq 'HASH' );
ok( exists $ret->{exception} && $ret->{exception} == 1 );
ok( $test_mask eq 'ab' ) or diag( "\$test_mask is $test_mask" );
}
1;
t/lib/test_04_recompute.pm view on Meta::CPAN
package test_04_recompute;
use strict;
use Test::More;
use parent 'Exporter';
use Time::HiRes qw(time);
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
plan tests => 12;
$cascade->rule(
target => 'big_array',
code => sub {
select( undef, undef, undef, 1.0 );
return [ 1 .. 1000 ];
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
},
recomputed => sub { $recomputed++ }
);
my ( $state );
my $time1 = time;
ok( ! defined $cascade->run( 'one_page_0',
defer => 1,
state => \$state )
);
my $time2 = time;
ok( $cascade->{stats}{recompute} == 0 );
cmp_ok( $time2 - $time1, '<', 0.5 );
ok( CHI::Cascade::Value->state_as_str($state) eq "CASCADE_DEFERRED | CASCADE_NO_CACHE" );
my $res;
$time1 = time;
ok( defined( $res = $cascade->run( 'one_page_0', state => \$state ) ) );
$time2 = time;
ok( $time2 - $time1 > 0.8 && $time2 - $time1 < 1.2 );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( CHI::Cascade::Value->state_as_str($state) eq "CASCADE_ACTUAL_VALUE | CASCADE_RECOMPUTED" );
$time1 = time;
ok( defined $cascade->run( 'one_page_0',
defer => 1,
state => \$state )
);
$time2 = time;
ok( $time2 - $time1 < 0.1 );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( CHI::Cascade::Value->state_as_str($state) eq "CASCADE_ACTUAL_VALUE | CASCADE_FROM_CACHE" );
}
1;
t/lib/test_05_expires.pm view on Meta::CPAN
package test_05_expires;
use strict;
use Test::More;
use parent 'Exporter';
use Time::HiRes qw(time);
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
$cascade->rule(
target => 'big_array',
code => sub {
$_[0]->value_expires( '2s' );
return [ 1 .. 1000 ];
}
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
}
);
my $res;
ok( defined( $res = $cascade->run( 'one_page_0' ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 2 );
ok( defined( $res = $cascade->run( 'one_page_1' ) ) );
is_deeply( $res, [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ] );
ok( $cascade->{stats}{recompute} == 3 );
sleep 3;
ok( defined( $res = $cascade->run( 'one_page_0' ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 5 );
ok( defined( $res = $cascade->run( 'one_page_1' ) ) );
is_deeply( $res, [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ] );
ok( $cascade->{stats}{recompute} == 6 );
done_testing;
}
1;
t/lib/test_06_ttl.pm view on Meta::CPAN
package test_06_ttl;
use strict;
use Test::More;
use CHI::Cascade::Value ':state';
use parent 'Exporter';
use Time::HiRes qw(time);
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
$cascade->rule(
target => 'reset',
code => sub { 1 }
);
$cascade->rule(
target => 'big_array',
depends => 'reset',
ttl => [ 1, 2 ],
code => sub {
return [ 1 .. 1000 ];
}
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
}
);
my ( $res, $state, $ttl );
ok( defined( $res = $cascade->run( 'one_page_0' ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 3 );
ok( defined( $res = $cascade->run( 'one_page_1', ttl => \$ttl ) ) );
is_deeply( $res, [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ] );
ok( $cascade->{stats}{recompute} == 4 );
ok( ! defined $ttl );
$cascade->target_remove('reset');
ok( defined( $res = $cascade->run( 'one_page_0', state => \$state, ttl => \$ttl ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 5 ); # reset is recomputed now but the one_page_0 is not
ok( $state & CASCADE_TTL_INVOLVED );
ok( not $state & CASCADE_RECOMPUTED );
ok( defined $ttl && $ttl > 0 );
my $prevTTL = $ttl;
select( undef, undef, undef, 0.2 );
# Now ttl will be reduced by ~ 0.2 seconds
ok( defined( $res = $cascade->run( 'one_page_0', state => \$state, ttl => \$ttl ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 5 );
ok( $state & CASCADE_TTL_INVOLVED );
ok( not $state & CASCADE_RECOMPUTED );
ok( defined $ttl && $ttl > 0 );
cmp_ok( $prevTTL - $ttl, '>', 0.1 );
cmp_ok( $prevTTL - $ttl, '<', 0.3 );
select( undef, undef, undef, 1.9 );
# Maximum (2 seconds) ttl has been reached now ( 0.2 + 1.9 time elapsed)
ok( defined( $res = $cascade->run( 'one_page_0', state => \$state, ttl => \$ttl ) ) );
ok( ! defined $ttl );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 7 );
ok( not $state & CASCADE_TTL_INVOLVED );
ok( $state & CASCADE_RECOMPUTED );
ok( defined( $res = $cascade->run( 'one_page_0', state => \$state, ttl => \$ttl ) ) );
ok( ! defined $ttl );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 7 );
ok( not $state & CASCADE_TTL_INVOLVED );
ok( ( $state & ( CASCADE_ACTUAL_VALUE | CASCADE_FROM_CACHE ) ) == ( CASCADE_ACTUAL_VALUE | CASCADE_FROM_CACHE ) );
done_testing;
}
1;
t/lib/test_07_deprecated_stash.pm view on Meta::CPAN
package test_07_deprecated_stash;
use strict;
use Test::More;
use parent 'Exporter';
use Time::HiRes qw(time);
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
plan tests => 6;
$cascade->rule(
target => 'big_array',
code => sub {
my $rule = shift;
ok( $rule->cascade->stash && $rule->cascade->stash->{key1} == 1 );
return [ 1 .. 1000 ];
}
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ( $rule, $target ) = @_;
ok( $target eq 'one_page_0'
?
$rule->cascade->stash && $rule->cascade->stash->{key2} == 2
:
ref $rule->cascade->stash eq 'HASH' && ! exists $rule->cascade->stash->{key2}
);
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
}
);
my $res;
ok( defined( $res = $cascade->run( 'one_page_0', stash => { key1 => 1, key2 => 2 } ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( defined( $res = $cascade->run( 'one_page_1' ) ) );
}
1;
t/lib/test_07_stash.pm view on Meta::CPAN
package test_07_stash;
use strict;
use Test::More;
use parent 'Exporter';
use Time::HiRes qw(time);
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
plan tests => 6;
$cascade->rule(
target => 'big_array',
code => sub {
my $rule = shift;
ok( $rule->stash && $rule->stash->{key1} == 1 );
return [ 1 .. 1000 ];
}
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ( $rule, $target ) = @_;
ok( $target eq 'one_page_0'
?
$rule->stash && $rule->stash->{key2} == 2
:
ref $rule->stash eq 'HASH' && ! exists $rule->stash->{key2}
);
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
}
);
my $res;
ok( defined( $res = $cascade->run( 'one_page_0', stash => { key1 => 1, key2 => 2 } ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( defined( $res = $cascade->run( 'one_page_1' ) ) );
}
1;
t/lib/test_08_actual_term_expires.pm view on Meta::CPAN
package test_08_actual_term_expires;
use strict;
use Test::More;
use CHI::Cascade::Value ':state';
use parent 'Exporter';
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
isa_ok( $cascade, 'CHI::Cascade');
$cascade->rule(
target => 'big_array',
code => sub {
return [ 1 .. 1000 ];
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => 'actual_test',
actual_term => 2.0,
value_expires => '4s',
depends => 'one_page_0',
code => sub {
$_[2]->{one_page_0}
}
);
ok( $cascade->{stats}{recompute} == 0, 'recompute stats - 1');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
ok( $cascade->{stats}{recompute} == 2 && $recomputed == 2, 'recompute stats - 2');
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 3, 'recompute stats - 3');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 3, 'recompute stats - 4');
select( undef, undef, undef, 1.0 );
# To force recalculate dependencied
$cascade->touch('big_array');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 4, 'recompute stats - 5');
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 5, 'recompute stats - 6');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 5, 'recompute stats - 7');
ok( $cascade->{stats}{recompute} == $recomputed, 'recompute stats - 8');
# To checking of actual_term option
my $state = 0;
is_deeply( $cascade->run( 'actual_test', state => \$state ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'actual_test');
ok( $cascade->{stats}{recompute} == 6 );
my $dependencies_lookup = $cascade->{stats}{dependencies_lookup};
is_deeply( $cascade->run( 'one_page_0', state => \$state, actual_term => 2.0 ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache after touching');
ok( $state & CASCADE_ACTUAL_TERM );
select( undef, undef, undef, 2.1 );
is_deeply( $cascade->run( 'actual_test', state => \$state ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'actual_test');
ok( not $state & CASCADE_ACTUAL_TERM );
is_deeply( $cascade->run('one_page_1', state => \$state, actual_term => 2.0), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ] );
ok( $cascade->{stats}{recompute} == 6 );
ok( not $state & CASCADE_ACTUAL_TERM );
ok( $cascade->{stats}{dependencies_lookup} > $dependencies_lookup );
select( undef, undef, undef, 2.0 );
# Here the 'value_expires' happened
# Before there was bug - the expires has been updated by actual_test checking
is_deeply( $cascade->run( 'actual_test', state => \$state ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'actual_test');
ok( $cascade->{stats}{dependencies_lookup} > $dependencies_lookup );
ok( $cascade->{stats}{recompute} == 7 ); # Here were recomputed 'actual_test' & 'one_page_0'
# Here target's value has expired before the actual term finished
ok( not $state & CASCADE_ACTUAL_TERM );
ok( ( $state & ( CASCADE_RECOMPUTED | CASCADE_ACTUAL_VALUE ) ) == ( CASCADE_RECOMPUTED | CASCADE_ACTUAL_VALUE ) );
select( undef, undef, undef, 1.0 );
is_deeply( $cascade->run( 'actual_test', state => \$state ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'actual_test');
ok( $state & CASCADE_ACTUAL_TERM );
ok( $cascade->{stats}{recompute} == 7 );
done_testing;
}
1;
t/lib/test_09_expires_cb.pm view on Meta::CPAN
package test_09_expires_cb;
use strict;
use Test::More;
use parent 'Exporter';
use Time::HiRes qw(time);
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
$cascade->rule(
target => 'big_array',
value_expires => sub { '2s' },
code => sub {
return [ 1 .. 1000 ];
}
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => 'big_array',
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
}
);
my $res;
ok( defined( $res = $cascade->run( 'one_page_0' ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 2 );
ok( defined( $res = $cascade->run( 'one_page_1' ) ) );
is_deeply( $res, [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ] );
ok( $cascade->{stats}{recompute} == 3 );
sleep 3;
ok( defined( $res = $cascade->run( 'one_page_0' ) ) );
is_deeply( $res, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] );
ok( $cascade->{stats}{recompute} == 5 );
ok( defined( $res = $cascade->run( 'one_page_1' ) ) );
is_deeply( $res, [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ] );
ok( $cascade->{stats}{recompute} == 6 );
done_testing;
}
1;
t/lib/test_10_nested_run_methods.pm view on Meta::CPAN
package test_10_nested_run_methods;
use strict;
use Test::More;
use CHI::Cascade::Value ':state';
use parent 'Exporter';
our @EXPORT = qw(test_cascade);
my $recomputed;
sub test_cascade {
my $cascade = shift;
$cascade->rule(
target => 'big_array',
code => sub {
return [ 1 .. 1000 ];
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => 'get_depends',
code => sub {
my $rule = shift;
ok( $rule->stash->{a} == 2, 'get_depends stash' );
return 'big_array';
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => qr/^one_page_(\d+)$/,
depends => [ sub { $_[0]->cascade->run('get_depends', stash => { a => 2 } ) } ],
code => sub {
my ($rule) = @_;
my ($page) = $rule->target =~ /^one_page_(\d+)$/;
ok( $page != 0 || $rule->stash->{a} == 1, 'one_page stash' );
my $ret = [ @{$rule->dep_values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
$ret;
},
recomputed => sub { $recomputed++ }
);
$cascade->rule(
target => 'actual_test',
actual_term => 2.0,
depends => 'one_page_0',
code => sub {
$_[2]->{one_page_0}
}
);
ok( $cascade->{stats}{recompute} == 0, 'recompute stats - 1');
is_deeply( $cascade->run('one_page_0', stash => { a => 1 } ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
ok( $cascade->{stats}{recompute} == 3 && $recomputed == 3, 'recompute stats - 2');
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 4, 'recompute stats - 3');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 4, 'recompute stats - 4');
select( undef, undef, undef, 0.5 );
# To force recalculate dependencied
$cascade->touch('big_array');
is_deeply( $cascade->run('one_page_0', stash => { a => 1 } ), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 5, 'recompute stats - 5');
is_deeply( $cascade->run('one_page_1'), [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20 ], '1th page from cache after touching');
cmp_ok( $cascade->{stats}{recompute}, '==', 6, 'recompute stats - 6');
is_deeply( $cascade->run('one_page_0'), [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], '0th page from cache');
cmp_ok( $cascade->{stats}{recompute}, '==', 6, 'recompute stats - 7');
ok( $cascade->{stats}{recompute} == $recomputed, 'recompute stats - 8');
}
1;
( run in 0.883 second using v1.01-cache-2.11-cpan-49f99fa48dc )