Data-Model
view release on metacpan or search on metacpan
lib/Data/Model.pm view on Meta::CPAN
# for query param validation
if ($RUN_VALIDATION && $query) {
my @p = %{ $query };
validate(
@p, {
index => {
type => HASHREF | UNDEF,
optional => 1,
callbacks => {
has_index_name => sub {
return 1 unless $_[0];
return 0 unless scalar(@{ [ %{ $_[0] } ] }) == 2;
my($name) = %{ $_[0] };
$schema->has_index($name);
},
},
},
where => {
type => HASHREF | ARRAYREF | UNDEF,
lib/Data/Model/Driver/Queue/Q4M.pm view on Meta::CPAN
use base 'Data::Model::Driver::DBI';
use Carp ();
$Carp::Internal{(__PACKAGE__)}++;
sub timeout { $_[0]->{timeout} }
sub _create_arguments {
my $arg_length = scalar(@_);
my $timeout;
my %callbacks;
my @queue_tables;
for (my $i = 0; $i < $arg_length; $i++) {
my($table, $value) = ($_[$i], $_[$i + 1]);
if (ref($value) eq 'CODE') {
# register callback
push @queue_tables, $table;
$callbacks{$table} = $value;
} elsif ($table eq 'timeout' && $value =~ /\A[0-9]+\z/) {
# timeout
$timeout = $value;
}
$i++;
}
(\@queue_tables, \%callbacks, $timeout);
}
sub queue_wait {
my($self, $timeout, @tables) = @_;
my $dbh = $self->r_handle;
my $sql = sprintf 'SELECT queue_wait(%s)', join(', ', (('?') x (scalar(@tables) + 1)));
my $sth = $dbh->prepare_cached($sql);
# bind params
lib/Data/Model/Driver/Queue/Q4M.pm view on Meta::CPAN
$sth->execute;
}
sub queue_running {
my($self, $c) = (shift, shift);
$self->{is_aborted} = 0;
my $arg_length = scalar(@_);
Carp::croak 'illegal parameter' if $arg_length % 2;
# create table attributes
my($queue_tables, $callbacks, $timeout) = _create_arguments(@_);
Carp::croak 'required is callback handler' unless @{ $queue_tables };
my %schema = map { $_ => 1 } $c->schema_names;
for my $table (@{ $queue_tables }) {
my($name) = split /:/, $table;
Carp::croak "'$name' is missing model name" unless $schema{$name};
}
$timeout ||= $self->timeout || 60;
lib/Data/Model/Driver/Queue/Q4M.pm view on Meta::CPAN
my $running_table = $queue_tables->[$table_id - 1];
my($real_table) = split /:/, $running_table;
my($row) = $c->get( $real_table );
unless ($row) {
$self->queue_abort;
return;
}
# running callback
eval {
$callbacks->{$running_table}->($row);
};
if ($@) {
$self->queue_abort unless $self->{is_aborted};
die $@; # throwing exception
}
return if $self->{is_aborted};
$self->queue_end;
return $real_table;
}
( run in 0.230 second using v1.01-cache-2.11-cpan-ec4f86ec37b )