Skip Menu |
 

This queue is for tickets about the Data-Queue-Persistent CPAN distribution.

Report information
The Basics
Id: 36337
Status: resolved
Priority: 0/
Queue: Data-Queue-Persistent

People
Owner: Nobody in particular
Requestors: paul.kinlan [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 0.12
Fixed in: (no value)



Subject: table_exists fails when it should succeed
Download (untitled) / with headers
text/plain 846b
Hi, I have been using your module, I think it is great. I think I have found an issue. When connecting to my mysql db I get: DBD::mysql::db do failed: Table 'tagQueue' already exists at /usr/local/share/perl/5.8.8/Data/Queue/Persistent.pm line 105. tagQueue is the name of the table that I am connecting to. It appears that the call in table_exists to dbh->tables returns the schema and also the table name in the results i.e 'schema'.'tagQueue' therefore the line return grep { $_ eq $table } @tables; will return an incorrect value. To replicate this problem I simply call Data::Queue::Persistent->new(table=>'tagQueue', id = 'Test', dbh=> $mydbh); The first call will work if the table isn't set up, the second will fail as the table is now created but the code isn't picking it up. I am using DBD::Mysql version 4.005 Thanks. Paul.
From: paul.kinlan [...] gmail.com
Download (untitled) / with headers
text/plain 1022b
This might be related to the DBD::Mysql change http://lists.mysql.com/commits/32548 On Sun Jun 01 16:09:42 2008, Kinlan wrote: Show quoted text
> Hi, > > I have been using your module, I think it is great. I think I have > found an issue. When connecting to my mysql db I get: DBD::mysql::db do > failed: Table 'tagQueue' already exists at > /usr/local/share/perl/5.8.8/Data/Queue/Persistent.pm line 105. > > tagQueue is the name of the table that I am connecting to. It appears > that the call in table_exists to dbh->tables returns the schema and also > the table name in the results i.e 'schema'.'tagQueue' therefore the line > return grep { $_ eq $table } @tables; will return an incorrect value. > > To replicate this problem I simply call > Data::Queue::Persistent->new(table=>'tagQueue', id = 'Test', dbh=> > $mydbh); > > The first call will work if the table isn't set up, the second will fail > as the table is now created but the code isn't picking it up. > > I am using DBD::Mysql version 4.005 > > Thanks. > Paul.
Subject: Re: [rt.cpan.org #36337] table_exists fails when it should succeed
Date: Sun, 1 Jun 2008 13:14:46 -0700
To: bug-Data-Queue-Persistent [...] rt.cpan.org
From: Mischa Spiegelmock <mspiegelmock [...] gmail.com>
Download (untitled) / with headers
text/plain 1.3k
Cool, send me a patch I guess. I don't have time to maintain this stuff at the moment Thanks, Mischa On Jun 1, 2008, at 1:12 PM, Paul Kinlan via RT wrote: Show quoted text
> > Queue: Data-Queue-Persistent > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=36337 > > > This might be related to the DBD::Mysql change > http://lists.mysql.com/commits/32548 > > On Sun Jun 01 16:09:42 2008, Kinlan wrote:
>> Hi, >> >> I have been using your module, I think it is great. I think I have >> found an issue. When connecting to my mysql db I get: >> DBD::mysql::db do >> failed: Table 'tagQueue' already exists at >> /usr/local/share/perl/5.8.8/Data/Queue/Persistent.pm line 105. >> >> tagQueue is the name of the table that I am connecting to. It >> appears >> that the call in table_exists to dbh->tables returns the schema and >> also >> the table name in the results i.e 'schema'.'tagQueue' therefore the >> line >> return grep { $_ eq $table } @tables; will return an incorrect value. >> >> To replicate this problem I simply call >> Data::Queue::Persistent->new(table=>'tagQueue', id = 'Test', dbh=> >> $mydbh); >> >> The first call will work if the table isn't set up, the second will >> fail >> as the table is now created but the code isn't picking it up. >> >> I am using DBD::Mysql version 4.005 >> >> Thanks. >> Paul.
> >
From: paul.kinlan [...] gmail.com
Download (untitled) / with headers
text/plain 1.7k
I have added a regex check into the grep part of the table_exists method.... It works for my case, but I couldn't say for other scenarios. I have not upadted any version numbers or anything. I am not too sure if this is the correct way to submit a patch. Paul. On Sun Jun 01 16:15:08 2008, mspiegelmock@gmail.com wrote: Show quoted text
> Cool, send me a patch I guess. I don't have time to maintain this > stuff at the moment > > Thanks, > Mischa > > On Jun 1, 2008, at 1:12 PM, Paul Kinlan via RT wrote: >
> > > > Queue: Data-Queue-Persistent > > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=36337 > > > > > This might be related to the DBD::Mysql change > > http://lists.mysql.com/commits/32548 > > > > On Sun Jun 01 16:09:42 2008, Kinlan wrote:
> >> Hi, > >> > >> I have been using your module, I think it is great. I think I have > >> found an issue. When connecting to my mysql db I get: > >> DBD::mysql::db do > >> failed: Table 'tagQueue' already exists at > >> /usr/local/share/perl/5.8.8/Data/Queue/Persistent.pm line 105. > >> > >> tagQueue is the name of the table that I am connecting to. It > >> appears > >> that the call in table_exists to dbh->tables returns the schema and > >> also > >> the table name in the results i.e 'schema'.'tagQueue' therefore the > >> line > >> return grep { $_ eq $table } @tables; will return an incorrect value. > >> > >> To replicate this problem I simply call > >> Data::Queue::Persistent->new(table=>'tagQueue', id = 'Test', dbh=> > >> $mydbh); > >> > >> The first call will work if the table isn't set up, the second will > >> fail > >> as the table is now created but the code isn't picking it up. > >> > >> I am using DBD::Mysql version 4.005 > >> > >> Thanks. > >> Paul.
> > > >
>
Download Persistent.pm
text/x-perl 9.4k
package Data::Queue::Persistent; use 5.008004; use strict; use warnings; use Carp qw / croak /; use DBI; our $VERSION = '0.12'; our $schema = q{ CREATE TABLE %s ( qkey VARCHAR(255) NOT NULL, idx INTEGER UNSIGNED NOT NULL, value BLOB, PRIMARY KEY (qkey, idx) ) }; sub new { my ($class, %opts) = @_; my $dsn = delete $opts{dsn}; my $dbh = delete $opts{dbh}; croak "No DSN or database handle passed to Data::Queue::Persistent->new" unless $dsn || $dbh; my $username = delete $opts{username}; my $pass = delete $opts{pass}; my $cache = delete $opts{cache} || 0; my $key = delete $opts{id} or croak "No queue id defined"; my $table = delete $opts{table} || 'persistent_queue'; my $noload = delete $opts{noload}; my $max_size = delete $opts{max_size}; # connect to db if ($dsn) { $dbh = DBI->connect($dsn, $username, $pass) or croak "Could not connect to database"; } my $self = { cache => $cache, dbh => $dbh, q => [], key => $key, table_name => $table, max_size => $max_size, }; bless $self, $class; $self->init; $self->load if $self->caching && ! $noload; return $self; } sub table_name { my $self = shift; return $self->dbh->quote_identifier($self->{table_name}); } sub dbh { $_[0]->{dbh} } sub key { $_[0]->{key} } sub q { $_[0]->{q} } sub caching { $_[0]->{cache} } sub max_size { $_[0]->{max_size} } # returns how many items are in the queue sub length { my $self = CORE::shift(); return (scalar @{$self->{q}}) if $self->caching; my $table = $self->table_name; my ($length) = $self->dbh->selectrow_array("SELECT COUNT(idx) FROM $table WHERE qkey=?", undef, $self->key); die $self->dbh->errstr if $self->dbh->err; return $length || 0; } sub _max_idx { my $self = CORE::shift(); # TODO: cache max index my $table = $self->table_name; my ($idx) = $self->dbh->selectrow_array("SELECT MAX(idx) FROM $table WHERE qkey=?", undef, $self->key); die $self->dbh->errstr if $self->dbh->err; return defined $idx ? $idx + 1 : 0; } # do a sql statement and die if it fails sub do { my ($self, $sql, @vals) = @_; $self->dbh->do($sql, undef, @vals); croak $self->dbh->errstr if $self->dbh->err; } # initialize the storage sub init { my ($self) = @_; croak "No table name defined" unless $self->table_name; # don't do anything if table already exists return if $self->table_exists; # table doesn't exist, create it my $sql = sprintf($schema, $self->table_name); $self->do($sql); } # load data from db sub load { my $self = CORE::shift(); my $table = $self->table_name or croak "No table name defined"; die "Table $table does not exist." unless $self->table_exists; my $rows = $self->dbh->selectall_arrayref("SELECT value FROM $table WHERE qkey=? ORDER BY idx", undef, $self->key); die $self->dbh->errstr if $self->dbh->err; return unless $rows && @$rows; $self->absorb_rows(@$rows); } sub absorb_rows { my ($self, @rows) = @_; push @{$self->{q}}, map { $_->[0] } @rows; } # delete everything from the queue sub empty { my ($self) = @_; my $table = $self->table_name; $self->do("DELETE FROM $table WHERE qkey=?", $self->key); $self->{q} = [] if $self->caching; } sub table_exists { my $self = CORE::shift(); # get table info, see if our table exists my @tables = $self->dbh->tables(undef, undef, $self->{table_name}, "TABLE"); my $table = $self->{table_name}; $table = $self->dbh->quote_identifier($self->{table_name}) if $self->dbh->get_info(29); # quote if the db driver uses table name quoting return grep { $_ =~ /$table$/ } @tables; } # add @vals to the queue *add = \&unshift; sub unshift { my ($self, @vals) = @_; my $idx = $self->_max_idx; my $key = $self->dbh->quote($self->key); my $table = $self->table_name; my $dbh = $self->dbh; $dbh->begin_work; my $sth = $dbh->prepare(qq[ INSERT INTO $table (qkey, idx, value) VALUES ($key, ?, ?) ]); foreach my $val (@vals) { push @{$self->{q}}, $val if $self->caching; $sth->execute($idx++, $val); if ($dbh->err) { die $dbh->errstr; $dbh->rollback; } } $dbh->commit; # truncate queue to max_size my $max_size = $self->max_size; my $length = $self->length; $self->shift($length - $max_size) if defined $max_size && $length > $max_size; } # shift $count elements off the queue *remove = \&shift; sub shift { my ($self, $_count) = @_; my $count = defined $_count ? $_count : 1; $count += 0; if ($self->caching) { CORE::shift(@{$self->{q}}) for 1 .. $count; } my $table = $self->table_name; # begin transaction $self->dbh->begin_work; # get $count elements my $rows = $self->dbh->selectall_arrayref("SELECT idx, value FROM $table WHERE qkey = ? ORDER BY idx LIMIT $count", undef, $self->key); die $self->dbh->errstr if $self->dbh->err; my @idx = map { $_->[0] } @$rows; my @vals = map { $_->[1] } @$rows; return () unless @vals; # remove the retreived elements my $bindstr = join(',', map { '?' } @idx); $self->do("DELETE FROM $table WHERE qkey=? AND idx BETWEEN ? AND ?", $self->key, $idx[0], $idx[-1]); # commit transaction $self->dbh->commit; # return first element if no $count defined, otherwise return array of values return $vals[0] unless defined $_count; return @vals; } # retreive elements at an index sub get { my ($self, $offset, $length, %opts) = @_; return $self->all unless defined $offset || defined $length; $length = -1 unless defined $length; # need to specify a limit when selecting an offset, this is wack $offset += 0; my $direction = $opts{reverse} ? "DESC" : ''; my $table = $self->table_name; my $rows = $self->dbh->selectcol_arrayref("SELECT value FROM $table WHERE qkey = ? ORDER BY idx $direction LIMIT $length OFFSET $offset", undef, $self->key); die $self->dbh->errstr if $self->dbh->err; return wantarray ? @$rows : $rows->[0]; } # returns all elements of the queue sub all { my $self = CORE::shift(); return @{$self->{q}} if $self->caching; my $valsref = $self->dbh->selectall_arrayref("SELECT value FROM " . $self->table_name . " WHERE qkey = ?", undef, $self->key); return map { @$_ } @$valsref; } 1; __END__ =head1 NAME Data::Queue::Persistent - Perisistent database-backed queue =head1 SYNOPSIS use Data::Queue::Persistent; my $q = Data::Queue::Persistent->new( table => 'persistent_queue', # name to save queues in dsn => 'dbi:SQLite:dbname=queue.db', # dsn for database to save queues id => 'testqueue', # queue identifier cache => 1, noload => 1, # don't load saved queue automatically max_size => 100, # limit to 100 items ); $q->add('first', 'second', 'third', 'fourth'); $q->remove; # returns 'first' $q->remove(2); # returns ('second', 'third') $q->empty; # removes everything =head1 DESCRIPTION This is a simple module to keep a persistent queue around. It is just a normal implementation of a queue, except it is backed by a database so that when your program exits the data won't disappear. =head2 EXPORT None by default. =head2 Methods =over 4 =item * new(%opts) Creates a new persistent data queue object. This will also initialize the database storage, and load the saved queue data if it already exists. Options: dsn: DSN for database connection. dbh: Already initialized DBI connection handle. id: The ID of this queue. You can have multiple queues stored in the same table, distinguished by their IDs. user: The username for database connection (optional). pass: The password for database connection (optional). cache: Enable caching of the queue for speed. Not reccommended if multiple instances of the queue will be used concurrently. Default is 0. table: The table name to use ('persistent_queue' by default). noload: Don't load queue data when initialized (only applicable if caching is used) max_size: Limit the queue to max_size, with the oldest elements falling off =item * add(@items) Adds a list of items to the queue. =item * remove($count) Removes $count (1 by default) items from the queue and returns them. Returns value if no $count specified, otherwise returns an array of values. =item * get([$offset[, $length]]) Gets $length elements starting at offset $offset =item * all Returns all elements in the queue. Does not modify the queue. =item * length Returns count of elements in the queue. =item * empty Removes all elements from the queue. =item * unshift(@items) Alias for C<add(@items)>. =item * shift($count) Alias for C<remove($count)>. =back =head1 SEE ALSO Any data structures book. =head1 AUTHOR Mischa Spiegelmock, E<lt>mspiegelmock@gmail.comE<gt> =head1 COPYRIGHT AND LICENSE Copyright (C) 2007 by Mischa Spiegelmock 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.4 or, at your option, any later version of Perl 5 you may have available. =cut
Thanks! Should be patched now in 0.13.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.