added role for the at query interval run job system
John Napiorkowski [Tue, 22 Apr 2008 19:18:08 +0000 (19:18 +0000)]
lib/DBIx/Class/Schema/AtQueryInterval.pm [new file with mode: 0644]
lib/DBIx/Class/Schema/Job.pm [new file with mode: 0644]
lib/DBIx/Class/Schema/QueryInterval.pm [new file with mode: 0644]
lib/DBIx/Class/Schema/Role/AtQueryInterval.pm [new file with mode: 0644]
t/99schema_roles.t
t/lib/DBICNGTest/Schema.pm

diff --git a/lib/DBIx/Class/Schema/AtQueryInterval.pm b/lib/DBIx/Class/Schema/AtQueryInterval.pm
new file mode 100644 (file)
index 0000000..ae1ba69
--- /dev/null
@@ -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<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
diff --git a/lib/DBIx/Class/Schema/Job.pm b/lib/DBIx/Class/Schema/Job.pm
new file mode 100644 (file)
index 0000000..4e11f25
--- /dev/null
@@ -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</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
diff --git a/lib/DBIx/Class/Schema/QueryInterval.pm b/lib/DBIx/Class/Schema/QueryInterval.pm
new file mode 100644 (file)
index 0000000..63114c5
--- /dev/null
@@ -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<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
diff --git a/lib/DBIx/Class/Schema/Role/AtQueryInterval.pm b/lib/DBIx/Class/Schema/Role/AtQueryInterval.pm
new file mode 100644 (file)
index 0000000..c21b808
--- /dev/null
@@ -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<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
index 770c4ab..6b0b0fc 100644 (file)
@@ -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
index 15ec398..57d2d50 100644 (file)
@@ -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<DBIx::Class> for more information regarding authors.