r38326 - in /trunk/libcoat-persistent-perl: ./ debian/ debian/patches/ lib/Coat/ lib/Coat/Persistent/ lib/Coat/Persistent/Types/ t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sat Jun 20 09:05:24 UTC 2009
Author: ansgar-guest
Date: Sat Jun 20 09:05:16 2009
New Revision: 38326
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38326
Log:
* New upstream release
+ (build-)depends on libclass-date-perl, libcoat-perl (>= 0.334)
* New patch: whatis-entries.patch (adds missing whatis entry).
* Bump Standards Version to 3.8.2 (no changes).
Added:
trunk/libcoat-persistent-perl/CHANGES
- copied unchanged from r38319, branches/upstream/libcoat-persistent-perl/current/CHANGES
trunk/libcoat-persistent-perl/debian/patches/whatis-entries.patch
trunk/libcoat-persistent-perl/lib/Coat/Persistent/Constraint.pm
- copied unchanged from r38319, branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Constraint.pm
trunk/libcoat-persistent-perl/lib/Coat/Persistent/Types/
- copied from r38319, branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Types/
trunk/libcoat-persistent-perl/lib/Coat/Persistent/Types.pm
- copied unchanged from r38319, branches/upstream/libcoat-persistent-perl/current/lib/Coat/Persistent/Types.pm
trunk/libcoat-persistent-perl/t/022_storage_value.t
- copied unchanged from r38319, branches/upstream/libcoat-persistent-perl/current/t/022_storage_value.t
trunk/libcoat-persistent-perl/t/023_types_and_coercions.t
- copied unchanged from r38319, branches/upstream/libcoat-persistent-perl/current/t/023_types_and_coercions.t
Modified:
trunk/libcoat-persistent-perl/Makefile.PL
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/patches/series
trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm
trunk/libcoat-persistent-perl/t/008_syntax.t
Modified: trunk/libcoat-persistent-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/Makefile.PL?rev=38326&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/Makefile.PL (original)
+++ trunk/libcoat-persistent-perl/Makefile.PL Sat Jun 20 09:05:16 2009
@@ -1,16 +1,23 @@
+use strict;
+use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
- NAME => 'Coat::Persistent',
+ NAME => 'Coat::Persistent',
+ AUTHOR => 'Alexis Sukrieh (sukria) <sukria at cpan.org>',
+ LICENSE => 'perl',
VERSION_FROM => 'lib/Coat/Persistent.pm',
- PREREQ_PM => {
- 'Coat' => '0.1_0.6',
- 'DBI' => '0',
- 'DBIx::Sequence' => 0,
- 'DBD::CSV' => 0, # needed for the test suite
- 'SQL::Abstract' => 0,
- 'List::Compare' => 0,
+ ABSTRACT => "ORM based on the Moose-like engine `Coat'",
+ PREREQ_PM => {
+ 'Coat' => '0.334',
+ 'DBI' => '0',
+ 'DBIx::Sequence' => '0',
+ 'Class::Date' => '0', # For the types defined
+ 'DBD::CSV' => '0', # needed for the test suite
+ 'SQL::Abstract' => '0',
+ 'List::Compare' => '0',
},
- ABSTRACT => "Ruby's ActiveRecord::Base port for Perl (ORM)",
- test => {TESTS => join( ' ', glob( 't/*.t' ))},
+ test => {TESTS => join( ' ', 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=38326&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/changelog (original)
+++ trunk/libcoat-persistent-perl/debian/changelog Sat Jun 20 09:05:16 2009
@@ -1,3 +1,12 @@
+libcoat-persistent-perl (0.210-1) unstable; urgency=low
+
+ * New upstream release
+ + (build-)depends on libclass-date-perl, libcoat-perl (>= 0.334)
+ * New patch: whatis-entries.patch (adds missing whatis entry).
+ * Bump Standards Version to 3.8.2 (no changes).
+
+ -- Ansgar Burchardt <ansgar at 43-1.org> Sat, 20 Jun 2009 11:04:53 +0200
+
libcoat-persistent-perl (0.104-1) unstable; urgency=low
[ Ansgar Burchardt ]
Modified: trunk/libcoat-persistent-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/control?rev=38326&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/control (original)
+++ trunk/libcoat-persistent-perl/debian/control Sat Jun 20 09:05:16 2009
@@ -3,14 +3,14 @@
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.2),
+ libsql-abstract-perl, libcoat-perl (>= 0.334),
liblist-compare-perl, libdbd-csv-perl (>= 0.2200-5),
- libcache-fastmmap-perl
+ libcache-fastmmap-perl, libclass-date-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Alexis Sukrieh <sukria at debian.org>,
gregor herrmann <gregoa at debian.org>,
Ansgar Burchardt <ansgar at 43-1.org>
-Standards-Version: 3.8.1
+Standards-Version: 3.8.2
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/
@@ -18,8 +18,8 @@
Package: libcoat-persistent-perl
Architecture: all
Depends: ${perl:Depends}, ${misc:Depends}, libdbi-perl,
- libdbix-sequence-perl, libsql-abstract-perl, libcoat-perl (>= 0.2),
- liblist-compare-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
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=38326&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/patches/pod-error.patch (original)
+++ trunk/libcoat-persistent-perl/debian/patches/pod-error.patch Sat Jun 20 09:05:16 2009
@@ -3,9 +3,9 @@
Date: Mon, 12 May 2008 15:46:44 +0200
Introduced-In: 0.9-6-2
---- a/lib/Coat/Persistent.pm
-+++ b/lib/Coat/Persistent.pm
-@@ -755,7 +755,7 @@
+--- libcoat-persistent-perl.orig/lib/Coat/Persistent.pm
++++ libcoat-persistent-perl/lib/Coat/Persistent.pm
+@@ -819,7 +819,7 @@
inserting, updating).
Coat::Peristent lets you use SQL if you want to, considering SQL is the best
@@ -14,7 +14,7 @@
=head1 WHY THIS MODULE ?
-@@ -862,7 +862,7 @@
+@@ -944,7 +944,7 @@
=over 4
@@ -23,7 +23,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.
-@@ -873,7 +873,7 @@
+@@ -955,7 +955,7 @@
use Coat::Persistent;
__PACKAGE__->map_to_dbi('csv', 'f_dir=./t/csv-directory');
@@ -32,7 +32,7 @@
to a MySQL database. B<@options> must be a list that contains repectively: the
database name, the database user, the database password.
-@@ -1012,8 +1012,6 @@
+@@ -1094,8 +1094,6 @@
=item B<limit>: An integer determining the limit on the number of rows that should
be returned.
@@ -41,7 +41,7 @@
Examples without options:
my $obj = Class->find(23);
-@@ -1025,8 +1023,6 @@
+@@ -1107,8 +1105,6 @@
my @list = Class->find($condition, { order => 'field1 desc' })
@@ -50,3 +50,14 @@
=item B<find_by_sql($sql, @bind_values>
Executes a custom sql query against your database and returns all the results
+--- libcoat-persistent-perl.orig/lib/Coat/Persistent/Types.pm
++++ libcoat-persistent-perl/lib/Coat/Persistent/Types.pm
+@@ -114,6 +114,8 @@
+ store_as => 'DateTime',
+ );
+
++=over
++
+ =item C<Class::Date>
+
+ All the types defined in this module are coerceable from or to the type UnixTimestamp.
Modified: trunk/libcoat-persistent-perl/debian/patches/series
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/patches/series?rev=38326&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/debian/patches/series (original)
+++ trunk/libcoat-persistent-perl/debian/patches/series Sat Jun 20 09:05:16 2009
@@ -1,1 +1,2 @@
pod-error.patch
+whatis-entries.patch
Added: trunk/libcoat-persistent-perl/debian/patches/whatis-entries.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/debian/patches/whatis-entries.patch?rev=38326&op=file
==============================================================================
--- trunk/libcoat-persistent-perl/debian/patches/whatis-entries.patch (added)
+++ trunk/libcoat-persistent-perl/debian/patches/whatis-entries.patch Sat Jun 20 09:05:16 2009
@@ -1,0 +1,29 @@
+Subject: Add missing whatis entries
+From: Ansgar Burchardt <ansgar at 43-1.org>
+Date: Sat, 20 Jun 2009 10:49:15 +0200
+
+This patch adds a missing whatis entry for lib/Coat/Persistent/Types.pm and
+fixes the whatis entry in lib/Coat/Persistent/Types/MySQL.pm.
+
+--- libcoat-persistent-perl.orig/lib/Coat/Persistent/Types.pm
++++ libcoat-persistent-perl/lib/Coat/Persistent/Types.pm
+@@ -54,7 +54,7 @@
+
+ =head1 NAME
+
+-Coat::Persistent::Types
++Coat::Persistent::Types - set of types and coercions that are of common use when dealing with an database
+
+ =head1 DESCRIPTION
+
+--- libcoat-persistent-perl.orig/lib/Coat/Persistent/Types/MySQL.pm
++++ libcoat-persistent-perl/lib/Coat/Persistent/Types/MySQL.pm
+@@ -50,7 +50,7 @@
+
+ =head1 NAME
+
+-Coat::Persistent::Types::MySQL -- Attribute types and coercions for MySQL data types
++Coat::Persistent::Types::MySQL - Attribute types and coercions for MySQL data types
+
+ =head1 DESCRIPTION
+
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=38326&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm (original)
+++ trunk/libcoat-persistent-perl/lib/Coat/Persistent.pm Sat Jun 20 09:05:16 2009
@@ -4,6 +4,7 @@
use Coat;
use Coat::Meta;
use Coat::Persistent::Meta;
+use Coat::Persistent::Constraint;
use Carp 'confess';
use Data::Dumper;
@@ -26,7 +27,7 @@
use vars qw($VERSION @EXPORT $AUTHORITY);
use base qw(Exporter);
-$VERSION = '0.104';
+$VERSION = '0.210';
$AUTHORITY = 'cpan:SUKRIA';
@EXPORT = qw(has_p has_one has_many);
@@ -35,7 +36,6 @@
# configuration place-holders
my $MAPPINGS = {};
-my $CONSTRAINTS = {};
# static accessors
sub mappings { $MAPPINGS }
@@ -53,6 +53,17 @@
$MAPPINGS->{'!cache'}{ $_[0] } ||
$MAPPINGS->{'!cache'}{'!default'} ||
undef;
+}
+
+# Access to the constraint meta data for the current class
+sub has_unique_constraint {
+ my ($class, $attr) = @_;
+ $class->has_constraint($attr, 'unique');
+}
+
+sub has_constraint {
+ my ($class, $attr, $constraint) = @_;
+ Coat::Persistent::Constraint->get_constraint($constraint, $class, $attr) || 0;
}
sub enable_cache {
@@ -139,6 +150,16 @@
_create_dbix_sequence_tables($MAPPINGS->{'!dbh'}{$class});
}
+# 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;
+
+ $class = '!default' if $class eq 'Coat::Persistent';
+ $MAPPINGS->{'!dbh'}{$class} = $dbh;
+ _create_dbix_sequence_tables($MAPPINGS->{'!dbh'}{$class});
+}
# This is done to wrap the original Coat::has method so we can
# generate finders for each attribute declared
@@ -158,9 +179,26 @@
confess "package main called has_p" if $caller eq 'main';
# unique field ?
- $CONSTRAINTS->{'!unique'}{$caller}{$attr} = $options{unique} || 0;
- # syntax check ?
- $CONSTRAINTS->{'!syntax'}{$caller}{$attr} = $options{syntax} || undef;
+ if ($options{'unique'}) {
+ Coat::Persistent::Constraint->add_constraint('unique', $caller, $attr, 1);
+ }
+
+ # specific storage type ?
+ if ($options{'store_as'}) {
+ # We need bi-directional coercion for this "store_as" feature ...
+ my $storage_type = Coat::Types::find_type_constraint($options{'store_as'});
+ confess "Unknown type \"".$options{'store_as'}."\" for storage"
+ unless defined $storage_type;
+ confess "No coercion defined for storage type \"".$options{'store_as'}."\""
+ unless $storage_type->has_coercion;
+
+ my $type = Coat::Types::find_type_constraint($options{isa});
+ confess "No cercion for attribute type : \"".$options{isa}."\""
+ unless $type->has_coercion;
+
+ Coat::Persistent::Constraint->add_constraint('store_as', $caller, $attr, $options{'store_as'});
+ $options{coerce} = 1;
+ }
Coat::has( $attr, ( '!caller' => $caller, %options ) );
Coat::Persistent::Meta->attribute($caller, $attr);
@@ -507,16 +545,9 @@
my $primary_key = Coat::Persistent::Meta->primary_key($class);
foreach my $attr (Coat::Persistent::Meta->linearized_attributes($class) ) {
- # checking for syntax validation
- if (defined $CONSTRAINTS->{'!syntax'}{$class}{$attr}) {
- my $regexp = $CONSTRAINTS->{'!syntax'}{$class}{$attr};
- confess "Value \"".$self->$attr."\" for attribute \"$attr\" is not valid"
- unless $self->$attr =~ /$regexp/;
- }
# checking for unique attributes on inserting (new objects)
- if ((! defined $self->$primary_key) &&
- $CONSTRAINTS->{'!unique'}{$class}{$attr}) {
+ if ($class->has_unique_constraint($attr)) {
# look for other instances that already have that attribute
my @items = $class->find(["$attr = ?", $self->$attr]);
confess "Value ".$self->$attr." violates unique constraint "
@@ -524,7 +555,6 @@
if @items;
}
}
-
}
sub delete {
@@ -571,6 +601,39 @@
}
}
+# This will return the value as to be stored in the underlying database
+# Most of the time it's just the value of the atrtribute, but it can
+# be different if a 'store_as' type is defined.
+sub get_storage_value_for {
+ my ($self, $attr_name) = @_;
+ my $class = ref $self;
+
+ my $attr = Coat::Meta->attribute($class, $attr_name);
+
+ if ($attr->{store_as}) {
+ my $storing_type = Coat::Types::find_type_constraint($attr->{store_as});
+ return $storing_type->coerce($self->$attr_name);
+ }
+ else {
+ return $self->$attr_name;
+ }
+}
+
+# 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) = @_;
@@ -588,8 +651,9 @@
# all the attributes of the class
my @fields = Coat::Persistent::Meta->linearized_attributes( ref $self );
- # a hash containing attr/value pairs for the current object.
- my %values = map { $_ => $self->$_ } @fields;
+
+ # a hash containing attr/value pairs for the current object
+ my %values = map { $_ => $self->get_storage_value_for($_) } @fields;
# if not a new object, we have to update
if ( $self->_db_state == CP_ENTRY_EXISTS ) {
@@ -811,6 +875,24 @@
=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
+
+=over 4
+
+=item B<set_dbh($dbh)>
+
+Set the given database handle for the calling class (set it by default if class
+is Coat::Persistent).
+
+=back
+
=head2 DBI MAPPING
You have to tell Coat::Persistent how to map a class to a DBI driver. You can
Modified: trunk/libcoat-persistent-perl/t/008_syntax.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcoat-persistent-perl/t/008_syntax.t?rev=38326&op=diff
==============================================================================
--- trunk/libcoat-persistent-perl/t/008_syntax.t (original)
+++ trunk/libcoat-persistent-perl/t/008_syntax.t Sat Jun 20 09:05:16 2009
@@ -6,8 +6,13 @@
{
package Person;
use Coat;
+ use Coat::Types;
use Coat::Persistent;
- has_p name => (isa => 'Str', unique => 1, syntax => '[a-zA-Z]{2}');
+
+ subtype 'Person:Name' => as 'Str' => where { /[a-zA-Z]{2}/ };
+ has_p name => (isa => 'Person:Name', unique => 1);
+ #has_p name => (isa => 'Str', unique => 1, syntax => '[a-zA-Z]{2}'); # DEPRECATED now
+
has_p age => (isa => 'Int');
}
More information about the Pkg-perl-cvs-commits
mailing list