From: John Napiorkowski Date: Mon, 5 May 2008 18:33:57 +0000 (+0000) Subject: removed query count stuff from trunk so we can play with this on a branch instead X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b0ca666f56fbdac8c0b4a08a292eed26ba8a21be;p=dbsrgits%2FDBIx-Class-Historic.git removed query count stuff from trunk so we can play with this on a branch instead --- diff --git a/lib/DBIx/Class/Schema/AtQueryInterval.pm b/lib/DBIx/Class/Schema/AtQueryInterval.pm deleted file mode 100644 index ae1ba69..0000000 --- a/lib/DBIx/Class/Schema/AtQueryInterval.pm +++ /dev/null @@ -1,91 +0,0 @@ -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/QueryInterval.pm b/lib/DBIx/Class/Schema/QueryInterval.pm deleted file mode 100644 index 63114c5..0000000 --- a/lib/DBIx/Class/Schema/QueryInterval.pm +++ /dev/null @@ -1,93 +0,0 @@ -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 deleted file mode 100644 index 5c47772..0000000 --- a/lib/DBIx/Class/Schema/Role/AtQueryInterval.pm +++ /dev/null @@ -1,272 +0,0 @@ -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 deleted file mode 100644 index c3b25c9..0000000 --- a/t/99schema_roles.t +++ /dev/null @@ -1,192 +0,0 @@ -use strict; -use warnings; -use lib qw(t/lib); -use Test::More; - -BEGIN { - eval "use Moose"; - plan $@ - ? ( skip_all => 'needs Moose for testing' ) - : ( tests => 35 ); -} - -=head1 NAME - -DBICNGTest::Schema::ResultSet:Person; Example Resultset - -=head1 DESCRIPTION - -Tests for the various Schema roles you can either use or apply - -=head1 TESTS - -=head2 initialize database - -create a schema and setup - -=cut - -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'; - -is ref $schema->source('Person'), 'DBIx::Class::ResultSource::Table' - => 'Found Expected Person Source'; - -is $schema->resultset('Person')->count, 5 - => 'Got the correct number of people'; - -is $schema->resultset('Gender')->count, 3 - => 'Got the correct number of genders'; - - -=head2 check query counter - -Test the query counter role - -=cut - -use_ok 'DBIx::Class::Storage::DBI::Role::QueryCounter'; -DBIx::Class::Storage::DBI::Role::QueryCounter->meta->apply($schema->storage); - -is $schema->storage->query_count, 0 - => 'Query Count is zero'; - -is $schema->resultset('Person')->find(1)->name, 'john' - => 'Found John!'; - -is $schema->resultset('Person')->find(2)->name, 'dan' - => 'Found Dan!'; - -is $schema->storage->query_count, 2 - => '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 an 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 an 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 - -Cleanup after ourselves - -=cut - -unlink $db_file; - - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut \ No newline at end of file