r44635 - in /trunk/libcoat-persistent-perl: ./ debian/ lib/Coat/ lib/Coat/Persistent/ t/ t/csv-test-database/ t/test-database/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue Sep 22 14:44:10 UTC 2009
Author: jawnsy-guest
Date: Tue Sep 22 14:44:03 2009
New Revision: 44635
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44635
Log:
* New upstream release
+ Add support for undefined primary_keys (RT#47772)
+ Make it possible to bypass DBIx::Sequence (RT#47773)
Added:
trunk/libcoat-persistent-perl/.gitignore
- copied unchanged from r44632, branches/upstream/libcoat-persistent-perl/current/.gitignore
trunk/libcoat-persistent-perl/Makefile.old
- copied unchanged from r44632, branches/upstream/libcoat-persistent-perl/current/Makefile.old
trunk/libcoat-persistent-perl/lib/Coat/Persistent/Object.pm
- copied unchanged from r44632, branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Object.pm
trunk/libcoat-persistent-perl/t/024_undefined_primary_key.t
- copied unchanged from r44632, branches/upstream/libcoat-persistent-perl/current/t/024_undefined_primary_key.t
trunk/libcoat-persistent-perl/t/TestUtils.pm
- copied unchanged from r44632, branches/upstream/libcoat-persistent-perl/current/t/TestUtils.pm
trunk/libcoat-persistent-perl/t/test-database/
- copied from r44632, branches/upstream/libcoat-persistent-perl/current/t/test-database/
Removed:
trunk/libcoat-persistent-perl/t/csv-test-database/
Modified:
trunk/libcoat-persistent-perl/CHANGES
trunk/libcoat-persistent-perl/Makefile.PL
trunk/libcoat-persistent-perl/debian/changelog
trunk/libcoat-persistent-perl/debian/control
trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm
trunk/libcoat-persistent-perl/lib/Coat/Persistent/Types.pm
trunk/libcoat-persistent-perl/t/009_cache.t
trunk/libcoat-persistent-perl/t/016_import.t
trunk/libcoat-persistent-perl/t/022_storage_value.t
Modified: trunk/libcoat-persistent-perl/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/CHANGES?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/CHANGES (original)
+++ trunk/libcoat-persistent-perl/CHANGES Tue Sep 22 14:44:03 2009
@@ -1,7 +1,12 @@
+2009-07-10 - 0.220 - Alexis Sukrieh
+ * Add support for undefined primary_keys (bug #47772)
+ * Now possible to bypass DBIx::Sequence (bug #47773)
+ * Use Test::Database for MySQL/SQLite specific tests
+
2009-06-19 - 0.210 - Alexis Sukrieh
* New module Coat::Persistent::Types for providing default types and coercions
* Class::Date support for default types
- * Uses now Class::Date instead of handling time dans dates by hand.
+ * Uses now Class::Date instead of handling time and dates by hand.
2009-06-19 - 0.200 - Alexis Sukrieh
Modified: trunk/libcoat-persistent-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/Makefile.PL?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/Makefile.PL (original)
+++ trunk/libcoat-persistent-perl/Makefile.PL Tue Sep 22 14:44:03 2009
@@ -17,7 +17,7 @@
'SQL::Abstract' => '0',
'List::Compare' => '0',
},
- test => {TESTS => join( ' ', glob( 't/*.t' ))},
+ test => {TESTS => join( ' ', (glob( 't/*.t'), glob('t/*/*.t')))},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 't/csv-test-database'},
);
Modified: trunk/libcoat-persistent-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/changelog?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/changelog (original)
+++ trunk/libcoat-persistent-perl/debian/changelog Tue Sep 22 14:44:03 2009
@@ -1,8 +1,11 @@
-libcoat-persistent-perl (0.210-2) UNRELEASED; urgency=low
+libcoat-persistent-perl (0.221-1) UNRELEASED; urgency=low
+ * New upstream release
+ + Add support for undefined primary_keys (RT#47772)
+ + Make it possible to bypass DBIx::Sequence (RT#47773)
* Removed Alexis Sukrieh from Uploaders (Closes: #536128)
- -- Jonathan Yu <frequency at cpan.org> Tue, 07 Jul 2009 11:11:24 -0400
+ -- Jonathan Yu <jawnsy at cpan.org> Tue, 22 Sep 2009 06:41:51 -0400
libcoat-persistent-perl (0.210-1) unstable; urgency=low
Modified: trunk/libcoat-persistent-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/control?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/control (original)
+++ trunk/libcoat-persistent-perl/debian/control Tue Sep 22 14:44:03 2009
@@ -2,12 +2,11 @@
Section: perl
Priority: optional
Build-Depends: debhelper (>= 7.0.8), quilt (>= 0.46-7)
-Build-Depends-Indep: perl (>= 5.8.8-12), libdbi-perl, libdbix-sequence-perl,
- libsql-abstract-perl, libcoat-perl (>= 0.334),
- liblist-compare-perl, libdbd-csv-perl (>= 0.2200-5),
- libcache-fastmmap-perl, libclass-date-perl
+Build-Depends-Indep: perl, libdbi-perl, libdbix-sequence-perl,
+ libsql-abstract-perl, libcoat-perl (>= 0.334), liblist-compare-perl,
+ libdbd-csv-perl (>= 0.2200-5), libcache-fastmmap-perl, libclass-date-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: gregor herrmann <gregoa at debian.org>,
+Uploaders: gregor herrmann <gregoa at debian.org>, Jonathan Yu <jawnsy at cpan.org>,
Ansgar Burchardt <ansgar at 43-1.org>
Standards-Version: 3.8.2
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libcoat-persistent-perl/
@@ -17,12 +16,13 @@
Package: libcoat-persistent-perl
Architecture: all
Depends: ${perl:Depends}, ${misc:Depends}, libdbi-perl,
- libdbix-sequence-perl, libsql-abstract-perl, libcoat-perl (>= 0.334),
- liblist-compare-perl, libclass-date-perl
+ libdbix-sequence-perl, libsql-abstract-perl, libcoat-perl (>= 0.334),
+ liblist-compare-perl, libclass-date-perl
Suggests: libcache-fastmmap-perl, libdbd-csv-perl (>= 0.2200-5)
Description: Ruby's ActiveRecord::Base port for Perl (ORM)
- Coat::Persistent is an object to relational-databases mapper, it allows you to
- build instances of Coat objects and save them into a database transparently.
+ Coat::Persistent is an Object Relational Mapper (ORM) for databases, which
+ allows you to build instances of Coat objects and save them into a database
+ transparently.
.
You basically define a mapping rule, either global or per-class and play with
your Coat objects without bothering with SQL for simple cases (selecting,
Modified: trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm (original)
+++ trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm Tue Sep 22 14:44:03 2009
@@ -27,7 +27,7 @@
use vars qw($VERSION @EXPORT $AUTHORITY);
use base qw(Exporter);
-$VERSION = '0.210';
+$VERSION = '0.221';
$AUTHORITY = 'cpan:SUKRIA';
@EXPORT = qw(has_p has_one has_many);
@@ -54,6 +54,14 @@
$MAPPINGS->{'!cache'}{'!default'} ||
undef;
}
+
+# The internel sequence engine (DBIx::Sequence)
+# If disabled, nothing will be done for the primary keys, their values
+# should be set by the underlying DB.
+my $USE_INTERNAL_SEQUENCE_ENGINE = 1;
+sub has_internal_sequence_engine { $USE_INTERNAL_SEQUENCE_ENGINE }
+sub enable_internal_sequence_engine { $USE_INTERNAL_SEQUENCE_ENGINE = 1 }
+sub disable_internal_sequence_engine { $USE_INTERNAL_SEQUENCE_ENGINE = 0 }
# Access to the constraint meta data for the current class
sub has_unique_constraint {
@@ -147,18 +155,24 @@
unless $MAPPINGS->{'!dbh'}{$class};
# if the DBIx::Sequence tables don't exist, create them
- _create_dbix_sequence_tables($MAPPINGS->{'!dbh'}{$class});
+ _create_dbix_sequence_tables($MAPPINGS->{'!dbh'}{$class}) if has_internal_sequence_engine();
}
# This is used if you already have a dbh instead of creating one with
# map_to_dbi
sub set_dbh {
- my ($class, $dbh) = @_;
- confess "Cannot set an undefined dbh" unless defined $dbh;
+ my ($class, $driver, $dbh) = @_;
+ confess "Cannot set an undefined dbh"
+ unless defined $dbh;
+ confess "Driver '$driver' is not supported"
+ unless defined exists $class->drivers->{$driver};
$class = '!default' if $class eq 'Coat::Persistent';
$MAPPINGS->{'!dbh'}{$class} = $dbh;
- _create_dbix_sequence_tables($MAPPINGS->{'!dbh'}{$class});
+ $MAPPINGS->{'!driver'}{$class} = $driver;
+
+ _create_dbix_sequence_tables($MAPPINGS->{'!dbh'}{$class})
+ if has_internal_sequence_engine();
}
# This is done to wrap the original Coat::has method so we can
@@ -280,6 +294,9 @@
my $owned_class = $options{class_name} || $name;
my $owned_table_name = Coat::Persistent::Meta->table_name($owned_class);
my $owned_primary_key = Coat::Persistent::Meta->primary_key($owned_class);
+
+ confess "The class \"$owned_class\" does not have a primary key."
+ unless defined $owned_primary_key;
my $attr_name = (defined $options{class_name}) ? $name : $owned_table_name ;
@@ -328,6 +345,10 @@
my $primary_key = Coat::Persistent::Meta->primary_key($class);
my $owned_table_name = Coat::Persistent::Meta->table_name($owned_class);
my $owned_primary_key = Coat::Persistent::Meta->primary_key($owned_class);
+
+ confess "The class \"$owned_class\" does not have a primary key."
+ unless defined $owned_primary_key;
+
my $attr_name = (defined $options{class_name})
? $name
@@ -383,16 +404,25 @@
# now, our caller inherits from Coat::Persistent
eval { Coat::_extends_class( ['Coat::Persistent'], $caller ) };
- # default values for mapping rules
- $options{primary_key} ||= 'id';
+ # is the primary_key disabled?
+ if (exists($options{primary_key}) && (not defined $options{primary_key})) {
+ $options{primary_key} = undef;
+ }
+ else {
+ $options{primary_key} ||= 'id';
+ }
+
+ # the table_name if not defined is taken from the model name
$options{table_name} ||= $caller->_to_sql;
# save the meta information obout the model mapping
Coat::Persistent::Meta->table_name($caller, $options{table_name});
Coat::Persistent::Meta->primary_key($caller, $options{primary_key});
- # a Coat::Persistent object must have a the primary key)
- has_p $options{primary_key} => ( isa => 'Int', '!caller' => $caller );
+ # if the primary_key is defined
+ if (defined $options{primary_key}) {
+ has_p $options{primary_key} => ( isa => 'Int', '!caller' => $caller );
+ }
# we have a couple of symbols to export outside
Coat::Persistent->export_to_level( 1, ($class, @EXPORT) );
@@ -451,6 +481,11 @@
else {
# the first item looks like a number (then it's an ID)
if (looks_like_number $value) {
+
+ # can I haz primary_key?
+ confess "Cannot use find(ID) queries without a primary key defined"
+ unless defined $primary_key;
+
my ($sql, @values) = $sql_abstract->select(
$from,
$select,
@@ -542,7 +577,6 @@
my ($self, @args) = @_;
my $class = ref($self);
my $table_name = Coat::Persistent::Meta->table_name($class);
- my $primary_key = Coat::Persistent::Meta->primary_key($class);
foreach my $attr (Coat::Persistent::Meta->linearized_attributes($class) ) {
@@ -563,6 +597,11 @@
my $dbh = $class->dbh;
my $table_name = Coat::Persistent::Meta->table_name($class);
my $primary_key = Coat::Persistent::Meta->primary_key($class);
+
+ # TODO : we should provide a delete_by_$attr method for each attribute
+ # and a also delete('condition SQL') support.
+ confess "Cannot delete an entry without a primary_key defined"
+ unless defined $primary_key;
confess "Cannot delete without an id"
if (!ref $self && !defined $id);
@@ -619,24 +658,9 @@
}
}
-# Takes a value (taken from the DB) and convert it to the real value for the attribute
-sub get_real_value_for {
- my ($self, $attr_name, $value) = @_;
- my $class = ref $self;
-
- my $attr = Coat::Meta->attribute($class, $attr_name);
- if ($attr->{store_as}) {
- my $type = Coat::Types::find_type_constraint($attr->{isa});
- return $type->coerce($value);
- }
- else {
- return $value;
- }
-}
-
# serialize the instance and save it with the mapper defined
sub save {
- my ($self) = @_;
+ my ($self, $conditions) = @_;
my $class = ref $self;
my $dbh = $class->dbh;
my $table_name = Coat::Persistent::Meta->table_name($class);
@@ -658,9 +682,21 @@
# if not a new object, we have to update
if ( $self->_db_state == CP_ENTRY_EXISTS ) {
+ # In order to update and entry, we need either a primary key or a sql
+ # condition
+ confess "cannot update without a primary key or a SQL condition"
+ if (not defined $primary_key) and (not defined $conditions);
+
# generate the SQL
- my ($sql, @values) = $sql_abstract->update(
- $table_name, \%values, { $primary_key => $self->$primary_key});
+ my ($sql, @values);
+ if (defined $primary_key) {
+ ($sql, @values) = $sql_abstract->update(
+ $table_name, \%values, { $primary_key => $self->$primary_key});
+ }
+ else {
+ ($sql, @values) = $sql_abstract->update(
+ $table_name, \%values, $conditions);
+ }
# execute the query
my $sth = $dbh->prepare($sql);
$sth->execute( @values )
@@ -669,25 +705,33 @@
# new object, insert
else {
- # if the id has been touched, trigger an error, that's not possible
- # with the use of DBIx::Sequence
- if ($self->{id}) {
- confess "The id has been set on a newborn object of class ".ref($self).", cannot save, id would change";
- }
-
- # get our ID from the sequence
- $self->$primary_key( $self->_next_id );
+ my ($sql, @values);
+
+ confess "Primary key \"$primary_key\" has been set on a newborn object of class ".ref($self)
+ if (defined $primary_key && $self->$primary_key);
+
+ if (defined $primary_key && has_internal_sequence_engine()) {
+ # get our ID from the sequence
+ $self->$primary_key( $self->_next_id );
- # generate the SQL
- my ($sql, @values) = $sql_abstract->insert(
- $table_name, { %values, $primary_key => $self->$primary_key });
-
+ # generate the SQL
+ ($sql, @values) = $sql_abstract->insert(
+ $table_name, { %values, $primary_key => $self->$primary_key });
+ }
+ else {
+ ($sql, @values) = $sql_abstract->insert($table_name, \%values);
+ }
+
# execute the query
#warn "sql: $sql ".join(', ', @values);
my $sth = $dbh->prepare($sql);
$sth->execute( @values )
or confess "Unable to execute query \"$sql\" : $DBI::errstr";
+ # Retrieve the primary key's value
+ $self->$primary_key($class->get_last_insert_id($sth))
+ if (defined $primary_key && !has_internal_sequence_engine());
+
$self->{_db_state} = CP_ENTRY_EXISTS;
}
@@ -698,13 +742,32 @@
}
delete $self->{_subobjects};
}
- return $self->$primary_key;
+
+ return $self->$primary_key if defined $primary_key;
+ return 'saved';
}
##############################################################################
# Private methods
+# return the last insert id for any DBD supported
+# raise an exception if the DBD is not supported
+sub get_last_insert_id {
+ my ($class, $sth) = @_;
+ my $dbh = $class->dbh;
+ my $driver = $class->driver;
+
+ if ($driver eq 'mysql') {
+ return $sth->{mysql_insertid} || $sth->{insertid};
+ }
+ elsif ($driver eq 'sqlite') {
+ return $dbh->func('last_insert_rowid');
+ }
+ else {
+ confess "DB driver '$driver' is not supported for last_insert_id";
+ }
+}
# instance method & stuff
sub _bind_code_to_symbol {
@@ -873,20 +936,65 @@
table_name => 'mymodel', # default would be 'my_model'
primary_key => 'mid'; # default would be 'id'
+=head2 ABOUT PRIMARY KEYS
+
+Even if your table does not have a primary key, you can still use a
+Coat::Persistent model over it. You just have to tell Coat::Persistent that
+this table/model doesn't have a primary key :
+
+ use Coat::Persistent primary_key => undef;
+
+Note that instances of such a model cannot be saved like regular ones: there's
+no primary key, so it's impossible to build UPDATE SQL queries properly. That's
+why you'll have to give a condition whenver you call save().
+
+For the same reason, it's impossible to use find() with numeric values (whi are
+assumed to be primary key values).
+
+Example :
+ package Model;
+ ...
+ use Coat::Persistent primary_key => undef;
+ ...
+
+ package main;
+
+ my $obj = Model->find(43); # FAIL : there's no primary key known for Model
+ my $obj = Model->find_by_some_attribute(25); # OK
+
+ $obj->save(); # FAIL : the SQL query cannot be built without a primary key
+ # defined
+
+ $obj->save({some_attribute => 25}); # OK
+
+Note that it's not recommended to use tables whithout primary keys, the support
+is only provided to support existing/border-line database schemas we can find
+in real-world.
+
+Use that feature with caution!
+
=head1 CONFIGURATION
You have two options for setting a database handle to your class. Either you
already have a dbh an you set it to your class, or you don't and you let
Coat::Persistent initialize it.
-If you already have a database handle, use Coat::Persistent->set_dbh($dbh),
-otherwise, use the DBI mapping explained below.
-
-=head2 Setting an existing database handle
+If you already have a database handle, use:
+
+ # $driver is the driver name of the database handle (mysql, sqlite, ...)
+ # $dbh is the database handle previously inititalized
+ Coat::Persistent->set_dbh( $driver => $dbh);
+
+Otherwise, use the DBI mapping explained below.
+
+head2 ALREADY EXISTING DATABASE HANDLE
+
+You may want to tell Coat::Persistent to use a $dbh you already have in hands,
+then you can use the set_dbh() method.
=over 4
-=item B<set_dbh($dbh)>
+=item B<set_dbh($driver => $dbh)>
Set the given database handle for the calling class (set it by default if class
is Coat::Persistent).
@@ -966,6 +1074,28 @@
__PACKAGE__->map_to_dbi('mysql' => 'dbname', 'dbuser', 'dbpass' );
=back
+
+=head2 MYSQL AUTO-INCREMENT FEATURE
+
+When using MySQL, you can choose either to let Coat::Persistent set itself
+primary key values for new entries, or use MySQL auto_increment mechanism.
+
+This is done by calling Coat::Persistent->disable_internal_sequence_engine();
+before any call to map_to_dbi() or set_dbh().
+
+Currently, this is only tested to work with MySQL, patches for supporting
+other database engines are welcome.
+
+Make sure you disable the internal sequence engine before initializing the $dbh,
+otherwise the two tables needed by DBIx::Sequence will be created in your DB
+(dbix_sequence_release and dbix_sequence_state).
+
+A typical use of a MySQL database with auto_increment primary keys woudl like
+the following:
+
+ # $dbh is an hanlde to a MySQL DB
+ Coat::Persistent->disable_internal_sequence_engine();
+ Coat::Persistent->set_dbh(mysql => $dbh);
=head2 CACHING
Modified: trunk/libcoat-persistent-perl/lib/Coat/Persistent/Types.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/lib/Coat/Persistent/Types.pm?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/lib/Coat/Persistent/Types.pm (original)
+++ trunk/libcoat-persistent-perl/lib/Coat/Persistent/Types.pm Tue Sep 22 14:44:03 2009
@@ -3,6 +3,7 @@
use strict;
use warnings;
+use Class::Date;
use Coat::Types;
subtype 'UnixTimestamp'
Modified: trunk/libcoat-persistent-perl/t/009_cache.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/t/009_cache.t?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/t/009_cache.t (original)
+++ trunk/libcoat-persistent-perl/t/009_cache.t Tue Sep 22 14:44:03 2009
@@ -50,7 +50,3 @@
$dbh->do("DROP TABLE dbix_sequence_state");
$dbh->do("DROP TABLE dbix_sequence_release");
};
-
-
-
-
Modified: trunk/libcoat-persistent-perl/t/016_import.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/t/016_import.t?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/t/016_import.t (original)
+++ trunk/libcoat-persistent-perl/t/016_import.t Tue Sep 22 14:44:03 2009
@@ -52,8 +52,8 @@
is( 'people_id', Coat::Persistent::Meta->primary_key( 'Person'), 'good primary_key' );
my $p = Person->create( name => 'John' );
-is( 1, $p->people_id, 'primary_key people_id is set' );
-is( 'John', $p->name, 'name is set' );
+is( $p->people_id, 1, 'primary_key people_id is set' );
+is( $p->name, 'John', 'name is set' );
$p = Person->find_by_name( 'John' );
ok( defined $p, 'find_by_name works' );
Modified: trunk/libcoat-persistent-perl/t/022_storage_value.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/t/022_storage_value.t?rev=44635&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/t/022_storage_value.t (original)
+++ trunk/libcoat-persistent-perl/t/022_storage_value.t Tue Sep 22 14:44:03 2009
@@ -47,7 +47,6 @@
is($t, $joe->created_at, "created_at is an int : $t ");
ok($t ne $t_str, "created_at storage value is : $t_str");
-is($t, $joe->get_real_value_for('created_at', $joe->get_storage_value_for('created_at')), 'real_value is correctly converted');
ok($joe->save, '$joe->save');
my $joe2 = Person->find($joe->pid);
More information about the Pkg-perl-cvs-commits
mailing list