r28196 - in /trunk/librose-db-object-perl: Changes META.yml debian/changelog lib/Rose/DB/Object.pm lib/Rose/DB/Object/Metadata.pm t/as-tree.t t/db-object-relationship.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Dec 13 02:56:43 UTC 2008
Author: gregoa
Date: Sat Dec 13 02:56:40 2008
New Revision: 28196
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28196
Log:
New upstream release.
Modified:
trunk/librose-db-object-perl/Changes
trunk/librose-db-object-perl/META.yml
trunk/librose-db-object-perl/debian/changelog
trunk/librose-db-object-perl/lib/Rose/DB/Object.pm
trunk/librose-db-object-perl/lib/Rose/DB/Object/Metadata.pm
trunk/librose-db-object-perl/t/as-tree.t
trunk/librose-db-object-perl/t/db-object-relationship.t
Modified: trunk/librose-db-object-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-object-perl/Changes?rev=28196&op=diff
==============================================================================
--- trunk/librose-db-object-perl/Changes (original)
+++ trunk/librose-db-object-perl/Changes Sat Dec 13 02:56:40 2008
@@ -1,3 +1,9 @@
+0.777 (12.12.2008) - John Siracusa <siracusa at gmail.com>
+
+ * Fixed a bug that caused foreign key proxy relationships to
+ be clobbered if relationships were set after foreign_keys.
+ (Reported by Peter Karman)
+
0.776 (12.09.2008) - John Siracusa <siracusa at gmail.com>
* Fixed a bug that was preventing the use of new comparison
Modified: trunk/librose-db-object-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-object-perl/META.yml?rev=28196&op=diff
==============================================================================
--- trunk/librose-db-object-perl/META.yml (original)
+++ trunk/librose-db-object-perl/META.yml Sat Dec 13 02:56:40 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Rose-DB-Object
-version: 0.776
+version: 0.777
abstract: Extensible, high performance object-relational mapper (ORM).
author:
- John Siracusa <siracusa at gmail.com>
Modified: trunk/librose-db-object-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-object-perl/debian/changelog?rev=28196&op=diff
==============================================================================
--- trunk/librose-db-object-perl/debian/changelog (original)
+++ trunk/librose-db-object-perl/debian/changelog Sat Dec 13 02:56:40 2008
@@ -1,3 +1,9 @@
+librose-db-object-perl (1:0.777-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Sat, 13 Dec 2008 03:55:40 +0100
+
librose-db-object-perl (1:0.776-1) unstable; urgency=low
[ gregor herrmann ]
Modified: trunk/librose-db-object-perl/lib/Rose/DB/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-object-perl/lib/Rose/DB/Object.pm?rev=28196&op=diff
==============================================================================
--- trunk/librose-db-object-perl/lib/Rose/DB/Object.pm (original)
+++ trunk/librose-db-object-perl/lib/Rose/DB/Object.pm Sat Dec 13 02:56:40 2008
@@ -16,7 +16,7 @@
use Rose::DB::Object::Exception;
use Rose::DB::Object::Util();
-our $VERSION = '0.776';
+our $VERSION = '0.777';
our $Debug = 0;
@@ -1969,7 +1969,7 @@
=head2 Inheritance
-Simple inheritance between L<Rose::DB::Object>-derived classes is supported. The first time the L<metadata object|/meta> for a given class is accessed, it is created by making a one-time "deep copy" of the base class's metadata object (as long that the base class has one or more L<columns|Rose::DB::Object::Metadata/columns> set). This includes all columns, relationships, foreign keys, and other metadata from the base class. From that point on, the subclass may add to or modify its metadata without affecting any other class.
+Simple, single inheritance between L<Rose::DB::Object>-derived classes is supported. (Multiple inheritance is not currently supported.) The first time the L<metadata object|/meta> for a given class is accessed, it is created by making a one-time "deep copy" of the base class's metadata object (as long that the base class has one or more L<columns|Rose::DB::Object::Metadata/columns> set). This includes all columns, relationships, foreign keys, and other metadata from the base class. From that point on, the subclass may add to or modify its metadata without affecting any other class.
B<Tip:> When using perl 5.8.0 or later, the L<Scalar::Util::Clone> module is highly recommended. If it's installed, it will be used to more efficiently clone base-class metadata objects.
Modified: trunk/librose-db-object-perl/lib/Rose/DB/Object/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-object-perl/lib/Rose/DB/Object/Metadata.pm?rev=28196&op=diff
==============================================================================
--- trunk/librose-db-object-perl/lib/Rose/DB/Object/Metadata.pm (original)
+++ trunk/librose-db-object-perl/lib/Rose/DB/Object/Metadata.pm Sat Dec 13 02:56:40 2008
@@ -25,7 +25,7 @@
use Clone(); # This is the backup clone method
-our $VERSION = '0.776';
+our $VERSION = '0.777';
our $Debug = 0;
@@ -1244,8 +1244,15 @@
sub delete_relationships
{
- my($self, $name) = @_;
- $self->{'relationships'} = {};
+ my($self) = shift;
+
+ # Delete everything except fk proxy relationships
+ foreach my $name (keys %{$self->{'relationships'} || {}})
+ {
+ delete $self->{'relationships'}{$name}
+ unless($self->{'relationships'}{$name}->foreign_key);
+ }
+
return;
}
@@ -1581,13 +1588,36 @@
return;
}
+sub delete_foreign_keys
+{
+ my($self) = shift;
+
+ # Delete fk proxy relationship
+ foreach my $fk (values %{$self->{'foreign_keys'}})
+ {
+ foreach my $rel ($self->relationships)
+ {
+ no warnings 'uninitialized';
+ if($rel->foreign_key eq $fk)
+ {
+ $self->delete_relationship($rel->name);
+ }
+ }
+ }
+
+ # Delete fks
+ $self->{'foreign_keys'} = {};
+
+ return;
+}
+
sub foreign_keys
{
my($self) = shift;
if(@_)
{
- $self->{'foreign_keys'} = {};
+ $self->delete_foreign_keys;
$self->add_foreign_keys(@_);
}
Modified: trunk/librose-db-object-perl/t/as-tree.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-object-perl/t/as-tree.t?rev=28196&op=diff
==============================================================================
--- trunk/librose-db-object-perl/t/as-tree.t (original)
+++ trunk/librose-db-object-perl/t/as-tree.t Sat Dec 13 02:56:40 2008
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 2 + (5 * 28) + 3;
+use Test::More tests => 2 + (5 * 28) + 4;
eval { require Test::Differences };
@@ -716,7 +716,7 @@
{
SKIP:
{
- skip("init_with_tree() bug tests", 3) unless(%Have);
+ skip("init_with_tree() bug tests", 4) unless(%Have);
}
next unless(%Have);
@@ -1009,6 +1009,10 @@
is($user_archive->id, 11647, 'init_with_tree() columns first bug 1');
is($user_archive->user_emails->[0]->user_id, 11647, 'init_with_tree() columns first bug 2');
is($user_archive->user_phones->[0]->user_id, 11647, 'init_with_tree() columns first bug 3');
+
+ $tree = as_tree($user_archive);
+
+ is($tree->{'user_phones'}[0]{'user_id'}, 11647, 'as_tree() traverse fks');
}
BEGIN
Modified: trunk/librose-db-object-perl/t/db-object-relationship.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-object-perl/t/db-object-relationship.t?rev=28196&op=diff
==============================================================================
--- trunk/librose-db-object-perl/t/db-object-relationship.t (original)
+++ trunk/librose-db-object-perl/t/db-object-relationship.t Sat Dec 13 02:56:40 2008
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 1578;
+use Test::More tests => 1590;
BEGIN
{
@@ -27,7 +27,7 @@
SKIP: foreach my $db_type ('pg')
{
- skip("Postgres tests", 390) unless($HAVE_PG);
+ skip("Postgres tests", 396) unless($HAVE_PG);
Rose::DB->default_type($db_type);
@@ -1533,6 +1533,8 @@
is($count, 5, "add 2 many to many on save 34 - $db_type");
# End "many to many" tests
+
+ test_meta(MyPgOtherObject2->meta, 'MyPg', $db_type);
}
#
@@ -4443,7 +4445,7 @@
SKIP: foreach my $db_type ('sqlite')
{
- skip("SQLite tests", 452) unless($HAVE_SQLITE);
+ skip("SQLite tests", 458) unless($HAVE_SQLITE);
Rose::DB->default_type($db_type);
@@ -6201,6 +6203,8 @@
is($o2->name, 'John2', "fk hook-up 2 - $db_type");
# End fk hook-up tests
+
+ test_meta(MySQLiteOtherObject2->meta, 'MySQLite', $db_type);
}
BEGIN
@@ -6380,7 +6384,7 @@
MyPgObject->meta->relationships
(
- other_obj =>
+ other_objx =>
{
type => 'one to one',
class => 'MyPgOtherObject',
@@ -7711,6 +7715,68 @@
}
}
+sub test_meta
+{
+ my($meta, $prefix, $db_type) = @_;
+
+ $meta->delete_relationships;
+
+ $meta->delete_foreign_keys;
+
+ $meta->foreign_keys
+ (
+ other_obj =>
+ {
+ class => "${prefix}Object",
+ key_columns => { pid => 'id' },
+ },
+ );
+
+ $meta->relationships
+ (
+ other_objx =>
+ {
+ type => 'many to one',
+ class => "${prefix}Object",
+ column_map => { pid => 'id' },
+ required => 1,
+ with_column_triggers => 1,
+ },
+ );
+
+ is(scalar @{$meta->foreign_keys}, 1, "proxy relationships 1 - $db_type");
+ is(scalar @{$meta->relationships}, 2, "proxy relationships 2 - $db_type");
+
+ $meta->delete_foreign_keys;
+
+ is(scalar @{$meta->foreign_keys}, 0, "proxy relationships 3 - $db_type");
+ is(scalar @{$meta->relationships}, 1, "proxy relationships 4 - $db_type");
+
+ $meta->relationships
+ (
+ other_objx =>
+ {
+ type => 'many to one',
+ class => "${prefix}Object",
+ column_map => { pid => 'id' },
+ required => 1,
+ with_column_triggers => 1,
+ },
+ );
+
+ $meta->foreign_keys
+ (
+ other_obj =>
+ {
+ class => "${prefix}Object",
+ key_columns => { pid => 'id' },
+ },
+ );
+
+ is(scalar @{$meta->foreign_keys}, 1, "proxy relationships 5 - $db_type");
+ is(scalar @{$meta->relationships}, 2, "proxy relationships 6 - $db_type");
+}
+
END
{
# Delete test table
More information about the Pkg-perl-cvs-commits
mailing list