summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJason Woodward2005-12-14 23:35:05 +0000
committerJason Woodward2005-12-14 23:35:05 +0000
commit462102ad01d8cad51d66542e63eea6cef17e4659 (patch)
tree6dedf69b752fa9a888ba117507a4ca1f06683f14
parent27f0626af520a1781d499b12b265717ed014e9f1 (diff)
downloadJaos-DBI-462102ad01d8cad51d66542e63eea6cef17e4659.tar.gz
initial import0.2
-rw-r--r--Build.PL19
-rw-r--r--Changes4
-rw-r--r--MANIFEST10
-rw-r--r--MANIFEST.SKIP27
-rw-r--r--META.yml18
-rw-r--r--Makefile.PL31
-rw-r--r--README237
-rw-r--r--lib/Jaos/DBI.pm718
-rw-r--r--t/01use.t4
-rw-r--r--t/02pod.t7
-rw-r--r--t/03podcoverage.t7
11 files changed, 1082 insertions, 0 deletions
diff --git a/Build.PL b/Build.PL
new file mode 100644
index 0000000..5d0542a
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,19 @@
+use strict;
+use Module::Build;
+
+my $build = Module::Build->new(
+ create_makefile_pl => 'passthrough',
+ license => 'perl',
+ module_name => 'Jaos::DBI',
+ requires => {
+ 'DBI' => 0,
+ 'Class::Data::Inheritable' => 0,
+ 'Class::Accessor' => 0,
+ },
+ create_makefile_pl => 'passthrough',
+ create_readme => 1,
+ test_files => [
+ glob('t/*.t')
+ ]
+);
+$build->create_build_script;
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..6c840bc
--- /dev/null
+++ b/Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension Jaos::DBI
+
+0.2
+ - initial release
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..db732e1
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,10 @@
+Build.PL
+Changes
+lib/Jaos/DBI.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/01use.t
+t/02pod.t
+t/03podcoverage.t
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..764e0da
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,27 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
+
+t/tmp
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..9df9ff5
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,18 @@
+---
+name: Catalyst-Plugin-Session-Store-JDBI
+version: 0.01
+author:
+ - 'Jason Woodward, <woodwardj@jaos.org>'
+abstract: Store your sessions in a database
+license: perl
+requires:
+ Catalyst: 5.49
+ Catalyst::Plugin::Session: 0
+ Catalyst::Plugin::Session::Store: 0
+ DBI: 0
+ MIME::Base64: 0
+provides:
+ Catalyst::Plugin::Session::Store::JDBI:
+ file: lib/Catalyst/Plugin/Session/Store/JDBI.pm
+ version: 0.01
+generated_by: Module::Build version 0.2611
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..51d31fd
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,31 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+ my $makefile = File::Spec->rel2abs($0);
+
+ CPAN::Shell->install('Module::Build::Compat')
+ or die " *** Cannot install without Module::Build. Exiting ...\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+ use lib '_build/lib';
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ require Module::Build;
+ Module::Build::Compat->write_makefile(build_class => 'Module::Build');
diff --git a/README b/README
new file mode 100644
index 0000000..9f463bc
--- /dev/null
+++ b/README
@@ -0,0 +1,237 @@
+
+NAME
+ Jaos::DBI - Jaos DBI object similar to Class::DBI
+
+SYNOPSIS
+ # subclassing
+ package Users;
+ use base qw/Jaos::DBI/;
+ use strict;
+ use warnings;
+
+ __PACKAGE__->db_dsn('dbi:Pg:dbname=foo');
+ __PACKAGE__->db_user('you');
+ __PACKAGE__->db_password('secret');
+ __PACKAGE__->db_options({RaiseError => 0, AutoCommit => 1, PrintError => 0});
+
+ __PACKAGE__->table('users');
+ __PACKAGE__->columns(qw/id nick password email logged_in/);
+ __PACKAGE__->primary_column('id');
+ __PACKAGE__->virtual_columns(qw/join_id join_name/);
+ __PACKAGE__->sequence('users_id_seq');
+ __PACKAGE__->base_select('select a.*,b.join_id,b.join_name from foo a join bar b on a.id=b.foo');
+ __PACKAGE__->manual_update(1);
+
+ __PACKAGE__->setup(); # initiates database connection and accessors
+ 1;
+
+ # using subclass
+ use Users;
+
+ # examine the class properties
+ print "table: ", Users->table, "\n";
+ print "columns: ", join(',', Users->columns ), "\n";
+
+ # retrieve objects
+ # by search
+ my @objs = Users->search(email => 'foo@bar.com',{ order_by => 'id', limit => '2'});
+ my @objs = Users->search(email => 'foo@bar.com',{ order_by => 'id', limit => '2'});
+ my @objs = Users->search_like(email => '%@bar.com',{ order_by => 'id', limit => '2'});
+ # all
+ my $objs_arrayref = Users->retrieve_all();
+ # by primary column value (primary key)
+ my $obj = Users->retrieve($id);
+
+ # insert (or alias create)
+ my $user = Users->insert(nick => 'zaphod', email => 'foo@bar.org');
+ $user = Users->find_or_create(nick => 'zaphod', email => 'foo@bar.org');
+
+ # modify
+ $user->email('newaddress@foo.com'); # setting attribute updates the database
+ $user->delete();
+ $user->update unless $user->manual_update == 1;
+ User->delete(nick => 'zaphod', email => 'newaddress@foo.com');
+
+DESCRIPTION
+ Some description here.
+
+METHODS
+ setup
+
+ Initializes the Class; creates a database handle callback and sets up the accessors for columns, primary_column, and virtual_columns. Must
+ have a table name, dsn, user, and pass specified prior to calling __PACKAGE__->setup().
+
+ db_dsn
+
+ Get or set the database dsn.
+
+ __PACKAGE__->db_dsn('dbi:Pg:dbname=foo');
+
+ db_user
+
+ Get or set the database user.
+
+ __PACKAGE__->db_user('user');
+
+ db_password
+
+ Get or set the database password.
+
+ __PACKAGE__->db_passwd('secret');
+
+ db_options
+
+ Get or set the database options.
+
+ __PACKAGE__->db_options({ Autocommit => 1});
+
+ base_select
+
+ This sets the basic select statement that is used to retrieve information. This can be used to create complex joins or subselects that
+ further where clauses can be built from.
+
+ __PACKAGE__->base_select('select a.*,b.field from table a left join table2 b on a.field=b.field');
+
+ table
+
+ Gets or sets the table name for the subclass or instance.
+
+ __PACKAGE__->table('foo');
+ my $table = __PACKAGE__->table();
+
+ columns
+
+ Get or set the tables column names.
+
+ __PACKAGE_->columns(qw/one two three/);
+ my @columns = __PACKAGE__->columns();
+
+ primary_column
+
+ Get or set the tables primary column;
+
+ __PACKAGE_->primary_column('id);
+
+ virtual_columns
+
+ These are virtual columns that may result from a base_select join. Accessors will be created for them just as if they were columns.
+
+ __PACKAGE__->virtual_columns(qw/join_id join_name/);
+
+ manual_update
+
+ Get or set the option to stop auto update on modification. Must call __PACKAGE__->update manually.
+
+ sequence
+
+ Get or set the tables sequence. This is used to generate unique primary keys.
+
+ __PACKAGE__->sequence('users_id_seq');
+
+ dbh
+
+ Retrieve the database handle [not recommended].
+
+ sequence_nextval
+
+ Returns the next value for the tables sequence.
+
+ my $new_id = __PACKAGE__->sequence_nextval();
+
+ sequence_currval
+
+ Returns the current value for the tables sequence.
+
+ my $current_id = __PACKAGE__->sequence_currval();
+
+ prepare
+
+ Returns a statement handle for the specified sql;
+
+ __PACKAGE__->prepare('select * from foo');
+
+ insert
+
+ Inserts a row into the database, returning an object representing that row. This calls __PACKAGE__->sequence_nextval for the primary col-
+ umn.
+
+ my $new_obj = __PACKAGE__->insert(column1 => $value1, column2 => $value2);
+
+ create
+
+ Alias to insert.
+
+ find_or_create
+
+ This attempts to find a row with the column values specified, or creates one. Calls __PACKAGE__->search(@_) and __PACKAGE__->insert(@_) if
+ search returns undef.
+
+ my $obj = __PACKAGE__->find_or_create(column1 => $value, column2 => $value);
+ =cut
+
+ sub find_or_create {
+ my $self = shift;
+ my $table = $self->table;
+
+ if (my ($r) = $self->search(@_)) {
+ return $r;
+ }
+ return $self->insert(@_);
+ }
+
+ search
+
+ Searches the table and returns a list of matching objects.
+
+ my @objs = __PACKAGE__->search(column1 => $value1, column2 => $value2);
+
+ search_like
+
+ Searches the table and returns a list of matching objects using column like $value rather than column = $value.
+
+ my @objs = __PACKAGE__->search_like(column1 => "%$value1%", column2 => "%$value2%");
+
+ search_where
+
+ Searches the table and returns a list of matching objects using the specified where clause
+
+ my @objs = __PACKAGE__->search_where('id = foo');
+
+ delete
+
+ Deletes either the referring object, if called as $obj->delete, or provides a class method to delete all all rows matching the arguments if
+ called as __PACKAGE__->delete();
+
+ $obj->delete();
+ __PACKAGE__->delete(column1 => $value1, column2 => $value2);
+
+ get
+
+ Get a column value.
+
+ __PACKAGE__->get('column');
+
+ set
+
+ Set a column value. This updates the column in the table row represented by the object.
+
+ __PACKAGE__->set('column',$value);
+
+ retrieve_all
+
+ Return all rows in the table;
+
+ my @objs = __PACKAGE__->retrieve_all();
+
+ retrieve
+
+ Return row mathing the specified key against the primary column.
+
+ my $obj = __PACKAGE__->retrieve($id);
+
+AUTHOR
+ Jason Woodward <woodwardj@jaos.org>
+
+LICENSE
+ This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
diff --git a/lib/Jaos/DBI.pm b/lib/Jaos/DBI.pm
new file mode 100644
index 0000000..dc8a70f
--- /dev/null
+++ b/lib/Jaos/DBI.pm
@@ -0,0 +1,718 @@
+package Jaos::DBI;
+use strict;
+use warnings;
+use base qw/Class::Data::Inheritable Class::Accessor/;
+use DBI ();
+
+our $VERSION = 0.2;
+our $if_active = ($DBI::VERSION >= '1.40') ? 3 : 0;
+
+=head1 NAME
+
+Jaos::DBI - Jaos DBI object similar to Class::DBI
+
+=head1 SYNOPSIS
+
+ # subclassing
+ package Users;
+ use base qw/Jaos::DBI/;
+ use strict;
+ use warnings;
+
+ __PACKAGE__->db_dsn('dbi:Pg:dbname=foo');
+ __PACKAGE__->db_user('you');
+ __PACKAGE__->db_password('secret');
+ __PACKAGE__->db_options({RaiseError => 0, AutoCommit => 1, PrintError => 0});
+
+ __PACKAGE__->table('users');
+ __PACKAGE__->columns(qw/id nick password email logged_in/);
+ __PACKAGE__->primary_column('id');
+ __PACKAGE__->virtual_columns(qw/join_id join_name/);
+ __PACKAGE__->sequence('users_id_seq');
+ __PACKAGE__->base_select('select a.*,b.join_id,b.join_name from foo a join bar b on a.id=b.foo');
+ __PACKAGE__->manual_update(1);
+
+ __PACKAGE__->setup(); # initiates database connection and accessors
+ 1;
+
+ # using subclass
+ use Users;
+
+ # examine the class properties
+ print "table: ", Users->table, "\n";
+ print "columns: ", join(',', Users->columns ), "\n";
+
+ # retrieve objects
+ # by search
+ my @objs = Users->search(email => 'foo@bar.com',{ order_by => 'id', limit => '2'});
+ my @objs = Users->search(email => 'foo@bar.com',{ order_by => 'id', limit => '2'});
+ my @objs = Users->search_like(email => '%@bar.com',{ order_by => 'id', limit => '2'});
+ # all
+ my $objs_arrayref = Users->retrieve_all();
+ # by primary column value (primary key)
+ my $obj = Users->retrieve($id);
+
+ # insert (or alias create)
+ my $user = Users->insert(nick => 'zaphod', email => 'foo@bar.org');
+ $user = Users->find_or_create(nick => 'zaphod', email => 'foo@bar.org');
+
+ # modify
+ $user->email('newaddress@foo.com'); # setting attribute updates the database
+ $user->delete();
+ $user->update unless $user->manual_update == 1;
+ User->delete(nick => 'zaphod', email => 'newaddress@foo.com');
+
+=head1 DESCRIPTION
+
+Some description here.
+
+=cut
+
+__PACKAGE__->mk_classdata('_table');
+__PACKAGE__->mk_classdata('_columns');
+__PACKAGE__->mk_classdata('_virtual_columns');
+__PACKAGE__->mk_classdata('_primary_column');
+__PACKAGE__->mk_classdata('_sequence');
+__PACKAGE__->mk_classdata('_db_handle');
+__PACKAGE__->mk_classdata('_db_dsn');
+__PACKAGE__->mk_classdata('_db_user');
+__PACKAGE__->mk_classdata('_db_password');
+__PACKAGE__->mk_classdata('_db_options');
+__PACKAGE__->mk_classdata('_base_select');
+__PACKAGE__->mk_classdata('_manual_update' => 0);
+
+=head1 METHODS
+
+=head2 setup
+
+Initializes the Class; creates a database handle callback and sets up the accessors for columns, primary_column, and virtual_columns. Must have a table name, dsn, user, and pass specified prior to calling __PACKAGE__->setup().
+
+=cut
+
+sub setup
+{
+ my $class = shift;
+
+ my @columns = $class->columns;
+ push @columns,$class->primary_column if $class->primary_column;
+ push @columns,$class->virtual_columns if $class->virtual_columns;
+ $class->mk_accessors(@columns);
+ $class->mk_classdata(
+ '_jaos_dbh' => sub {
+ unless ($class->_db_handle && $class->_db_handle->ping) {
+ $class->_db_handle(DBI->connect_cached(
+ $class->_db_dsn,
+ $class->_db_user,
+ $class->_db_password,
+ $class->_db_options
+ )) or die $DBI::errstr;
+ }
+ return $class->_db_handle;
+ }
+ );
+
+ my $self = $class->SUPER::new(@_);
+
+ return $self;
+}
+
+=head2 db_dsn
+
+Get or set the database dsn.
+
+ __PACKAGE__->db_dsn('dbi:Pg:dbname=foo');
+
+=cut
+
+sub db_dsn
+{
+ my $self = shift;
+ if (@_) {
+ $self->_db_dsn(@_);
+ }
+ $self->_db_dsn();
+}
+
+=head2 db_user
+
+Get or set the database user.
+
+ __PACKAGE__->db_user('user');
+
+=cut
+
+sub db_user
+{
+ my $self = shift;
+ if (@_) {
+ $self->_db_user(@_);
+ }
+ $self->_db_user();
+}
+
+=head2 db_password
+
+Get or set the database password.
+
+ __PACKAGE__->db_passwd('secret');
+
+=cut
+
+sub db_password
+{
+ my $self = shift;
+ if (@_) {
+ $self->_db_password(@_);
+ }
+ $self->_db_password();
+}
+
+=head2 db_options
+
+Get or set the database options.
+
+ __PACKAGE__->db_options({ Autocommit => 1});
+
+=cut
+
+sub db_options
+{
+ my $self = shift;
+ if (@_) {
+ $self->_db_options(@_);
+ }
+ $self->_db_options();
+}
+
+=head2 base_select
+
+This sets the basic select statement that is used to retrieve information. This can be used to create complex joins or subselects that further where clauses can be built from.
+
+ __PACKAGE__->base_select('select a.*,b.field from table a left join table2 b on a.field=b.field');
+
+=cut
+
+sub base_select
+{
+ my $self = shift;
+ if (@_) {
+ $self->_base_select(@_);
+ }
+ $self->_base_select();
+}
+
+=head2 table
+
+Gets or sets the table name for the subclass or instance.
+
+ __PACKAGE__->table('foo');
+ my $table = __PACKAGE__->table();
+
+=cut
+
+sub table
+{
+ my $self = shift;
+ if (@_) {
+ $self->_table(@_);
+ }
+ $self->_table();
+}
+
+=head2 columns
+
+Get or set the tables column names.
+
+ __PACKAGE_->columns(qw/one two three/);
+ my @columns = __PACKAGE__->columns();
+
+=cut
+
+sub columns
+{
+ my $self = shift;
+ if (@_) {
+ $self->_columns([@_]);
+ }
+ @{$self->_columns() || [] };
+}
+
+=head2 primary_column
+
+Get or set the tables primary column;
+
+ __PACKAGE_->primary_column('id);
+
+=cut
+
+sub primary_column
+{
+ my $self = shift;
+ if (@_) {
+ $self->_primary_column(@_);
+ }
+ $self->_primary_column();
+}
+
+=head2 virtual_columns
+
+These are virtual columns that may result from a base_select join. Accessors will be created for them just as if they were columns.
+
+ __PACKAGE__->virtual_columns(qw/join_id join_name/);
+
+=cut
+
+sub virtual_columns
+{
+ my $self = shift;
+ if (@_) {
+ $self->_virtual_columns(@_);
+ }
+ $self->_virtual_columns();
+}
+
+=head2 manual_update
+
+Get or set the option to stop auto update on modification. Must call __PACKAGE__->update manually.
+
+=cut
+
+sub manual_update
+{
+ my $self = shift;
+ if (@_) {
+ $self->_manual_update(@_);
+ }
+ $self->_manual_update();
+}
+
+=head2 sequence
+
+Get or set the tables sequence. This is used to generate unique primary keys.
+
+ __PACKAGE__->sequence('users_id_seq');
+
+=cut
+
+sub sequence
+{
+ my $self = shift;
+ if (@_) {
+ $self->_sequence(@_);
+ }
+ $self->_sequence() || undef;
+}
+
+=head2 dbh
+
+Retrieve the database handle [not recommended].
+
+=cut
+
+=head2 sequence_nextval
+
+Returns the next value for the tables sequence.
+
+ my $new_id = __PACKAGE__->sequence_nextval();
+
+=cut
+
+sub sequence_nextval
+{
+ my ($self) = @_;
+ return undef unless $self->sequence;
+
+ my $sql = 'select nextval(\'' . $self->sequence .'\')';
+ my $val = $self->_jaos_dbh()->()->selectrow_arrayref($sql);
+ return $val->[0] ? $val->[0] : undef;
+}
+
+=head2 sequence_currval
+
+Returns the current value for the tables sequence.
+
+ my $current_id = __PACKAGE__->sequence_currval();
+
+=cut
+
+sub sequence_currval
+{
+ my ($self) = @_;
+ return undef unless $self->sequence;
+
+ my $sql = 'select currval(\'' . $self->sequence .'\')';
+ my $val = $self->_jaos_dbh()->()->selectrow_arrayref($sql);
+ return $val->[0] ? $val->[0] : undef;
+}
+
+=head2 prepare
+
+Returns a statement handle for the specified sql;
+
+ __PACKAGE__->prepare('select * from foo');
+
+=cut
+
+sub prepare
+{
+ my $self = shift;
+ my $sql = shift;
+
+ # this causes weird issues with the statement handles being recreated causing
+ # mod_perl, apache, and postgres to have issues
+ #return $self->_jaos_dbh->prepare_cached(@_,undef,$if_active);
+
+ $self->_jaos_dbh()->()->prepare_cached($sql);
+}
+
+=head2 insert
+
+Inserts a row into the database, returning an object representing that row. This calls __PACKAGE__->sequence_nextval for the primary column.
+
+ my $new_obj = __PACKAGE__->insert(column1 => $value1, column2 => $value2);
+
+=cut
+
+sub insert
+{
+ my ($self,%opts) = @_;
+ my $table = $self->table;
+ my @columns = keys %opts;
+ my $sql = "insert into $table (";
+ my $seq = undef;
+
+ #$self->_jaos_dbh()->()->begin_work();
+
+ $seq = $self->sequence_nextval();
+
+ if ($seq) {
+ push @columns, $self->primary_column;
+ $opts{$self->primary_column} = $seq;
+ }
+ $sql .= join(',',@columns) . ') values (';
+ $sql .= join(',',('?') x scalar(keys %opts)) . ')';
+
+ #print STDERR "insert:$sql [",join(',',map {$opts{$_} ? $opts{$_} : undef} @columns),"]\n";
+ eval {
+ my $stmt = $self->prepare($sql) or die "Faild to prepare [$sql]";
+ $stmt->execute(map {$opts{$_} ? $opts{$_} : undef} @columns) or $stmt->finish(),die "[$sql]" . $!;
+ $stmt->finish();
+ };
+ if ($@) {
+ warn $@;
+ return undef;
+ };
+
+ $seq = $self->sequence_currval();
+ #$self->_jaos_dbh()->()->commit();
+
+ if ($seq) {
+ #return ($self->search($self->primary_column => $seq))[0];
+ return $self->retrieve($seq);
+ } else {
+ if (my ($r) = $self->search(%opts)) {
+ return $r;
+ }
+ return undef;
+ }
+}
+
+=head2 create
+
+Alias to insert.
+
+=cut
+
+sub create
+{
+ my $self = shift;
+ $self->insert(@_);
+}
+
+=head2 find_or_create
+
+This attempts to find a row with the column values specified, or creates one. Calls __PACKAGE__->search(@_) and __PACKAGE__->insert(@_) if search returns undef.
+
+ my $obj = __PACKAGE__->find_or_create(column1 => $value, column2 => $value);
+=cut
+
+sub find_or_create
+{
+ my $self = shift;
+ my $table = $self->table;
+
+ if (my ($r) = $self->search(@_)) {
+ return $r;
+ }
+ return $self->insert(@_);
+}
+
+=head2 search
+
+Searches the table and returns a list of matching objects.
+
+ my @objs = __PACKAGE__->search(column1 => $value1, column2 => $value2);
+
+=cut
+
+sub search
+{
+ my $self = shift;
+ return $self->_do_search('=',undef,@_);
+}
+
+=head2 search_like
+
+Searches the table and returns a list of matching objects using column like $value rather than column = $value.
+
+ my @objs = __PACKAGE__->search_like(column1 => "%$value1%", column2 => "%$value2%");
+
+=cut
+
+sub search_like
+{
+ my $self = shift;
+ return $self->_do_search('like',undef,@_);
+}
+
+=head2 search_where
+
+Searches the table and returns a list of matching objects using the specified where clause
+
+ my @objs = __PACKAGE__->search_where('id = foo');
+
+=cut
+
+sub search_where
+{
+ my $self = shift;
+ return $self->_do_search('=',@_);
+}
+
+sub _do_search
+{
+ my ($self,$type,$where,@opts) = @_;
+ my $class = ref($self) || $self;
+ my $table = $self->table;
+ my $sql = $self->base_select || "select * from $table";
+ my @values = ();
+
+ my ($search_opts,%data,@columns);
+ if (@opts) {
+ $search_opts = @opts % 2 ? pop @opts : {};
+ %data = @opts;
+ @columns = (keys %data) if %data;
+ }
+
+ if ($where) {
+ $sql .= ' where ' . $where;
+ } elsif (@columns) {
+ $sql .= ' where ';
+ $sql .= join(' and ',map { "$_ $type ?" } @columns);
+ }
+ if ($search_opts) {
+ $sql .= " order by $search_opts->{order_by}" if $search_opts->{order_by};
+ $sql .= " limit $search_opts->{limit}" if $search_opts->{limit};
+ $sql .= " offset $search_opts->{offset}" if $search_opts->{offset};
+ }
+
+ if (@columns) {
+ @values = map {$data{$_} ? $data{$_} : undef} @columns;
+ }
+
+ my $result = [];
+ #print STDERR "search:",$sql,"[",join(',',@values),"]","\n";
+ eval {
+ my $stmt = $self->prepare($sql) or die "Failed to prepare [$sql]";
+ $stmt->execute(@values) or $stmt->finish(),die "[$sql]" . $!;
+ $result = [ map { $class->SUPER::new($_) } @{$stmt->fetchall_arrayref({})} ];
+ $stmt->finish();
+ };
+ if ($@) {
+ warn $@;
+ return ();
+ }
+
+ return (scalar(@$result) > 0) ? @$result : ();
+
+}
+
+=head2 delete
+
+Deletes either the referring object, if called as $obj->delete, or provides a class method to delete all all rows matching the arguments if called as __PACKAGE__->delete();
+
+ $obj->delete();
+ __PACKAGE__->delete(column1 => $value1, column2 => $value2);
+
+=cut
+
+sub delete
+{
+ my ($self,%opts) = @_;
+ my $table = $self->table;
+ my $sql = undef;
+ my @values = ();
+
+ if (%opts) {
+ my @columns = keys %opts;
+
+ $sql = "delete from $table where ";
+ $sql .= join(' and ', map { "$_ = ?" } @columns);
+
+ @values = map { $opts{$_} ? $opts{$_} : undef } @columns;
+ } elsif (ref $self) {
+
+ $sql = "delete from $table where ";
+ if ( $self->primary_column ) {
+ $sql .= $self->primary_column() . ' = ?';
+ } else {
+ $sql .= join(' and ',map { "$_ = ?" } $self->columns);
+ }
+
+ if ($self->primary_column) {
+ @values = ($self->get($self->primary_column()));
+ } else {
+ @values = map {$self->$_} $self->columns;
+ }
+
+ } else {
+ return;
+ }
+
+ #$self->_jaos_dbh()->()->begin_work();
+ #print STDERR "delete:$sql [",join(',',@values),"]\n";
+ eval {
+ my $stmt = $self->prepare($sql) or die "Failed to prepare [$sql]";
+ $stmt->execute(@values) or $stmt->finish(),die "[$sql]" . $!;
+ $stmt->finish();
+ };
+ if ($@) {
+ warn $@;
+ #$self->_jaos_dbh()->()->rollback();
+ return;
+ } else {
+ if ( ref $self ) {
+ undef %$self;
+ }
+ #$self->_jaos_dbh()->()->commit();
+ return 1;
+ }
+
+}
+
+=head2 get
+
+Get a column value.
+
+ __PACKAGE__->get('column');
+
+=cut
+
+=head2 set
+
+Set a column value. This updates the column in the table row represented by the object.
+
+ __PACKAGE__->set('column',$value);
+
+=cut
+
+sub set
+{
+ my ($self, $key) = splice(@_, 0, 2);
+ $self->SUPER::set($key, @_);
+ $self->_update($key) unless ($self->manual_update == 1);
+}
+
+sub update
+{
+ my $self = shift;
+ $self->_update();
+}
+
+sub _update
+{
+ my ($self,$key) = @_;
+ my $table = $self->table;
+ my $primary_column = $self->primary_column;
+ my $sql = undef;
+ my @values = ();
+ return undef unless ref $self;
+ return undef unless $primary_column;
+
+ if ($key) {
+ $sql = "update $table set $key = ? where $primary_column = ?";
+ @values = ($self->$key,$self->get($self->primary_column));
+ } else {
+ my @columns = $self->columns;
+ $sql = "update $table set ";
+ $sql .= join(',', map { "$_ = ?" } @columns);
+ $sql .= " where $primary_column = ?";
+ @values = map { $self->$_ ? $self->$_ : undef } @columns;
+ push @values, $self->get($self->primary_column);
+ }
+
+ my $stmt;
+ #print STDERR "update:$sql ",join(',',@values),"\n";
+ eval {
+ my $stmt = $self->prepare($sql) or die "Failed to prepare [$sql]";
+ $stmt->execute(@values) or $stmt->finish(),die "[$sql]" . $!;
+ $stmt->finish();
+ };
+ if ($@) {
+ warn $@;
+ return;
+ } else {
+ return 1;
+ }
+}
+
+=head2 retrieve_all
+
+Return all rows in the table;
+
+ my @objs = __PACKAGE__->retrieve_all();
+
+=cut
+
+sub retrieve_all
+{
+ my ($self) = @_;
+
+ return $self->search();
+}
+
+=head2 retrieve
+
+Return row mathing the specified key against the primary column.
+
+ my $obj = __PACKAGE__->retrieve($id);
+
+=cut
+
+sub retrieve
+{
+ my ($self,$key) = @_;
+
+ unless ($self->primary_column) {
+ warn "No primary key set for " . $self->table;
+ return undef;
+ }
+
+ if (my ($r) = $self->search_where( $self->primary_column . " = " . $key )) {
+ return $r;
+ }
+ return undef;
+}
+
+=head1 AUTHOR
+
+Jason Woodward <woodwardj@jaos.org>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/t/01use.t b/t/01use.t
new file mode 100644
index 0000000..a25b774
--- /dev/null
+++ b/t/01use.t
@@ -0,0 +1,4 @@
+use Test::More tests => 2;
+
+use_ok('Catalyst::Plugin::Session::Store::JDBI');
+can_ok('Catalyst::Plugin::Session::Store::JDBI',qw/get_session_data store_session_data delete_session_data delete_expired_sessions/);
diff --git a/t/02pod.t b/t/02pod.t
new file mode 100644
index 0000000..1647794
--- /dev/null
+++ b/t/02pod.t
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
diff --git a/t/03podcoverage.t b/t/03podcoverage.t
new file mode 100644
index 0000000..d91be5e
--- /dev/null
+++ b/t/03podcoverage.t
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();