[Bast-commits] r4761 - in DBIx-Class/0.08/trunk:
lib/DBIx/Class/Relationship lib/SQL/Translator/Parser/DBIx t
t/lib/DBICTest/Schema
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Fri Aug 22 13:48:18 BST 2008
Author: ribasushi
Date: 2008-08-22 13:48:18 +0100 (Fri, 22 Aug 2008)
New Revision: 4761
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm
DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/trunk/t/86sqlt.t
DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm
Log:
- Allow explicit specification of ON DELETE/ON UPDATE constraints when using the SQLT parser
- Minor refactor of the parser (needs more work)
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm 2008-08-22 12:46:11 UTC (rev 4760)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm 2008-08-22 12:48:18 UTC (rev 4761)
@@ -109,6 +109,19 @@
should, set this attribute to a true or false value to override the detection
of when to create constraints.
+=item on_delete / on_update
+
+If you are using L<SQL::Translator> to create SQL for you, you can use these
+attributes to explicitly set the desired C<ON DELETE> or C<ON UPDATE> constraint
+type. If not supplied the SQLT parser will attempt to infer the constraint type by
+interrogating the attributes of the B<opposite> relationship. For any 'multi'
+relationship with C<< cascade_delete => 1 >>, the corresponding belongs_to
+relationship will be created with an C<ON DELETE CASCADE> constraint. For any
+relationship bearing C<< cascade_copy => 1 >> the resulting belongs_to constraint
+will be C<ON UPDATE CASCADE>. If you wish to disable this autodetection, and just
+use the RDBMS' default constraint type, pass C<< on_delete => undef >> or
+C<< on_delete => '' >>, and the same for C<on_update> respectively.
+
=item is_deferrable
Tells L<SQL::Translator> that the foreign key constraint it creates should be
Modified: DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm 2008-08-22 12:46:11 UTC (rev 4760)
+++ DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm 2008-08-22 12:48:18 UTC (rev 4761)
@@ -129,6 +129,9 @@
my $othertable = $source->related_source($rel);
my $rel_table = $othertable->name;
+ my $reverse_rels = $source->reverse_relationship_info($rel);
+ my ($otherrelname, $otherrelationship) = each %{$reverse_rels};
+
# Force the order of @cond to match the order of ->add_columns
my $idx;
my %other_columns_idx = map {'foreign.'.$_ => ++$idx } $othertable->columns;
@@ -138,44 +141,55 @@
my @refkeys = map {/^\w+\.(\w+)$/} @cond;
my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
+ # determine if this relationship is a self.fk => foreign.pk (i.e. belongs_to)
+ my $fk_constraint;
+
+ #first it can be specified explicitly
+ if ( exists $rel_info->{attrs}{is_foreign_key_constraint} ) {
+ $fk_constraint = $rel_info->{attrs}{is_foreign_key_constraint};
+ }
+ # it can not be multi
+ elsif ( $rel_info->{attrs}{accessor} eq 'multi' ) {
+ $fk_constraint = 0;
+ }
+ # if indeed single, check if all self.columns are our primary keys.
+ # this is supposed to indicate a has_one/might_have...
+ # where's the introspection!!?? :)
+ else {
+ $fk_constraint = not $source->compare_relationship_keys(\@keys, \@primary);
+ }
+
+ my $cascade;
+ for my $c (qw/delete update/) {
+ if (exists $rel_info->{attrs}{"on_$c"}) {
+ if ($fk_constraint) {
+ $cascade->{$c} = $rel_info->{attrs}{"on_$c"};
+ }
+ else {
+ warn "SQLT attribute 'on_$c' was supplied for relationship '$moniker/$rel', which does not appear to be a foreign constraint. "
+ . "If you are sure that SQLT must generate a constraint for this relationship, add 'is_foreign_key_constraint => 1' to the attributes.\n";
+ }
+ }
+ elsif (defined $otherrelationship and $otherrelationship->{attrs}{$c eq 'update' ? 'cascade_copy' : 'cascade_delete'}) {
+ $cascade->{$c} = 'CASCADE';
+ }
+ }
+
if($rel_table)
{
- my $reverse_rels = $source->reverse_relationship_info($rel);
- my ($otherrelname, $otherrelationship) = each %{$reverse_rels};
+ # Constraints are added only if applicable
+ next unless $fk_constraint;
- my $on_delete = '';
- my $on_update = '';
+ # Make sure we dont create the same foreign key constraint twice
+ my $key_test = join("\x00", @keys);
+ next if $created_FK_rels{$rel_table}->{$key_test};
- if (defined $otherrelationship) {
- $on_delete = $otherrelationship->{'attrs'}->{cascade_delete} ? 'CASCADE' : '';
- $on_update = $otherrelationship->{'attrs'}->{cascade_copy} ? 'CASCADE' : '';
- }
-
my $is_deferrable = $rel_info->{attrs}{is_deferrable};
# global parser_args add_fk_index param can be overridden on the rel def
my $add_fk_index_rel = (exists $rel_info->{attrs}{add_fk_index}) ? $rel_info->{attrs}{add_fk_index} : $add_fk_index;
- # Make sure we dont create the same foreign key constraint twice
- my $key_test = join("\x00", @keys);
- #Decide if this is a foreign key based on whether the self
- #items are our primary columns.
-
- # If the sets are different, then we assume it's a foreign key from
- # us to another table.
- # OR: If is_foreign_key_constraint attr is explicity set (or set to false) on the relation
- next if ( exists $created_FK_rels{$rel_table}->{$key_test} );
- if ( exists $rel_info->{attrs}{is_foreign_key_constraint}) {
- # not is this attr set to 0 but definitely if set to 1
- next unless ($rel_info->{attrs}{is_foreign_key_constraint});
- } else {
- # not if might have
- # next if ($rel_info->{attrs}{accessor} eq 'single' && exists $rel_info->{attrs}{join_type} && uc($rel_info->{attrs}{join_type}) eq 'LEFT');
- # not sure about this one
- next if $source->compare_relationship_keys(\@keys, \@primary);
- }
-
$created_FK_rels{$rel_table}->{$key_test} = 1;
if (scalar(@keys)) {
$table->add_constraint(
@@ -184,8 +198,8 @@
fields => \@keys,
reference_fields => \@refkeys,
reference_table => $rel_table,
- on_delete => $on_delete,
- on_update => $on_update,
+ on_delete => $cascade->{delete},
+ on_update => $cascade->{update},
(defined $is_deferrable ? ( deferrable => $is_deferrable ) : ()),
);
Modified: DBIx-Class/0.08/trunk/t/86sqlt.t
===================================================================
--- DBIx-Class/0.08/trunk/t/86sqlt.t 2008-08-22 12:46:11 UTC (rev 4760)
+++ DBIx-Class/0.08/trunk/t/86sqlt.t 2008-08-22 12:48:18 UTC (rev 4761)
@@ -10,7 +10,7 @@
my $schema = DBICTest->init_schema;
-plan tests => 130;
+plan tests => 131;
my $translator = SQL::Translator->new(
parser_args => {
@@ -19,15 +19,24 @@
producer_args => {},
);
-$translator->parser('SQL::Translator::Parser::DBIx::Class');
-$translator->producer('SQLite');
+{
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn = shift };
-my $output = $translator->translate();
+ my $relinfo = $schema->source('Artist')->relationship_info ('cds');
+ local $relinfo->{attrs}{on_delete} = 'restrict';
+ $translator->parser('SQL::Translator::Parser::DBIx::Class');
+ $translator->producer('SQLite');
-ok($output, "SQLT produced someoutput")
- or diag($translator->error);
+ my $output = $translator->translate();
+ ok($output, "SQLT produced someoutput")
+ or diag($translator->error);
+
+ like ($warn, qr/^SQLT attribute .+? was supplied for relationship/, 'Warn about dubious on_delete/on_update attributes');
+}
+
# Note that the constraints listed here are the only ones that are tested -- if
# more exist in the Schema than are listed here and all listed constraints are
# correct, the test will still pass. If you add a class with UNIQUE or FOREIGN
@@ -117,7 +126,7 @@
'name' => 'cd_fk_artist', 'index_name' => 'cd_idx_artist',
'selftable' => 'cd', 'foreigntable' => 'artist',
'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
- on_delete => 'CASCADE', on_update => 'CASCADE', deferrable => 1,
+ on_delete => '', on_update => 'SET NULL', deferrable => 1,
},
],
@@ -128,14 +137,14 @@
'name' => 'artist_undirected_map_fk_id1', 'index_name' => 'artist_undirected_map_idx_id1',
'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
'selfcols' => ['id1'], 'foreigncols' => ['artistid'],
- on_delete => 'CASCADE', on_update => '', deferrable => 1,
+ on_delete => 'RESTRICT', on_update => 'CASCADE', deferrable => 1,
},
{
'display' => 'artist_undirected_map->artist for id2',
'name' => 'artist_undirected_map_fk_id2', 'index_name' => 'artist_undirected_map_idx_id2',
'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
'selfcols' => ['id2'], 'foreigncols' => ['artistid'],
- on_delete => 'CASCADE', on_update => '', deferrable => 1,
+ on_delete => '', on_update => 'CASCADE', deferrable => 1,
},
],
@@ -203,7 +212,6 @@
on_delete => '', on_update => '', deferrable => 1,
},
],
-
);
my %unique_constraints = (
Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm 2008-08-22 12:46:11 UTC (rev 4760)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm 2008-08-22 12:48:18 UTC (rev 4761)
@@ -10,8 +10,8 @@
);
__PACKAGE__->set_primary_key(qw/id1 id2/);
-__PACKAGE__->belongs_to( 'artist1', 'DBICTest::Schema::Artist', 'id1' );
-__PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2');
+__PACKAGE__->belongs_to( 'artist1', 'DBICTest::Schema::Artist', 'id1', { on_delete => 'RESTRICT', on_update => 'CASCADE'} );
+__PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2', { on_delete => undef, on_update => 'CASCADE'} );
__PACKAGE__->has_many(
'mapped_artists', 'DBICTest::Schema::Artist',
[ {'foreign.artistid' => 'self.id1'}, {'foreign.artistid' => 'self.id2'} ],
Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm 2008-08-22 12:46:11 UTC (rev 4760)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm 2008-08-22 12:48:18 UTC (rev 4761)
@@ -24,7 +24,11 @@
__PACKAGE__->set_primary_key('cdid');
__PACKAGE__->add_unique_constraint([ qw/artist title/ ]);
-__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist', undef, { is_deferrable => 1 } );
+__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist', undef, {
+ is_deferrable => 1,
+ on_delete => undef,
+ on_update => 'SET NULL',
+});
__PACKAGE__->has_many( tracks => 'DBICTest::Schema::Track' );
__PACKAGE__->has_many(
More information about the Bast-commits
mailing list