libpoe-component-dbiagent-perl-0.26/0000755000175000017500000000000011221137512016415 5ustar cajuscajuslibpoe-component-dbiagent-perl-0.26/MANIFEST0000644000175000017500000000025210744146656017567 0ustar cajuscajusREADME Changes DBIAgent.pm DBIAgent/Helper.pm DBIAgent/Queue.pm MANIFEST Makefile.PL t/1.t META.yml Module meta-data (added by MakeMaker) libpoe-component-dbiagent-perl-0.26/t/0000755000175000017500000000000011221137512016660 5ustar cajuscajuslibpoe-component-dbiagent-perl-0.26/t/1.t0000644000175000017500000000123510744146656017230 0ustar cajuscajus# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use POE::Component::DBIAgent; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): libpoe-component-dbiagent-perl-0.26/DBIAgent.pm0000644000175000017500000004342310744146656020360 0ustar cajuscajuspackage POE::Component::DBIAgent; # {{{ POD =head1 NAME POE::Component::DBIAgent - POE Component for running asynchronous DBI calls. =head1 SYNOPSIS sub _start { my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; $heap->{helper} = POE::Component::DBIAgent->new( DSN => [$dsn, $username, $password ], Queries => $self->make_queries, Count => 3, Debug => 1, ); # Queries takes a hashref of the form: # { query_name => 'select blah from table where x = ?', # other_query => 'select blah_blah from big_view', # etc. # } $heap->{helper}->query(query_name => { cookie => 'starting_query' }, session => 'get_row_from_dbiagent'); } sub get_row_from_dbiagent { my ($kernel, $self, $heap, $row, $cookie) = @_[KERNEL, OBJECT, HEAP, ARG0, ARG1]; if ($row ne 'EOF') { # {{{ PROCESS A ROW #row is a listref of columns # }}} PROCESS A ROW } else { # {{{ NO MORE ROWS #cleanup code here # }}} NO MORE ROWS } } =head1 DESCRIPTION DBIAgent is your answer to non-blocking DBI in POE. It fires off a configurable number child processes (defaults to 3) and feeds database queries to it via two-way pipe (or sockets ... however POE::Component::Wheel::Run is able to manage it). The primary method is C. =head2 Usage After initializing a DBIAgent and storing it in a session's heap, one executes a C (or C) with the query name, destination session (name or id) and destination state (as well as any query parameters, optionally) as arguments. As each row of data comes back from the query, the destination state (in the destination session) is invoked with that row of data in its C<$_[ARG0]> slot. When there are no more rows to return, the data in C<$_[ARG0]> is the string 'EOF'. Not EVERY query should run through the DBIAgent. If you need to run a short lookup from within a state, sometimes it can be a hassle to have to define a whole seperate state to receive its value, and resume processing from there.. The determining factor, of course, is how long your query will take to execute. If you are trying to retrieve one row from a properly indexed table, use C<$dbh-Eselectrow_array()>. If there's a join involved, or multiple rows, or a view, you probably want to use DBIAgent. If it's a longish query and startup costs (time) don't matter to you, go ahead and do it inline.. but remember the whole of your program suspends waiting for the result. If startup costs DO matter, use DBIAgent. =head2 Return Values The destination state in the destination session (specified in the call to C) will receive the return values from the query in its C<$_[ARG0]> parameter. DBIAgent invokes DBI's C method internally, so the value will be a reference to an array. If your query returns multiple rows, then your state will be invoked multiple times, once per row. B, your state will be called one time with C<$_[ARG0]> containing the string 'EOF'. 'EOF' is returned I. This is also what to expect for DML (INSERT, UPDATE, DELETE) queries. A way to utilise this might be as follows: sub some_state { #... if ($enough_values_to_begin_updating) { $heap->{dbiagent}->query(update_values_query => this_session => update_next_value => shift @{$heap->{values_to_be_updated}} ); } } sub update_next_value { my ($self, $heap) = @_[OBJECT, HEAP]; # we got 'EOF' in ARG0 here but we don't care... we know that an # update has been executed. for (1..3) { # Do three at a time! my $value; last unless defined ($value = shift @{$heap->{values_to_be_updated}}); $heap->{dbiagent}->query(update_values => this_session => update_next_value => $value ); } } =cut # }}} POD #use Data::Dumper; use Storable qw/freeze thaw/; use Carp; use strict; use POE qw/Session Filter::Reference Wheel::Run Component::DBIAgent::Helper Component::DBIAgent::Queue/; use vars qw/$VERSION/; $VERSION = sprintf("%d.%02d", q$Revision: 0.26 $ =~ /(\d+)\.(\d+)/); use constant DEFAULT_KIDS => 3; sub debug { $_[0]->{debug} } #sub debug { 1 } #sub debug { 0 } #sub carp { warn @_ } #sub croak { die @_ } # {{{ new =head2 new() Creating an instance creates a POE::Session to manage communication with the Helper processes. Queue management is transparent and automatic. The constructor is named C (surprised, eh? Yeah, me too). The parameters are as follows: =over =item DSN An arrayref of parameters to pass to DBI->connect (usually a dsn, username, and password). =item Queries A hashref of the form Query_Name => "$SQL". For example: { sysdate => "select sysdate from dual", employee_record => "select * from emp where id = ?", increase_inventory => "update inventory set count = count + ? where item_id = ?", } As the example indicates, DBI placeholders are supported, as are DML statements. =item Count The number of helper processes to spawn. Defaults to 3. The optimal value for this parameter will depend on several factors, such as: how many different queries your program will be running, how much RAM you have, how often you run queries, and most importantly, how many queries you intend to run I. =item ErrorState An listref containing a session and event name to receive error messages from the DBI. The message arrives in ARG0. =back =cut sub new { my $type = shift; croak "$type needs an even number of parameters" if @_ & 1; my %params = @_; my $dsn = delete $params{DSN}; croak "$type needs a DSN parameter" unless defined $dsn; croak "DSN needs to be an array reference" unless ref $dsn eq 'ARRAY'; my $queries = delete $params{Queries}; croak "$type needs a Queries parameter" unless defined $queries; croak "Queries needs to be a hash reference" unless ref $queries eq 'HASH'; my $count = delete $params{Count} || DEFAULT_KIDS; #croak "$type needs a Count parameter" unless defined $queries; # croak "Queries needs to be a hash reference" unless ref $queries eq 'HASH'; my $debug = delete $params{Debug} || 0; # $count = 1 if $debug; my $errorstate = delete $params{ErrorState} || undef; # Make sure the user didn't pass in parameters we're not aware of. if (scalar keys %params) { carp( "unknown parameters in $type constructor call: ", join(', ', sort keys %params) ); } my $self = bless {}, $type; my $config = shift; $self->{dsn} = $dsn; $self->{queries} = $queries; $self->{count} = $count; $self->{debug} = $debug; $self->{errorstate} = $errorstate; $self->{finish} = 0; $self->{pending_query_count} = 0; $self->{active_query_count} = 0; $self->{cookies} = []; $self->{group_cache} = []; # POE::Session->new( $self, # [ qw [ _start _stop db_reply remote_stderr error ] ] # ); POE::Session->create( object_states => [ $self => [ qw [ _start _stop db_reply remote_stderr error ] ] ] ); return $self; } # }}} new # {{{ query # {{{ POD =head2 query(I<$query_name>, [ \%args, ] I<$session>, I<$state>, [ I<@parameters> ]) The C method takes at least three parameters, plus any bind values for the specific query you are executing. =over =item $query_name This parameter must be one of the keys to the Queries hashref you passed to the constructor. It is used to indicate which query you wish to execute. =item \%args This is an OPTIONAL hashref of arguments to pass to the query. Currently supported arguments: =over 4 =item hash Return rows hash references instead of array references. =item cookie A cookie to pass to this query. This is passed back unchanged to the destination state in C<$_[ARG1]>. Can be any scalar (including references, and even POE postbacks, so be careful!). You can use this as an identifier if you have one destination state handling multiple different queries or sessions. =item delay Insert a 1ms delay between each row of output. I know what you're thinking: "WHY would you want to slow down query responses?!?!?" It has to do with CONCURRENCY. When a response (finally) comes in from the agent after running the query, it floods the input channel with response data. This has the effect of monopolizing POE's attention, so that any other handles (network sockets, pipes, file descriptors) keep getting pushed further back on the queue, and to all other processes EXCEPT the agent, your POE program looks hung for the amount of time it takes to process all of the incoming query data. So, we insert 1ms of time via Time::HiRes's C function. In human terms, this is essentially negligible. But it is just enough time to allow competing handles (sockets, files) to trigger C, and get handled by the POE::Kernel, in situations where concurrency has priority over transfer rate. Naturally, the Time::HiRes module is required for this functionality. If Time::HiRes is not installed, the delay is ignored. =item group Sends the return event back when C rows are retrieved from the database, to avoid event spam when selecting lots of rows. NB: using group means that C<$row> will be an arrayref of rows, not just a single row. =back =item $session, $state These parameters indicate the POE state that is to receive the data returned from the database. The state indicated will receive the data in its C<$_[ARG0]> parameter. I make sure this is a valid state, otherwise you will spend a LOT of time banging your head against the wall wondering where your query data is. =item @parameters These are any parameters your query requires. B You must supply exactly as many parameters as your query has placeholders! This means that if your query has NO placeholders, then you should pass NO extra parameters to C. Suggestions to improve this syntax are welcome. =back =cut # }}} POD sub query { my ($self, $query, $package, $state, @rest) = @_; my $options = {}; if (ref $package) { unless (ref $package eq 'HASH') { carp "Options has must be a HASH reference"; } $options = $package; # this shifts the first element off of @rest and puts it into # $state ($package, $state) = ($state, shift @rest); } # warn "QD: Running $query"; my $agent = $self->{helper}->next; my $input = { query => $query, package => $package, state => $state, params => \@rest, delay => 0, id => "_", %$options, }; $self->{pending_query_count}++; if ($self->{active_query_count} < $self->{count} ) { $input->{id} = $agent->ID; $self->{cookies}[$input->{id}] = delete $input->{cookie}; $agent->put( $input ); $self->{active_query_count}++; $self->{group_cache}[$input->{id}] = []; } else { push @{$self->{pending_queries}}, $input; } $self->debug && warn sprintf("QA:(#%s) %d pending: %s => %s, return %d rows at once\n", $input->{id}, $self->{pending_query_count}, $input->{query}, "$input->{package}::$input->{state}", $input->{group} || 1, ); } # }}} query #======================================================================================== # {{{ shutdown =head2 finish() The C method tells DBIAgent that the program is finished sending queries. DBIAgent will shut its helpers down gracefully after they complete any pending queries. If there are no pending queries, the DBIAgent will shut down immediately. =cut sub finish { my $self = shift; $self->{finish} = 1; unless ($self->{pending_query_count}) { $self->debug and carp "QA: finish() called without pending queries. Shutting down now."; $self->{helper}->exit_all(); } else { $self->debug && carp "QA: Setting finish flag for later.\n"; } } # }}} shutdown #======================================================================================== # {{{ STATES # {{{ _start sub _start { my ($self, $kernel, $heap, $dsn, $queries) = @_[OBJECT, KERNEL, HEAP, ARG0, ARG1]; $self->debug && warn __PACKAGE__ . " received _start.\n"; # make this session accessible to the others. #$kernel->alias_set( 'qa' ); my $queue = POE::Component::DBIAgent::Queue->new(); $self->{filter} = POE::Filter::Reference->new(); ## Input and output from the children will be line oriented foreach (1..$self->{count}) { my $helper = POE::Wheel::Run->new( Program => sub { POE::Component::DBIAgent::Helper->run($self->{dsn}, $self->{queries}); }, StdoutEvent => 'db_reply', StderrEvent => 'remote_stderr', ErrorEvent => 'error', #StdinFilter => POE::Filter::Line->new(), StdinFilter => POE::Filter::Reference->new(), StdoutFilter => POE::Filter::Reference->new(), ) or warn "Can't create new Wheel::Run: $!\n"; $self->debug && warn __PACKAGE__, " Started db helper pid ", $helper->PID, " wheel ", $helper->ID, "\n"; $queue->add($helper); } $self->{helper} = $queue; } # }}} _start # {{{ _stop sub _stop { my ($self, $heap) = @_[OBJECT, HEAP]; $self->{helper}->kill_all(); # Oracle clients don't like to TERMinate sometimes. $self->{helper}->kill_all(9); $self->debug && warn __PACKAGE__ . " has stopped.\n"; } # }}} _stop # {{{ db_reply sub db_reply { my ($kernel, $self, $heap, $input) = @_[KERNEL, OBJECT, HEAP, ARG0]; # Parse the "receiving state" and dispatch the input line to that state. # not needed for Filter::Reference my ($package, $state, $data, $cookie, $group); $package = $input->{package}; $state = $input->{state}; $data = $input->{data}; $group = $input->{group} || 0; # change so cookies are no longer sent over the reference channel $cookie = $self->{cookies}[$input->{id}]; unless (ref $data or $data eq 'EOF') { warn "QA: Got $data\n"; } # $self->debug && $self->debug && warn "QA: received db_reply for $package => $state\n"; unless (defined $data) { $self->debug && warn "QA: Empty input value.\n"; return; } if ($data eq 'EOF') { # $self->debug && warn "QA: ${package}::${state} (#$input->{id}): EOF\n"; $self->{pending_query_count}--; $self->{active_query_count}--; $self->debug && warn sprintf("QA:(#%s) %d pending: EOF => %s\n", $input->{id}, $self->{pending_query_count}, "$input->{package}::$input->{state}"); # If this was the last query to go, and we've been requested # to finish, then turn out the lights. unless ($self->{pending_query_count}) { if ($self->{finish}) { $self->debug and warn "QA: Last query done, and finish flag set. Shutting down.\n"; $self->{helper}->exit_all(); } } elsif ($self->debug and $self->{pending_query_count} < 0) { die "QA: Pending query count went negative (should never do that)"; } # place this agent at the front of the queue, for next query $self->{helper}->make_next($input->{id}); if ( $self->{pending_queries} and @{$self->{pending_queries}} and $self->{active_query_count} < $self->{count} ) { my $input = shift @{$self->{pending_queries}}; my $agent = $self->{helper}->next; $input->{id} = $agent->ID; $self->{cookies}[$input->{id}] = delete $input->{cookie}; $agent->put( $input ); $self->{active_query_count}++; $self->debug && warn sprintf("QA:(#%s) %d pending: %s => %s\n", $input->{id}, $self->{pending_query_count}, $input->{query}, "$input->{package}::$input->{state}" ); } } if ($group) { push @{ $self->{group_cache}[$input->{id}] }, $data; if (scalar @{ $self->{group_cache}[$input->{id}] } == $group || $data eq 'EOF') { $kernel->post($package => $state => $self->{group_cache}[$input->{id}], $cookie); $self->{group_cache}[$input->{id}] = []; } } else { $kernel->post($package => $state => $data => $cookie); } } # }}} db_reply # {{{ remote_stderr sub remote_stderr { my ($self, $kernel, $operation, $errnum, $errstr, $wheel_id, $data) = @_[OBJECT, KERNEL, ARG0..ARG4]; $self->debug && warn defined $errstr ? "$operation: $errstr\n" : "$operation\n"; $kernel->post(@{$self->{errorstate}}, $operation, $errstr, $wheel_id) if defined $self->{errorstate}; } # }}} remote_stderr # {{{ error sub error { my ($self, $operation, $errnum, $errstr, $wheel_id) = @_[OBJECT, ARG0..ARG3]; $errstr = "child process closed connection" unless $errnum; $self->debug and warn "error: Wheel $wheel_id generated $operation error $errnum: $errstr\n"; $self->{helper}->remove_by_wheelid($wheel_id); } # }}} error # }}} STATES 1; __END__ =head1 NOTES =over =item * Error handling is practically non-existent. =item * The calling syntax is still pretty weak... but improving. We may eventually add an optional attributes hash so that each query can be called with its own individual characteristics. =item * I might eventually want to support returning hashrefs, if there is any demand. =item * Every query is prepared at Helper startup. This could potentially be pretty expensive. Perhaps a cached or deferred loading might be better? This is considering that not every helper is going to run every query, especially if you have a lot of miscellaneous queries. =back Suggestions welcome! Diffs I welcome! :-) =head1 AUTHOR This module has been fine-tuned and packaged by Rob Bloodgood Erobb@empire2.comE. However, most of the queuing code originated with Fletch Efletch@phydeaux.orgE, either directly or via his ideas. Thank you for making this module a reality, Fletch! However, I own all of the bugs. This module is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut libpoe-component-dbiagent-perl-0.26/DBIAgent/0000755000175000017500000000000011221137512017772 5ustar cajuscajuslibpoe-component-dbiagent-perl-0.26/DBIAgent/Helper.pm0000644000175000017500000001636010744146656021577 0ustar cajuscajuspackage POE::Component::DBIAgent::Helper; use DBI; #use Daemon; # qw//; use Data::Dumper; use POE::Filter::Reference; BEGIN { my $can_delay = 0; eval { require Time::HiRes; }; unless ($@) { Time::HiRes->import(qw/usleep/); $can_delay = 1; } sub CAN_DELAY { $can_delay } } use strict; use vars qw/$VERSION/; $VERSION = sprintf("%d.%02d", q$Revision: 0.03 $ =~ /(\d+)\.(\d+)/); use constant DEBUG => 0; use constant DEBUG_NOUPDATE => 0; my $filter = POE::Filter::Reference->new(); sub run { DEBUG && warn " QA: start\n"; DEBUG_NOUPDATE && warn " QA: NO UPDATE\n"; my ($type, $dsn, $queries) = @_; my $self = bless {}, $type; $self->_init_dbi($dsn, $queries); $| = 1; $self->{dbh}->{RaiseError} = 0; $self->{dbh}->{PrintError} = 0; DEBUG && warn " QA: initialized\n"; my ($row, $output); # to hold DBI results while ( sysread( STDIN, my $buffer = '', 1024 ) ) { my $lines = $filter->get( [ $buffer ] ); #++ look for the exit sign in the current set of commands my $exit = grep /^EXIT$/, map $_->{query}, @$lines; ### DEBUG && warn "Exit? - ", $exit, "\n"; foreach my $task (@$lines) { ### DEBUG && warn " QA: Got line: ", Dumper($task), "\n"; #++ this doesn't match what DBIAgent::Queue sends in exit_all(); # last if /^EXIT$/; # allow parent to tell us to exit # Set up query my ($query_id); $query_id = $task->{query}; my $rowtype = $task->{hash} ? 'fetchrow_hashref' : 'fetchrow_arrayref'; if ($query_id eq 'CREATE' or $query_id eq 'EXIT') { #++ make sure the EXIT event isn't actually sent to the db next; } ### DEBUG && warn " QA: Read data: $query_id for $task->{state} (params @{$task->{params}})\n"; unless (exists $self->{$query_id}) { DEBUG && warn " QA: No such query: $query_id"; next; } DEBUG && warn " QA: query $query_id exists\n"; my $rowcount = 0; my $result = { package => $task->{package}, state => $task->{state}, data => undef, query => $query_id, id => $task->{id}, cookie => $task->{cookie} || undef, # XXX remove? group => $task->{group}, }; if (ref $self->{$query_id}) { # Is it a DBI statement handle? # Normal query loop. This is where we usually go. unless ( $self->{$query_id}->execute( @{$task->{params}} ) ) { DEBUG && warn " QA: error executing query: ", $self->{$query_id}->errstr,"\n"; # this goes to stderr. If an ErrorState was # supplied, the user will see this message. warn "QA: error executing query: ", $self->{$query_id}->errstr,"\n"; $result->{data} = 'EOF'; $output = $filter->put( [ $result ] ); print @$output; #print "ERROR|", $self->{$query_id}->errstr, "\n"; } else { DEBUG && warn " QA: query running\n"; if ($self->{$query_id}{Active}) { while (defined ($row = $self->{$query_id}->$rowtype())) { $rowcount++; $result->{data} = $row; $output = $filter->put( [ $result ] ); # This prevents monopolizing the parent with # db responses. CAN_DELAY and $task->{delay} and usleep(1); print @$output; #warn " QA: got row $rowcount: ",,"\n"; } } $result->{data} = 'EOF'; $output = $filter->put( [ $result ] ); print @$output; DEBUG && warn " QA: ROWS|$rowcount\n"; } } else { # *NOT* a DBI statement handle # $queries->{$query_id} is a STRING query. This is a # debug feature. Print a debug message, and send back # EOF, but don't actually touch the database. my $query = $queries->{$query_id}; my @params = @{$task->{params}}; # Replace ? placeholders with bind values. $query =~ s/\?/@params/eg; DEBUG && warn " QA: $query\n"; $result->{data} = 'EOF'; $output = $filter->put( [ $result ] ); print @$output; } } #++ put here to make sure all the queries in the current buffer are dealt with before disconnecting last if $exit; } DEBUG && warn " QA: Disconnect and Exit\n"; $self->{dbh}->disconnect; } # {{{ _init_dbi sub _init_dbi { my ($heap, $dsn, $queries) = @_; my $dbh = DBI->connect(@$dsn, { AutoCommit => 1, RaiseError => 0, PrintError => 0 }) or die DBI->errstr; $heap->{dbh} = $dbh; #$dbh->{RowCacheSize} = 500; if (defined $queries) { foreach (keys %$queries) { if ($queries->{$_} =~ /insert|update|delete/i and DEBUG_NOUPDATE) { $heap->{$_} = $queries->{$_}; } else { $heap->{$_} = $dbh->prepare($queries->{$_}) or die $dbh->errstr; } } return; } } # }}} _init_dbi 1; __END__ =head1 NAME POE::Component::DBIAgent::Helper - DBI Query Helper for DBIAgent =head1 SYNOPSYS use Socket qw/:crlf/; use POE qw/Filter::Line Wheel::Run Component::DBIAgent::Helper/; sub _start { my $helper = POE::Wheel::Run ->new( Program => sub { POE::Component::DBIAgent::Helper->run($self->{dsn}, $self->{queries} ); }, StdoutEvent => 'db_reply', StderrEvent => 'remote_stderr', ErrorEvent => 'error', StdinFilter => POE::Filter::Line->new(), StdoutFilter => POE::Filter::Line->new( Literal => CRLF), StderrFilter => POE::Filter::Line->new(), ) or carp "Can't create new DBIAgent::Helper: $!\n"; } sub query { my ($self, $query, $package, $state, @rest) = @_; $self->{helper}->put(join '|', $query, $package, $state, @rest); } sub db_reply { my ($kernel, $self, $heap, $input) = @_[KERNEL, OBJECT, HEAP, ARG0]; # $input is either the string 'EOF' or a Storable object. } =head1 DESCRIPTION This is our helper routine for DBIAgent. It accepts queries on STDIN, and returns the results on STDOUT. Queries are returned on a row-by-row basis, followed by a row consisting of the string 'EOF'. Each row is the return value of $sth->fetch, which is an arrayref. This row is then passed to Storable for transport, and printed to STDOUT. HOWEVER, Storable uses newlines ("\n") in its serialized strings, so the Helper is designed to use the "network newline" pair CR LF as the line terminator for STDOUT. When fetch() returns undef, one final row is returned to the calling state: the string 'EOF'. Sessions should test for this value FIRST when being invoked with input from a query. =head2 Initialization The Helper has one public subroutine, called C, and is invoked with two parameters: =over =item The DSN An arrayref of parameters to pass to DBI->connect (usually a dsn, username, and password). =item The Queries. A hashref of the form Query_Name => "$SQL". See L for details. =back =head1 BUGS I have NO idea what to do about handling signals intelligently. Specifically, under some circumstances, Oracle will refuse to acknowledge SIGTERM (presumably since its libraries are non-reentrant) so sometimes SIGKILL is required to terminate a Helper process. =head1 AUTHOR This module has been fine-tuned and packaged by Rob Bloodgood Erobb@empire2.comE. However, most of the code came directly from Fletch Efletch@phydeaux.orgE, either directly (Po:Co:DBIAgent:Queue) or via his ideas. Thank you, Fletch! However, I own all of the bugs. This module is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut libpoe-component-dbiagent-perl-0.26/DBIAgent/Queue.pm0000644000175000017500000000747010744146656021446 0ustar cajuscajuspackage POE::Component::DBIAgent::Queue; =head1 NAME POE::Component::DBIAgent::Queue -- Helper class for managing a round-robin queue of Po:Co:DBIAgent:Helper's. =cut #### originally by Fletch #### originally by Fletch #### originally by Fletch #### See the credits in the AUTHOR section of the POD. =head1 SYNOPSIS =head1 DESCRIPTION =cut $VERSION = sprintf("%d.%02d", q$Revision: 0.02 $ =~ /(\d+)\.(\d+)/); use strict; use Carp qw/ croak carp /; use Class::MethodMaker new_with_init => 'new', new_hash_init => 'hash_init', list => [ qw( _queue ) ], ; =head2 Methods This are the methods we recognize: =over 4 =item init init the queue (currently noop) =cut sub init { my $self = shift; return $self; } =item add append argument to the queue =cut sub add { $_[0]->_queue_push( $_[1] ) } =item clear Clear the queue =cut sub clear { $_[0]->_queue_clear } ## Internal use only ## _find_by -- Return indicies in queue for which supplied predicate ## returns true ## sub _find_by { my( $self, $predicate ) = @_; my $queue = $self->_queue; my @ret = grep $predicate->( $queue->[ $_ ] ), 0..$#{$queue}; return wantarray ? @ret : $ret[0]; } =item find_by_pid Find the index of helper with specified pid =cut sub find_by_pid { my( $self, $pid ) = @_; return $self->_find_by( sub { $_[0]->PID == $pid } ); } =item find_by_wheelid Find the index of helper with specified wheel id =cut sub find_by_wheelid { my( $self, $wheel_id ) = @_; return $self->_find_by( sub { $_[0]->ID == $wheel_id } ); } ## Internal use only ## _remove_by -- Remove first item from the queue for which supplied ## predicate returns true ## sub _remove_by { my( $self, $predicate ) = @_; my $index = ( $self->_find_by( $predicate ) )[0]; return splice( @{scalar $self->_queue}, $index, 1 ) if defined $index; return } =item remove_by_pid Remove helper with specified pid =cut sub remove_by_pid { my( $self, $pid ) = @_; $self->_remove_by( sub { $_[0]->PID == $pid } ); } =item remove_by_wheelid Remove helper with specified wheel id =cut sub remove_by_wheelid { my( $self, $wheel_id ) = @_; $self->_remove_by( sub { $_[0]->ID == $wheel_id } ); } =item next Get next helper off the head of the queue (and put it back on the end (round robin)) =cut sub next { my $self = shift; my $ret = $self->_queue_shift; $self->_queue_push( $ret ); return $ret } =item make_next Force the helper with the specified wheel id to the head of the queue. =cut sub make_next { my $self = shift; my $id = shift; my $ret = $self->remove_by_wheelid( $id ); $self->_queue_unshift( $ret ); } =item exit_all Tell all our helpers to exit gracefully. =cut sub exit_all { my $self = shift; #++ modified command to stop POE::Filter::Reference moaning $_->put({query => "EXIT"}) foreach $self->_queue; } =item kill_all Send the specified signal (default SIGTERM) to all helper processes =cut sub kill_all { my $self = shift; my $sig = shift || 'TERM'; my @helpers = map { $_->PID } $self->_queue; if (@helpers) { kill $sig => @helpers; } # Causes @helpers to be empty on subsequent kill_all() calls. This # was here already; I'm just commenting it. $self->_queue_clear; return } =back =cut 1; __END__ =head1 AUTHOR This module has been fine-tuned and packaged by Rob Bloodgood Erobb@empire2.comE. However, most of the code came I from Fletch Efletch@phydeaux.orgE and adapted for the release of POE::Component::DBIAgent. Thank you, Fletch! However, I own all of the bugs. This module is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut libpoe-component-dbiagent-perl-0.26/debian/0000755000175000017500000000000011221137512017637 5ustar cajuscajuslibpoe-component-dbiagent-perl-0.26/debian/watch0000644000175000017500000000030710744146656020712 0ustar cajuscajus# format version number, currently 3; this line is compulsory! version=3 http://search.cpan.org/dist/POE-Component-DBIAgent/ .*/POE-Component-DBIAgent-v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ libpoe-component-dbiagent-perl-0.26/debian/rules0000755000175000017500000000325210744146656020743 0ustar cajuscajus#!/usr/bin/make -f # This debian/rules file is provided as a template for normal perl # packages. It was created by Marc Brockschmidt for # the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may # be used freely wherever it is useful. # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 # If set to a true value then MakeMaker's prompt function will # always return the default without waiting for user input. export PERL_MM_USE_DEFAULT=1 PACKAGE=$(shell dh_listpackages) ifndef PERL PERL = /usr/bin/perl endif TMP =$(CURDIR)/debian/$(PACKAGE) build: build-stamp build-stamp: dh_testdir # Add commands to compile the package here $(PERL) Makefile.PL INSTALLDIRS=vendor $(MAKE) $(MAKE) test touch $@ clean: dh_testdir dh_testroot dh_clean build-stamp install-stamp # Add commands to clean up after the build process here [ ! -f Makefile ] || $(MAKE) realclean install: install-stamp install-stamp: build-stamp dh_testdir dh_testroot dh_clean -k # Add commands to install the package into $(TMP) here $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr [ ! -d $(TMP)/usr/lib/perl5 ] || rmdir --ignore-fail-on-non-empty --parents --verbose $(TMP)/usr/lib/perl5 touch $@ binary-arch: # We have nothing to do here for an architecture-independent package binary-indep: build install dh_testdir dh_testroot dh_installexamples dh_installdocs README dh_installchangelogs Changes dh_perl dh_compress dh_fixperms dh_installdeb dh_gencontrol dh_md5sums dh_builddeb source diff: @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false binary: binary-indep binary-arch .PHONY: build clean binary-indep binary-arch binary libpoe-component-dbiagent-perl-0.26/debian/compat0000644000175000017500000000000210744146656021057 0ustar cajuscajus5 libpoe-component-dbiagent-perl-0.26/debian/copyright0000644000175000017500000000207011177647750021615 0ustar cajuscajusThis is the debian package for the POE-Component-DBIAgent module. It was created by Cajus Pollmeier . It was downloaded from http://search.cpan.org/dist/POE-Component-DBIAgent/ The upstream author is: This module has been fine-tuned and packaged by Rob Bloodgood . However, most of the queuing code originated with Fletch , either directly or via his ideas. Thank you for making this module a reality, Fletch! However, I own all of the bugs. Copyright: Copyright (C) 2006 Rob Bloodgood License: This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. Perl is distributed under either the Artistic Licence or the GPL. The full text of the GPL is available on Debian systems in /usr/share/common-licenses/GPL The full text of the Artistic Licence is available on Debian systems in /usr/share/common-licenses/Artistic. libpoe-component-dbiagent-perl-0.26/debian/changelog0000644000175000017500000000025511221137307021515 0ustar cajuscajuslibpoe-component-dbiagent-perl (0.26-1) unstable; urgency=low * Initial upload (Closes: #532687) -- Cajus Pollmeier Tue, 24 Jun 2009 10:16:00 +0200 libpoe-component-dbiagent-perl-0.26/debian/control0000644000175000017500000000214211221137307021243 0ustar cajuscajusSource: libpoe-component-dbiagent-perl Section: perl Priority: optional Build-Depends: debhelper (>= 5.0.0), libclass-methodmaker-perl, libpoe-perl, libdbi-perl Build-Depends-Indep: perl (>= 5.8.8) Depends: libclass-methodmaker-perl, libpoe-perl Maintainer: GOsa packages mainteners group Uploaders: Cajus Pollmeier , Benoit Mortier Standards-Version: 3.8.2 Homepage: http://search.cpan.org/dist/POE-Component-DBIAgent/ Vcs-Browser: https://oss.gonicus.de/repositories/goto/trunk/libpoe-component-dbiagent-perl Vcs-Svn: https://oss.gonicus.de/repositories/goto/trunk/libpoe-component-dbiagent-perl Package: libpoe-component-dbiagent-perl Architecture: all Depends: ${perl:Depends}, ${misc:Depends}, Description: POE Component for running asynchronous DBI calls DBIAgent is your answer to non-blocking DBI in POE. . It fires off a configurable number child processes (defaults to 3) and feeds database queries to it via two-way pipe (or sockets ... however POE::Component::Wheel::Run is able to manage it). The primary method is query. . libpoe-component-dbiagent-perl-0.26/debian/libpoe-component-dbiagent.lintian-overrides0000644000175000017500000000010411046046610030242 0ustar cajuscajuslibpoe-component-dbiagent-perl: copyright-without-copyright-notice libpoe-component-dbiagent-perl-0.26/Makefile.PL0000644000175000017500000000044210744146656020411 0ustar cajuscajususe ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'POE::Component::DBIAgent', 'VERSION_FROM' => 'DBIAgent.pm', 'PREREQ_PM' => { 'POE' => 0.17, 'DBI' => 0, 'Storable' => 0, 'Socket' => 0, 'Class::MethodMaker' => 0, }, ); libpoe-component-dbiagent-perl-0.26/META.yml0000644000175000017500000000076210744146656017715 0ustar cajuscajus# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: POE-Component-DBIAgent version: 0.26 version_from: DBIAgent.pm installdirs: site requires: Class::MethodMaker: 0 DBI: 0 POE: 0.17 Socket: 0 Storable: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 libpoe-component-dbiagent-perl-0.26/Changes0000644000175000017500000000325610744146656017740 0ustar cajuscajusRevision history for Perl extension POE::Component::DBIAgent. -*-text-*- 0.25 Doc cleanups. Code cleanups. 0.24 Added patches from fluffle on #poe to add support for returning rows in batches instead of one at a time. This is a performance speedup, in most cases. 0.23 Internal revision 0.22 Internal revision 0.21 Forgot to add the parameter passing code in the main to complete cookie support. The HELPER understood it... 0.20 Reworked the query() syntax. Added an optional parameter hash to query(), which obsoleted query_slow in favor of delay => 1. Also added query cookies, to facilitate more advanced query handling. Added option to return hashref rows instead of listrefs. 0.15 Added query_slow method. This introduces a 1ms delay between each row of output. The REASON is that if you are concurrently handling many handles/sockets, the DBI output won't monopolize all traffic, making everybody else wait. Updated queue management so that when agents finish their queries, they move to the head of the line for the next query. Manages query concurrency MUCH better. If more queries are run than there are agents, queries are spooled and then run as agents complete their jobs and are freed. 0.14 Finally got rid of Filter::Line! All communication from the component to the agents is now via Filter::Reference... woo-hoo! 0.13 Added finish() method to signal helper shutdown. 0.12 POE changed the syntax for calling POE::Wheel::Run. So, syntax updated. 0.11 Initial release, part 2... this one saw daylight. :-) 0.10 Initial release, but it was my first time using PAUSE, so it never saw daylight. libpoe-component-dbiagent-perl-0.26/README0000644000175000017500000000372610744146656017327 0ustar cajuscajusPOE::Component::DBIAgent 0.10 README 11-07-01 The DBIAgent is your answer to non-blocking DBI in POE. This module was written because I was developing a system that was bogging down at ONLY 1 million hits/day on dual 1GHz processors. That's only 11.5 requests/second! Needless to say, it was obvious that something wasn't working right. After much sweat, research, and profiling, I noticed an odd thing: Sometimes, my per-request times were in the milliseconds. Other times, it was taking over 25 seconds to answer a single request. The difference? DBI. During the times that my response times sucked, POE was blocking on a DBI request. I was actually serving my requests, all code considered, in milliseconds. But in the steps between assembling the response and delivering it, my program was stuck in a state that was making a DBI call, and waiting for the response. The answer? FORK! Or, more specifically, use POE's facility for forking off child processes to handle long-running tasks while the main program continues to cycle between states: Wheel::Run. DBIAgent forks off a configurable number of helper processes for running DBI queries. The states that depend on the output of the queries only get called when there is data for them to process. No more agonizing about query optimization in terms of milliseconds because the rest of your program will suffer. Leave that to the operating system! POE is designed for doing a lot of things concurrently. Waiting isn't doing, it's waiting... :-) This module will ONLY work in the places where POE::Wheel::Run will work. This generally means, *nix. Meaning, not on Windows (yet). I can't take most of the credit for this module. Fletch (fletch@fletch@phydeaux.org) had already done alot of this, and contributed the skeleton code for the Helper module. The Queue module is 99.6% his. I just packaged it up and wrote docs... (*his* was tied into his program... *I* made distributable. :-) Rob Bloodgood