--- /dev/null
+package DBIx::Class::Schema::AtQueryInterval;
+
+use Moose;
+
+=head1 NAME
+
+DBIx::Class::Schema::Role::AtQueryInterval; Defines a job control interval.
+
+=head1 SYNOPSIS
+
+The following example shows how to define a job control interval and assign it
+to a particular L<DBIx::Class::Schema::Job> for a L<DBIx::Class::Schema>
+
+ my $job = DBIx::Class::Schema->new(runs => sub { print 'did job'});
+ my $interval = DBIx::Class::Schema::Interval->new(every => 10);
+
+ if($interval->matches($query_count)) {
+ print "I indentified the query count as matching";
+ }
+
+ ## $schema->isa(DBIx::Class::Schema);
+ $schema->create_and_add_at_query_intervals($interval => $job);
+
+=head1 DESCRIPTION
+
+An AtQueryInterval is a plan object that will execute a certain
+
+=head1 ATTRIBUTES
+
+This package defines the following attributes.
+
+=head2 job (DBIx::Class::Schema::Job)
+
+This is the job which will run at the specified query interval
+
+=cut
+
+has 'job' => (
+ is=>'ro',
+ isa=>'DBIx::Class::Schema::Job',
+ required=>1,
+ handles=>['execute'],
+);
+
+
+=head2 interval (Int)
+
+This is the interval we are watching for
+
+=cut
+
+has 'interval' => (
+ is=>'ro',
+ isa=>'DBIx::Class::Schema::QueryInterval',
+ required=>1,
+ handles=>['matches'],
+);
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 execute_if_matches ($query_count, @args)
+
+Does the $query_count match the defined interval? Returns a Boolean.
+
+=cut
+
+sub execute_if_matches {
+ my ($self, $query_count, @args) = @_;
+ if($self->matches($query_count)) {
+ return $self->execute(@args);
+ } else {
+ return;
+ }
+}
+
+
+=head1 AUTHORS
+
+See L<DBIx::Class> for more information regarding authors.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+
+1;
\ No newline at end of file
--- /dev/null
+package DBIx::Class::Schema::Job;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+
+=head1 NAME
+
+DBIx::Class::Schema::Job; A job associated with a Schema
+
+=head1 SYNOPSIS
+
+The following example creates a new job and then executes it.
+
+ my $job = DBIx::Class::Schema->new(runs => sub { print 'did job'});
+ $job->execute; # 'did job' -> STDOUT
+
+=head1 DESCRIPTION
+
+This is a base class intended to hold code that get's executed by the schema
+according to rules known to the schema. Subclassers may wish to override how
+the L</runs> attribute is defined in order to create custom behavior.
+
+=head1 SUBTYPES
+
+This package defines the following subtypes
+
+=head2 Handler
+
+A coderef based type that the job runs when L</execute> is called.
+
+=cut
+
+subtype 'DBIx::Class::Schema::Job::Handler'
+ => as 'CodeRef';
+
+coerce 'DBIx::Class::Schema::Job::Handler'
+ => from 'Str'
+ => via {
+ my $handler_method = $_;
+ sub {
+ my $job = shift @_;
+ my $target = shift @_;
+ $target->$handler_method($job, @_);
+ };
+ };
+
+=head1 ATTRIBUTES
+
+This package defines the following attributes.
+
+=head2 runs
+
+This is a coderef which is de-reffed by L</execute> and is passed the job object
+(ie $self), and any additional arguments passed to L</execute>
+
+=cut
+
+has 'runs' => (
+ is=>'ro',
+ isa=>'DBIx::Class::Schema::Job::Handler',
+ coerce=>1,
+ required=>1,
+);
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 execute ($schema, $query_interval)
+
+Method called by the L<DBIx::Class::Schema> when it wants a given job to run.
+
+=cut
+
+sub execute {
+ return $_[0]->runs->(@_);
+}
+
+
+=head1 AUTHORS
+
+See L<DBIx::Class> for more information regarding authors.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+
+1;
\ No newline at end of file
--- /dev/null
+package DBIx::Class::Schema::QueryInterval;
+
+use Moose;
+
+=head1 NAME
+
+DBIx::Class::Schema::Role::QueryInterval; Defines a job control interval.
+
+=head1 SYNOPSIS
+
+The following example shows how to define a job control interval and assign it
+to a particular L<DBIx::Class::Schema::Job> for a L<DBIx::Class::Schema>
+
+ my $job = DBIx::Class::Schema->new(runs => sub { print 'did job'});
+ my $interval = DBIx::Class::Schema::Interval->new(every => 10);
+
+ if($interval->matches($query_count)) {
+ print "I indentified the query count as matching";
+ }
+
+ ## $schema->isa(DBIx::Class::Schema);
+ $schema->create_and_add_at_query_intervals($interval => $job);
+
+=head1 DESCRIPTION
+
+A Query Interval defines a reoccuring period based on the query count from a
+given offset. For example, you can define a query interval of 10 queries
+with an offset of 1 query. This interval identifies query number 11, 21, 31,
+and so on.
+
+=head1 ATTRIBUTES
+
+This package defines the following attributes.
+
+=head2 every (Int)
+
+This is the 'size' of the gap identifying a query as matching a particular
+interval. Think, "I match every X queries".
+
+=cut
+
+has 'every' => (
+ is=>'ro',
+ isa=>'Int',
+ required=>1,
+);
+
+
+=head2 offset (Int)
+
+This is a number of queries from the start of all queries to offset the match
+counting mechanism. This is basically added to the L</every> attribute to
+identify a query as matching the interval we wish to define.
+
+=cut
+
+has 'offset' => (
+ is=>'ro',
+ isa=>'Int',
+ required=>1,
+ default=>0,
+);
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 matches ($query_count)
+
+Does the $query_count match the defined interval? Returns a Boolean.
+
+=cut
+
+sub matches {
+ my ($self, $query_count) = @_;
+ my $offset_count = $query_count - $self->offset;
+ return $offset_count % $self->every ? 0:1;
+}
+
+
+=head1 AUTHORS
+
+See L<DBIx::Class> for more information regarding authors.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+
+1;
\ No newline at end of file
--- /dev/null
+package DBIx::Class::Schema::Role::AtQueryInterval;
+
+use Moose::Role;
+use MooseX::AttributeHelpers;
+use DBIx::Class::Schema::Job;
+use DBIx::Class::Schema::QueryInterval;
+use DBIx::Class::Schema::AtQueryInterval;
+
+=head1 NAME
+
+DBIx::Class::Schema::Role::AtQueryInterval; Execute code at query intervals
+
+=head1 SYNOPSIS
+
+The follow will execute the 'do_something' method each and every 10 queries,
+excute a subref each 20 queries, and do both each 30 queries. This first
+example is the long, hard way.
+
+ ## ISA DBIx::Class::Schema::Job
+
+ my $job1 = $schema->create_job(
+ runs => 'do_something',
+ );
+
+ my $job2 = $schema->create_job(
+ runs => sub {warn 'queries counted'},
+ );
+
+
+ ## ISA DBIx::Class::Schema::QueryInterval
+
+ my $interval_10 = $schema->create_query_interval(every => 10);
+ my $interval_20 = $schema->create_query_interval(every => 20);
+ my $interval_30 = $schema->create_query_interval(every => 30);
+
+
+ ## USA DBIx::Class::Schema::AtQueryInterval
+
+ my $at1 = $schema->create_at_query_interval(
+ interval => $interval_10, job => $job1,
+ );
+
+ my $at2 = $schema->create_at_query_interval(
+ interval => $interval_20, job => $job2,
+ );
+
+ my $at3 = $schema->create_at_query_interval(
+ interval => $interval_30, job=>$job1,
+ );
+
+ my $at4 = $schema->create_at_query_interval(
+ interval => $interval_30, job=>$job2,
+ );
+
+ $schema->query_intervals([$1, $at2, $at3, $at4]);
+
+Or you can take the express trip (assuming you are not creating any custom
+Query Intervals, Jobs, etc.) Notice that this method allows jobs to be defined
+as an arrayref to make it easier to defined multiple jobs for a given interval.
+
+In order to perform the needed object instantiation, this class will use the
+methods 'query_interval_class', 'job_class' and 'at_query_interval_class'.
+
+ $schema->create_and_add_at_query_intervals(
+ {every => 10} => {
+ runs => 'do_something',
+ },
+ {every => 20} => {
+ runs => sub {
+ warn 'queries counted';
+ },
+ },
+ {every => 30} => [
+ {runs => 'do_something'},
+ {runs => sub{
+ warn 'queries counted';
+ }},
+ ],
+ );
+
+All the above sit in a DBIx::Class::Schema that consumes the proper roles and
+defines a function which receives three arguments:
+
+ sub do_something {
+ my ($job, $schema, $at_query_interval) = @_;
+ }
+
+=head1 DESCRIPTION
+
+Sometime you'd like to perform certain housekeeping activities at preset query
+intervals. For example, every 100 queries you want to update a reporting table
+that contains denormalized information. This role allows you to assign a
+scalar containing the name of a method in your schema class, an anonymous sub,
+or an arrayref of either to a particular interval.
+
+=head1 ATTRIBUTES
+
+This package defines the following attributes.
+
+=head2 query_interval_class
+
+The default class used to create an interval class from a hash of initializing
+information.
+
+=cut
+
+has 'query_interval_class' => (
+ is=>'ro',
+ isa=>'ClassName',
+ required=>1,
+ default=>'DBIx::Class::Schema::QueryInterval',
+ handles=> {
+ 'create_query_interval' => 'new',
+ },
+);
+
+
+=head2 job_class
+
+The default class used to create an job class from a hash of initializing
+information.
+
+=cut
+
+has 'job_class' => (
+ is=>'ro',
+ isa=>'ClassName',
+ required=>1,
+ default=>'DBIx::Class::Schema::Job',
+ handles=> {
+ 'create_job' => 'new',
+ },
+);
+
+
+=head2 at_query_interval_class
+
+The default class used to create an job class from a hash of initializing
+information.
+
+=cut
+
+has 'at_query_interval_class' => (
+ is=>'ro',
+ isa=>'ClassName',
+ required=>1,
+ default=>'DBIx::Class::Schema::AtQueryInterval',
+ handles=> {
+ 'create_at_query_interval' => 'new',
+ },
+);
+
+
+=head2 at_query_intervals
+
+This is an arrayref of L<DBIx::Class::Schema::AtQueryInterval> objects which
+holds all the jobs that need to be run at the given interval.
+
+=cut
+
+has 'at_query_intervals' => (
+ is=>'rw',
+ metaclass => 'Collection::Array',
+ auto_deref => 1,
+ isa=>'ArrayRef[DBIx::Class::Schema::AtQueryInterval]',
+ provides => {
+ push => 'add_at_query_interval',
+ },
+);
+
+
+=head1 METHODS
+
+This module defines the following methods.
+
+=head2 execute_jobs_at_query_interval ($int)
+
+Execute all the jobs which match the given interval
+
+=cut
+
+sub execute_jobs_at_query_interval {
+ my ($self, $query_count, @args) = @_;
+ my @responses;
+ foreach my $at ($self->at_query_intervals) {
+ push @responses,
+ $at->execute_if_matches($query_count, $self, @args);
+ }
+ return @responses;
+}
+
+
+=head2 create_and_add_at_query_intervals (%definitions)
+
+Uses the shortcut method shown above to quickly build a plan from a simple perl
+array of hashes.
+
+=cut
+
+sub create_and_add_at_query_intervals {
+ my ($self, @definitions) = @_;
+ while (@definitions) {
+ my $interval = $self->normalize_query_interval(shift @definitions);
+ my @jobs = $self->normalize_to_jobs(shift @definitions);
+ foreach my $job (@jobs) {
+ my $at = $self->create_at_query_interval(interval=>$interval, job=>$job);
+ $self->add_at_query_interval($at);
+ }
+ }
+}
+
+
+=head2 normalize_query_interval ($hash||$obj)
+
+Given an argument, make sure it's a L<DBIx::Class::Schema::QueryInterval>,
+coercing it if neccessary.
+
+=cut
+
+sub normalize_query_interval {
+ my ($self, $arg) = @_;
+ if(blessed $arg && $arg->isa('DBIx::Class::Schema::QueryInterval')) {
+ return $arg;
+ } else {
+ return $self->create_query_interval($arg);
+ }
+}
+
+=head2 normalize_to_jobs ($hash||$obj||$arrayref)
+
+Incoming jobs need to be normalized to an array, so that we can handle adding
+multiple jobs per interval.
+
+=cut
+
+sub normalize_to_jobs {
+ my ($self, $arg) = @_;
+ my @jobs = ref $arg eq 'ARRAY' ? @$arg : ($arg);
+ return map {$self->normalize_job($_)} @jobs;
+}
+
+
+=head2 normalize_job ($hash||$obj)
+
+Given an argument, make sure it's a L<DBIx::Class::Schema::Job>,
+coercing it if neccessary.
+
+=cut
+
+sub normalize_job {
+ my ($self, $arg) = @_;
+ if(blessed $arg && $arg->isa('DBIx::Class::Schema::Job')) {
+ return $arg;
+ } else {
+ return $self->create_job($arg);
+ }
+}
+
+
+=head1 AUTHORS
+
+See L<DBIx::Class> for more information regarding authors.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+
+1;
\ No newline at end of file
eval "use Moose";
plan $@
? ( skip_all => 'needs Moose for testing' )
- : ( tests => 11 );
+ : ( tests => 35 );
}
=head1 NAME
ok my $db_file = Path::Class::File->new(qw/t var DBIxClassNG.db/)
=> 'created a path for the test database';
+unlink $db_file;
+
ok my $schema = DBICNGTest::Schema->connect_and_setup($db_file)
=> 'Created a good Schema';
=> 'Found Dan!';
is $schema->storage->query_count, 2
- => 'Query Count is zero';
+ => 'Query Count is two';
+
+
+=head2 check at query interval
+
+Test the role for associating events with a given query interval
+
+=cut
+
+use_ok 'DBIx::Class::Schema::Role::AtQueryInterval';
+DBIx::Class::Schema::Role::AtQueryInterval->meta->apply($schema);
+
+ok my $job1 = $schema->create_job(runs=>sub { 'hello'})
+ => 'Created a job';
+
+is $job1->execute, 'hello',
+ => 'Got expected information from the job';
+
+ok my $job2 = $schema->create_job(runs=>'job_handler_echo')
+ => 'Created a job';
+
+is $job2->execute($schema, 'hello1'), 'hello1',
+ => 'Got expected information from the job';
+
+ok my $interval1 = $schema->create_query_interval(every=>10)
+ => 'Created a interval';
+
+ok $interval1->matches(10)
+ => 'correctly matched 10';
+
+ok $interval1->matches(20)
+ => 'correctly matched 20';
+
+ok !$interval1->matches(22)
+ => 'correctly didnt matched 22';
+
+ok my $interval2 = $schema->create_query_interval(every=>10, offset=>2)
+ => 'Created a interval';
+
+ok $interval2->matches(12)
+ => 'correctly matched 12';
+
+ok $interval2->matches(22)
+ => 'correctly matched 22';
+
+ok !$interval2->matches(25)
+ => 'correctly didnt matched 25';
+
+ok my $at = $schema->create_at_query_interval(interval=>$interval2, job=>$job2)
+ => 'created the at query interval object';
+
+is $at->execute_if_matches(32, $schema, 'hello2'), 'hello2'
+ => 'Got correct return';
+
+ok $schema->at_query_intervals([$at])
+ => 'added job to run at a given interval';
+
+is_deeply [$schema->execute_jobs_at_query_interval(42, 'hello4')], ['hello4']
+ => 'got expected job return value';
+
+=head2 create jobs via express method
+
+Using the express method, build a bunch of jobs
+
+=cut
+
+ok my @ats = $schema->create_and_add_at_query_intervals(
+
+ {every => 10} => {
+ runs => sub {10},
+ },
+ {every => 20} => {
+ runs => sub {20},
+ },
+ {every => 30} => {
+ runs => sub {30},
+ },
+ {every => 101} => [
+ {runs => sub {101.1}},
+ {runs => sub {101.2}},
+ ],
+
+) => 'created express method at query intervals';
+
+
+is_deeply [$schema->execute_jobs_at_query_interval(10)], [10]
+ => 'Got Expected return for 10';
+
+is_deeply [$schema->execute_jobs_at_query_interval(12, 'hello5')], ['hello5']
+ => 'Got Expected return for 12';
+
+is_deeply [$schema->execute_jobs_at_query_interval(20)], [10,20]
+ => 'Got Expected return for 20';
+
+is_deeply [$schema->execute_jobs_at_query_interval(30)], [10,30]
+ => 'Got Expected return for 30';
+
+is_deeply [$schema->execute_jobs_at_query_interval(60)], [10,20,30]
+ => 'Got Expected return for 60';
+
+is_deeply [$schema->execute_jobs_at_query_interval(101)], [101.1,101.2]
+ => 'Got Expected return for 101';
=head2 cleanup
}
+=head2 job_handler_echo
+
+This is a method to test the job handler role.
+
+=cut
+
+sub job_handler_echo {
+ my ($schema, $job, $alert) = @_;
+ return $alert;
+}
+
+
=head1 AUTHORS
See L<DBIx::Class> for more information regarding authors.
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff