TheSchwartz-1.12000755000764000764 012506132345 13611 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/CHANGES000444000764000764 404612506132345 14745 0ustar00jfearnjfearn0000000000001.12 Mon Mar 30 2015 - Fix replace_job hanging & postgresql issues. RT #65712 - Add strict_remove_ability to prevent auto resetting of abilities. - Stricter job check. https://github.com/jfearn/TheSchwartz/pull/1 - Add accessor methods for strict_remove_ability. - Add debug message to mark_database_as_dead. RT #102510 1.11 Mon Nov 03 2014 - Move from Make to Module::Build - Remove inc & autobuild - Add perltidyrc and run over all perl files. - Add perlcritic test & fix errors - Add Test::Spelling and fix all spelling errors in POD. RT #89165 - Reorder jobs when prioritize is set. RT #99075 - Fix wrong return precedence. RT #87222 - Fix get_server_time for Oracle. # RT #58049 - Support Data::ObjectDriver->get_dbh. RT #50022 - Use sort by jobid on selects. RT #34843 - Added floor methods to limit priortity job selection. RT #50842 - Add batch_size methods to expose FIND_JOB_BATCH_SIZE. RT #72815 - Add run_after param to decline. RT #60797 - Add jobid param to list_jobs. 1.10 (2010-03-15) - Add $job->declined method for workers to be able to decline handling a job at this time. - Added $client->grab_and_work_on($handle) to securely work on a job you know the handle of. Yann Kerherve (yannk@cpan.org) - Fixed docs and tests (miyagawa, athomason, simonw) 1.07 (2008-07-31) - bchoate: Updates to support optional prioritization of jobs. - ykerherve: Croak with a nice message id a driver cannot be found for a handle 1.06 (2007-09-07) - Code to allow a 'top' like view of runnin schwartz workers. - include postgres schema in docs. from Michael Zedeler Currently not tested in regression tests, though, so not "officially" supported yet. - start of work on gearman-based schwartz server. 1.05 - Set TheSchwartz::Job::insert_time to current server time when inserting a new job. 1.04 (2007-05-22) - no code changes, just packaging/dep/test fixes, as pointed out by Dan Rench 1.03 - first packaged release, now that all SixApart products have been using this heavily for quite some time. it's overdue. TheSchwartz-1.12/README.md000444000764000764 451012506132345 15225 0ustar00jfearnjfearn000000000000TheSchwartz ============= **TheSchwartz** is a reliable job queue system. Your application can put jobs into the system, and your worker processes can pull jobs from the queue atomically to perform. Failed jobs can be left in the queue to retry later. **Abilities** specify what jobs a worker process can perform. Abilities are the names of *TheSchwartz::Worker* subclasses, as in the synopsis: the *MyWorker* class name is used to specify that the worker script can perform the job. When using the *TheSchwartz* client's *work* functions, the class-ability duality is used to automatically dispatch to the proper class to do the actual work. TheSchwartz clients will also prefer to do jobs for unused abilities before reusing a particular ability, to avoid exhausting the supply of one kind of job while jobs of other types stack up. Some jobs with high set-up times can be performed more efficiently if a group of related jobs are performed together. TheSchwartz offers a facility to **coalesce** jobs into groups, which a properly constructed worker can find and perform at once. For example, if your worker were delivering email, you might store the domain name from the recipient's address as the coalescing value. The worker that grabs that job could then batch deliver all the mail for that domain once it connects to that domain's mail server. INSTALLATION ------------ Just follow the usual procedure: perl Build.PL ./Build ./Build test ./Build install If you want to install a private copy of this module-suite in your home directory, then you should try to produce the initial Makefile with something like this command: perl Build.PL PREFIX=~/perl See perldoc perlmodinstall for more information on installing modules. SUPPORT ------- Just follow the usual procedure: perl Build.PL ./Build Questions, bug reports, useful code bits, and suggestions for this module should just be sent to JFEARN@cpan.org or open a ticket in the [CPAN RT](https://rt.cpan.org//Dist/Display.html?Queue=TheSchwartz) AVAILABILITY ------- The latest version of this module is available from the Comprehensive Perl Archive Network (CPAN). Visit (http://www.perl.com/CPAN/) to find a CPAN site near you. The source is available on github (https://github.com/jfearn/TheSchwartz), patches should be sent as pull requests against this repository. TheSchwartz-1.12/perltidyrc000444000764000764 116612506132345 16056 0ustar00jfearnjfearn000000000000-l=78 # Max line width is 78 cols -i=4 # Indent level is 4 cols -ci=4 # Continuation indent is 4 cols -st # Output to STDOUT -se # Errors to STDERR -vt=2 # Maximal vertical tightness -cti=0 # No extra indentation for closing brackets -pt=1 # Medium parenthesis tightness -bt=1 # Medium brace tightness -sbt=1 # Medium square bracket tightness -bbt=1 # Medium block brace tightness -nsfs # No space before semicolons -nolq # Don't outdent long quoted strings -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" # Break before all operators TheSchwartz-1.12/MANIFEST000444000764000764 206412506132345 15101 0ustar00jfearnjfearn000000000000bin/schwartzmon Build.PL CHANGES doc/http-mappings.txt doc/notes.txt doc/schema-postgres.sql doc/schema.sql extras/check_schwartz extras/perl-TheSchwartz.spec extras/thetop lib/TheSchwartz.pm lib/TheSchwartz/Error.pm lib/TheSchwartz/ExitStatus.pm lib/TheSchwartz/FuncMap.pm lib/TheSchwartz/Job.pm lib/TheSchwartz/JobHandle.pm lib/TheSchwartz/Worker.pm MANIFEST This list of files MANIFEST.SKIP META.yml perltidyrc README.md server/bin/schwartzd server/doc/deps.txt server/doc/protocol.txt server/t/00-start-ping.t server/t/01-insert-and-get.t server/t/lib/testlib.pl t/05-job-ctor.t t/api.t t/cleanup.t t/client-time-unsync.t t/coalesce.t t/dead-dbs.t t/declined.t t/empty-db.t t/evenly-distribute.t t/fail-working-multiple.t t/funcid.t t/grab-race.t t/grab_and_work_on.t t/high-funcid-starvation.t t/insert-and-do.t t/lib/db-common.pl t/parallel-workers.t t/priority.t t/replace-abort.t t/replace-with.t t/retry-delay.t t/schema-sqlite.sql t/scoreboard.t t/server-time.t t/unique.t t/work-before-funcids-exist.t xt/perlcritic.t xt/pod-coverage.t xt/pod-spelling.t xt/pod.t TheSchwartz-1.12/META.yml000444000764000764 170112506132345 15216 0ustar00jfearnjfearn000000000000--- abstract: 'reliable job queue' author: - 'Six Apart ' build_requires: Data::ObjectDriver: 0.04 Digest::MD5: 0 Module::Build: 0 Storable: 0 Test::More: 0 configure_requires: Module::Build: 0 generated_by: 'Module::Build version 0.3624' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: TheSchwartz provides: TheSchwartz: file: lib/TheSchwartz.pm version: 1.12 TheSchwartz::Error: file: lib/TheSchwartz/Error.pm TheSchwartz::ExitStatus: file: lib/TheSchwartz/ExitStatus.pm TheSchwartz::FuncMap: file: lib/TheSchwartz/FuncMap.pm TheSchwartz::Job: file: lib/TheSchwartz/Job.pm TheSchwartz::JobHandle: file: lib/TheSchwartz/JobHandle.pm TheSchwartz::Worker: file: lib/TheSchwartz/Worker.pm requires: Data::ObjectDriver: 0.04 Digest::MD5: 0 Storable: 0 resources: license: http://dev.perl.org/licenses/ version: 1.12 TheSchwartz-1.12/MANIFEST.SKIP000444000764000764 117612506132345 15651 0ustar00jfearnjfearn000000000000MANIFEST.bak ts1.db ts2.db build-stamp install-stamp .shipit svn-commit.tmp # Avoid version control files. \bRCS\b \bCVS\b ,v$ \B\.svn\b \B\.git\b \B\.gitignore\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib$ # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ ^Notes.md$ \bTheSchwartz-[\d\.\_]+ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.git/ \cover_db/ ^MYMETA.*$ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b \bcovered\b # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ \.swp$ \.swo$ TheSchwartz-1.12/Build.PL000444000764000764 241512506132345 15244 0ustar00jfearnjfearn000000000000use 5.008; use strict; use warnings; use Module::Build; my $class = Module::Build->subclass( class => 'My::Builder', code => q{ sub ACTION_authortest { my ($self) = @_; $self->test_files( qw< xt > ); $self->recursive_test_files(1); $self->depends_on('test'); return; } sub ACTION_distdir { my ($self) = @_; $self->depends_on('authortest'); return $self->SUPER::ACTION_distdir(); } } ); my $builder = $class->new( module_name => 'TheSchwartz', license => 'perl', dist_author => 'Six Apart ', dist_version_from => 'lib/TheSchwartz.pm', configure_requires => { 'Module::Build' => 0 }, build_requires => { 'Module::Build' => 0, 'Test::More' => 0, 'Data::ObjectDriver' => 0.04, 'Digest::MD5' => 0, 'Storable' => 0, }, requires => { 'Data::ObjectDriver' => 0.04, 'Digest::MD5' => 0, 'Storable' => 0, }, add_to_cleanup => [ 'TheSchwartz-*', 'tmp', 'blib', '*.bak', 'META.*' ], script_files => ['bin/schwartzmon'], ); $builder->create_build_script(); TheSchwartz-1.12/bin000755000764000764 012506132345 14361 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/bin/schwartzmon000555000764000764 1744712506132345 17060 0ustar00jfearnjfearn000000000000#!/usr/bin/perl use strict; use DBI; use Getopt::Long; my $dbname = "schwartz"; my $user = "root"; my $pass = ""; my $job = ""; my $max_age = 0; my $max_count = 0; =head1 NAME schwartzmon - monitor The Schwartz =head1 USAGE Type schwartzmon --help to get full usage. =cut sub usage { die < [OPTS] Possible commands: queues View past-due job queue depths. (default cmd) errors View errors. Global options: --job= Only look at one specific job name. Else all are considered. --user= Connect to the database as this user --pass= Connect to the database with this password --database= Connect to this database --dsn= Connect to the database using this DSN Options for 'queues' command: --maxage= Don't complain if age of overdue job queue is <= 'n' --maxcount= Don't complain if depth of overdue job queue is <= 'n' Options for 'errors' command: --follow | -f Like 'tail -f' for tracking the error log --last=n Show last 'n' errors from log --inlast=n Show errors in last 'n' seconds Verbosity: if no alerts, nothing is printed, and exit status is 0. Exit status: 0 if no alerts, non-zero if there are alerts, in which case the alerts are printed. USAGE } my $opt_help = 0; my ( $opt_follow, $opt_last, $opt_inlast, $opt_func, $dsn ); usage() unless GetOptions( "job=s" => \$job, "maxage=i" => \$max_age, "maxcount=i" => \$max_count, "help" => \$opt_help, "follow|f" => \$opt_follow, "last=i" => \$opt_last, "inlast=i" => \$opt_inlast, "user=s" => \$user, "pass=s" => \$pass, "dsn=s" => \$dsn, "database=s" => \$dbname, "func=s" => \$opt_func, ); usage() if $opt_help; my $cmd = shift || "queues"; usage() unless $cmd =~ /^queues|errors$/; my $dbset = DBSet->new; $dsn ||= "DBI:mysql:$dbname"; $dbset->add( DBHandle->new( { dsn => $dsn, user => $user, pass => $pass } ) ); if ( $cmd eq "queues" ) { queues($dbset); } if ( $cmd eq "errors" ) { errors($dbset); } exit 0; ################# sub queues { my $dbs = shift; my $some_alert = 0; $dbs->foreach( sub { my $db = shift; my $dbh = $db->dbh or next; my $funcmap = $dbh->selectall_hashref( "SELECT funcid, funcname FROM funcmap", "funcid" ); foreach my $funcid ( sort { $funcmap->{$a}{funcname} cmp $funcmap->{$b}{funcname} } keys %$funcmap ) { my $funcname = $funcmap->{$funcid}{funcname}; next if $job && $funcname ne $job; my $now = time(); my $inf = $dbh->selectrow_hashref( "SELECT COUNT(*) as 'ct', MIN(run_after) 'oldest' FROM job WHERE funcid=? AND run_after <= $now", undef, $funcid ); my $behind = $inf->{ct} ? ( $now - $inf->{oldest} ) : 0; # okay by default, then we apply rules: my $okay = 1; $okay = 0 if $behind > $max_age; $okay = 0 if $inf->{ct} > $max_count; next if $okay; $some_alert = 1; print "$funcname\n"; print " outstanding: $inf->{ct}\n"; print " behind_secs: $behind\n"; } } ); exit( $some_alert ? 1 : 0 ); } sub errors { my $dbs = shift; if ($opt_follow) { follow_errors($dbs); } $opt_last = 100 unless $opt_last || $opt_inlast; my @rows; $dbs->foreach( sub { my $db = shift; my $dbh = $db->dbh or next; my $extra_where = ''; if ($opt_func) { my $funcid = $db->funcid_of_func($opt_func) || 0; $extra_where = "AND funcid=$funcid"; } my $sql; if ($opt_last) { $sql = "SELECT error_time, jobid, message FROM error WHERE 1=1 $extra_where " . "ORDER BY error_time DESC LIMIT $opt_last"; } elsif ($opt_inlast) { my $since = time() - $opt_inlast; $sql = "SELECT error_time, jobid, message FROM error WHERE error_time >= $since $extra_where " . "ORDER BY error_time LIMIT 50000"; } my $sth = $dbh->prepare($sql); $sth->execute; push @rows, $_ while $_ = $sth->fetchrow_hashref; } ); @rows = sort { $a->{error_time} <=> $b->{error_time} } @rows; if ( $opt_last && @rows > $opt_last ) { shift @rows while @rows > $opt_last; } foreach my $r (@rows) { print_error($r); } } sub follow_errors { my $dbs = shift; while (1) { $dbs->foreach( sub { my $db = shift; my $dbh = $db->dbh or next; my $notes = $db->notes; my $lastmax = $notes->{lastmax} || time(); my $seen = $notes->{seen} ||= {}; my $extra_where = ''; if ($opt_func) { my $funcid = $db->funcid_of_func($opt_func) || 0; $extra_where = "AND funcid=$funcid"; } my $sth = $dbh->prepare( "SELECT error_time, jobid, message FROM error WHERE error_time >= ? $extra_where ORDER BY error_time" ); $sth->execute($lastmax); my @errors; push @errors, $_ while $_ = $sth->fetchrow_hashref; my $newmax = $lastmax; foreach my $r (@errors) { my $sig = join( ",", map { $_, $r->{$_} } sort keys %$r ); next if $seen->{$sig}; $seen->{$sig} = $r->{error_time}; print_error($r); $newmax = $r->{error_time} if $r->{error_time} > $newmax; } $notes->{lastmax} = $newmax; foreach my $sig ( keys %$seen ) { my $time = $seen->{$sig}; delete $seen->{$sig} if $time < $newmax; } } ); sleep 1; } } sub print_error { my $r = shift; my $msg = $r->{message}; $msg =~ s/\s+$//g; printf scalar( localtime( $r->{error_time} ) ) . " [$r->{jobid}]: $msg\n"; } package DBSet; sub new { my ( $this, $args ) = @_; my $class = ref($this) || $this; return bless {}, $class; } sub add { my ( $self, $db ) = @_; push @$self, $db; } sub foreach { my ( $self, $cb ) = @_; foreach my $dbh (@$self) { $cb->($dbh); } } package DBHandle; sub new { my ( $class, $dbinf ) = @_; return bless $dbinf, $class; } sub notes { my $self = shift; return $self->{notes} ||= {}; } # returns DBI handle sub dbh { my $self = shift; return $self->{_dbh} ||= DBI->connect( $self->{dsn}, $self->{user}, $self->{pass} ) } sub funcid_of_func { my ( $self, $func ) = @_; my $notes = $self->notes; return $notes->{"funcid_of_$func"} if exists $notes->{"funcid_of_$func"}; my $dbh = $self->dbh; return $notes->{"funcid_of_$func"} = $dbh->selectrow_array( "SELECT funcid FROM funcmap WHERE funcname=?", undef, $func ); } =head1 COPYRIGHT, LICENSE & WARRANTY This software is Copyright 2007, 2008 Six Apart Ltd, cpan@sixapart.com. All rights reserved. TheSchwartz is free software; you may redistribute it and/or modify it under the same terms as Perl itself. TheSchwartz comes with no warranty of any kind. =cut TheSchwartz-1.12/t000755000764000764 012506132345 14054 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/t/replace-abort.t000444000764000764 653212506132345 17124 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 13; run_tests_pgsql(13, sub { my $client1 = test_client(dbs => ['ts1']); my $client2 = test_client(dbs => ['ts1']); my $driver = $client1->driver_for( ($client1->shuffled_databases)[0] ); my $dbh = $driver->rw_handle; is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey IN ('1','2','3','4','5');"), 0, 'namespace empty', ); $client1->can_do('Test::Job::Completed'); $client2->can_do('Test::Job::Replace'); # job 1 $client1->insert(TheSchwartz::Job->new( funcname => 'Test::Job::Completed', uniqkey => 1, )); is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '1';"), 1, 'Job 1 gepostet', ); # Job 1 $client1->work_once; is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '1';"), 0, 'Job 1 abgearbeitet', ); # Job 2 $client2->insert(TheSchwartz::Job->new( funcname => 'Test::Job::Replace', uniqkey => 2, arg => 3, )); is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '2';"), 1, 'Job 2 gepostet', ); # Job 2 $client2->work_once; is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '2';"), 0, 'Job 2 abgearbeitet', ); is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '3';"), 1, 'Job 2 ersetzt durch Job 3', ); # Job 4 $client2->insert(TheSchwartz::Job->new( funcname => 'Test::Job::Replace', uniqkey => 4, arg => 3, )); is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '4';"), 1, 'Job 4 gepostet', ); # Job 4 $client2->work_once; is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '4';"), 1, 'Job 4 abgebrochen', ); is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '3';"), 1, 'Job 4 nicht durch Job 3 ersetzt', ); # Job 3 $client1->work_once; is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '3';"), 0, 'Job 3 abgearbeitet', ); # cleanup job.run_after & retry_at, so we dont have to wait $dbh->do("UPDATE job SET run_after = 0 WHERE uniqkey = '4';"); $client2->{retry_at} = {}; # Job 4 $client2->work_once; is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '4';"), 0, 'Job 4 abgearbeitet', ); is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '3';"), 1, 'Job 4 ersetzt durch Job 3', ); # Job 5 $client1->work_once; is( query_sql($dbh, "SELECT COUNT(*) FROM job WHERE uniqkey = '3';"), 0, 'Job 3 erneut abgearbeitet', ); }); # TheSchwartz Worker/Jobs package Test::Job::Completed; use base qw(TheSchwartz::Worker); sub work { my ($client, $job) = @_; $job->completed; } sub max_retries { 10; } package Test::Job::Replace; use base qw(TheSchwartz::Worker); sub work { my ($client, $job) = @_; $job->replace_with(TheSchwartz::Job->new( funcname => 'Test::Job::Completed', uniqkey => $job->arg, )); } sub max_retries { 10; } TheSchwartz-1.12/t/cleanup.t000444000764000764 526012506132345 16030 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 30; # for testing: $TheSchwartz::T_EXITSTATUS_CLEAN_THRES = 1; # delete 100% of the time, not 10% of the time $TheSchwartz::T_ERRORS_MAX_AGE = 2; # keep errors for 3 seconds, not 1 week run_tests( 10, sub { my $client = test_client( dbs => ['ts1'] ); my $dbh = DBI->connect( dsn_for("ts1"), $ENV{TS_DB_USER}, $ENV{TS_DB_PASS} ); $client->can_do("Worker::Fail"); $client->can_do("Worker::Complete"); # insert a job which will fail, then succeed. { my $handle = $client->insert("Worker::Fail"); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; $client->work_until_done; is( $handle->failures, 1, "job has failed once" ); my $min; my $rows = $dbh->selectrow_array("SELECT COUNT(*) FROM exitstatus"); is( $rows, 1, "has 1 exitstatus row" ); ok( $client->insert("Worker::Complete"), "inserting to-pass job" ); $client->work_until_done; $rows = $dbh->selectrow_array("SELECT COUNT(*) FROM exitstatus"); is( $rows, 2, "has 2 exitstatus rows" ); ( $rows, $min ) = $dbh->selectrow_array( "SELECT COUNT(*), MIN(jobid) FROM error"); is( $rows, 1, "has 1 error rows" ); is( $min, 1, "error jobid is the old one" ); # wait for exit status to pass sleep 3; # now make another job fail to cleanup some errors $handle = $client->insert("Worker::Fail"); $client->work_until_done; $rows = $dbh->selectrow_array("SELECT COUNT(*) FROM exitstatus"); is( $rows, 1, "1 exit status row now" ); ( $rows, $min ) = $dbh->selectrow_array( "SELECT COUNT(*), MIN(jobid) FROM error"); is( $rows, 1, "has 1 error row still" ); is( $min, 3, "error jobid is only the new one" ); } teardown_dbs('ts1'); } ); ############################################################################ package Worker::Fail; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->failed("an error message"); return; } sub keep_exit_status_for { 1 } # keep exit status for 20 seconds after on_complete sub max_retries {0} sub retry_delay {1} # --------------- package Worker::Complete; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->completed; return; } sub keep_exit_status_for {1} TheSchwartz-1.12/t/server-time.t000444000764000764 72212506132345 16621 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 6; run_tests( 2, sub { my $client = test_client( dbs => ['ts1'] ); my $driver = $client->driver_for( ( $client->shuffled_databases )[0] ); isa_ok $driver, 'Data::ObjectDriver::Driver::DBI'; cmp_ok $client->get_server_time($driver), '>', 0, 'got server time'; teardown_dbs('ts1'); } ); TheSchwartz-1.12/t/fail-working-multiple.t000444000764000764 311712506132345 20622 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 12; run_tests( 4, sub { my $client = test_client( dbs => ['ts1'] ); my $job2h; for ( 1 .. 2 ) { my $job = TheSchwartz::Job->new( funcname => 'Worker::CoalesceTest', arg => { n => $_ }, coalesce => "a$_", ); my $h = $client->insert($job); $job2h = $h if $_ == 2; ok( $h, "inserted $h" ); } $client->reset_abilities; $client->can_do("Worker::CoalesceTest"); my $job = $client->find_job_with_coalescing_prefix( "Worker::CoalesceTest", "a1" ); Worker::CoalesceTest->work_safely($job); # this one should have succeeded: is( $job->handle->failures, 0, "no failures on first job" ); # the second one should have failures: is( $job2h->failures, 1, "1 failure on second job" ); teardown_dbs('ts1'); } ); ############################################################################ package Worker::CoalesceTest; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->completed; my $arg = $job->arg; my $job2 = $job->handle->client->find_job_with_coalescing_prefix( "Worker::CoalesceTest", "a2" ); $job2->set_as_current; die "Failed working on job2\n"; } sub keep_exit_status_for { 20 } # keep exit status for 20 seconds after on_complete sub grab_for {10} sub max_retries {1} sub retry_delay {10} TheSchwartz-1.12/t/high-funcid-starvation.t000444000764000764 305412506132345 20755 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 12; run_tests( 4, sub { my $client = test_client( dbs => ['ts1'] ); my $n_jobs = 10; for ( 1 .. $n_jobs ) { $client->insert("Worker::Job1") or die; $client->insert("Worker::Job2") or die; } my $db1 = DBI->connect( dsn_for("ts1"), $ENV{TS_DB_USER}, $ENV{TS_DB_PASS} ); die unless $db1; my $jobs1 = $db1->selectrow_array( "SELECT COUNT(*) FROM job WHERE funcid=1"); is( $jobs1, $n_jobs, "have $n_jobs funcid 1s" ); my $jobs2 = $db1->selectrow_array( "SELECT COUNT(*) FROM job WHERE funcid=2"); is( $jobs2, $n_jobs, "have $n_jobs funcid 2s" ); my $do_jobs = int( $n_jobs / 2 ); $client->can_do("Worker::Job1"); $client->can_do("Worker::Job2"); for ( 1 .. ( $do_jobs * 2 ) ) { $client->work_once or die "Couldn't find job to do"; } my $jobs1b = $db1->selectrow_array( "SELECT COUNT(*) FROM job WHERE funcid=1"); is( $jobs1b, $n_jobs - $do_jobs, "have half funcid 1s" ); my $jobs2b = $db1->selectrow_array( "SELECT COUNT(*) FROM job WHERE funcid=2"); is( $jobs2b, $n_jobs - $do_jobs, "have half funcid 2s" ); } ); package Worker::Job1; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->completed; } package Worker::Job2; use base 'Worker::Job1'; TheSchwartz-1.12/t/schema-sqlite.sql000444000764000764 212712506132345 17473 0ustar00jfearnjfearn000000000000CREATE TABLE funcmap ( funcid INTEGER PRIMARY KEY AUTOINCREMENT, funcname VARCHAR(255) NOT NULL, UNIQUE(funcname) ); CREATE TABLE job ( jobid INTEGER PRIMARY KEY AUTOINCREMENT, funcid INTEGER UNSIGNED NOT NULL, arg MEDIUMBLOB, uniqkey VARCHAR(255) NULL, insert_time INTEGER UNSIGNED, run_after INTEGER UNSIGNED NOT NULL, grabbed_until INTEGER UNSIGNED NOT NULL, priority SMALLINT UNSIGNED, coalesce VARCHAR(255), UNIQUE(funcid,uniqkey) ); CREATE TABLE error ( error_time INTEGER UNSIGNED NOT NULL, jobid INTEGER NOT NULL, message VARCHAR(255) NOT NULL, funcid INT UNSIGNED NOT NULL DEFAULT 0 ); CREATE TABLE exitstatus ( jobid INTEGER PRIMARY KEY NOT NULL, funcid INT UNSIGNED NOT NULL DEFAULT 0, status SMALLINT UNSIGNED, completion_time INTEGER UNSIGNED, delete_after INTEGER UNSIGNED ); TheSchwartz-1.12/t/empty-db.t000444000764000764 163012506132345 16117 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 9; run_tests( 3, sub { teardown_dbs("tempty1"); my $client = TheSchwartz->new( databases => [ { dsn => dsn_for('tempty1'), user => $ENV{TS_DB_USER}, pass => $ENV{TS_DB_PASS}, }, ] ); # insert a job { my $handle; $handle = $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ); ok( !$handle, "can't insert into empty database" ); $handle = $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ); ok( !$handle, "still can't insert into empty database" ); } ok( 1, "test finishes" ); teardown_dbs("tempty1"); } ); TheSchwartz-1.12/t/priority.t000444000764000764 1067312506132345 16306 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => ( ( 31 * 3 ) + ( 16 * 3 ) + ( 12 * 3 ) ); our $record_expected; our $testnum = 0; our $floor = 3; $TheSchwartz::FIND_JOB_BATCH_SIZE = 1; run_tests( 59, sub { my $client = test_client( dbs => ['ts1'] ); # Define that we want to use priority selection # limit batch size to 1 so we always process jobs in # priority order $client->set_prioritize(1); for ( 1 .. 10 ) { # Postgres uses ORDER BY priority NULLS FIRST when DESC is used my $job = TheSchwartz::Job->new( funcname => 'Worker::PriorityTest', arg => { num => $_ }, ( !$ENV{USE_PGSQL} && $_ == 1 ? () : ( priority => $_ ) ), ); my $h = $client->insert($job); ok( $h, "inserted job (priority $_)" ); } $client->reset_abilities; $client->can_do("Worker::PriorityTest"); Worker::PriorityTest->set_client($client); for ( 1 .. 10 ) { # Postgres uses ORDER BY priority NULLS FIRST when DESC is used $record_expected = !$ENV{USE_PGSQL} && 11 - $_ == 1 ? undef : 11 - $_; my $rv = eval { $client->work_once; }; ok( $rv, "did stuff" ); } my $rv = eval { $client->work_once; }; ok( !$rv, "nothing to do now" ); teardown_dbs('ts1'); # test we get in jobid order for equal priority RT #99075 $testnum = 1; my $client2 = test_client( dbs => ['ts2'] ); $client2->reset_abilities; $client2->can_do("Worker::PriorityTest"); Worker::PriorityTest->set_client($client2); # Define that we want to use priority selection # limit batch size to 1 so we always process jobs in # priority order $client2->set_prioritize(1); for ( 1 .. 5 ) { my $job = TheSchwartz::Job->new( funcname => 'Worker::PriorityTest', arg => { num => $_ }, priority => 5, ); my $h = $client2->insert($job); ok( $h, "inserted job (priority $_)" ); } for ( 1 .. 5 ) { $record_expected = $_; my $rv = eval { $client2->work_once; }; ok( $rv, "did stuff 1-5" ); } $rv = eval { $client2->work_once; }; ok( !$rv, "nothing to do now 1-5" ); teardown_dbs('ts2'); # test floor RT #50842 $testnum = 2; $client2 = test_client( dbs => ['ts3'] ); $client2->set_prioritize(1); $client2->reset_abilities; $client2->can_do("Worker::PriorityTest"); Worker::PriorityTest->set_client($client2); $client2->set_floor($floor); for ( 1 .. 5 ) { my $job = TheSchwartz::Job->new( funcname => 'Worker::PriorityTest', arg => { num => $_ }, priority => $_, ); my $h = $client2->insert($job); ok( $h, "inserted job (priority $_)" ); } for ( $floor .. 5 ) { $record_expected = $_; my $rv = eval { $client2->work_once; }; ok( $rv, "did stuff 3-5" ); } $rv = eval { $client2->work_once; }; ok( !$rv, "sub-floor jobs remaining but you can't have them" ); teardown_dbs('ts3'); $testnum = 0; } ); ############################################################################ package Worker::PriorityTest; use base 'TheSchwartz::Worker'; use Test::More; use strict; my $client; sub set_client { $client = $_[1]; } sub work { my ( $class, $job ) = @_; my $priority = $job->priority; if ( $main::testnum == 1 ) { ok( $job->jobid == $main::record_expected, "order by ID for same priority" ); } elsif ( $main::testnum == 2 ) { ok( $job->priority >= $floor, "check floor" ); } else { ok( ( !defined($main::record_expected) && ( !defined($priority) ) ) || ( $priority == $main::record_expected ), "priority matches expected priority" ); } $job->completed; } sub keep_exit_status_for { 20; } # keep exit status for 20 seconds after on_complete sub grab_for {10} sub max_retries {1} sub retry_delay { my $class = shift; my $fails = shift; return 2**$fails; } TheSchwartz-1.12/t/parallel-workers.t000444000764000764 465412506132345 17675 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 2; # how we keep track of if job was done twice: signal from children back up to us my $work_count = 0; my $lost_race = 0; $SIG{USR1} = sub { $work_count++; }; $SIG{USR2} = sub { $lost_race++; }; # tell our parent when we lost a race { no warnings 'once'; $TheSchwartz::FIND_JOB_BATCH_SIZE = 2; $TheSchwartz::T_LOST_RACE = sub { $lost_race = 1; # this one's in our child process. kill 'USR2', getppid(); }; $TheSchwartz::T_AFTER_GRAB_SELECT_BEFORE_UPDATE = sub { # force the race condition to happen, at least until we've triggered it select undef, undef, undef, 0.25 unless $lost_race; }; } # kill children on exit my %children; # pid -> 1 END { my @pids = keys %children; kill -9, @pids if @pids; } my $jobs = 40; run_tests_innodb( 2, sub { # get one job into database, to see if children do it twice: { my $client = test_client( dbs => ['ts1'] ); for ( 1 .. $jobs ) { $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ) or die; } } # two children to race work(); work(); # hang out waiting for children to init/race/finish # while ( $work_count < $jobs ) { sleep 1; } my $now = time(); while ( time < $now + 2 ) { sleep 1; } is( $work_count, $jobs, "$jobs jobs done" ); ok( $lost_race, "lost the race at least once" ); teardown_dbs('ts1'); } ); sub work { # parent: if ( my $childpid = fork() ) { $children{$childpid} = 1; return; } my $client = test_client( dbs => ['ts1'], init => 0 ); # child: while ( my $job = Worker::Addition->grab_job($client) ) { eval { Worker::Addition->work($job); }; } exit 0; } ############################################################################ package Worker::Addition; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; kill 'USR1', getppid(); $job->completed; } # tell framework to set 'grabbed_until' to time() + 60. because if # we can't add some numbers in 30 seconds, our process probably # failed and work should be reassigned. sub grab_for {5} TheSchwartz-1.12/t/declined.t000444000764000764 625112506132345 16151 0ustar00jfearnjfearn000000000000use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => (5 + 21) * 3; our $decline = 1; run_tests( 5, sub { my $client = test_client( dbs => ['ts1'] ); # insert a job which will fail, fail, then succeed. { my $handle = $client->insert("Worker::CompleteEventually"); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; $client->can_do("Worker::CompleteEventually"); $client->work_until_done; is( $handle->failures, 0, "job hasn't failed" ); is( $handle->is_pending, 1, "job is still pending" ); my $job = Worker::CompleteEventually->grab_job($client); ok( !$job, "a job isn't ready yet" ); # hasn't been two seconds sleep 3; # 2 seconds plus 1 buffer second $job = Worker::CompleteEventually->grab_job($client); ok( !$job, "didn't get a job, because job is 'held' not retrying" ); } teardown_dbs('ts1'); } ); run_tests( 21, sub { my $client = test_client( dbs => ['ts2'] ); { $decline = 1; $client->reset_abilities; $client->can_do("Worker::DeclineWithTime"); $client->verbose(1); Worker::DeclineWithTime->set_client($client); for ( 1 .. 5 ) { my $job = TheSchwartz::Job->new( funcname => 'Worker::DeclineWithTime', arg => { num => $_ }, ); my $h = $client->insert($job); ok( $h, "inserted job $_" ); } for ( 1 .. 5 ) { my $rv = eval { $client->work_once; }; ok( $rv, "did stuff 1-5" ); } my $job = Worker::DeclineWithTime->grab_job($client); ok( !$job, "didn't get a job, because run_after" ); sleep 5; $decline = 0; for ( 1 .. 5 ) { my $rv = eval { $client->work_once; }; ok( $rv, "end stuff 1-5" ); } } teardown_dbs('ts2'); } ); done_testing(); ############################################################################ package Worker::CompleteEventually; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->declined; return; } sub keep_exit_status_for { 20; } # keep exit status for 20 seconds after on_complete sub max_retries {2} sub retry_delay { my $class = shift; my $fails = shift; return [ undef, 2, 0 ]->[$fails] ; # fails 2 seconds first time, then immediately } 1; ############################################################################ package Worker::DeclineWithTime; use base 'TheSchwartz::Worker'; use strict; use Test::More; my $client; sub set_client { $client = $_[1]; } sub work { my ( $class, $job ) = @_; if ($main::decline) { $job->declined( time() + 2 ); } else { ok( $job->run_after < time(), 'ensure time out' ); } return; } sub keep_exit_status_for { 20; } # keep exit status for 20 seconds after on_complete 1; TheSchwartz-1.12/t/grab-race.t000444000764000764 401312506132345 16217 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 2; # how we keep track of if job was done twice: signal from children back up to us my $work_count = 0; $SIG{USR1} = sub { $work_count++; }; # force the race condition to happen { no warnings 'once'; $TheSchwartz::T_AFTER_GRAB_SELECT_BEFORE_UPDATE = sub { select undef, undef, undef, 1.5; }; } # kill children on exit my %children; # pid -> 1 END { my @pids = keys %children; kill -9, @pids if @pids; } run_tests_innodb( 2, sub { # get one job into database, to see if children do it twice: { my $client = test_client( dbs => ['ts1'] ); my $handle = $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; } # two children to race to get the above job. work(); work(); # hang out for 3 seconds waiting for children to init/race/finish my $now = time(); while ( time() < $now + 3 ) { sleep 1; } is( $work_count, 1, "only got one signal from worker children" ); teardown_dbs('ts1'); } ); sub work { # parent: if ( my $childpid = fork() ) { $children{$childpid} = 1; return; } my $client = test_client( dbs => ['ts1'], init => 0 ); # child: my $job = Worker::Addition->grab_job($client); if ($job) { eval { Worker::Addition->work($job); }; } exit 0; } ############################################################################ package Worker::Addition; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; kill 'USR1', getppid(); $job->completed; } # tell framework to set 'grabbed_until' to time() + 60. because if # we can't add some numbers in 30 seconds, our process probably # failed and work should be reassigned. sub grab_for {30} TheSchwartz-1.12/t/scoreboard.t000444000764000764 471212506132345 16525 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use Test::More tests => 30; use TheSchwartz; use File::Spec qw(); use File::Temp qw(tempdir); # create a tmp directory with a unique name. This stops # us conflicting with any other runs of this process and means # we tidy up after ourselves my $tempdir = tempdir( CLEANUP => 1 ); run_tests( 10, sub { my $pfx = ''; my $dbs = ['ts1']; setup_dbs( { prefix => $pfx }, $dbs ); my $client = TheSchwartz->new( scoreboard => $tempdir, databases => [ map { { dsn => dsn_for($_), user => $ENV{TS_DB_USER}, pass => $ENV{TS_DB_PASS}, prefix => $pfx, } } @$dbs ] ); my $sb_file = $client->scoreboard; { ( undef, my ( $sb_dir, $sb_name ) ) = File::Spec->splitpath($sb_file); ok( -e $sb_dir, "Looking for dir $sb_dir" ); } { my $handle = $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ); my $job = Worker::Addition->grab_job($client); my $rv = eval { Worker::Addition->work_safely($job); }; ok( length($@) == 0, 'Finished job with out error' ) or diag($@); unless ( ok( -e $sb_file, "Scoreboard file exists" ) ) { return; } open( FH, $sb_file ) or die "Can't open '$sb_file': $!\n"; my %info = map { chomp; /^([^=]+)=(.*)$/ } ; close(FH); ok( $info{pid} == $$, 'Has our PID' ); ok( $info{funcname} eq 'Worker::Addition', 'Has our funcname' ); ok( $info{started} =~ /\d+/, 'Started time is a number' ); ok( $info{started} <= time, 'Started time is in the past' ); ok( $info{arg} =~ /^numbers=ARRAY/, 'Has right args' ); ok( $info{done} =~ /\d+/, 'Job has done time' ); } { $client->DESTROY; ok( !-e $sb_file, 'Scoreboard file goes away when worker finishes' ); } teardown_dbs('ts1'); } ); ############################################################################ package Worker::Addition; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; # .... } 1; TheSchwartz-1.12/t/replace-with.t000444000764000764 424012506132345 16762 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 30; run_tests( 10, sub { my $client = test_client( dbs => ['ts1'] ); my $handle = $client->insert( "Worker::Foo", { cluster => 'all' } ); ok($handle); my $job = Worker::Foo->grab_job($client); ok( $job, "no addition jobs to be grabbed" ); Worker::Foo->work_safely($job); $client->can_do("Worker::Foo"); $client->work_until_done; # should process 5 jobs. # finish a job by replacing it with nothing $handle = $client->insert( "Worker::Foo", { cluster => 'gibberish' } ); ok( $handle->is_pending, "job is still pending" ); $job = $handle->job; $job->replace_with(); ok( !$handle->is_pending, "job no longer pending" ); teardown_dbs('ts1'); } ); ############################################################################ package Worker::Foo; use base 'TheSchwartz::Worker'; use Test::More; ## Import test methods. sub work { my ( $class, $job ) = @_; my $args = $job->arg; if ( $args->{cluster} eq "all" ) { ok( 1, "got the expand job" ); my @jobs; for ( 1 .. 5 ) { push @jobs, TheSchwartz::Job->new_from_array( "Worker::Foo", { cluster => $_ } ); } # which does a $job->completed iff all the @jobs, in one txn, insert # on the same database that $job was on. and it should DIE if the # transaction fails, just so txn flow doesn't proceed on accident. # then work_safely with catch the die and call $job->failed $job->replace_with(@jobs); return; } if ( $args->{cluster} =~ /^\d+$/ ) { ok( 1, "got job $args->{cluster}" ); $job->completed; return; } # if anything were to fall through the bottom of here without # first calling fail/completed/replace_with, or dying, then the # work_safely wrapper should treat it as a "fall-through" failure # and log it, doing the whole retries/delay thing as with a # regular die. } sub grab_for {30} TheSchwartz-1.12/t/work-before-funcids-exist.t000444000764000764 214212506132345 21402 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 6; run_tests( 2, sub { my $client = test_client( dbs => ['ts1'] ); my $handle = $client->insert("Worker::Dummy"); ok( $handle, "inserted job" ); $client->can_do("Worker::Dummy"); $client->can_do("Worker::Dummy2"); $client->can_do("Worker::Dummy3"); $client->work_until_done; ok( !$handle->is_pending, "job is done" ); teardown_dbs('ts1'); } ); ############################################################################ package Worker::Dummy; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; my $subjob = TheSchwartz::Job->new( funcname => 'Worker::Dummy2', ); $job->replace_with($subjob); } sub max_retries {2} sub retry_delay {5} package Worker::Dummy2; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->completed; } package Worker::Dummy3; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->completed; } TheSchwartz-1.12/t/insert-and-do.t000444000764000764 1212512506132345 17063 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 26 * 3; run_tests( 26, sub { my $client = test_client( dbs => ['ts1'] ); # insert a job { my $handle = $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; } # let's do some work. the tedious way, specifying which class should grab a job { my $job = Worker::Addition->grab_job($client); isa_ok $job, 'TheSchwartz::Job'; my $args = $job->arg; is( ref $args, "HASH" ); # thawed it for us is_deeply( $args, { numbers => [ 1, 2 ] }, "got our args back" ); # insert a dummy job to test that next grab ignors it ok( $client->insert( "dummy", [ 1, 2, 3 ] ) ); # verify no more jobs can be grabbed of this type, even though # we haven't done the first one my $job2 = Worker::Addition->grab_job($client); ok( !$job2, "no addition jobs to be grabbed" ); my $rv = eval { Worker::Addition->work($job); }; # .... } # inserting and getting job w/ regular scalar arg foreach my $scalar ( "short_arg", "long arg more than 11 bytes long", "\x05scalar that begins with the 5 byte", ) { my $handle = $client->insert( "Worker::Addition", $scalar ); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; my $job = Worker::Addition->grab_job($client); isa_ok $job, 'TheSchwartz::Job'; my $args = $job->arg; ok( !ref $args, "not a reference" ); # not a reference is( $args, $scalar, "got correct scalar arg back" ); } # insert some more jobs { ok( $client->insert( "Worker::MergeInternalDict", { foo => 'bar' } ) ); ok( $client->insert( "Worker::MergeInternalDict", { bar => 'baz' } ) ); ok( $client->insert( "Worker::MergeInternalDict", { baz => 'foo' } ) ); } # work the easier way { Worker::MergeInternalDict->reset; $client->can_do("Worker::MergeInternalDict") ; # single arg form: say we can do this job name, which is also its package $client->work_until_done; # blocks until all databases are empty is_deeply( Worker::MergeInternalDict->dict, { foo => "bar", bar => "baz", baz => "foo", }, "all jobs got completed" ); } # errors { $client->reset_abilities; # now it, as a worker, can't do anything $client->can_do("Worker::Division") ; # now it can only do one thing my $handle = $client->insert( "Worker::Division", { n => 5, d => 0 } ); ok($handle); my $job = Worker::Division->grab_job($client); isa_ok $job, 'TheSchwartz::Job'; # wrapper around 'work' implemented in the base class which runs work in # eval and notes a failure (with backoff) if job died. Worker::Division->work_safely($job); is( $handle->failures, 1, "job has failed once" ); like( join( '', $handle->failure_log ), qr/Illegal division by zero/, "noted that we divided by zero" ); } teardown_dbs('ts1'); } ); ############################################################################ package Worker::Addition; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; # .... } # tell framework to set 'grabbed_until' to time() + 60. because if # we can't add some numbers in 30 seconds, our process probably # failed and work should be reassigned. sub grab_for {30} ############################################################################ package Worker::MergeInternalDict; use base 'TheSchwartz::Worker'; my %internal_dict; sub reset { %internal_dict = (); } sub dict { \%internal_dict } sub work { my ( $class, $job ) = @_; my $args = $job->arg; %internal_dict = ( %internal_dict, %$args ); $job->completed; } sub grab_for {10} ############################################################################ package Worker::Division; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; my $args = $job->arg; my $ans = $args->{n} / $args->{d}; # throw it away, just here to die on d==0 $job->set_exit_status(1); $job->completed; } sub keep_exit_status_for { 20 } # keep exit status for 20 seconds after on_complete sub grab_for {10} sub max_retries {1} sub retry_delay { my $class = shift; my $fails = shift; return 2**$fails; } TheSchwartz-1.12/t/unique.t000444000764000764 245312506132345 15710 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 18; #use Data::ObjectDriver; #$Data::ObjectDriver::DEBUG = 1; run_tests( 6, sub { my $client = test_client( dbs => ['ts1'] ); $client->set_verbose(1); my ( $job, $handle ); # insert a job with unique $job = TheSchwartz::Job->new( funcname => 'feed', uniqkey => "major", ); ok( $job, "made first feed major job" ); $handle = $client->insert($job); isa_ok $handle, 'TheSchwartz::JobHandle'; # insert same uniqkey, but different func $job = TheSchwartz::Job->new( funcname => 'scratch', uniqkey => "major", ); ok( $job, "made scratch major job" ); $handle = $client->insert($job); isa_ok $handle, 'TheSchwartz::JobHandle'; # pg failes and marks the database as dead $client->{retry_at} = {}; # insert again (notably to same db) and see it fails $job = TheSchwartz::Job->new( funcname => 'feed', uniqkey => "major", ); ok( $job, "made another feed major job" ); $handle = $client->insert($job); ok( !$handle, 'no handle' ); } ); TheSchwartz-1.12/t/05-job-ctor.t000444000764000764 540712506132345 16345 0ustar00jfearnjfearn000000000000# $Id$ use strict; use warnings; use Test::More tests => 19; use TheSchwartz; use Storable; # With this test, all data structures are in memory so far. Nothing's # been inserted into the database because we have no client object # yet with which to insert. my $args = { scoops => 2, with => [ 'cheese', 'love' ] }; my $fargs = Storable::nfreeze($args); my $job1 = TheSchwartz::Job->new_from_array( "feedmajor", $fargs ); isa_ok( $job1, 'TheSchwartz::Job' ); my $job2 = TheSchwartz::Job->new_from_array( "feedmajor", \$fargs ); isa_ok( $job2, 'TheSchwartz::Job' ); my $job3 = TheSchwartz::Job->new( funcname => 'feedmajor', arg => $args ); isa_ok( $job3, 'TheSchwartz::Job' ); my $job4 = TheSchwartz::Job->new( funcname => 'feedmajor', arg => $fargs ); isa_ok( $job4, 'TheSchwartz::Job' ); my $job5 = TheSchwartz::Job->new( funcname => 'feedmajor', arg => \$fargs ); isa_ok( $job5, 'TheSchwartz::Job' ); is_deeply( $job1->column_values, $job2->column_values, "job2 is equivalent" ); is_deeply( $job1->column_values, $job3->column_values, "job3 is equivalent" ); is_deeply( $job1->column_values, $job4->column_values, "job4 is equivalent" ); is_deeply( $job1->column_values, $job5->column_values, "job5 is equivalent" ); my $job6 = TheSchwartz::Job->new( funcname => 'feeddog', run_after => time() + 60, priority => 7, arg => { scoops => 2, with => [ 'cheese', 'love' ] }, coalesce => 'major', jobid => int( rand() * 5000 ), ); isa_ok $job6, 'TheSchwartz::Job'; # second arg can also be an arrayref my $job_a1 = TheSchwartz::Job->new_from_array( "feedmajor", [ 'cheese', 'water', 'beer' ] ); my $job_a2 = TheSchwartz::Job->new( funcname => "feedmajor", arg => [ 'cheese', 'water', 'beer' ] ); is_deeply( $job_a1->column_values, $job_a2->column_values, "ctors with arrayrefs match" ); my $jobbad = eval { TheSchwartz::Job->new( funcname => 'feeddog', run_atter => time() + 60, # [sic] typo ); }; ok( !$jobbad, "no bad job" ); ok( $@, "error creating job with bad argument" ); # can't have multiple non-ref args $jobbad = eval { TheSchwartz::Job->new_from_array( "feeddog", "scalar1", "scalar2" ); }; ok( !$jobbad, "no bad job" ); ok( $@, "error creating job with bad argument" ); # can't have multiple non-ref args, even if first is scalarref $jobbad = eval { TheSchwartz::Job->new_from_array( "feeddog", \"scalar1", "scalar2" ); }; ok( !$jobbad, "no bad job" ); ok( $@, "error creating job with bad argument" ); # can't have multiple non-ref args, even if first is hashrf $jobbad = eval { TheSchwartz::Job->new_from_array( "feeddog", { with => 'poison' }, { extra => 'arg' } ); }; ok( !$jobbad, "no bad job" ); ok( $@, "error creating job with bad argument" ); TheSchwartz-1.12/t/funcid.t000444000764000764 230212506132345 15643 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 24; run_tests( 8, sub { my $client = test_client( dbs => ['ts1'] ); my $handle; $handle = $client->insert( "feedmajor", { scoops => 2, with => [ 'cheese', 'love' ] } ); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; my $job = $handle->job; isa_ok $job, 'TheSchwartz::Job'; ok( $job->funcid, 'jobs have funcids' ); is $job->funcname, 'feedmajor', 'handle->job gives us the right job'; my $job2 = TheSchwartz::Job->new( funcname => 'feedmajor', run_after => time() + 60, priority => 7, arg => { scoops => 2, with => [ 'cheese', 'love' ] }, coalesce => 'major', jobid => int rand(5000), ); ok($job2); my $h2 = $client->insert($job2); isa_ok $h2, 'TheSchwartz::JobHandle'; my $job2_back = $h2->job; ok( $job2->funcid, "internal: funcid present" ); is( $job2->funcname, "feedmajor", "funcname mapping worked" ); teardown_dbs('ts1'); } ); TheSchwartz-1.12/t/dead-dbs.t000444000764000764 241612506132345 16044 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 6; run_tests( 2, sub { setup_dbs('ts1'); teardown_dbs('ts2'); # doesn't exist my $client = test_client( dbs => [ 'ts2', 'ts1' ], init => 0 ); # insert a job my $n_handles = 0; for ( 1 .. 50 ) { my $handle = $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ); $n_handles++ if $handle; } is( $n_handles, 50, "got 50 handles" ); # let's do some work. the tedious way, specifying which class should grab a job my $n_grabbed = 0; while ( my $job = Worker::Addition->grab_job($client) ) { $n_grabbed++; } is( $n_grabbed, 50, "grabbed 50 times" ); teardown_dbs('ts1'); } ); ############################################################################ package Worker::Addition; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; # .... } # tell framework to set 'grabbed_until' to time() + 60. because if # we can't add some numbers in 30 seconds, our process probably # failed and work should be reassigned. sub grab_for {30} TheSchwartz-1.12/t/grab_and_work_on.t000444000764000764 354612506132345 17701 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 27; run_tests( 9, sub { my $client = test_client( dbs => ['ts1'] ); my $available = TheSchwartz::Job->new( funcname => 'Worker::Grabber', ); my $grabbed_until = time + 2; my $grabbed = TheSchwartz::Job->new( funcname => 'Worker::Grabber', grabbed_until => $grabbed_until, ); my $available_handle = $client->insert($available); my $grabbed_handle = $client->insert($grabbed); $client->reset_abilities; $client->can_do("Worker::Grabber"); Worker::Grabber->set_client($client); my $rv = $client->grab_and_work_on( $grabbed_handle->as_string ); ok( !$rv, "we couldn't grab it" ); is scalar $grabbed->failure_log, 0, "no errors"; $grabbed->refresh; is $grabbed->grabbed_until, $grabbed_until, "Still grabbed"; $rv = $client->grab_and_work_on( $available_handle->as_string ); is scalar $available->failure_log, 0, "no errors"; ok( $rv, "we worked on it" ); $rv = $client->grab_and_work_on( $available_handle->as_string ); is scalar $available->failure_log, 0, "no errors"; ok( !$rv, "There is nothing to do for it now." ); teardown_dbs('ts1'); } ); ############################################################################ package Worker::Grabber; use base 'TheSchwartz::Worker'; use Test::More; my $client; sub set_client { $client = $_[1]; } sub work { my ( $class, $job ) = @_; ok( ( $job->grabbed_until > time ), "this job is locked" ); ## try to work on it my $rv = $client->grab_and_work_on( $job->handle->as_string ); ok( !$rv, "We are already working on it, so we can't grab it" ); $job->completed; } TheSchwartz-1.12/t/evenly-distribute.t000444000764000764 354212506132345 20060 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 12; run_tests( 4, sub { my $client = test_client( dbs => [ 'ts1', 'ts2' ] ); my $n_jobs = 60; for ( 1 .. $n_jobs ) { my $handle = $client->insert("Worker::Foo"); die unless $handle; } my $db1 = DBI->connect( dsn_for("ts1"), $ENV{TS_DB_USER}, $ENV{TS_DB_PASS} ); my $db2 = DBI->connect( dsn_for("ts2"), $ENV{TS_DB_USER}, $ENV{TS_DB_PASS} ); die unless $db1 && $db2; my $jobs1 = $db1->selectrow_array("SELECT COUNT(*) FROM job"); my $jobs2 = $db2->selectrow_array("SELECT COUNT(*) FROM job"); is( $jobs1 + $jobs2, $n_jobs, "inserted all $n_jobs" ); ok( $jobs1 > $n_jobs / 4, "at least a quarter of jobs went to db1 ($jobs1 / $n_jobs)" ); ok( $jobs2 > $n_jobs / 4, "at least a quarter of jobs went to db1 ($jobs2 / $n_jobs)" ); my $do_jobs = int( $n_jobs / 2 ); $client->can_do("Worker::Foo"); for ( 1 .. $do_jobs ) { $client->work_once or die; } my $jobs1b = $db1->selectrow_array("SELECT COUNT(*) FROM job"); my $jobs2b = $db2->selectrow_array("SELECT COUNT(*) FROM job"); my $remain_jobs = $n_jobs - $do_jobs; is( $jobs1b + $jobs2b, $remain_jobs, "expected jobs remain" ); # deltas: how much work gone done each my $jobs1d = $jobs1 - $jobs1b; my $jobs2d = $jobs2 - $jobs2b; # difference in work done: my $workdiff = abs( $jobs1d - $jobs2d ); teardown_dbs( 'ts1', 'ts2' ); } ); sub max { $_[0] > $_[1] ? $_[0] : $_[1] } package Worker::Foo; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; $job->completed; } TheSchwartz-1.12/t/api.t000444000764000764 1172212506132345 15172 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 58 * 3; run_tests( 58, sub { foreach my $pfx ( "", "testprefix_" ) { my $client = test_client( dbs => ['ts1'], dbprefix => $pfx, ); my $handle; $handle = $client->insert( "feedmajor", { scoops => 2, with => [ 'cheese', 'love' ] } ); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; is( $handle->is_pending, 1, "job is still pending" ); is( $handle->exit_status, undef, "job hasn't exitted yet" ); # to give to javascript, perl, etc... my $hstr = $handle->as_string; # - ok( $hstr, "handle stringifies" ); my $job = $handle->job; isa_ok $job, 'TheSchwartz::Job'; is $job->funcname, 'feedmajor', 'handle->job gives us the right job'; cmp_ok $job->insert_time, '>', 0, 'insert_time is non-zero'; # getting a handle object back my $hand2 = $client->handle_from_string($hstr); ok( $hand2, "handle recreated from stringified version" ); is( $handle->is_pending, 1, "job is still pending" ); is( $handle->exit_status, undef, "job hasn't exitted yet" ); $job = $handle->job; isa_ok $job, 'TheSchwartz::Job'; is $job->funcname, 'feedmajor', 'recreated handle gives us the right job'; # grab an job by ID. my $id = $job->jobid; my @jobs = $client->list_jobs( { funcname => 'feedmajor', jobid => $id } ); is( scalar @jobs, 1, 'one job' ); is( $jobs[0]->jobid, $id, 'expected jobid' ); $job = TheSchwartz::Job->new( funcname => 'feedmajor', run_after => time() + 60, priority => 7, arg => { scoops => 2, with => [ 'cheese', 'love' ] }, coalesce => 'major', jobid => int rand(5000), ); ok($job); $handle = $client->insert($job); isa_ok $handle, 'TheSchwartz::JobHandle'; # inserting multiple at a time in scalar context { my $job1 = TheSchwartz::Job->new( funcname => 'feedmajor' ); my $job2 = TheSchwartz::Job->new( funcname => 'feedmajor' ); my $rv = $client->insert_jobs( $job1, $job2 ); is( $rv, 2, "inserted two jobs" ); } # inserting multiple at a time in list context { my $job1 = TheSchwartz::Job->new( funcname => 'feedmajor' ); my $job2 = TheSchwartz::Job->new( funcname => 'feedmajor' ); my @handles = $client->insert_jobs( $job1, $job2 ); is( scalar @handles, 2, "inserted two jobs" ); isa_ok $handles[0], 'TheSchwartz::JobHandle', "got job handle"; } # inserting with a regular scalar arg { $job = TheSchwartz::Job->new( funcname => 'feedmajor', arg => "gruel that's longer than 11 bytes, for sure!", ); ok($job); $handle = $client->insert($job); isa_ok $handle, 'TheSchwartz::JobHandle'; my $same = $client->lookup_job( $handle->as_string ); ok $same; isa_ok $same, 'TheSchwartz::Job'; is $same->handle->as_string, $handle->as_string; } ## Just test that handles for unknown database croak with an explicit message { eval { $client->lookup_job( ( "6a" x 16 ) . "-666" ) }; ok $@ && unlike( $@, qr/No Driver/ ) && like( $@, qr/database.*hash/ ); } # inserting multiple with wrong method fails eval { my $job1 = TheSchwartz::Job->new( funcname => 'feedmajor' ); my $job2 = TheSchwartz::Job->new( funcname => 'feedmajor' ); my @handles = $client->insert( $job1, $job2 ); }; like( $@, qr/multiple jobs with method/, "used wrong method" ); # insert multiple that fail { my $job1 = TheSchwartz::Job->new( funcname => 'feedmajor', uniqkey => 'u1' ); my $job2 = TheSchwartz::Job->new( funcname => 'feedmajor', uniqkey => 'u1' ); my @handles = $client->insert_jobs( $job1, $job2 ); is( scalar @handles, 0, "failed to insert anything" ); } teardown_dbs('ts1'); } } ); done_testing(); TheSchwartz-1.12/t/client-time-unsync.t000444000764000764 521012506132345 20123 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- # # This test tests one client with good time, who grabs a job for 5 seconds. But while he's # working on it, another client comes along with a clock set to the future, and grabs the job # but getting it, since for it, 5 seconds has passed. # # This tests that the library doesn't rely on the client's time, but the server's time. # use strict; use warnings; # make time() be overridable in the future at runtime, rather than be an opcode: BEGIN { *CORE::GLOBAL::time = sub { time() }; } no warnings 'redefine'; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 2; # how we keep track of if job was done twice: signal from children back up to us my $got_job = 0; my $got_done = 0; $SIG{USR1} = sub { $got_job++; }; $SIG{USR2} = sub { $got_done++; }; # kill children on exit my %children; # pid -> 1 my $parent = $$; END { if ( $$ == $parent ) { my @pids = keys %children; kill 9, @pids if @pids; } } run_tests_innodb( 2, sub { # put one job into database my $client = test_client( dbs => ['ts1'] ); $client->insert( "Worker::Addition", { numbers => [ 1, 2 ] } ) or die; # two children to race. this one with normal time: work(); # let first dude get started first select( undef, undef, undef, 1.5 ); # make this worker 60 seconds in the future: (well past the grabbed until time) work(60); # hang out waiting for children to finish or timeout my $now = time(); while ( $got_done < 2 && time() < $now + 7 ) { sleep 1; } is( $got_done, 2, "two children finished" ); is( $got_job, 1, "only did one job" ); teardown_dbs('ts1'); } ); sub work { my $future = shift; # parent: if ( my $childpid = fork() ) { $children{$childpid} = 1; return; } if ($future) { *CORE::GLOBAL::time = sub { CORE::time() + $future }; } my $client = test_client( dbs => ['ts1'], init => 0 ); # child: while ( my $job = Worker::Addition->grab_job($client) ) { eval { Worker::Addition->work($job); }; } kill 'USR2', getppid(); exit 0; } ############################################################################ package Worker::Addition; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; sleep 3; kill 'USR1', getppid(); $job->completed; } # tell framework to set 'grabbed_until' to time() + 60. because if # we can't add some numbers in 30 seconds, our process probably # failed and work should be reassigned. sub grab_for {5} TheSchwartz-1.12/t/coalesce.t000444000764000764 370612506132345 16162 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 14 * 3; run_tests( 14, sub { my $client = test_client( dbs => ['ts1'] ); my @keys = qw(foo bar baz); my $n = 0; for ( 1 .. 10 ) { my $key = $keys[ $n++ % 3 ]; my $job = TheSchwartz::Job->new( funcname => 'Worker::CoalesceTest', arg => { key => $key, num => $_ }, coalesce => $key ); my $h = $client->insert($job); ok( $h, "inserted $h ($_ = $key)" ); } $client->reset_abilities; $client->can_do("Worker::CoalesceTest"); Worker::CoalesceTest->set_client($client); for ( 1 .. 3 ) { my $rv = eval { $client->work_once; }; ok( $rv, "did stuff" ); } my $rv = eval { $client->work_once; }; ok( !$rv, "nothing to do now" ); teardown_dbs('ts1'); } ); ############################################################################ package Worker::CoalesceTest; use base 'TheSchwartz::Worker'; my $client; sub set_client { $client = $_[1]; } sub work { my ( $class, $job ) = @_; my $args = $job->arg; my $key = $args->{key}; $job->completed; if ( $key eq "foo" ) { while ( my $job = $client->find_job_with_coalescing_prefix( "Worker::CoalesceTest", "f" ) ) { $job->completed; } } else { while ( my $job = $client->find_job_with_coalescing_value( "Worker::CoalesceTest", $key ) ) { $job->completed; } } } sub keep_exit_status_for { 20 } # keep exit status for 20 seconds after on_complete sub grab_for {10} sub max_retries {1} sub retry_delay { my $class = shift; my $fails = shift; return 2**$fails; } TheSchwartz-1.12/t/retry-delay.t000444000764000764 370412506132345 16643 0ustar00jfearnjfearn000000000000# $Id$ # -*-perl-*- use strict; use warnings; require 't/lib/db-common.pl'; use TheSchwartz; use Test::More tests => 24; run_tests( 8, sub { my $client = test_client( dbs => ['ts1'] ); # insert a job which will fail, fail, then succeed. { my $handle = $client->insert("Worker::CompleteEventually"); isa_ok $handle, 'TheSchwartz::JobHandle', "inserted job"; $client->can_do("Worker::CompleteEventually"); $client->work_until_done; is( $handle->failures, 1, "job has failed once" ); my $job = Worker::CompleteEventually->grab_job($client); ok( !$job, "a job isn't ready yet" ); # hasn't been two seconds sleep 3; # 2 seconds plus 1 buffer second $job = Worker::CompleteEventually->grab_job($client); ok( $job, "got a job, since time has gone by" ); Worker::CompleteEventually->work_safely($job); is( $handle->failures, 2, "job has failed twice" ); $job = Worker::CompleteEventually->grab_job($client); ok( $job, "got the job back" ); Worker::CompleteEventually->work_safely($job); ok( !$handle->is_pending, "job has exited" ); is( $handle->exit_status, 0, "job succeeded" ); } teardown_dbs('ts1'); } ); ############################################################################ package Worker::CompleteEventually; use base 'TheSchwartz::Worker'; sub work { my ( $class, $job ) = @_; my $failures = $job->failures; if ( $failures < 2 ) { $job->failed; } else { $job->completed; } return; } sub keep_exit_status_for { 20 } # keep exit status for 20 seconds after on_complete sub max_retries {2} sub retry_delay { my $class = shift; my $fails = shift; return [ undef, 2, 0 ]->[$fails] ; # fails 2 seconds first time, then immediately } TheSchwartz-1.12/t/lib000755000764000764 012506132345 14622 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/t/lib/db-common.pl000555000764000764 1461312506132345 17217 0ustar00jfearnjfearn000000000000# $Id$ use strict; use File::Spec; use Carp qw(croak); sub run_tests { my ( $n, $code ) = @_; run_tests_mysql( $n, $code ); run_tests_pgsql( $n, $code ); run_tests_sqlite( $n, $code ); } sub run_tests_innodb { my ( $n, $code ) = @_; run_tests_mysql( $n, $code, 1 ); } sub run_tests_mysql { my ( $n, $code, $innodb ) = @_; SKIP: { local $ENV{USE_MYSQL} = 1; local $ENV{TS_DB_USER} ||= 'root'; my $dbh = eval { mysql_dbh() }; skip "MySQL not accessible as root on localhost", $n if $@; skip "InnoDB not available on localhost's MySQL", $n if $innodb && !has_innodb($dbh); $code->(); } } sub run_tests_pgsql { my ( $n, $code ) = @_; SKIP: { local $ENV{USE_PGSQL} = 1; local $ENV{TS_DB_USER} ||= 'postgres'; my $dbh = eval { pgsql_dbh() }; skip "PgSQL not accessible as root on localhost", $n if $@; $code->(); } } sub run_tests_sqlite { my ( $n, $code ) = @_; # SQLite SKIP: { my $rv = eval "use DBD::SQLite; 1"; $rv = 0 if $ENV{SKIP_SQLITE}; skip "SQLite not installed", $n if !$rv; $code->(); } } sub test_client { my %opts = @_; my $dbs = delete $opts{dbs}; my $init = delete $opts{init}; my $pfx = delete $opts{dbprefix}; croak "'dbs' not an ARRAY" unless ref $dbs eq "ARRAY"; croak "unknown opts" if %opts; $init = 1 unless defined $init; if ($init) { setup_dbs( { prefix => $pfx }, $dbs ); } if ( $ENV{USE_DBH_FOR_TEST} || $ENV{USE_GET_DBH_FOR_TEST} ) { my @tmp; for (@$dbs) { eval { my $dsn = dsn_for($_); my $dbh = DBI->connect( $dsn, "root", "", { RaiseError => 1, PrintError => 0, AutoCommit => 1, } ) or die $DBI::errstr; my $driver = Data::ObjectDriver::Driver::DBI->new( $ENV{USE_GET_DBH_FOR_TEST} ? ( get_dbh => sub {$dbh} ) : ( dbh => $dbh ) ); push @tmp, { driver => $driver, prefix => $pfx }; }; } return TheSchwartz->new( databases => [@tmp] ); } else { return TheSchwartz->new( databases => [ map { { dsn => dsn_for($_), user => $ENV{TS_DB_USER}, pass => $ENV{TS_DB_PASS}, prefix => $pfx, } } @$dbs ] ); } } sub has_innodb { my $dbh = shift; my $tmpname = "test_to_see_if_innoavail"; $dbh->do("CREATE TABLE IF NOT EXISTS $tmpname (i int) ENGINE=INNODB") or return 0; my @row = $dbh->selectrow_array("SHOW CREATE TABLE $tmpname"); my $row = join( ' ', @row ); my $has_it = ( $row =~ /=InnoDB/i ); $dbh->do("DROP TABLE $tmpname"); return $has_it; } sub schema_file { return "doc/schema.sql" if $ENV{USE_MYSQL}; return "doc/schema-postgres.sql" if $ENV{USE_PGSQL}; return "t/schema-sqlite.sql"; } sub db_filename { my ($dbname) = @_; return $dbname . '.db'; } sub mysql_dbname { my ($dbname) = @_; return 't_sch_' . $dbname; } sub dsn_for { my $dbname = shift; if ( $ENV{USE_MYSQL} ) { return 'dbi:mysql:' . mysql_dbname($dbname); } elsif ( $ENV{USE_PGSQL} ) { return 'dbi:Pg:dbname=' . mysql_dbname($dbname); } else { return 'dbi:SQLite:dbname=' . db_filename($dbname); } } sub setup_dbs { shift if $_[0] =~ /\.sql$/; # skip filenames (old) my $opts = ref $_[0] eq "HASH" ? shift : {}; my $pfx = delete $opts->{prefix} || ""; die "unknown opts" if %$opts; my (@dbs) = @_; my $dbs = ref $dbs[0] ? $dbs[0] : \@dbs; # support array or arrayref (old) my $schema = schema_file(); teardown_dbs(@$dbs); for my $dbname (@$dbs) { if ( $ENV{USE_MYSQL} ) { create_mysql_db( mysql_dbname($dbname) ); } elsif ( $ENV{USE_PGSQL} ) { create_pgsql_db( mysql_dbname($dbname) ); } my $dbh = DBI->connect( dsn_for($dbname), $ENV{TS_DB_USER}, $ENV{TS_DB_PASS}, { RaiseError => 1, PrintError => 0 } ) or die "Couldn't connect: $!\n"; my @sql = load_sql($schema); for my $sql (@sql) { $sql =~ s!^\s*create\s+table\s+(\w+)!CREATE TABLE ${pfx}$1!mi; $sql =~ s!^\s*(create.*?index)\s+(\w+)\s+on\s+(\w+)!$1 $2 ON ${pfx}$3!i; $sql .= " ENGINE=INNODB\n" if $ENV{USE_MYSQL}; $dbh->do($sql); } $dbh->disconnect; } } sub mysql_dbh { return DBI->connect( "DBI:mysql:mysql", "root", "", { RaiseError => 1 } ) || die "Couldn't connect to database"; } my $pg_dbh; sub pgsql_dbh { return $pg_dbh if $pg_dbh; $pg_dbh ||= DBI->connect( "DBI:Pg:dbname=postgres", "postgres", "", { RaiseError => 1 } ) or die "Couldn't connect to database"; } sub create_mysql_db { my $dbname = shift; mysql_dbh()->do("CREATE DATABASE $dbname"); } sub drop_mysql_db { my $dbname = shift; mysql_dbh()->do("DROP DATABASE IF EXISTS $dbname"); } sub create_pgsql_db { my $dbname = shift; pgsql_dbh()->do("CREATE DATABASE $dbname"); } sub drop_pgsql_db { my $dbname = shift; undef $pg_dbh; eval { pgsql_dbh()->do("DROP DATABASE IF EXISTS $dbname") }; } sub teardown_dbs { my (@dbs) = @_; for my $db (@dbs) { if ( $ENV{USE_MYSQL} ) { drop_mysql_db( mysql_dbname($db) ); } elsif ( $ENV{USE_PGSQL} ) { drop_pgsql_db( mysql_dbname($db) ); } else { my $file = db_filename($db); next unless -e $file; unlink $file or die "Can't teardown $db: $!"; } } } sub load_sql { my ($file) = @_; open my $fh, $file or die "Can't open $file: $!"; my $sql = do { local $/; <$fh> }; close $fh; split /;\s*/, $sql; } sub query_sql { my ( $dbh, $sql ) = @_; my ( $query, $bind ) = ref($sql) ? @$sql : ( $sql, [] ); my $sth = $dbh->prepare($sql); my $i = 0; $sth->bind_param( ++$i, $_ ) for @$bind; $sth->execute; $sth->bind_columns( \my $result ); $sth->fetch; return $result; } 1; TheSchwartz-1.12/server000755000764000764 012506132345 15117 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/server/bin000755000764000764 012506132345 15667 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/server/bin/schwartzd000555000764000764 305412506132345 17765 0ustar00jfearnjfearn000000000000#!/usr/bin/perl use strict; use lib "$ENV{HOME}/hack/Data-ObjectDriver/lib"; use lib "$ENV{HOME}/hack/TheSchwartz/lib"; use lib "$ENV{HOME}/hack/gearman/api/perl/Gearman/lib"; use lib "$ENV{HOME}/cvs/Data-ObjectDriver/lib"; use lib "$ENV{HOME}/cvs/TheSchwartz/lib"; use lib "$ENV{HOME}/cvs/gearman/api/perl/Gearman/lib"; use Gearman::Worker; use TheSchwartz; use JSON::Any; my $j = JSON::Any->new; my $ts = TheSchwartz->new( databases => [ { dsn => "dbi:mysql:database=t_sch_unnamed", user => "root", pass => "", } ] ); # FIXME: use embedded gearman server, and workers be child processes my $worker = Gearman::Worker->new; $worker->job_servers('127.0.0.1:7003'); $worker->register_function( "insert_job" => handler( \&insert_job ) ); $worker->work while 1; ############################################################################ sub handler { my ($code) = @_; return sub { my $job = shift; my $arg = $job->arg; my $jreq = eval { $j->jsonToObj( $job->arg ) }; unless ($jreq) { die "not a valid JSON request"; } return $code->( $job, $jreq ); }; } sub insert_job { my ( $job, $json ) = @_; my $funcname = $json->{funcname} or die "No funcname"; my $job = TheSchwartz::Job->new( funcname => $json->{funcname}, arg => $json->{arg}, uniqkey => $json->{uniqkey}, coalesce => $json->{coalesce}, ); my $h = $ts->insert($job) or die "insert_failure\n"; return $h->as_string; } TheSchwartz-1.12/server/t000755000764000764 012506132345 15362 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/server/t/01-insert-and-get.t000444000764000764 160212506132345 20742 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; use Test::More; BEGIN { require 't/lib/testlib.pl'; } use Gearman::Client; use Data::Dumper; my $db = TestDB->new; plan tests => 1; ok( $db, "got a test database" ); my $srv = TestServer->new($db); ok( $srv, "got a test server" ); my $cl = $srv->gearman_client; my $ret; # FIXME: test currently requires running gearmand on localhost { use IO::Socket::INET; my $sock = IO::Socket::INET->new( PeerAddr => "127.0.0.1:7003" ); ok( $sock, "local gearmand is up for testing" ) or die "can't continue"; } sub do_req { my $req = shift; my $ret = $cl->do_task( "insert_job", json($req) ); return undef unless $ret; return $$ret unless $$ret =~ /^\s*[\[\{]/; return unjson($$ret); } $ret = do_req( { funcname => "foo", arg => "fooarg", } ); like( $ret, qr/^\w+-\d+$/, "got a job handle" ); TheSchwartz-1.12/server/t/00-start-ping.t000444000764000764 34212506132345 20170 0ustar00jfearnjfearn000000000000# -*-perl-*- use strict; use warnings; use Test::More; require 't/lib/testlib.pl'; my $db = TestDB->new; plan tests => 1; ok( $db, "got a test database" ); my $srv = TestServer->new($db); ok( $srv, "got a test server" ); TheSchwartz-1.12/server/t/lib000755000764000764 012506132345 16130 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/server/t/lib/testlib.pl000444000764000764 717712506132345 20304 0ustar00jfearnjfearn000000000000# $Id: db-common.pl 91 2006-08-17 00:39:55Z bradfitz $ use strict; use File::Spec; use Carp qw(croak); use DBI; use FindBin; use JSON::Any; use lib "$ENV{HOME}/hack/Data-ObjectDriver/lib"; use lib "$ENV{HOME}/hack/TheSchwartz/lib"; use lib "$ENV{HOME}/hack/gearman/api/perl/Gearman/lib"; use lib "$ENV{HOME}/cvs/Data-ObjectDriver/lib"; use lib "$ENV{HOME}/cvs/TheSchwartz/lib"; use lib "$ENV{HOME}/cvs/gearman/api/perl/Gearman/lib"; sub json { return JSON::Any->objToJson(shift); } sub unjson { return JSON::Any->json_to_obj(shift); } sub test_client { my %opts = @_; my $dbs = delete $opts{dbs}; my $init = delete $opts{init}; my $pfx = delete $opts{dbprefix}; croak "'dbs' not an ARRAY" unless ref $dbs eq "ARRAY"; croak "unknown opts" if %opts; $init = 1 unless defined $init; if ($init) { setup_dbs( { prefix => $pfx }, $dbs ); } return TheSchwartz->new( databases => [ map { { dsn => dsn_for($_), user => "root", pass => "", prefix => $pfx, } } @$dbs ] ); } package TestDB; use strict; sub new { my $class = shift; my $name = shift || "unnamed"; my $db = TestDB::MySQL->new($name) || TestDB::SQLite->new($name); if ($db) { my $dbh = $db->dbh; my $schema = $db->schema_file; my @sql = _load_sql($schema); for my $sql (@sql) { $db->alter_create( \$sql ); $dbh->do($sql); } $dbh->disconnect; return $db; } eval { Test::More::plan( skip_all => "MySQL or SQLite not available for testing" ); }; if ($@) { return undef; } exit(0); } sub dbh { my ($self) = @_; return DBI->connect( $self->dsn, "root", "", { RaiseError => 1 } ); } sub alter_create { my $sqlref = shift; # subclasses can override } sub _load_sql { my ($file) = @_; open my $fh, $file or die "Can't open $file: $!"; my $sql = do { local $/; <$fh> }; close $fh; split /;\s*/, $sql; } package TestDB::MySQL; use strict; use base 'TestDB'; sub new { my ( $class, $name ) = @_; my $dbh = eval { _mysql_dbh() } or return undef; my $self = bless { basename => $name, dbname => "t_sch_$name", root_dbh => $dbh, }, $class; $dbh->do("DROP DATABASE IF EXISTS $self->{dbname}"); $dbh->do("CREATE DATABASE $self->{dbname}"); return $self; } sub dsn { my ($self) = @_; return "DBI:mysql:" . $self->{dbname}; } sub _mysql_dbh { return DBI->connect( "DBI:mysql:mysql", "root", "", { RaiseError => 1 } ) or die "Couldn't connect to database"; } sub alter_create { my ( $self, $sqlref ) = @_; $$sqlref .= " ENGINE=INNODB\n"; } sub schema_file { return "../doc/schema.sql"; } package TestDB::SQLite; use strict; use base 'TestDB'; sub new { return undef; } package TestServer; use strict; sub new { my ( $class, $db ) = @_; $db ||= TestDB->new || return undef; my $pid = fork; die "out of memory" unless defined $pid; if ($pid) { return bless { pid => $pid, }, $class; } my $bin = "$FindBin::Bin/../bin/schwartzd"; die "Not exist: $bin" unless -e $bin; die "Not executable: $bin" unless -x $bin; exec $bin; die "Failed to exec test schwartzd!"; } sub gearman_client { my $self = shift; my $cl = Gearman::Client->new; $cl->job_servers('127.0.0.1:7003'); return $cl; } sub DESTROY { my $self = shift; if ( $self->{pid} ) { kill 9, $self->{pid}; } } 1; TheSchwartz-1.12/server/doc000755000764000764 012506132345 15664 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/server/doc/deps.txt000444000764000764 62212506132345 17475 0ustar00jfearnjfearn000000000000TheSchwartz (itself) Data::ObjectDriver DBI Class::Accessor::Fast (libclass-accessor-perl) Class::Trigger (libclass-trigger-perl) libio-stringy-perl Class::Data::Inheritable List::Util Test::Exception -- build_requires (libtest-exception-perl) Digest::MD5 Storable Gearman::Server Danga::Socket Sys::Syscall JSON::Any JSON ---- Perl client: Gearman::Client String::CRC32 TheSchwartz-1.12/server/doc/protocol.txt000444000764000764 134512506132345 20426 0ustar00jfearnjfearn000000000000grab_job: { can_do: [@can_do], } -> { jobid, job, arg, # failure_count? } (or) -> Nothing insert_job: { job: "foo", arg: "lskdjflksdjflskdf", uniqkey: "blah", run_after: $unix_time, coalesce: "to_foo", } -> jobid # atomic insert multiple jobs: insert_jobs: [ {...}, {...}, ] -> @jobids mark_completed: { jobid: 5, replace_with: [@jobs], #optional } -> { handles => [@handles] } mark_failed: { jobid: 5, message: "error message", exit_status: 6, retry_in: 80, # optional. if not present, no retry. } get_failure_log: { jobid: 6 } -> [ {time:2342342,exitstatus ... }, {....}, {...} ] get_status: { jobid: 6, } -> { exitstatus: 0, } TheSchwartz-1.12/lib000755000764000764 012506132345 14357 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/lib/TheSchwartz.pm000444000764000764 11376312506132345 17373 0ustar00jfearnjfearn000000000000# $Id$ package TheSchwartz; use 5.008; use strict; use fields qw( databases retry_seconds dead_dsns retry_at funcmap_cache verbose all_abilities current_abilities current_job cached_drivers driver_cache_expiration scoreboard prioritize floor batch_size strict_remove_ability); our $VERSION = "1.12"; use Carp qw( croak ); use Data::ObjectDriver::Errors; use Data::ObjectDriver::Driver::DBI; use Digest::MD5 qw( md5_hex ); use List::Util qw( shuffle ); use TheSchwartz::FuncMap; use TheSchwartz::Job; use TheSchwartz::JobHandle; use constant RETRY_DEFAULT => 30; use constant OK_ERRORS => { map { $_ => 1 } Data::ObjectDriver::Errors->UNIQUE_CONSTRAINT, }; # test harness hooks our $T_AFTER_GRAB_SELECT_BEFORE_UPDATE; our $T_LOST_RACE; ## Number of jobs to fetch at a time in find_job_for_workers. our $FIND_JOB_BATCH_SIZE = 50; sub new { my TheSchwartz $client = shift; my %args = @_; $client = fields::new($client) unless ref $client; croak "databases must be an arrayref if specified" unless !exists $args{databases} || ref $args{databases} eq 'ARRAY'; my $databases = delete $args{databases}; $client->{retry_seconds} = delete $args{retry_seconds} || RETRY_DEFAULT; $client->set_prioritize( delete $args{prioritize} ); $client->set_verbose( delete $args{verbose} ); $client->set_scoreboard( delete $args{scoreboard} ); $client->{driver_cache_expiration} = delete $args{driver_cache_expiration} || 0; $client->{batch_size} = delete $args{batch_size} || $FIND_JOB_BATCH_SIZE; $client->{strict_remove_ability} = delete $args{strict_remove_ability}; my $floor = delete $args{floor}; $client->set_floor($floor) if ($floor); croak "unknown options ", join( ', ', keys %args ) if keys %args; $client->hash_databases($databases); $client->reset_abilities; $client->{dead_dsns} = {}; $client->{retry_at} = {}; $client->{funcmap_cache} = {}; return $client; } sub debug { my TheSchwartz $client = shift; return unless $client->{verbose}; $client->{verbose}->(@_); # ($msg, $job) but $job is optional } sub hash_databases { my TheSchwartz $client = shift; my ($list) = @_; for my $ref (@$list) { my $var; my @parts; if ( $ref->{driver} ) { my $dbh; if ( my $getter = $ref->{driver}->get_dbh ) { $dbh = $getter->(); } else { $dbh = $ref->{driver}->dbh; } $dbh = tied( %{$dbh} ); my $dsn = "dbd:" . $dbh->{Driver}->{Name} . ":" . $dbh->{Name}; my $user = $dbh->{Username} || ''; @parts = ( $dsn, $user ); } else { @parts = map { $ref->{$_} || '' } qw(dsn user); } my $full = join '|', @parts; $client->{databases}{ md5_hex($full) } = $ref; } } sub driver_for { my TheSchwartz $client = shift; my ($hashdsn) = @_; my $driver; my $t = time; my $cache_duration = $client->{driver_cache_expiration}; if ( $cache_duration && $client->{cached_drivers}{$hashdsn}{create_ts} && $client->{cached_drivers}{$hashdsn}{create_ts} + $cache_duration > $t ) { $driver = $client->{cached_drivers}{$hashdsn}{driver}; } else { my $db = $client->{databases}{$hashdsn} or croak "Ouch, I don't know about a database whose hash is $hashdsn"; if ( $db->{driver} ) { $driver = $db->{driver}; } else { $driver = Data::ObjectDriver::Driver::DBI->new( dsn => $db->{dsn}, username => $db->{user}, password => $db->{pass}, ); } $driver->prefix( $db->{prefix} ) if exists $db->{prefix}; if ($cache_duration) { $client->{cached_drivers}{$hashdsn}{driver} = $driver; $client->{cached_drivers}{$hashdsn}{create_ts} = $t; } } return $driver; } sub mark_database_as_dead { my TheSchwartz $client = shift; my ($hashdsn) = @_; $client->{dead_dsns}{$hashdsn} = 1; $client->{retry_at}{$hashdsn} = time + $client->{retry_seconds}; $client->debug("Disabling DB $hashdsn because " . ($client->driver_for($hashdsn)->last_error() || 'unknown')); } sub is_database_dead { my TheSchwartz $client = shift; my ($hashdsn) = @_; ## If this database is marked as dead, check the retry time. If ## it has passed, try the database again to see if it's undead. if ( $client->{dead_dsns}{$hashdsn} ) { if ( $client->{retry_at}{$hashdsn} < time ) { delete $client->{dead_dsns}{$hashdsn}; delete $client->{retry_at}{$hashdsn}; return 0; } else { return 1; } } return 0; } sub lookup_job { my TheSchwartz $client = shift; my $handle = $client->handle_from_string(@_); my $driver = $client->driver_for( $handle->dsn_hashed ); my $id = $handle->jobid; my $job = $driver->lookup( 'TheSchwartz::Job' => $handle->jobid ) or return; $job->handle($handle); $job->funcname( $client->funcid_to_name( $driver, $handle->dsn_hashed, $job->funcid ) ); return $job; } sub list_jobs { my TheSchwartz $client = shift; my $arg = shift; my ( %terms, %options ); $terms{run_after} = { op => '<=', value => $arg->{run_after} } if exists $arg->{run_after}; $terms{grabbed_until} = { op => '<=', value => $arg->{grabbed_until} } if exists $arg->{grabbed_until}; $terms{jobid} = { op => '=', value => $arg->{jobid} } if exists $arg->{jobid}; die "No funcname" unless exists $arg->{funcname}; $arg->{want_handle} = 1 unless defined $arg->{want_handle}; my $limit = $arg->{limit} || $client->batch_size; if ( $arg->{coalesce} ) { $arg->{coalesce_op} ||= '='; } $options{limit} = $limit; if ( $client->prioritize ) { $options{sort} = [ { column => 'priority', direction => 'descend' }, { column => 'jobid' }, ]; } else { # RT #34843 $options{sort} = [ { column => 'jobid' }, ]; } if ( $client->floor ) { $terms{priority} = { op => '>=', value => $client->floor }; } my @jobs; for my $hashdsn ( $client->shuffled_databases ) { ## If the database is dead, skip it next if $client->is_database_dead($hashdsn); my $driver = $client->driver_for($hashdsn); if ( ref( $arg->{funcname} ) ) { $terms{funcid} = [ map { $client->funcname_to_id( $driver, $hashdsn, $_ ) } @{ $arg->{funcname} } ]; } else { $terms{funcid} = $client->funcname_to_id( $driver, $hashdsn, $arg->{funcname} ); } if ( $arg->{want_handle} ) { push @jobs, map { my $handle = TheSchwartz::JobHandle->new( { dsn_hashed => $hashdsn, client => $client, jobid => $_->jobid } ); $_->handle($handle); $_; } $driver->search( 'TheSchwartz::Job' => \%terms, \%options ); } else { push @jobs, $driver->search( 'TheSchwartz::Job' => \%terms, \%options ); } } return @jobs; } sub find_job_with_coalescing_prefix { my TheSchwartz $client = shift; my ( $funcname, $coval ) = @_; $coval .= "%"; return $client->_find_job_with_coalescing( 'LIKE', $funcname, $coval ); } sub find_job_with_coalescing_value { my TheSchwartz $client = shift; return $client->_find_job_with_coalescing( '=', @_ ); } sub _find_job_with_coalescing { my TheSchwartz $client = shift; my ( $op, $funcname, $coval ) = @_; for my $hashdsn ( $client->shuffled_databases ) { ## If the database is dead, skip it next if $client->is_database_dead($hashdsn); my $driver = $client->driver_for($hashdsn); my $unixtime = $driver->dbd->sql_for_unixtime; my %options = ( limit => $client->batch_size ); if ( $client->prioritize ) { $options{sort} = [ { column => 'priority', direction => 'descend' }, { column => 'jobid' }, ]; } else { # RT #34843 $options{sort} = [ { column => 'jobid' }, ]; } my @jobs; eval { ## Search for jobs in this database where: ## 1. funcname is in the list of abilities this $client supports; ## 2. the job is scheduled to be run (run_after is in the past); ## 3. no one else is working on the job (grabbed_until is in ## in the past). my $funcid = $client->funcname_to_id( $driver, $hashdsn, $funcname ); my %terms = ( funcid => $funcid, run_after => \"<= $unixtime", grabbed_until => \"<= $unixtime", coalesce => { op => $op, value => $coval }, ); if ( $client->floor ) { $terms{priority} = { op => '>=', value => $client->floor }; } @jobs = $driver->search( 'TheSchwartz::Job' => \%terms, \%options, ); }; if ($@) { unless ( OK_ERRORS->{ $driver->last_error || 0 } ) { $client->mark_database_as_dead($hashdsn); } } my $job = $client->_grab_a_job( $hashdsn, @jobs ); return $job if $job; } } sub find_job_for_workers { my TheSchwartz $client = shift; my ($worker_classes) = @_; $worker_classes ||= $client->{current_abilities}; my %options = ( limit => $client->batch_size ); if ( $client->prioritize ) { $options{sort} = [ { column => 'priority', direction => 'descend' }, { column => 'jobid' }, ]; } else { # RT #34843 $options{sort} = [ { column => 'jobid' }, ]; } for my $hashdsn ( $client->shuffled_databases ) { ## If the database is dead, skip it. next if $client->is_database_dead($hashdsn); my $driver = $client->driver_for($hashdsn); my $unixtime = $driver->dbd->sql_for_unixtime; my @jobs; eval { ## Search for jobs in this database where: ## 1. funcname is in the list of abilities this $client supports; ## 2. the job is scheduled to be run (run_after is in the past); ## 3. no one else is working on the job (grabbed_until is in ## in the past). my @ids = map { $client->funcname_to_id( $driver, $hashdsn, $_ ) } @$worker_classes; my %terms = ( funcid => \@ids, run_after => \"<= $unixtime", grabbed_until => \"<= $unixtime", ); if ( $client->floor ) { $terms{priority} = { op => '>=', value => $client->floor }; } @jobs = $driver->search( 'TheSchwartz::Job' => \%terms, \%options, ); }; if ($@) { unless ( OK_ERRORS->{ $driver->last_error || 0 } ) { $client->mark_database_as_dead($hashdsn); } } # for test harness race condition testing $T_AFTER_GRAB_SELECT_BEFORE_UPDATE->() if $T_AFTER_GRAB_SELECT_BEFORE_UPDATE; my $job = $client->_grab_a_job( $hashdsn, @jobs ); return $job if $job; } } sub get_server_time { my TheSchwartz $client = shift; my ($driver) = @_; my $unixtime_sql = $driver->dbd->sql_for_unixtime; # RT #58049 $unixtime_sql .= ' FROM DUAL' if ( $driver->dbd->isa('Data::ObjectDriver::Driver::DBD::Oracle') ); return $driver->rw_handle->selectrow_array("SELECT $unixtime_sql"); } sub _grab_a_job { my TheSchwartz $client = shift; my $hashdsn = shift; my $driver = $client->driver_for($hashdsn); ## Got some jobs! Randomize them to avoid contention between workers. my @jobs = shuffle(@_); JOB: while ( my $job = shift @jobs ) { ## Convert the funcid to a funcname, based on this database's map. $job->funcname( $client->funcid_to_name( $driver, $hashdsn, $job->funcid ) ); ## Update the job's grabbed_until column so that ## no one else takes it. my $worker_class = $job->funcname; my $old_grabbed_until = $job->grabbed_until; my $server_time = $client->get_server_time($driver) or die "expected a server time"; $job->grabbed_until( $server_time + ( $worker_class->grab_for || 1 ) ); ## Update the job in the database, and end the transaction. ## NOTE: For some reason, D::OD doesn't ensure the object's value is ## in bounds of original search query. so we need to be more paranoic ## to make sure it's not grabbed by other workers. my $unixtime = $driver->dbd->sql_for_unixtime; if ( $driver->update( $job, { grabbed_until => [ '-and', { op => '=', value => $old_grabbed_until}, \" <= $unixtime" ]}) < 1 ) { ## We lost the race to get this particular job--another worker must ## have got it and already updated it. Move on to the next job. $T_LOST_RACE->() if $T_LOST_RACE; next JOB; } ## Now prepare the job, and return it. my $handle = TheSchwartz::JobHandle->new( { dsn_hashed => $hashdsn, jobid => $job->jobid, } ); $handle->client($client); $job->handle($handle); return $job; } return; } sub shuffled_databases { my TheSchwartz $client = shift; my @dsns = keys %{ $client->{databases} }; return shuffle(@dsns); } sub insert_job_to_driver { my $client = shift; my ( $job, $driver, $hashdsn ) = @_; eval { ## Set the funcid of the job, based on the funcname. Since each ## database has a separate cache, this needs to be calculated based ## on the hashed DSN. Also: this might fail, if the database is dead. $job->funcid( $client->funcname_to_id( $driver, $hashdsn, $job->funcname ) ); ## This is sub-optimal because of clock skew, but something is ## better than a NULL value. And currently, nothing in TheSchwartz ## code itself uses insert_time. TODO: use server time, but without ## having to do a roundtrip just to get the server time. $job->insert_time(time); ## Now, insert the job. This also might fail. $driver->insert($job); }; if ($@) { unless ( OK_ERRORS->{ $driver->last_error || 0 } ) { $client->mark_database_as_dead($hashdsn); } } elsif ( $job->jobid ) { ## We inserted the job successfully! ## Attach a handle to the job, and return the handle. my $handle = TheSchwartz::JobHandle->new( { dsn_hashed => $hashdsn, client => $client, jobid => $job->jobid } ); $job->handle($handle); return $handle; } return; } sub insert_jobs { my TheSchwartz $client = shift; my (@jobs) = @_; ## Try each of the databases that are registered with $client, in ## random order. If we successfully create the job, exit the loop. my @handles; DATABASE: for my $hashdsn ( $client->shuffled_databases ) { ## If the database is dead, skip it. next if $client->is_database_dead($hashdsn); my $driver = $client->driver_for($hashdsn); $driver->begin_work; for my $j (@jobs) { my $h = $client->insert_job_to_driver( $j, $driver, $hashdsn ); if ($h) { push @handles, $h; } else { $driver->rollback; @handles = (); next DATABASE; } } last if eval { $driver->commit }; @handles = (); next DATABASE; } return wantarray ? @handles : scalar @handles; } sub insert { my TheSchwartz $client = shift; my $job = shift; if ( ref( $_[0] ) eq "TheSchwartz::Job" ) { croak "Can't insert multiple jobs with method 'insert'\n"; } unless ( ref($job) eq 'TheSchwartz::Job' ) { $job = TheSchwartz::Job->new_from_array( $job, $_[0] ); } ## Try each of the databases that are registered with $client, in ## random order. If we successfully create the job, exit the loop. for my $hashdsn ( $client->shuffled_databases ) { ## If the database is dead, skip it. next if $client->is_database_dead($hashdsn); my $driver = $client->driver_for($hashdsn); ## Try to insert the job into this database. If we get a handle ## back, return it. my $handle = $client->insert_job_to_driver( $job, $driver, $hashdsn ); return $handle if $handle; } ## If the job wasn't submitted successfully to any database, return. return; } sub handle_from_string { my TheSchwartz $client = shift; my $handle = TheSchwartz::JobHandle->new_from_string(@_); $handle->client($client); return $handle; } sub can_do { my TheSchwartz $client = shift; my ($class) = @_; push @{ $client->{all_abilities} }, $class; push @{ $client->{current_abilities} }, $class; } sub reset_abilities { my TheSchwartz $client = shift; $client->{all_abilities} = []; $client->{current_abilities} = []; } sub restore_full_abilities { my $client = shift; $client->{current_abilities} = [ @{ $client->{all_abilities} } ]; } sub temporarily_remove_ability { my $client = shift; my ($class) = @_; $client->{current_abilities} = [ grep { $_ ne $class } @{ $client->{current_abilities} } ]; if ( !@{ $client->{current_abilities} } ) { $client->restore_full_abilities; } } sub work_on { my TheSchwartz $client = shift; my $hstr = shift; # Handle string my $job = $client->lookup_job($hstr) or return 0; return $client->work_once($job); } sub grab_and_work_on { my TheSchwartz $client = shift; my $hstr = shift; # Handle string my $job = $client->lookup_job($hstr) or return 0; ## check that the job is grabbable my $hashdsn = $job->handle->dsn_hashed; my $driver = $client->driver_for($hashdsn); my $current_time = $client->get_server_time($driver); return 0 if $current_time < $job->grabbed_until; ## grab the job the usual way $job = $client->_grab_a_job( $hashdsn, $job ) or return 0; return $client->work_once($job); } sub work { my TheSchwartz $client = shift; my ($delay) = @_; $delay ||= 5; while (1) { sleep $delay unless $client->work_once; } } sub work_until_done { my TheSchwartz $client = shift; while (1) { $client->work_once or last; } } ## Returns true if it did something, false if no jobs were found sub work_once { my TheSchwartz $client = shift; my $job = shift; # optional specific job to work on ## Look for a job with our current set of abilities. Note that the ## list of current abilities may not be equal to the full set of ## abilities, to allow for even distribution between jobs. $job ||= $client->find_job_for_workers; ## If we didn't find anything, restore our full abilities, and try ## again. if ( !$job && !$client->{strict_remove_ability} && @{ $client->{current_abilities} } < @{ $client->{all_abilities} } ) { $client->restore_full_abilities; $job = $client->find_job_for_workers; } my $class = $job ? $job->funcname : undef; if ($job) { my $priority = $job->priority ? ", priority " . $job->priority : ""; $job->debug( "TheSchwartz::work_once got job of class '$class'$priority"); } else { $client->debug("TheSchwartz::work_once found no jobs"); } ## If we still don't have anything, return. return unless $job; ## Now that we found a job for this particular funcname, remove it ## from our list of current abilities. So the next time we look for a ## we'll find a job for a different funcname. This prevents starvation of ## high funcid values because of the way MySQL's indexes work. ## BUGBUG this looks odd since ordering by job_id should limit any skew ... $client->temporarily_remove_ability($class) unless($client->{strict_remove_ability}); $class->work_safely($job); ## We got a job, so return 1 so work_until_done (which calls this method) ## knows to keep looking for jobs. return 1; } sub funcid_to_name { my TheSchwartz $client = shift; my ( $driver, $hashdsn, $funcid ) = @_; my $cache = $client->_funcmap_cache($hashdsn); return $cache->{funcid2name}{$funcid}; } sub funcname_to_id { my TheSchwartz $client = shift; my ( $driver, $hashdsn, $funcname ) = @_; my $cache = $client->_funcmap_cache($hashdsn); unless ( exists $cache->{funcname2id}{$funcname} ) { my $map = TheSchwartz::FuncMap->create_or_find( $driver, $funcname ); $cache->{funcname2id}{ $map->funcname } = $map->funcid; $cache->{funcid2name}{ $map->funcid } = $map->funcname; } return $cache->{funcname2id}{$funcname}; } sub _funcmap_cache { my TheSchwartz $client = shift; my ($hashdsn) = @_; unless ( exists $client->{funcmap_cache}{$hashdsn} ) { my $driver = $client->driver_for($hashdsn); my @maps = $driver->search('TheSchwartz::FuncMap'); my $cache = { funcname2id => {}, funcid2name => {} }; for my $map (@maps) { $cache->{funcname2id}{ $map->funcname } = $map->funcid; $cache->{funcid2name}{ $map->funcid } = $map->funcname; } $client->{funcmap_cache}{$hashdsn} = $cache; } return $client->{funcmap_cache}{$hashdsn}; } # accessors sub verbose { my TheSchwartz $client = shift; return $client->{verbose}; } sub set_verbose { my TheSchwartz $client = shift; my $logger = shift; # or non-coderef to just print to stderr if ( $logger && ref $logger ne "CODE" ) { $logger = sub { my $msg = shift; $msg =~ s/\s+$//; print STDERR "$msg\n"; }; } $client->{verbose} = $logger; } sub scoreboard { my TheSchwartz $client = shift; return $client->{scoreboard}; } sub set_scoreboard { my TheSchwartz $client = shift; my ($dir) = @_; return unless $dir; # They want the scoreboard but don't care where it goes if ( ( $dir eq '1' ) or ( $dir eq 'on' ) ) { # Find someplace in tmpfs to save this foreach my $d (qw(/var/run /dev/shm)) { $dir = $d; last if -e $dir; } } $dir .= '/theschwartz'; unless ( -e $dir ) { mkdir( $dir, 0755 ) or die "Can't create scoreboard directory '$dir': $!"; } $client->{scoreboard} = $dir . "/scoreboard.$$"; } sub start_scoreboard { my TheSchwartz $client = shift; # Don't do anything if we're not configured to write to the scoreboard my $scoreboard = $client->scoreboard; return unless $scoreboard; # Don't do anything of (for some reason) we don't have a current job my $job = $client->current_job; return unless $job; my $class = $job->funcname; open( my $SB, '>', $scoreboard ) or $job->debug("Could not write scoreboard '$scoreboard': $!"); print $SB join( "\n", ( "pid=$$", 'funcname=' . ( $class || '' ), 'started=' . ( $job->grabbed_until - ( $class->grab_for || 1 ) ), 'arg=' . _serialize_args( $job->arg ), ) ), "\n"; close($SB); return; } # Quick and dirty serializer. Don't use Data::Dumper because we don't need to # recurse indefinitely and we want to truncate the output produced sub _serialize_args { my ($args) = @_; if ( ref $args ) { if ( ref $args eq 'HASH' ) { return join ',', map { ( $_ || '' ) . '=' . substr( $args->{$_} || '', 0, 200 ) } keys %$args; } elsif ( ref $args eq 'ARRAY' ) { return join ',', map { substr( $_ || '', 0, 200 ) } @$args; } } else { return $args; } } sub end_scoreboard { my TheSchwartz $client = shift; # Don't do anything if we're not configured to write to the scoreboard my $scoreboard = $client->scoreboard; return unless $scoreboard; my $job = $client->current_job; open( my $SB, '>>', $scoreboard ) or $job->debug("Could not append scoreboard '$scoreboard': $!"); print $SB "done=" . time . "\n"; close($SB); return; } sub clean_scoreboard { my TheSchwartz $client = shift; # Don't do anything if we're not configured to write to the scoreboard my $scoreboard = $client->scoreboard; return unless $scoreboard; unlink($scoreboard); } sub prioritize { my TheSchwartz $client = shift; return $client->{prioritize}; } sub set_prioritize { my TheSchwartz $client = shift; $client->{prioritize} = shift; } sub floor { my TheSchwartz $client = shift; return $client->{floor}; } sub set_floor { my TheSchwartz $client = shift; die "set_floor only works if prioritize is set." unless ( $client->prioritize ); $client->{floor} = shift; } sub batch_size { my TheSchwartz $client = shift; return $client->{batch_size}; } sub set_batch_size { my TheSchwartz $client = shift; $client->{batch_size} = shift; } # current job being worked. so if something dies, work_safely knows which to mark as dead. sub current_job { my TheSchwartz $client = shift; $client->{current_job}; } sub set_current_job { my TheSchwartz $client = shift; $client->{current_job} = shift; } sub strict_remove_ability { my TheSchwartz $client = shift; return $client->{strict_remove_ability}; } sub set_strict_remove_ability { my TheSchwartz $client = shift; $client->{strict_remove_ability} = shift; } DESTROY { foreach my $arg (@_) { # Call 'clean_scoreboard' on TheSchwartz objects if ( ref($arg) and $arg->isa('TheSchwartz') ) { $arg->clean_scoreboard; } } } 1; __END__ =head1 NAME TheSchwartz - reliable job queue =head1 SYNOPSIS # MyApp.pm package MyApp; sub work_asynchronously { my %args = @_; my $client = TheSchwartz->new( databases => $DATABASE_INFO ); $client->insert('MyWorker', \%args); } # myworker.pl package MyWorker; use base qw( TheSchwartz::Worker ); sub work { my $class = shift; my TheSchwartz::Job $job = shift; print "Workin' hard or hardly workin'? Hyuk!!\n"; $job->completed(); } package main; my $client = TheSchwartz->new( databases => $DATABASE_INFO ); $client->can_do('MyWorker'); $client->work(); =head1 DESCRIPTION TheSchwartz is a reliable job queue system. Your application can put jobs into the system, and your worker processes can pull jobs from the queue atomically to perform. Failed jobs can be left in the queue to retry later. I specify what jobs a worker process can perform. Abilities are the names of C sub-classes, as in the synopsis: the C class name is used to specify that the worker script can perform the job. When using the C client's C functions, the class-ability duality is used to automatically dispatch to the proper class to do the actual work. TheSchwartz clients will also prefer to do jobs for unused abilities before reusing a particular ability, to avoid exhausting the supply of one kind of job while jobs of other types stack up. Some jobs with high setup times can be performed more efficiently if a group of related jobs are performed together. TheSchwartz offers a facility to I jobs into groups, which a properly constructed worker can find and perform at once. For example, if your worker were delivering email, you might store the domain name from the recipient's address as the coalescing value. The worker that grabs that job could then batch deliver all the mail for that domain once it connects to that domain's mail server. =head1 USAGE =head2 Cnew( %args )> Optional members of C<%args> are: =over 4 =item * C An arrayref of database information. TheSchwartz workers can use multiple databases, such that if any of them are unavailable, the worker will search for appropriate jobs in the other databases automatically. Each member of the C value should be a hashref containing either: =over 4 =item * C The database DSN for this database. =item * C The user name to use when connecting to this database. =item * C The password to use when connecting to this database. =back or =over 4 =item * C A C object. See note below. =back =item * C A value indicating whether to log debug messages. If C is a coderef, it is called to log debug messages. If C is not a coderef but is some other true value, debug messages will be sent to C. Otherwise, debug messages will not be logged. =item * C A value indicating whether to utilize the job 'priority' field when selecting jobs to be processed. If unspecified, jobs will always be executed in a randomized order. =item * C A value indicating the minimum priority a job needs to be for this worker to perform. If unspecified all jobs are considered. =item * C A value indicating how many jobs should be fetched from the DB for consideration. =item * C Optional value to control how long database connections are cached for in seconds. By default, connections are not cached. To re-use the same database connection for five minutes, pass driver_cache_expiration => 300 to the constructor. Improves job throughput in cases where the work to process a job is small compared to the database connection set-up and tear-down time. =item * C The number of seconds after which to try reconnecting to apparently dead databases. If not given, TheSchwartz will retry connecting to databases after 30 seconds. =item * C By default when work_once does not find a job it will reset current_abilities to all_abilities and look for a job. Setting this option will prevent work_once from resetting abilities if it can't find a job for the current capabilities. =back =head2 C<$client-Elist_jobs( %args )> Returns a list of C objects matching the given arguments. The required members of C<%args> are: =over 4 =item * C the name of the function or a reference to an array of functions =item * C the value you want to check <= against on the run_after column =item * C the value you want to check <= against on the grabbed_until column =item * C defaults to '=', set it to whatever you want to compare the coalesce field too if you want to search, you can use 'LIKE' =item * C coalesce value to search for, if you set op to 'LIKE' you can use '%' here, do remember that '%' searches anchored at the beginning of the string are much faster since it is can do a btree index lookup =item * C if you want all your jobs to be set up using a handle. defaults to true. this option might be removed, as you should always have this on a Job object. =item * C if you want a specific job you can pass in it's ID and if it's available it will be listed. =back It is important to remember that this function does not lock anything, it just returns as many jobs as there is up to amount of databases * $client->{batch_size} =head2 C<$client-Elookup_job( $handle_id )> Returns a C corresponding to the given handle ID. =head2 C<$client-Eset_verbose( $verbose )> Sets the current logging function to C<$verbose> if it's a coderef. If not a coderef, enables debug logging to C if C<$verbose> is true; otherwise, disables logging. =head1 POSTING JOBS The methods of TheSchwartz clients used by applications posting jobs to the queue are: =head2 C<$client-Einsert( $job )> Adds the given C to one of the client's job databases. =head2 C<$client-Einsert( $funcname, $arg )> Adds a new job with function name C<$funcname> and arguments C<$arg> to the queue. =head2 C<$client-Einsert_jobs( @jobs )> Adds the given C objects to one of the client's job databases. All the given jobs are recorded in I job database. =head2 C<$client-Eset_prioritize( $prioritize )> Set the C value as described in the constructor. =head2 C<$client-Eset_floor( $floor )> Set the C value as described in the constructor. =head2 C<$client-Eset_batch_size( $batch_size )> Set the C value as described in the constructor. =head2 C<$client-Eset_strict_remove_ability( $strict_remove_ability )> Set the C value as described in the constructor. =head1 WORKING The methods of TheSchwartz clients for use in worker processes are: =head2 C<$client-Ecan_do( $ability )> Adds C<$ability> to the list of abilities C<$client> is capable of performing. Subsequent calls to that client's C methods will find jobs requiring the given ability. =head2 C<$client-Ework_once()> Find and perform one job C<$client> can do. =head2 C<$client-Ework_until_done()> Find and perform jobs C<$client> can do until no more such jobs are found in any of the client's job databases. =head2 C<$client-Ework( [$delay] )> Find and perform any jobs C<$client> can do, forever. When no job is available, the working process will sleep for C<$delay> seconds (or 5, if not specified) before looking again. =head2 C<$client-Ework_on($handle)> Given a job handle (a scalar string) I<$handle>, runs the job, then returns. =head2 C<$client-Egrab_and_work_on($handle)> Similar to L<$client-Ework_on($handle)>, except that the job will be grabbed before being run. It guarantees that only one worker will work on it (at least in the C interval). Returns false if the worker could not grab the job, and true if the worker worked on it. =head2 C<$client-Efind_job_for_workers( [$abilities] )> Returns a C for a random job that the client can do. If specified, the job returned matches one of the abilities in the arrayref C<$abilities>, rather than C<$client>'s abilities. =head2 C<$client-Efind_job_with_coalescing_value( $ability, $coval )> Returns a C for a random job for a worker capable of C<$ability> and with a coalescing value of C<$coval>. =head2 C<$client-Efind_job_with_coalescing_prefix( $ability, $coval )> Returns a C for a random job for a worker capable of C<$ability> and with a coalescing value beginning with C<$coval>. Note the C implementation of this function uses a C query to find matching jobs, with all the attendant performance implications for your job databases. =head2 C<$client-Eget_server_time( $driver )> Given an open driver I<$driver> to a database, gets the current server time from the database. =head1 THE SCOREBOARD The scoreboards can be used to monitor what the TheSchwartz::Worker sub-classes are currently working on. Once the scoreboard has been enabled in the workers with C method the C utility (shipped with TheSchwartz distribution in the C directory) can be used to list all current jobs being worked on. =head2 C<< $client->set_scoreboard( $dir ) >> Enables the scoreboard. Setting this to C<1> or C will cause TheSchwartz to create a scoreboard file in a location it determines is optimal. Passing in any other option sets the directory the TheSchwartz scoreboard directory should be created in. For example, if you set this to C then this would create a directory called C and a scoreboard file C in it (where pid is the current process pid.) =head2 C<< $client->scoreboard() >> Returns the path to the current scoreboard file. =head2 C<< $client->start_scoreboard() >> Writes the current job information to the scoreboard file (called by the worker in work_safely before it actually starts working) =head2 C<< $client->end_scoreboard() >> Appends the current job duration to the end of the scoreboard file (called by the worker in work_safely once work has been completed) =head2 C<< $client->clean_scoreboard() >> Removes the scoreboard file (but not the scoreboard directory.) Automatically called by TheSchwartz during object destruction (i.e. when the instance goes out of scope) =head1 PASSING IN AN EXISTING DRIVER You can pass in a existing C object which also allows you to reuse exist Database handles like so: my $dbh = DBI->connect( $dsn, "root", "", { RaiseError => 1, PrintError => 0, AutoCommit => 1, } ) or die $DBI::errstr; my $driver = Data::ObjectDriver::Driver::DBI->new( dbh => $dbh); return TheSchwartz->new(databases => [{ driver => $driver }]); B: it's important that the C and C flags are set on the handle for various bits of functionality to work. =head1 COPYRIGHT, LICENSE & WARRANTY This software is Copyright 2007, Six Apart Ltd, cpan@sixapart.com. All rights reserved. TheSchwartz is free software; you may redistribute it and/or modify it under the same terms as Perl itself. TheSchwartz comes with no warranty of any kind. =cut TheSchwartz-1.12/lib/TheSchwartz000755000764000764 012506132345 16625 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/lib/TheSchwartz/Error.pm000444000764000764 35412506132345 20373 0ustar00jfearnjfearn000000000000# $Id$ package TheSchwartz::Error; use strict; use base qw( Data::ObjectDriver::BaseObject ); __PACKAGE__->install_properties( { columns => [qw( jobid funcid message error_time )], datasource => 'error', } ); 1; TheSchwartz-1.12/lib/TheSchwartz/JobHandle.pm000444000764000764 270612506132345 21153 0ustar00jfearnjfearn000000000000# $Id$ package TheSchwartz::JobHandle; use strict; use base qw( Class::Accessor::Fast ); __PACKAGE__->mk_accessors(qw( dsn_hashed jobid client )); use TheSchwartz::ExitStatus; use TheSchwartz::Job; sub new_from_string { my $class = shift; my ($hstr) = @_; my ( $hashdsn, $jobid ) = split /\-/, $hstr, 2; return TheSchwartz::JobHandle->new( { dsn_hashed => $hashdsn, jobid => $jobid, } ); } sub as_string { my $handle = shift; return join '-', $handle->dsn_hashed, $handle->jobid; } sub driver { my $handle = shift; unless ( exists $handle->{__driver} ) { $handle->{__driver} = $handle->client->driver_for( $handle->dsn_hashed ); } return $handle->{__driver}; } sub job { my $handle = shift; my $job = $handle->client->lookup_job( $handle->as_string ) or return; $job->handle($handle); return $job; } sub is_pending { my $handle = shift; return $handle->job ? 1 : 0; } sub exit_status { my $handle = shift; my $status = $handle->driver->lookup( 'TheSchwartz::ExitStatus' => $handle->jobid ) or return; return $status->status; } sub failure_log { my $handle = shift; my @failures = $handle->driver->search( 'TheSchwartz::Error' => { jobid => $handle->jobid }, ); return map { $_->message } @failures; } sub failures { my $handle = shift; return scalar $handle->failure_log; } 1; TheSchwartz-1.12/lib/TheSchwartz/ExitStatus.pm000444000764000764 51312506132345 21414 0ustar00jfearnjfearn000000000000# $Id$ package TheSchwartz::ExitStatus; use strict; use base qw( Data::ObjectDriver::BaseObject ); __PACKAGE__->install_properties( { columns => [ qw( jobid status funcid completion_time delete_after ) ], datasource => 'exitstatus', primary_key => 'jobid', } ); 1; TheSchwartz-1.12/lib/TheSchwartz/Worker.pm000444000764000764 1043112506132345 20610 0ustar00jfearnjfearn000000000000# $Id$ package TheSchwartz::Worker; use strict; use Carp qw( croak ); use Storable (); sub grab_job { my $class = shift; my ($client) = @_; return $client->find_job_for_workers( [$class] ); } sub keep_exit_status_for {0} sub max_retries {0} sub retry_delay {0} sub grab_for { 60 * 60 } ## 1 hour sub work_safely { my ( $class, $job ) = @_; my $client = $job->handle->client; my $res; $job->debug("Working on $class ..."); $job->set_as_current; $client->start_scoreboard; eval { $res = $class->work($job); }; my $errstr = $@; my $cjob = $client->current_job; if ($errstr) { # something went wrong, better make a rollback! my $driver = $cjob->driver; $driver->rollback; $job->debug("Eval failure: $errstr"); $cjob->failed($errstr); } if ( !$cjob->was_declined && !$cjob->did_something ) { $cjob->failed( 'Job did not explicitly complete, fail, or get replaced'); } $client->end_scoreboard; # FIXME: this return value is kinda useless/undefined. should we even return anything? any callers? -brad return $res; } 1; __END__ =head1 NAME TheSchwartz::Worker - superclass for defining task behavior =head1 SYNOPSIS package MyWorker; use base qw( TheSchwartz::Worker ); sub work { my $class = shift; my TheSchwartz::Job $job = shift; print "Workin' hard or hardly workin'? Hyuk!!\n"; $job->completed(); } package main; my $client = TheSchwartz->new( databases => $DATABASE_INFO ); $client->can_do('MyWorker'); $client->work(); =head1 DESCRIPTION I objects are the salt of the reliable job queuing earth. The behavior required to perform posted jobs are defined in sub-classes of I. These sub-classes are named for the ability required of a C client to do the job, so that the clients can dispatch automatically to the appropriate worker routine. Because jobs can be performed by any machine running code for capable worker classes, Cs are generally stateless. All mutable state is stored in the C objects. This means all C methods are I methods, and C classes are generally never instantiated. =head1 SUBCLASSING Define and customize how a job is performed by overriding these methods in your subclass: =head2 C<$class-Ework( $job )> Performs the job that required ability C<$class>. Override this method to define how to do the job you're defining. Note that will need to call C<$job-Ecompleted()> or C<$job-Efailed()> as appropriate to indicate success or failure. See L. =head2 C<$class-Emax_retries( $job )> Returns the number of times workers should attempt the given job. After this many tries, the job is marked as completed with errors (that is, a C is recorded for it) and removed from the queue. By default, returns 0. =head2 C<$class-Eretry_delay( $num_failures )> Returns the number of seconds after a failure workers should wait until reattempting a job that has already failed C<$num_failures> times. By default, returns 0. =head2 C<$class-Ekeep_exit_status_for()> Returns the number of seconds to allow a C record for a job performed by this worker class to exist. By default, returns 0. =head2 C<$class-Egrab_for()> Returns the number of seconds workers of this class will claim a grabbed a job. That is, returns the length of the I after which other workers will decide a worker that claimed a job has crashed or faulted without marking the job failed. Jobs that are marked as failed by a worker are also marked for immediate retry after a delay indicated by C. =head1 USAGE =head2 C<$class-Egrab_job( $client )> Finds and claims a job for workers with ability C<$class>, using C client C<$client>. This job can then be passed to C or C to perform it. =head2 C<$class-Ework_safely( $job )> Performs the job associated with the worker's class name. If an error is thrown while doing the job, the job is appropriately marked as failed, unlike when calling C directly. =cut TheSchwartz-1.12/lib/TheSchwartz/Job.pm000444000764000764 4027112506132345 20056 0ustar00jfearnjfearn000000000000# $Id$ package TheSchwartz::Job; use strict; use base qw( Data::ObjectDriver::BaseObject ); use Carp qw( croak ); use Storable (); use TheSchwartz::Error; use TheSchwartz::ExitStatus; use TheSchwartz::JobHandle; __PACKAGE__->install_properties( { columns => [ qw(jobid funcid arg uniqkey insert_time run_after grabbed_until priority coalesce) ], datasource => 'job', column_defs => { arg => 'blob' }, primary_key => 'jobid', } ); __PACKAGE__->add_trigger( pre_save => sub { my ($job) = @_; my $arg = $job->arg or return; if ( ref($arg) ) { $job->arg( Storable::nfreeze($arg) ); } } ); __PACKAGE__->add_trigger( post_load => sub { my ($job) = @_; my $arg = $job->arg or return; $job->arg( _cond_thaw( $job->arg ) ); } ); sub new_from_array { my $class = shift; my (@arg) = @_; croak "usage: new_from_array(funcname, arg)" unless @arg == 2; return $class->new( funcname => $arg[0], arg => $arg[1], ); } sub new { my $class = shift; my (%param) = @_; my $job = $class->SUPER::new; if ( my $arg = $param{arg} ) { if ( ref($arg) eq 'SCALAR' ) { $param{arg} = Storable::thaw($$arg); } elsif ( !ref($arg) ) { # if a regular scalar, test to see if it's a storable or not. $param{arg} = _cond_thaw($arg); } } $param{run_after} ||= time; $param{grabbed_until} ||= 0; for my $key ( keys %param ) { $job->$key( $param{$key} ); } return $job; } sub funcname { my $job = shift; if (@_) { $job->{__funcname} = shift; } # lazily load, if ( !$job->{__funcname} ) { my $handle = $job->handle; my $client = $handle->client; my $driver = $client->driver_for( $handle->dsn_hashed ); my $funcname = $client->funcid_to_name( $driver, $handle->dsn_hashed, $job->funcid ) or die "Failed to lookup funcname of job $job"; return $job->{__funcname} = $funcname; } return $job->{__funcname}; } sub handle { my $job = shift; if (@_) { $job->{__handle} = $_[0]; } return $job->{__handle}; } sub driver { my $job = shift; unless ( exists $job->{__driver} ) { my $handle = $job->handle; $job->{__driver} = $handle->client->driver_for( $handle->dsn_hashed ); } return $job->{__driver}; } sub add_failure { my $job = shift; my ($msg) = @_; my $error = TheSchwartz::Error->new; $error->error_time( time() ); $error->jobid( $job->jobid ); $error->funcid( $job->funcid ); $error->message( $msg || '' ); my $driver = $job->driver; $driver->insert($error); # and let's lazily clean some errors while we're here. my $unixtime = $driver->dbd->sql_for_unixtime; my $maxage = $TheSchwartz::T_ERRORS_MAX_AGE || ( 86400 * 7 ); $driver->remove( 'TheSchwartz::Error', { error_time => \"< $unixtime - $maxage", }, { nofetch => 1, limit => $driver->dbd->can_delete_with_limit ? 1000 : undef, } ); return $error; } sub exit_status { shift->handle->exit_status } sub failure_log { shift->handle->failure_log } sub failures { shift->handle->failures } sub set_exit_status { my $job = shift; my ($exit) = @_; my $class = $job->funcname; my $secs = $class->keep_exit_status_for or return; my $status = TheSchwartz::ExitStatus->new; $status->jobid( $job->jobid ); $status->funcid( $job->funcid ); $status->completion_time(time); $status->delete_after( $status->completion_time + $secs ); $status->status($exit); my $driver = $job->driver; $driver->insert($status); # and let's lazily clean some exitstatus while we're here. but # rather than doing this query all the time, we do it 1/nth of the # time, and deleting up to n*10 queries while we're at it. # default n is 10% of the time, doing 100 deletes. my $clean_thres = $TheSchwartz::T_EXITSTATUS_CLEAN_THRES || 0.10; if ( rand() < $clean_thres ) { my $unixtime = $driver->dbd->sql_for_unixtime; $driver->remove( 'TheSchwartz::ExitStatus', { delete_after => \"< $unixtime", }, { nofetch => 1, limit => $driver->dbd->can_delete_with_limit ? int( 1 / $clean_thres * 100 ) : undef, } ); } return $status; } sub was_declined { my $job = shift; if (@_) { $job->{__was_declined} = shift; } return $job->{__was_declined}; } sub did_something { my $job = shift; if (@_) { $job->{__did_something} = shift; } return $job->{__did_something}; } sub debug { my ( $job, $msg ) = @_; $job->handle->client->debug( $msg, $job ); } sub completed { my $job = shift; $job->debug("job completed"); if ( $job->did_something ) { $job->debug("can't call 'completed' on already finished job"); return 0; } $job->set_exit_status(0); $job->driver->remove($job); $job->did_something(1); } sub permanent_failure { my ( $job, $msg, $ex_status ) = @_; if ( $job->did_something ) { $job->debug("can't call 'permanent_failure' on already finished job"); return 0; } $job->_failed( $msg, $ex_status, 0 ); } sub declined { my $job = shift; my $run_after = shift; if ( $job->did_something ) { $job->debug("can't call 'declined' on already finished job"); return 0; } $job->was_declined(1); if ($run_after) { $job->run_after($run_after); $job->grabbed_until(0); $job->driver->update($job); $job->debug( "job declined. retry will be considered after lease is up at " . $job->run_after ); } else { $job->debug( "job declined. retry will be considered after lease is up at " . $job->grabbed_until ); } # we do nothing regarding the job's status } sub failed { my ( $job, $msg, $ex_status ) = @_; if ( $job->did_something ) { $job->debug("can't call 'failed' on already finished job"); return 0; } ## If this job class specifies that jobs should be retried, ## update the run_after if necessary, but keep the job around. my $class = $job->funcname; my $failures = $job->failures + 1; # include this one, since we haven't ->add_failure yet my $max_retries = $class->max_retries($job); $job->debug( "job failed. considering retry. is max_retries of $max_retries >= failures of $failures?" ); $job->_failed( $msg, $ex_status, $max_retries >= $failures, $failures ); } sub _failed { my ( $job, $msg, $exit_status, $_retry, $failures ) = @_; $job->debug( "job failed: " . ( $msg || "" ) ); ## Mark the failure in the error table. $job->add_failure($msg); if ($_retry) { my $class = $job->funcname; if ( my $delay = $class->retry_delay($failures) ) { $job->run_after( time() + $delay ); } $job->grabbed_until(0); $job->driver->update($job); } else { $job->set_exit_status( $exit_status || 1 ); $job->driver->remove($job); } $job->did_something(1); } sub replace_with { my $job = shift; my (@jobs) = @_; if ( $job->did_something ) { $job->debug("can't call 'replace_with' on already finished job"); return 0; } # Note: we don't set 'did_something' here because completed does it down below. ## The new jobs @jobs should be inserted into the same database as $job, ## which they're replacing. So get a driver for the database that $job ## belongs to. my $handle = $job->handle; my $client = $handle->client; my $hashdsn = $handle->dsn_hashed; my $driver = $job->driver; $job->debug( "replacing job with " . ( scalar @jobs ) . " other jobs" ); ## Start a transaction. $driver->begin_work; ## Insert the new jobs. for my $j (@jobs) { $client->insert_job_to_driver( $j, $driver, $hashdsn ); } ## Mark the original job as completed successfully. $job->completed; # for testing if ($TheSchwartz::Job::_T_REPLACE_WITH_FAIL) { $driver->rollback; die "commit failed for driver: due to testing\n"; } ## Looks like it's all ok, so commit. $driver->commit; } sub set_as_current { my $job = shift; my $client = $job->handle->client; $client->set_current_job($job); } sub _cond_thaw { my $data = shift; my $magic = eval { Storable::read_magic($data); }; if ( $magic && $magic->{major} && $magic->{major} >= 2 && $magic->{major} <= 5 ) { my $thawed = eval { Storable::thaw($data) }; if ($@) { # false alarm... looked like a Storable, but wasn't. return $data; } return $thawed; } else { return $data; } } 1; __END__ =head1 NAME TheSchwartz::Job - jobs for the reliable job queue =head1 SYNOPSIS my $client = TheSchwartz->new( databases => $DATABASE_INFO ); my $job = TheSchwartz::Job->new_from_array('MyWorker', [ foo => 'bar' ]); $client->insert($job); $job = TheSchwartz::Job->new( funcname => 'MyWorker', uniqkey => 7, arg => [ foo => 'bar' ], ); $client->insert($job); =head1 DESCRIPTION C models the jobs that are posted to the job queue by your application, then grabbed and performed by your worker processes. C is a C model class. See L. =head1 FIELDS C objects have these possible fields: =head2 C The unique numeric identifier for this job. Set automatically when saved. =head2 C The numeric identifier for the type of job to perform. C clients map function names (also known as abilities and worker class names) to these numbers using C records. =head2 C Arbitrary state data to supply to the worker process for this job. If specified as a reference, the data is frozen to a blob with the C module. =head2 C An arbitrary string identifier used to prevent applications from posting duplicate jobs. At most one with the same C value can be posted to a single C database. =head2 C The C field is not used. =head2 C The UNIX system time after which the job can next be attempted by a worker process. This time stamp is set when a job is first created or is released after a failure. =head2 C The UNIX system time after which the job can next be available by a worker process. This time stamp is set when a job is grabbed by a worker process, and reset to C<0> when is released due to failure to complete the job. =head2 C An integer value to specify the priority of the job to be executed; larger numbers mean higher priority. See C property of L for details. =head2 C A string used to discover jobs that can be efficiently pipe-lined with a given job due to some shared resource. For example, for email delivery jobs, the domain of an email address could be used as the C value. A worker process could then deliver all the mail queued for a given mail host after connecting to it once. =head1 USAGE =head2 Cnew( %args )> Returns a new job object with the given data. Members of C<%args> can be keyed on any of the fields described above, or C. =head2 Cnew_from_array( $funcname, $arg )> Returns a new job with the given function name (also called I or I), and the scalar or reference C<$arg> for an argument. =head2 C<$job-Efuncname([ $funcname ])> Returns the function name for the given job, after setting it to C<$funcname>, if specified. =head2 C<$job-Ehandle([ $handle ])> Returns the C object describing this job, after setting it to C<$handle>, if specified. A I is a convenience class for accessing other records related to jobs; as its convenience methods are also available directly from C instances, you will usually not need to work directly with job handles. =head2 C<$job-Edriver()> Returns the C object driver for accessing the database in which C<$job> is stored. See L. =head2 C<$job-Eadd_failure( $msg )> Records and returns a new C object representing a failure to perform C<$job>, for reason C<$msg>. =head2 C<$job-Eexit_status()> Returns the I specified by the worker that either completed the job or declared it failed permanently. The exit status for a job will be available for a period of time after the job has exited the queue. That time is defined in the job's worker class's C method. =head2 C<$job-Efailure_log()> Returns a list of the error messages specified to C when a worker failed to perform the given job. =head2 C<$job-Efailures()> Returns the number of times a worker has grabbed this job, only to fail to complete it. =head2 C<$job-Eset_exit_status( $status )> Records the exit status of the given job as C<$status>. =head2 C<$job-Edid_something([ $value ])> Returns whether the given job has been completed or failed since it was created or loaded, setting whether it has to C<$value> first, if specified. =head2 C<$job-Ewas_declined()> Sets (if given an argument) and returns the value of the was_declined flag for a job object. See also C<$job-Edeclined()> =head2 C<$job-Edebug( $msg )> Sends the given message to the job's C client as debug output. =head2 C<$job-Eset_as_current()> Set C<$job> as the current job being performed by its associated C client. =head1 WORKING C classes should use these methods to update the status of their jobs: =head2 C<$job-Ecompleted()> Records that the given job has been fully performed and removes it from the job queue. Completing a job records its exit status as C<0>. =head2 C<$job-Efailed( $msg, $exit_status )> Records that the worker performing this job failed to complete it, for reason C<$msg>. If workers have not failed to complete the job more times than the maximum number of retries for that type of job, the job will be reattempted after its retry delay has elapsed. The maximum number of retries and the delay before a retry are defined in the job's worker class definition as C and C respectively. If workers I exceeded the maximum number of reattempts for this job, the job's exit status is recorded as C<$exit_status>, and the job is removed from the queue. If C<$exit_status> is not defined or C<0>, the job will be recorded with an exit status of C<1>, to indicate a failure. =head2 C<$job-Epermanent_failure( $msg, $exit_status )> Records that the worker performing this job failed to complete it, as in C, but that the job should I be reattempted, no matter how many times the job has been attempted before. The job's exit status is thus recorded as C<$exit_status> (or C<1>), and the job is removed from the queue. =head2 C<$job-Edeclined([ $run_after ])> Report that the job has been declined for handling at this time, which means that the job will be retried after the next grabbed_until interval, and does not count against the max_retries count. If $run_after is set then the job will be grabbed_until will be reset and the job will be reconsidered at $run_after, and does not count against the max_retries count. =head2 C<$job-Ereplace_with( @jobs )> Atomically replaces the single job C<$job> with the given set of jobs. This can be used to decompose one "meta job" posted by your application into a set of jobs workers can perform, or to post a job or jobs required to complete the process already partly performed. =head1 SEE ALSO L, L, L =cut TheSchwartz-1.12/lib/TheSchwartz/FuncMap.pm000444000764000764 236112506132345 20653 0ustar00jfearnjfearn000000000000# $Id$ package TheSchwartz::FuncMap; use strict; use base qw( Data::ObjectDriver::BaseObject ); use Carp qw( croak ); __PACKAGE__->install_properties( { columns => [qw( funcid funcname )], datasource => 'funcmap', primary_key => 'funcid', } ); sub create_or_find { my $class = shift; my ( $driver, $funcname ) = @_; ## Attempt to select funcmap record by name. If successful, return ## object, otherwise proceed with insertion and return. my ($map) = $driver->search( 'TheSchwartz::FuncMap' => { funcname => $funcname } ); return $map if $map; ## Attempt to insert a new funcmap row. Since the funcname column is ## UNIQUE, if the row already exists, an exception will be thrown. $map = $class->new; $map->funcname($funcname); eval { $driver->insert($map) }; ## If we got an exception, try to load the record with this funcname; ## in all likelihood, the exception was that the record was added by ## another process. if ( my $err = $@ ) { ($map) = $driver->search( 'TheSchwartz::FuncMap' => { funcname => $funcname } ) or croak "Can't find or create funcname $funcname: $err"; } return $map; } 1; TheSchwartz-1.12/doc000755000764000764 012506132345 14356 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/doc/schema-postgres.sql000444000764000764 370312506132345 20343 0ustar00jfearnjfearn000000000000-- From: Michael Zedeler -- Date: July 30, 2007 7:31:55 AM PDT -- To: cpan@sixapart.com -- Subject: TheSchwartz database schema for postgresql -- -- Hi. -- -- I couldn't find any useful postgresql compatible schema file for -- the tables that TheSchwartz seems to depend on, so I rewrote the -- one supplied in the package. -- -- Here it is. Feel free to include it in the next release. -- -- Regards, -- -- Michael. CREATE TABLE funcmap ( funcid SERIAL, funcname VARCHAR(255) NOT NULL, UNIQUE(funcname) ); CREATE TABLE job ( jobid BIGSERIAL, funcid INT NOT NULL, arg BYTEA, uniqkey VARCHAR(255) NULL, insert_time INTEGER, run_after INTEGER NOT NULL, grabbed_until INTEGER NOT NULL, priority SMALLINT, coalesce VARCHAR(255) ); CREATE UNIQUE INDEX job_funcid_uniqkey ON job (funcid, uniqkey); CREATE INDEX job_funcid_runafter ON job (funcid, run_after); CREATE INDEX job_funcid_coalesce ON job (funcid, coalesce); CREATE TABLE note ( jobid BIGINT NOT NULL, notekey VARCHAR(255), PRIMARY KEY (jobid, notekey), value BYTEA ); CREATE TABLE error ( error_time INTEGER NOT NULL, jobid BIGINT NOT NULL, message TEXT NOT NULL, funcid INT NOT NULL DEFAULT 0 ); CREATE INDEX error_funcid_errortime ON error (funcid, error_time); CREATE INDEX error_time ON error (error_time); CREATE INDEX error_jobid ON error (jobid); CREATE TABLE exitstatus ( jobid BIGINT PRIMARY KEY NOT NULL, funcid INT NOT NULL DEFAULT 0, status SMALLINT, completion_time INTEGER, delete_after INTEGER ); CREATE INDEX exitstatus_funcid ON exitstatus (funcid); CREATE INDEX exitstatus_deleteafter ON exitstatus (delete_after); TheSchwartz-1.12/doc/notes.txt000444000764000764 27212506132345 16365 0ustar00jfearnjfearn000000000000TODO: verify replace_with() with empty list is the same as $job->completed policy is all on worker side client really cheap priority: low number is higher priority. 0 is highest. TheSchwartz-1.12/doc/http-mappings.txt000444000764000764 16712506132345 20033 0ustar00jfearnjfearn000000000000FUTURE: provide HTTP server interface to all TheSchwartz commands. insert insert_jobs grab_job grab_job_from_handle TheSchwartz-1.12/doc/schema.sql000444000764000764 302012506132345 16467 0ustar00jfearnjfearn000000000000CREATE TABLE funcmap ( funcid INT UNSIGNED PRIMARY KEY NOT NULL AUTO_INCREMENT, funcname VARCHAR(255) NOT NULL, UNIQUE(funcname) ); CREATE TABLE job ( jobid BIGINT UNSIGNED PRIMARY KEY NOT NULL AUTO_INCREMENT, funcid INT UNSIGNED NOT NULL, arg MEDIUMBLOB, uniqkey VARCHAR(255) NULL, insert_time INTEGER UNSIGNED, run_after INTEGER UNSIGNED NOT NULL, grabbed_until INTEGER UNSIGNED NOT NULL, priority SMALLINT UNSIGNED, coalesce VARCHAR(255), INDEX (funcid, run_after), UNIQUE(funcid, uniqkey), INDEX (funcid, coalesce) ); CREATE TABLE note ( jobid BIGINT UNSIGNED NOT NULL, notekey VARCHAR(255), PRIMARY KEY (jobid, notekey), value MEDIUMBLOB ); CREATE TABLE error ( error_time INTEGER UNSIGNED NOT NULL, jobid BIGINT UNSIGNED NOT NULL, message VARCHAR(255) NOT NULL, funcid INT UNSIGNED NOT NULL DEFAULT 0, INDEX (funcid, error_time), INDEX (error_time), INDEX (jobid) ); CREATE TABLE exitstatus ( jobid BIGINT UNSIGNED PRIMARY KEY NOT NULL, funcid INT UNSIGNED NOT NULL DEFAULT 0, status SMALLINT UNSIGNED, completion_time INTEGER UNSIGNED, delete_after INTEGER UNSIGNED, INDEX (funcid), INDEX (delete_after) ); TheSchwartz-1.12/xt000755000764000764 012506132345 14244 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/xt/pod-coverage.t000444000764000764 174712506132345 17152 0ustar00jfearnjfearn000000000000use strict; use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; ## Eventually we would be able to test coverage for all modules with ## Test::Pod::all_pod_files(), but let's write the docs first. my %modules = ( 'TheSchwartz' => { also_private => [ map {qr{ \A $_ \z }xms} qw( current_job debug driver_for funcid_to_name funcname_to_id handle_from_string hash_databases insert_job_to_driver is_database_dead mark_database_as_dead reset_abilities restore_full_abilities set_current_job shuffled_databases temporarily_remove_ability ) ], }, 'TheSchwartz::Worker' => 1, 'TheSchwartz::Job' => 1, ); plan tests => scalar keys %modules; while ( my ( $module, $params ) = each %modules ) { pod_coverage_ok( $module, ref $params ? $params : () ); } TheSchwartz-1.12/xt/pod.t000444000764000764 21612506132345 15327 0ustar00jfearnjfearn000000000000use strict; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); TheSchwartz-1.12/xt/perlcritic.t000444000764000764 62412506132345 16710 0ustar00jfearnjfearn000000000000#!perl use Test::More; eval "use Test::Perl::Critic"; if ($@) { Test::More::plan( skip_all => "Test::Perl::Critic required for testing PBP compliance" ); } else { Test::Perl::Critic->import( -verbose => 8, -severity => 5, -exclude => [ 'ProhibitAccessOfPrivateData', # false positives ] ); } Test::Perl::Critic::all_critic_ok(); TheSchwartz-1.12/xt/pod-spelling.t000444000764000764 36612506132345 17150 0ustar00jfearnjfearn000000000000use strict; use Test::More; eval "use Test::Spelling"; if ($@) { plan skip_all => "Test::Spelling required for testing POD spelling"; } else { add_stopwords(qw(DSN TheSchwartz btree schwartzmon lookup)); } all_pod_files_spelling_ok(); TheSchwartz-1.12/extras000755000764000764 012506132345 15117 5ustar00jfearnjfearn000000000000TheSchwartz-1.12/extras/perl-TheSchwartz.spec000444000764000764 307112506132345 21337 0ustar00jfearnjfearn000000000000Name: perl-TheSchwartz Version: 1.12 Release: 0%{?dist} Summary: Reliable job queue License: GPL+ or Artistic Group: Development/Libraries URL: http://search.cpan.org/dist/TheSchwartz/ Source0: http://www.cpan.org/modules/by-module/TheSchwartz/TheSchwartz-%{version}.tar.gz BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) BuildArch: noarch BuildRequires: perl(Data::ObjectDriver) >= 0.04 BuildRequires: perl(Module::Build) BuildRequires: perl(Test::More) BuildRequires: perl(DBD::SQLite) Requires: perl(Data::ObjectDriver) >= 0.04 Requires: perl(:MODULE_COMPAT_%(eval "`%{__perl} -V:version`"; echo $version)) %description TheSchwartz is a reliable job queue system. Your application can put jobs into the system, and your worker processes can pull jobs from the queue atomically to perform. Failed jobs can be left in the queue to retry later. %prep %setup -q -n TheSchwartz-%{version} %build %{__perl} Build.PL installdirs=site ./Build %install rm -rf $RPM_BUILD_ROOT ./Build install destdir=$RPM_BUILD_ROOT create_packlist=0 find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null \; %{_fixperms} $RPM_BUILD_ROOT/* find $RPM_BUILD_ROOT -type f -print | sed "s@^$RPM_BUILD_ROOT@@g" > filelist %check ./Build test %clean rm -rf $RPM_BUILD_ROOT %files -f filelist %defattr(-,root,root,-) %doc CHANGES doc README.md %changelog * Mon Mar 30 2015 Jeff Fearn 1.12-0 - New release. * Mon Nov 03 2014 Jeff Fearn 1.11-1 - Specfile autogenerated by cpanspec 1.79. TheSchwartz-1.12/extras/check_schwartz000555000764000764 273512506132345 20213 0ustar00jfearnjfearn000000000000#!/usr/bin/perl -w use strict; # $Id$ ## Nagios plugin to check the queue depth of a Schwartz database. use utils qw( %ERRORS $TIMEOUT ); use Getopt::Long qw( :config no_ignore_case ); use DBI; use constant QUEUE_CRITICAL => 100; use constant QUEUE_WARNING => 30; GetOptions( 'h|help!' => \my ($help), 'v|verbose' => \my ($verbose), 'dsn=s' => \my ($dsn), 'user=s' => \my ($user), 'password=s' => \my ($pass), ); if ($help) { print "$0 --dsn --user --password "; exit $ERRORS{OK}; } unless ( $dsn && $user ) { print <connect( $dsn, $user, $pass ) or exit_with 'CRITICAL', "Can't connect to $dsn: $DBI::errstr"; my $inf = $dbh->selectrow_arrayref( <[0] ) { exit_with 'CRITICAL', "Failed getting job count: " . $dbh->errstr; } if ( $inf->[0] < QUEUE_WARNING ) { exit_with 'OK'; } elsif ( $inf->[0] < QUEUE_CRITICAL ) { exit_with 'WARNING', "Schwartz queue depth is $inf->[0]"; } else { exit_with 'CRITICAL', "Schwartz queue depth is $inf->[0]"; } TheSchwartz-1.12/extras/thetop000555000764000764 1202412506132345 16524 0ustar00jfearnjfearn000000000000#!/usr/bin/perl -w =pod =head1 NAME thetop - A 'top' utility for the schwartz =head1 SYNOPSIS thetop [--func FORMAT] [--arg FORMAT] [--sort ARGS] [--delay SECS] [--score-dir DIR] =head1 DESCRIPTION =cut #--------------------------------------# # Dependencies use strict; use Getopt::Long; use Term::Cap; use POSIX; #--------------------------------------# # Global Variables use vars qw( $OSPEED ); BEGIN { my $termios = POSIX::Termios->new; $termios->getattr; $OSPEED = $termios->getospeed || 9600; } our $TERM = Term::Cap->Tgetent( { OSPEED => $OSPEED } ); #--------------------------------------# # Main Program my ( $score_dir, $delay, $func_col, @arg_col, $sort ); GetOptions( 'score-dir=s' => \$score_dir, 'delay|d=s' => \$delay, 'func=s' => \$func_col, 'arg=s' => \@arg_col, 'sort|s=s' => \$sort, ); # Make sure we know where to find the scoreboard files unless ($score_dir) { foreach my $d (qw(/var/run /dev/shm /tmp)) { if ( -e "$d/theschwartz" ) { $score_dir = "$d/theschwartz"; last; } } die "Can't find scoreboard directory. Use '--score-dir'\n" unless $score_dir; } # If we got some formatting instructions for the arg column, parse it out my %arg_col_by_func; if (@arg_col) { foreach my $a (@arg_col) { if ( $a =~ /=/ ) { my ( $func, $fmt ) = split( '=', $a ); $arg_col_by_func{$func} = $fmt; } else { $arg_col_by_func{'__ALL__'} = $a; } } } # Make sure to give a reasonable default for delay $delay ||= 3; # Start reporting clr_screen(); while (1) { report( $score_dir, $func_col, \%arg_col_by_func, $sort ); sleep($delay); clr_screen(); } ################################################################################ sub report { my ( $dir, $func_col, $arg_col_by_func, $sort ) = @_; # Find the files available opendir( SD, $dir ) or die "Can't read directory '$dir': $!\n"; my @files = map { $dir . "/$_" } readdir(SD); closedir(SD); # Grab the data out of them my @data; foreach my $f (@files) { next unless $f =~ /scoreboard\.[0-9]+$/; open( SF, '<', $f ) or die "Can't open score file '$f': $!\n"; my %dat = map { chomp; split('=') } ; close(SF); $dat{arg_array} = [ split( ',', $dat{arg} || '' ) ]; push @data, \%dat; } my $num = scalar(@data); my $width = 80 - 17 - $num; printf( "Workers: %d total %${width}s\n\n", $num, scalar localtime ); printf( "% 5s % 20s % 2s % 7s % 41s\n", 'PID', 'FUNC', 'S', 'TIME', 'ARGS' ); foreach my $d ( sort { order_by( $sort, $a, $b ) } @data ) { my $func_str = fmt_func( $d, $func_col ); printf( "% 5s % 20s % 2s % 7s % 41s\n", $d->{pid}, $func_str, ( $d->{done} ? 'S' : 'R' ), fmt_time($d), fmt_arg( $d, $arg_col_by_func, $func_str ), ); } } sub order_by { my ( $sort, $a, $b ) = @_; if ($sort) { } else { # Default to push running tasks to the top return ( $a->{done} || 0 ) <=> ( $b->{done} || 0 ) || ( $a->{started} || 0 ) <=> ( $b->{started} || 0 ); } } sub fmt_func { my ( $d, $fmt ) = @_; my $val = $d->{funcname}; if ($fmt) { if ( $fmt eq 'trim' ) { $val =~ s/^.+:://g; } else { $val =~ /($fmt)/; $val = $1; } } return substr( $val, 0, 20 ),; } sub fmt_time { my ($d) = @_; my $secs = ( $d->{done} || time ) - $d->{started}; if ( $secs < 60 ) { return sprintf( "%02d:%02d", 0, $secs ); } elsif ( $secs < 3600 ) { my $min = int( $secs / 60 ); $secs = $secs % 60; return sprintf( "%02d:%02d", $min, $secs ); } else { my $hr = int( $secs / 60 / 60 ); my $min = int( $secs / 60 % 60 ); $secs = $secs % 60; return sprintf( "%d:%02d:%02d", $hr, $min, $secs ); } } ## Format the arguments by interpreting the args as either a hash or an array ## and printing out the appropriate element. sub fmt_arg { my ( $d, $arg_col_by_func, $func_str ) = @_; my $val = $d->{arg}; my $func_orig = $d->{funcname}; if ($arg_col_by_func) { my $fmt = ( $arg_col_by_func{$func_str} || $arg_col_by_func{$func_orig} || $arg_col_by_func{'__ALL__'} ); if ($fmt) { my $arg_array = $d->{arg_array}; # If its a number treat the args as an array if ( $fmt =~ /^[0-9]+$/ ) { $val = $arg_array->[$fmt]; } # otherwise, treat the args as a hash else { # Compensate for odd numbers of args push @$arg_array, undef if scalar(@$arg_array) % 2; my %h = @$arg_array; $val = $h{$fmt}; } } } return substr( $val || '', 0, 41 ),; } sub clr_screen { $TERM->Tputs( 'cl', 1, \*STDOUT ); }