From: John Napiorkowski Date: Tue, 22 Apr 2008 19:18:08 +0000 (+0000) Subject: added role for the at query interval run job system X-Git-Tag: v0.08240~479 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=25e4a0c430b828cc45546506158e9443eb922cf1;p=dbsrgits%2FDBIx-Class.git added role for the at query interval run job system --- diff --git a/lib/DBIx/Class/Schema/AtQueryInterval.pm b/lib/DBIx/Class/Schema/AtQueryInterval.pm new file mode 100644 index 0000000..ae1ba69 --- /dev/null +++ b/lib/DBIx/Class/Schema/AtQueryInterval.pm @@ -0,0 +1,91 @@ +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 for a L + + 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 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 diff --git a/lib/DBIx/Class/Schema/Job.pm b/lib/DBIx/Class/Schema/Job.pm new file mode 100644 index 0000000..4e11f25 --- /dev/null +++ b/lib/DBIx/Class/Schema/Job.pm @@ -0,0 +1,92 @@ +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 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 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 and is passed the job object +(ie $self), and any additional arguments passed to L + +=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 when it wants a given job to run. + +=cut + +sub execute { + return $_[0]->runs->(@_); +} + + +=head1 AUTHORS + +See L 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 diff --git a/lib/DBIx/Class/Schema/QueryInterval.pm b/lib/DBIx/Class/Schema/QueryInterval.pm new file mode 100644 index 0000000..63114c5 --- /dev/null +++ b/lib/DBIx/Class/Schema/QueryInterval.pm @@ -0,0 +1,93 @@ +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 for a L + + 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 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 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 diff --git a/lib/DBIx/Class/Schema/Role/AtQueryInterval.pm b/lib/DBIx/Class/Schema/Role/AtQueryInterval.pm new file mode 100644 index 0000000..c21b808 --- /dev/null +++ b/lib/DBIx/Class/Schema/Role/AtQueryInterval.pm @@ -0,0 +1,271 @@ +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 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, +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, +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 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 diff --git a/t/99schema_roles.t b/t/99schema_roles.t index 770c4ab..6b0b0fc 100644 --- a/t/99schema_roles.t +++ b/t/99schema_roles.t @@ -7,7 +7,7 @@ BEGIN { eval "use Moose"; plan $@ ? ( skip_all => 'needs Moose for testing' ) - : ( tests => 11 ); + : ( tests => 35 ); } =head1 NAME @@ -31,6 +31,8 @@ use_ok 'DBICNGTest::Schema'; 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'; @@ -63,7 +65,108 @@ is $schema->resultset('Person')->find(2)->name, 'dan' => '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 diff --git a/t/lib/DBICNGTest/Schema.pm b/t/lib/DBICNGTest/Schema.pm index 15ec398..57d2d50 100644 --- a/t/lib/DBICNGTest/Schema.pm +++ b/t/lib/DBICNGTest/Schema.pm @@ -136,6 +136,18 @@ sub initial_populate { } +=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 for more information regarding authors.