r37692 - in /trunk/libcoat-persistent-perl: debian/changelog debian/control debian/patches/pod-error.patch debian/rules lib/Coat/Persistent.pm t/007_unique.t t/018_find_with_undef.t t/019_state_object.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sat Jun 6 16:47:49 UTC 2009
Author: ansgar-guest
Date: Sat Jun 6 16:47:44 2009
New Revision: 37692
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=37692
Log:
* New upstream release.
* Bump Standards Version to 3.8.1 (no changes)
* Use minimal debian/rules
+ Depend on debhelper (>= 7.2.11), quilt (>= 0.46-7) for dh --with quilt
* Refresh pod-error.patch and add description.
Added:
trunk/libcoat-persistent-perl/t/018_find_with_undef.t
- copied unchanged from r37688, branches/upstream/libcoat-persistent-perl/current/t/018_find_with_undef.t
trunk/libcoat-persistent-perl/t/019_state_object.t
- copied unchanged from r37688, branches/upstream/libcoat-persistent-perl/current/t/019_state_object.t
Modified:
trunk/libcoat-persistent-perl/debian/changelog
trunk/libcoat-persistent-perl/debian/control
trunk/libcoat-persistent-perl/debian/patches/pod-error.patch
trunk/libcoat-persistent-perl/debian/rules
trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm
trunk/libcoat-persistent-perl/t/007_unique.t
Modified: trunk/libcoat-persistent-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/changelog?rev=37692&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/changelog (original)
+++ trunk/libcoat-persistent-perl/debian/changelog Sat Jun 6 16:47:44 2009
@@ -1,7 +1,12 @@
-libcoat-persistent-perl (0.102-2) UNRELEASED; urgency=low
+libcoat-persistent-perl (0.104-1) unstable; urgency=low
[ Ansgar Burchardt ]
* debian/control: Fix Suggests for libcache-fastmmap-perl
+ * New upstream release.
+ * Bump Standards Version to 3.8.1 (no changes)
+ * Use minimal debian/rules
+ + Depend on debhelper (>= 7.2.11), quilt (>= 0.46-7) for dh --with quilt
+ * Refresh pod-error.patch and add description.
[ gregor herrmann ]
* debian/control: Changed: Switched Vcs-Browser field to ViewSVN
@@ -9,10 +14,8 @@
[ Nathan Handler ]
* debian/watch: Update to ignore development releases.
- * debian/watch: Update to ignore development releases.
- * debian/watch: Update to ignore development releases.
- -- Ansgar Burchardt <ansgar at 43-1.org> Mon, 27 Oct 2008 11:35:49 +0100
+ -- Ansgar Burchardt <ansgar at 43-1.org> Sat, 06 Jun 2009 18:47:31 +0200
libcoat-persistent-perl (0.102-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=37692&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/control (original)
+++ trunk/libcoat-persistent-perl/debian/control Sat Jun 6 16:47:44 2009
@@ -1,7 +1,7 @@
Source: libcoat-persistent-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7), quilt (>= 0.40)
+Build-Depends: debhelper (>= 7.2.11), quilt (>= 0.46-7)
Build-Depends-Indep: perl (>= 5.8.8-12), libdbi-perl, libdbix-sequence-perl,
libsql-abstract-perl, libcoat-perl (>= 0.2),
liblist-compare-perl, libdbd-csv-perl (>= 0.2200-5),
@@ -10,7 +10,7 @@
Uploaders: Alexis Sukrieh <sukria at debian.org>,
gregor herrmann <gregoa at debian.org>,
Ansgar Burchardt <ansgar at 43-1.org>
-Standards-Version: 3.8.0
+Standards-Version: 3.8.1
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libcoat-persistent-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libcoat-persistent-perl/
Homepage: http://search.cpan.org/dist/Coat-Persistent/
Modified: trunk/libcoat-persistent-perl/debian/patches/pod-error.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/patches/pod-error.patch?rev=37692&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/patches/pod-error.patch (original)
+++ trunk/libcoat-persistent-perl/debian/patches/pod-error.patch Sat Jun 6 16:47:44 2009
@@ -1,6 +1,11 @@
---- a/lib/Coat/Persistent.pm
-+++ b/lib/Coat/Persistent.pm
-@@ -785,7 +785,7 @@
+From: gregor herrmann <gregoa at debian.org>
+Subject: Fix POD errors
+Date: Mon, 12 May 2008 15:46:44 +0200
+Introduced-In: 0.9-6-2
+
+--- libcoat-persistent-perl.orig/lib/Coat/Persistent.pm
++++ libcoat-persistent-perl/lib/Coat/Persistent.pm
+@@ -862,7 +862,7 @@
=over 4
@@ -9,7 +14,7 @@
file. B<@options> must contains a string as its first element being like the
following: "f_dir=<DIRECTORY>" where DIRECTORY is the directory where to store
de CSV files.
-@@ -796,7 +796,7 @@
+@@ -873,7 +873,7 @@
use Coat::Persistent;
__PACKAGE__->map_to_dbi('csv', 'f_dir=./t/csv-directory');
@@ -18,7 +23,16 @@
to a MySQL database. B<@options> must be a list that contains repectively: the
database name, the database user, the database password.
-@@ -954,8 +954,6 @@
+@@ -1012,8 +1012,6 @@
+ =item B<limit>: An integer determining the limit on the number of rows that should
+ be returned.
+
+-=back
+-
+ Examples without options:
+
+ my $obj = Class->find(23);
+@@ -1025,8 +1023,6 @@
my @list = Class->find($condition, { order => 'field1 desc' })
Modified: trunk/libcoat-persistent-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/rules?rev=37692&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/rules (original)
+++ trunk/libcoat-persistent-perl/debian/rules Sat Jun 6 16:47:44 2009
@@ -1,25 +1,3 @@
#!/usr/bin/make -f
-
-include /usr/share/quilt/quilt.make
-
-build: build-stamp
-build-stamp: $(QUILT_STAMPFN)
- dh build
- touch $@
-
-clean: unpatch
- dh $@
-
-install: install-stamp
-install-stamp: build-stamp
- dh install
- touch $@
-
-binary-arch:
-
-binary-indep: install
- dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build
+%:
+ dh --with quilt $@
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=37692&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm (original)
+++ trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm Sat Jun 6 16:47:44 2009
@@ -18,11 +18,15 @@
use DBIx::Sequence;
use SQL::Abstract;
+# Constants
+use constant CP_ENTRY_NEW => 0;
+use constant CP_ENTRY_EXISTS => 1;
+
# Module meta-data
use vars qw($VERSION @EXPORT $AUTHORITY);
use base qw(Exporter);
-$VERSION = '0.102';
+$VERSION = '0.104';
$AUTHORITY = 'cpan:SUKRIA';
@EXPORT = qw(has_p has_one has_many);
@@ -75,6 +79,31 @@
undef $MAPPINGS->{'!cache'}{$class};
}
+# A singleton that stores the driver/module mappings
+# The ones here are default drivers that are known to be compliant
+# with Coat::Persistent.
+# Any DBI driver should work though.
+my $drivers = {
+ csv => 'DBI:CSV',
+ mysql => 'dbi:mysql',
+ sqlite => 'dbi:SQLite',
+};
+sub drivers { $drivers }
+
+# Accessor to a driver
+sub get_driver {
+ my ($class, $driver) = @_;
+ confess "driver needed" unless $driver;
+ return $class->drivers->{$driver};
+}
+
+# This lets you add the DBI driver you want to use
+sub add_driver {
+ my ($class, $driver, $module) = @_;
+ confess "driver and module needed" unless $driver and $module;
+ $class->drivers->{$driver} = $module;
+}
+
# This is the configration stuff, you basically bind a class to
# a DBI driver
sub map_to_dbi {
@@ -84,11 +113,9 @@
# if map_to_dbi is called from Coat::Persistent, this is the default dbh
$class = '!default' if $class eq 'Coat::Persistent';
- my $drivers = {
- mysql => 'dbi:mysql',
- csv => 'DBI:CSV',
- };
- confess "No such driver : $driver"
+ 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
@@ -444,6 +471,7 @@
$obj->{$field} = $r->{$field};
}
+ $obj->{_db_state} = CP_ENTRY_EXISTS;
push @objects, $obj;
}
}
@@ -465,6 +493,11 @@
sub init_on_find {
+}
+
+sub BUILD {
+ my ($self) = @_;
+ $self->{_db_state} = CP_ENTRY_NEW;
}
sub validate {
@@ -550,7 +583,7 @@
confess "Cannot save without a mapping defined for class " . ref $self
unless defined $dbh;
- # first call validate to check the object is sane
+ # make sure the object is sane
$self->validate();
# all the attributes of the class
@@ -558,8 +591,9 @@
# a hash containing attr/value pairs for the current object.
my %values = map { $_ => $self->$_ } @fields;
- # if we have an id, update
- if ( defined $self->$primary_key ) {
+ # if not a new object, we have to update
+ if ( $self->_db_state == CP_ENTRY_EXISTS ) {
+
# generate the SQL
my ($sql, @values) = $sql_abstract->update(
$table_name, \%values, { $primary_key => $self->$primary_key});
@@ -569,11 +603,17 @@
or confess "Unable to execute query \"$sql\" : $DBI::errstr";
}
- # no id, insert with a valid id
+ # 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 );
-
+
# generate the SQL
my ($sql, @values) = $sql_abstract->insert(
$table_name, { %values, $primary_key => $self->$primary_key });
@@ -583,6 +623,8 @@
my $sth = $dbh->prepare($sql);
$sth->execute( @values )
or confess "Unable to execute query \"$sql\" : $DBI::errstr";
+
+ $self->{_db_state} = CP_ENTRY_EXISTS;
}
# if subobjects defined, save them
@@ -654,6 +696,13 @@
my $sequence = new DBIx::Sequence({ dbh => $dbh });
my $id = $sequence->Next($table);
return $id;
+}
+
+# Returns a constant describing if the object exists or not
+# already in the underlying DB
+sub _db_state {
+ my ($self) = @_;
+ return $self->{_db_state} ||= CP_ENTRY_NEW;
}
# DBIx::Sequence needs two tables in the schema,
@@ -768,6 +817,34 @@
either choose to define a default mapper (in most of the cases this is what
you want) or define a mapper for a specific class.
+In order for your mapping to be possible, the driver you use must be known by
+Coat::Persistent, you can modify its driver mapping matrix if needed.
+
+=over 4
+
+=item B<drivers( )>
+
+Return a hashref representing all the drivers mapped.
+
+ MyClass->drivers;
+
+=item B<get_driver( $name )>
+
+Return the Perl module of the driver defined for the given driver name.
+
+ MyClass->get_driver( 'mysql' );
+
+=item B<add_driver( $name, $module )>
+
+Add or replace a driver mapping rule.
+
+ MyClass->add_driver( sqlite => 'dbi:SQLite' );
+
+=back
+
+Then, you can use your driver in mapping rules. Basically, the mapping will
+generate a DBI-E<gt>connect() call.
+
=over 4
=item B<Coat::Persistent-E<gt>map_to_dbi $driver, @options >
@@ -905,12 +982,6 @@
=over 4
-=item B<find( @conditions, \%options )>
-
-Find operates with three different retrieval approaches:
-
-=over 4
-
=item I<Find by id>: This can either be a specific id or a list of ids (1, 5,
6)
Modified: trunk/libcoat-persistent-perl/t/007_unique.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/t/007_unique.t?rev=37692&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/t/007_unique.t (original)
+++ trunk/libcoat-persistent-perl/t/007_unique.t Sat Jun 6 16:47:44 2009
@@ -13,10 +13,11 @@
Person->map_to_dbi('csv', 'f_dir=./t/csv-test-database');
+
# fixture
my $dbh = Person->dbh;
$dbh->do("CREATE TABLE person (id INTEGER, name CHAR(64), age INTEGER)");
-foreach my $name ('Joe', 'John', 'Brenda') {
+foreach my $name ('MisterJoe', 'MisterJohn', 'MissBrenda') {
my $p = new Person name => $name, age => 20;
$p->save;
}
@@ -24,10 +25,10 @@
# tests
my $p;
eval {
- $p = new Person name => 'Joe';
+ $p = Person->new(name => 'MisterJoe');
$p->save;
};
-ok( $@, "Value Joe violates unique constraint for attribute name");
+ok( $@, "Value MisterJoe violates unique constraint for attribute name");
# clean
$dbh->do("DROP TABLE person");
More information about the Pkg-perl-cvs-commits
mailing list