r47775 - in /branches/upstream/libcoat-persistent-perl/current: .gitignore CHANGES MANIFEST Makefile.PL Makefile.old lib/Coat/Persistent.pm lib/Coat/Persistent/Types.pm t/test-database/001_auto_increment.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Nov 26 04:06:30 UTC 2009
Author: jawnsy-guest
Date: Thu Nov 26 04:06:24 2009
New Revision: 47775
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47775
Log:
[svn-upgrade] Integrating new upstream version, libcoat-persistent-perl (0.223)
Added:
branches/upstream/libcoat-persistent-perl/current/MANIFEST
Removed:
branches/upstream/libcoat-persistent-perl/current/Makefile.old
Modified:
branches/upstream/libcoat-persistent-perl/current/.gitignore
branches/upstream/libcoat-persistent-perl/current/CHANGES
branches/upstream/libcoat-persistent-perl/current/Makefile.PL
branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent.pm
branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Types.pm
branches/upstream/libcoat-persistent-perl/current/t/test-database/001_auto_increment.t
Modified: branches/upstream/libcoat-persistent-perl/current/.gitignore
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcoat-persistent-perl/current/.gitignore?rev=47775&op=diff
==============================================================================
--- branches/upstream/libcoat-persistent-perl/current/.gitignore (original)
+++ branches/upstream/libcoat-persistent-perl/current/.gitignore Thu Nov 26 04:06:24 2009
@@ -1,3 +1,5 @@
+Makefile.old
Makefile
pm_to_blib
+t/sqlite/db.sqlite
blib
Modified: branches/upstream/libcoat-persistent-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcoat-persistent-perl/current/CHANGES?rev=47775&op=diff
==============================================================================
--- branches/upstream/libcoat-persistent-perl/current/CHANGES (original)
+++ branches/upstream/libcoat-persistent-perl/current/CHANGES Thu Nov 26 04:06:24 2009
@@ -1,3 +1,6 @@
+2009-11-25 - 0.222 Alexis Sukrieh
+ * support for DBD::CSV >= 0.22
+
2009-07-10 - 0.220 - Alexis Sukrieh
* Add support for undefined primary_keys (bug #47772)
* Now possible to bypass DBIx::Sequence (bug #47773)
Added: branches/upstream/libcoat-persistent-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcoat-persistent-perl/current/MANIFEST?rev=47775&op=file
==============================================================================
--- branches/upstream/libcoat-persistent-perl/current/MANIFEST (added)
+++ branches/upstream/libcoat-persistent-perl/current/MANIFEST Thu Nov 26 04:06:24 2009
@@ -1,0 +1,37 @@
+CHANGES
+COPYING
+lib/Coat/Persistent/Constraint.pm
+lib/Coat/Persistent/Meta.pm
+lib/Coat/Persistent/Object.pm
+lib/Coat/Persistent.pm
+lib/Coat/Persistent/Types/MySQL.pm
+lib/Coat/Persistent/Types.pm
+Makefile.PL
+t/001_csv_binding.t
+t/002_subobjects.t
+t/003_classes_scope.t
+t/004_default_dbh.t
+t/005_context.t
+t/006_find_by_sql.t
+t/007_unique.t
+t/008_syntax.t
+t/009_cache.t
+t/009_required_read_only.t
+t/010_update.t
+t/011_create.t
+t/012_find.t
+t/013_find_or_create.t
+t/014_find_or_init.t
+t/015_meta.t
+t/016_import.t
+t/017_rename.t
+t/018_find_with_undef.t
+t/019_mix.t
+t/019_state_object.t
+t/022_storage_value.t
+t/023_types_and_coercions.t
+t/024_undefined_primary_key.t
+t/CoatPersistentA.pm
+t/CoatPersistentB.pm
+t/test-database/001_auto_increment.t
+t/TestUtils.pm
Modified: branches/upstream/libcoat-persistent-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcoat-persistent-perl/current/Makefile.PL?rev=47775&op=diff
==============================================================================
--- branches/upstream/libcoat-persistent-perl/current/Makefile.PL (original)
+++ branches/upstream/libcoat-persistent-perl/current/Makefile.PL Thu Nov 26 04:06:24 2009
@@ -16,6 +16,7 @@
'DBD::CSV' => '0', # needed for the test suite
'SQL::Abstract' => '0',
'List::Compare' => '0',
+ 'Test::Database' => '0',
},
test => {TESTS => join( ' ', (glob( 't/*.t'), glob('t/*/*.t')))},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
Modified: branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent.pm?rev=47775&op=diff
==============================================================================
--- branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent.pm (original)
+++ branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent.pm Thu Nov 26 04:06:24 2009
@@ -27,7 +27,7 @@
use vars qw($VERSION @EXPORT $AUTHORITY);
use base qw(Exporter);
-$VERSION = '0.221';
+$VERSION = '0.223';
$AUTHORITY = 'cpan:SUKRIA';
@EXPORT = qw(has_p has_one has_many);
@@ -54,6 +54,7 @@
$MAPPINGS->{'!cache'}{'!default'} ||
undef;
}
+
# The internel sequence engine (DBIx::Sequence)
# If disabled, nothing will be done for the primary keys, their values
@@ -128,20 +129,23 @@
sub map_to_dbi {
my ( $class, $driver, @options ) = @_;
confess "Static method cannot be called from instance" if ref $class;
+ my $connect_options = { PrintError => 0, RaiseError => 0 };
# if map_to_dbi is called from Coat::Persistent, this is the default dbh
$class = '!default' if $class eq 'Coat::Persistent';
my $drivers = Coat::Persistent->drivers;
+
confess "No such driver : $driver, please register the driver first with add_driver()"
unless exists $drivers->{$driver};
# the csv driver needs to load the appropriate DBD module
if ($driver eq 'csv') {
- eval "use DBD::CSV";
+ eval "use DBD::CSV 0.22";
confess "Unable to load DBD::CSV : $@" if $@;
DBD::CSV->import;
+ $connect_options->{csv_null} = 1; # since version 0.25 we have to do that to preserve undef values
}
$MAPPINGS->{'!driver'}{$class} = $driver;
@@ -149,7 +153,7 @@
my ( $table, $user, $pass ) = @options;
$driver = $drivers->{$driver};
$MAPPINGS->{'!dbh'}{$class} =
- DBI->connect( "${driver}:${table}", $user, $pass, { PrintError => 0, RaiseError => 0 });
+ DBI->connect( "${driver}:${table}", $user, $pass, $connect_options);
confess "Can't connect to database ${DBI::err} : ${DBI::errstr}"
unless $MAPPINGS->{'!dbh'}{$class};
@@ -231,6 +235,7 @@
# find_or_create_by_
my $sub_find_or_create = sub {
+
# if 2 args : we're given the value of $attr only
if (@_ == 2) {
my ($class, $value) = @_;
@@ -301,7 +306,7 @@
my $attr_name = (defined $options{class_name}) ? $name : $owned_table_name ;
# record the foreign key
- my $foreign_key = $owned_table_name . '_' . $owned_primary_key;
+ my $foreign_key = $options{foreign_key} || ($owned_table_name . '_' . $owned_primary_key);
has_p $foreign_key => ( isa => 'Int', '!caller' => $class );
my $symbol = "${class}::${attr_name}";
@@ -509,7 +514,6 @@
sub find_by_sql {
my ( $class, $sql, @values ) = @_;
my @objects;
-# warn "find_by_sql\n\tsql: $sql\n\tval: @values\n";
# if cached, try to returned a cached value
if (defined $class->cache) {
@@ -538,7 +542,9 @@
# create the object with attributes, and set virtual ones
foreach my $r (@$rows) {
- my $obj = $class->new(map { ($_ => $r->{$_}) } @given_attr);
+ my %attributes = map { ($_ => $r->{$_}) } @given_attr;
+
+ my $obj = $class->new(%attributes);
$obj->init_on_find();
foreach my $field (@virtual_attr) {
$obj->{$field} = $r->{$field};
@@ -626,6 +632,7 @@
# Class->create([ { foo => 'x' }, {...}, ... ]); # multiple creation
sub create {
# if only two args, we should have an ARRAY containing HASH
+
if (@_ == 2) {
my ($class, $values) = @_;
confess "create received only two args but no ARRAY"
@@ -678,6 +685,9 @@
# a hash containing attr/value pairs for the current object
my %values = map { $_ => $self->get_storage_value_for($_) } @fields;
+# foreach my $k (keys %values) {
+# delete $values{$k} if not defined $values{$k};
+# }
# if not a new object, we have to update
if ( $self->_db_state == CP_ENTRY_EXISTS ) {
@@ -719,6 +729,8 @@
$table_name, { %values, $primary_key => $self->$primary_key });
}
else {
+ map { delete $values{$_} unless defined $values{$_} } keys %values;
+ #warn "values: ".join(", ", keys(%values));
($sql, @values) = $sql_abstract->insert($table_name, \%values);
}
Modified: branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Types.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Types.pm?rev=47775&op=diff
==============================================================================
--- branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Types.pm (original)
+++ branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Types.pm Thu Nov 26 04:06:24 2009
@@ -16,6 +16,14 @@
coerce 'Class::Date'
=> from 'UnixTimestamp'
+ => via { Class::Date->new($_) };
+
+coerce 'Class::Date'
+ => from 'Date'
+ => via { Class::Date->new($_) };
+
+coerce 'Class::Date'
+ => from 'DateTime'
=> via { Class::Date->new($_) };
subtype 'DateTime'
Modified: branches/upstream/libcoat-persistent-perl/current/t/test-database/001_auto_increment.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcoat-persistent-perl/current/t/test-database/001_auto_increment.t?rev=47775&op=diff
==============================================================================
--- branches/upstream/libcoat-persistent-perl/current/t/test-database/001_auto_increment.t (original)
+++ branches/upstream/libcoat-persistent-perl/current/t/test-database/001_auto_increment.t Thu Nov 26 04:06:24 2009
@@ -1,5 +1,5 @@
# This test is here to validate that C::P works without DBIx::Sequence
-use Test::More tests => 10;
+use Test::More;
{
package Book;
@@ -23,65 +23,66 @@
}
my $dbh;
-SKIP: {
- # init
- eval "use Test::Database";
- skip "Test::Database is needed", 5 if $@;
- Test::Database->import;
-
- # MySQL tests
- my ($mysql) = Test::Database->handles( 'mysql' );
- skip "No MySQL database handle available", 5 unless defined $mysql;
- $dbh = $mysql->dbh;
- Coat::Persistent->disable_internal_sequence_engine();
- Coat::Persistent->set_dbh(mysql => $dbh);
-
- eval { $dbh->do("CREATE TABLE books (
- id int(11) not null auto_increment,
- name varchar(30) not null default '',
- created_at datetime not null,
- primary key (id)
- )") };
+# init
+eval "use Test::Database";
+plan skip_all => "Test::Database is needed" if $@;
- my $b = Book->new(name => 'Ubik');
- ok($b->save, 'save works');
- is(1, $b->id, 'first object inserted got id 1');
- ok($b->created_at, 'field created_at is set');
- ok($b->created_at->epoch, 'created_at is a Class::Date object: '.$b->created_at->epoch);
+# MySQL tests
+my ($mysql) = Test::Database->handles( 'mysql' );
+plan skip_all => "No MySQL database handle available"
+ unless defined $mysql;
- my $c = Book->create(name => 'Blade Runner');
- is(2, $c->id, 'second object inserted got id 2');
+plan tests => 10;
+$dbh = $mysql->dbh;
+Coat::Persistent->disable_internal_sequence_engine();
+Coat::Persistent->set_dbh(mysql => $dbh);
- $dbh->do('DROP TABLE books');
+eval { $dbh->do("CREATE TABLE books (
+ id int(11) not null auto_increment,
+ name varchar(30) not null default '',
+ created_at datetime not null,
+ primary key (id)
+)") };
- # SQLite tests
- my ($sqlite) = Test::Database->handles( 'SQLite' );
- skip "No SQLite database handle available", 5 unless defined $sqlite;
+my $b = Book->new(name => 'Ubik');
+ok($b->save, 'save works');
+is(1, $b->id, 'first object inserted got id 1');
+ok($b->created_at, 'field created_at is set');
+ok($b->created_at->epoch, 'created_at is a Class::Date object: '.$b->created_at->epoch);
- $dbh = $sqlite->dbh;
- Coat::Persistent->disable_internal_sequence_engine();
- Coat::Persistent->set_dbh(sqlite => $dbh);
+my $c = Book->create(name => 'Blade Runner');
+is(2, $c->id, 'second object inserted got id 2');
- # Fixtures
- eval { $dbh->do("CREATE TABLE books (
- id INTEGER PRIMARY KEY,
- name varchar(30) ,
- created_at TIMESTAMP
- )") };
+$dbh->do('DROP TABLE books');
- # tests
- $b = Book->new(name => 'Ubik');
- ok($b->save, 'save works');
- is(1, $b->id, 'first object inserted got id 1');
- ok($b->created_at, 'field created_at is set');
- ok($b->created_at->epoch, 'created_at is a Class::Date object: '.$b->created_at->epoch);
+# SQLite tests
- $c = Book->create(name => 'Blade Runner');
- is(2, $c->id, 'second object inserted got id 2');
+my ($sqlite) = Test::Database->handles( 'SQLite' );
+skip "No SQLite database handle available", 5 unless defined $sqlite;
- # cleanup
- $dbh->do('DROP TABLE books');
-};
+$dbh = $sqlite->dbh;
+Coat::Persistent->disable_internal_sequence_engine();
+Coat::Persistent->set_dbh(sqlite => $dbh);
+
+# Fixtures
+eval { $dbh->do("CREATE TABLE books (
+ id INTEGER PRIMARY KEY,
+ name varchar(30) ,
+ created_at TIMESTAMP
+)") };
+
+# tests
+$b = Book->new(name => 'Ubik');
+ok($b->save, 'save works');
+is(1, $b->id, 'first object inserted got id 1');
+ok($b->created_at, 'field created_at is set');
+ok($b->created_at->epoch, 'created_at is a Class::Date object: '.$b->created_at->epoch);
+
+$c = Book->create(name => 'Blade Runner');
+is(2, $c->id, 'second object inserted got id 2');
+
+# cleanup
+$dbh->do('DROP TABLE books');
More information about the Pkg-perl-cvs-commits
mailing list