From: Justin Wheeler Date: Thu, 26 Apr 2007 16:09:29 +0000 (+0000) Subject: Merge 'oracle8' into 'DBIx-Class-current' X-Git-Tag: v0.08010~150^2~86 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9382ad0721370b25b9b93d78c76ecab0b46cc74e;hp=a439ec1916f46381937a97f49a04b06476147af1;p=dbsrgits%2FDBIx-Class.git Merge 'oracle8' into 'DBIx-Class-current' Made Oracle/WhereJoins for using in Oracle 8 and higher because Oracle < 9i doesn't support ANSI joins, and Oracle >= 9i doesn't do ANSI joins worth a damn. --- diff --git a/Changes b/Changes index f1671d7..09cea11 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,11 @@ Revision history for DBIx::Class + - select et al weren't properly detecing when the server connection + had timed out when not in a transaction + - The SQL::T parser class now respects a relationship attribute of + is_foreign_key_constrain to allow explicit control over wether or not + a foreign constraint is needed + 0.07999_02 2007-01-25 20:11:00 - add support for binding BYTEA and similar parameters (w/Pg impl) - add support to Ordered for multiple ordering columns @@ -26,9 +32,9 @@ Revision history for DBIx::Class You can make it work like before via __PACKAGE__->column_info_from_storage(1) for now - Replaced DBIx::Class::AccessorGroup and Class::Data::Accessor with - Class::Accessor::Grouped. Only user noticible change is to - table_class on ResultSourceProxy::Table (i.e. table objects in - schemas) and, resultset_class and result_class in ResultSource. + Class::Accessor::Grouped. Only user noticible change is to + table_class on ResultSourceProxy::Table (i.e. table objects in + schemas) and, resultset_class and result_class in ResultSource. These accessors no longer automatically require the classes when set. @@ -115,7 +121,7 @@ Revision history for DBIx::Class - fixes to pass test suite on Windows - rewrote and cleaned up SQL::Translator tests - changed relationship helpers to only call ensure_class_loaded when the - join condition is inferred + join condition is inferred - rewrote many_to_many implementation, now provides helpers for adding and deleting objects without dealing with the link table - reworked InflateColumn implementation to lazily deflate where @@ -123,12 +129,12 @@ Revision history for DBIx::Class - changed join merging to not create a rel_2 alias when adding a join that already exists in a parent resultset - Storage::DBI::deployment_statements now calls ensure_connected - if it isn't passed a type + if it isn't passed a type - fixed Componentized::ensure_class_loaded - InflateColumn::DateTime supports date as well as datetime - split Storage::DBI::MSSQL into MSSQL and Sybase::MSSQL - - fixed wrong debugging hook call in Storage::DBI - - set connect_info properly before setting any ->sql_maker things + - fixed wrong debugging hook call in Storage::DBI + - set connect_info properly before setting any ->sql_maker things 0.06999_02 2006-06-09 23:58:33 - Fixed up POD::Coverage tests, filled in some POD holes diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index b626bee..72eac66 100644 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@ -203,6 +203,8 @@ da5id: David Jack Olrik dkubb: Dan Kubb +dnm: Justin Wheeler + draven: Marcus Ramberg dwc: Daniel Westermann-Clark diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 8409165..f31e685 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -102,6 +102,13 @@ related object, but you also want the relationship accessor to double as a column accessor). For C accessors, an add_to_* method is also created, which calls C for the relationship. +=item is_foreign_key_constraint + +If you are using L to create SQL for you and you find that it +is creating constraints where it shouldn't, or not creating them where it +should, set this attribute to a true or false value to override the detection +of when to create constraints. + =back =head2 register_relationship diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 774c922..941b6a4 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -701,16 +701,6 @@ sub _populate_dbh { $self->debugobj->query_end($sql_statement) if $self->debug(); } - # Rebless after we connect to the database, so we can take advantage of - # values in get_info - if(ref $self eq 'DBIx::Class::Storage::DBI') { - my $driver = $self->_dbh->{Driver}->{Name}; - if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) { - bless $self, "DBIx::Class::Storage::DBI::${driver}"; - $self->_rebless() if $self->can('_rebless'); - } - } - $self->_conn_pid($$); $self->_conn_tid(threads->tid) if $INC{'threads.pm'}; } @@ -852,47 +842,55 @@ sub _execute { map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; $self->debugobj->query_start($sql, @debug_bind); } - my $sth = eval { $self->sth($sql,$op) }; - if (!$sth || $@) { - $self->throw_exception( - 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql" - ); - } + my ($rv, $sth); + RETRY: while (1) { + $sth = eval { $self->sth($sql,$op) }; - my $rv; - if ($sth) { - my $time = time(); - $rv = eval { - my $placeholder_index = 1; + if (!$sth || $@) { + $self->throw_exception( + 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql" + ); + } - foreach my $bound (@bind) { + if ($sth) { + my $time = time(); + $rv = eval { + my $placeholder_index = 1; - my $attributes = {}; - my($column_name, @data) = @$bound; + foreach my $bound (@bind) { - if( $bind_attributes ) { - $attributes = $bind_attributes->{$column_name} - if defined $bind_attributes->{$column_name}; - } + my $attributes = {}; + my($column_name, @data) = @$bound; - foreach my $data (@data) - { - $data = ref $data ? ''.$data : $data; # stringify args + if( $bind_attributes ) { + $attributes = $bind_attributes->{$column_name} + if defined $bind_attributes->{$column_name}; + } - $sth->bind_param($placeholder_index, $data, $attributes); - $placeholder_index++; + foreach my $data (@data) + { + $data = ref $data ? ''.$data : $data; # stringify args + + $sth->bind_param($placeholder_index, $data, $attributes); + $placeholder_index++; + } } + $sth->execute(); + }; + + if ($@ || !$rv) { + $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)) + if $self->connected; + $self->_populate_dbh; + } else { + last RETRY; } - $sth->execute(); - }; - - if ($@ || !$rv) { - $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)); + } else { + $self->throw_exception("'$sql' did not generate a statement."); } - } else { - $self->throw_exception("'$sql' did not generate a statement."); - } + } # While(1) to retry if disconencted + if ($self->debug) { my @debug_bind = map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm index 4d289af..ea956ba 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm @@ -1,29 +1,35 @@ package DBIx::Class::Storage::DBI::Oracle; -# -*- mode: cperl; cperl-indent-level: 2 -*- use strict; use warnings; use base qw/DBIx::Class::Storage::DBI/; +print STDERR "Oracle.pm got called.\n"; + sub _rebless { - my ($self) = @_; + my ($self) = @_; + + print STDERR "Rebless got called.\n"; + + my $version = eval { $self->_dbh->get_info(18); }; + + if ( !$@ ) { + my ($major, $minor, $patchlevel) = split(/\./, $version); - my $version = eval { $self->_dbh->get_info(18); }; - unless ( $@ ) { - my ($major,$minor,$patchlevel) = split(/\./,$version); + # Default driver + my $class = $major >= 8 + ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins' + : 'DBIx::Class::Storage::DBI::Oracle::Generic'; - # Default driver - my $class = "DBIx::Class::Storage::DBI::Oracle::Generic"; + print STDERR "Class: $class\n"; - # Version specific drivers - $class = "DBIx::Class::Storage::DBI::Oracle::8" - if $major == 8; + # Load and rebless + eval "require $class"; - # Load and rebless - eval "require $class"; - bless $self, $class unless $@; - } + print STDERR "\$@: $@\n"; + bless $self, $class unless $@; + } } diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm b/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm new file mode 100644 index 0000000..2ba6815 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm @@ -0,0 +1,185 @@ +package DBIx::Class::Storage::DBI::Oracle::WhereJoins; + +use base qw( DBIx::Class::Storage::DBI::Oracle::Generic ); + +use strict; +use warnings; + +BEGIN { + package DBIC::SQL::Abstract::Oracle; + + use base qw( DBIC::SQL::Abstract ); + + sub select { + my ($self, $table, $fields, $where, $order, @rest) = @_; + + $self->_oracle_joins($where, @{ $table }); + + return $self->SUPER::select($table, $fields, $where, $order, @rest); + } + + sub _recurse_from { + my ($self, $from, @join) = @_; + + my @sqlf = $self->_make_as($from); + + foreach my $j (@join) { + my ($to, $on) = @{ $j }; + + if (ref $to eq 'ARRAY') { + push (@sqlf, $self->_recurse_from(@{ $to })); + } + else { + push (@sqlf, $self->_make_as($to)); + } + } + + return join q{, }, @sqlf; + } + + sub _oracle_joins { + my ($self, $where, $from, @join) = @_; + + foreach my $j (@join) { + my ($to, $on) = @{ $j }; + + if (ref $to eq 'ARRAY') { + $self->_oracle_joins($where, @{ $to }); + } + + my $to_jt = ref $to eq 'ARRAY' ? $to->[0] : $to; + my $left_join = q{}; + my $right_join = q{}; + + if (ref $to_jt eq 'HASH' and exists $to_jt->{-join_type}) { + #TODO: Support full outer joins -- this would happen much earlier in + #the sequence since oracle 8's full outer join syntax is best + #described as INSANE. + die "Can't handle full outer joins in Oracle 8 yet!\n" + if $to_jt->{-join_type} =~ /full/i; + + $left_join = q{(+)} if $to_jt->{-join_type} =~ /right/i + && $to_jt->{-join_type} !~ /inner/i; + + $right_join = q{(+)} if $to_jt->{-join_type} =~ /left/i + && $to_jt->{-join_type} !~ /inner/i; + } + + foreach my $lhs (keys %{ $on }) { + $where->{$lhs . $left_join} = \" = $on->{ $lhs }$right_join"; + } + } + } +} + +sub sql_maker { + my ($self) = @_; + + unless ($self->_sql_maker) { + $self->_sql_maker( + new DBIC::SQL::Abstract::Oracle( $self->_sql_maker_args ) + ); + } + + return $self->_sql_maker; +} + +1; + +__END__ + +=pod + +=head1 NAME + +DBIx::Class::Storage::DBI::Oracle::WhereJoins - Oracle joins in WHERE syntax +support (instead of ANSI). + +=head1 PURPOSE + +This module was originally written to support Oracle < 9i where ANSI joins +weren't supported at all, but became the module for Oracle >= 8 because +Oracle's optimising of ANSI joins is horrible. (See: +http://scsys.co.uk:8001/7495) + +=head1 SYNOPSIS + +DBIx::Class should automagically detect Oracle and use this module with no +work from you. + +=head1 DESCRIPTION + +This class implements Oracle's WhereJoin support. Instead of: + + SELECT x FROM y JOIN z ON y.id = z.id + +It will write: + + SELECT x FROM y, z WHERE y.id = z.id + +It should properly support left joins, and right joins. Full outer joins are +not possible due to the fact that Oracle requires the entire query be written +to union the results of a left and right join, and by the time this module is +called to create the where query and table definition part of the sql query, +it's already too late. + +=head1 METHODS + +This module replaces a subroutine contained in DBIC::SQL::Abstract: + +=over + +=item sql_maker + +=back + +It also creates a new module in its BEGIN { } block called +DBIC::SQL::Abstract::Oracle which has the following methods: + +=over + +=item select ($\@$;$$@) + +Replaces DBIC::SQL::Abstract's select() method, which calls _oracle_joins() +to modify the column and table list before calling SUPER::select(). + +=item _recurse_from ($$\@) + +Recursive subroutine that builds the table list. + +=item _oracle_joins ($$$@) + +Creates the left/right relationship in the where query. + +=back + +=head1 BUGS + +Does not support full outer joins. +Probably lots more. + +=head1 SEE ALSO + +=over + +=item L + +=item L + +=item L + +=back + +=head1 AUTHOR + +Justin Wheeler C<< >> + +=head1 CONTRIBUTORS + +David Jack Olrik C<< >> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. + +=cut diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm index edf6224..e3f0860 100644 --- a/lib/SQL/Translator/Parser/DBIx/Class.pm +++ b/lib/SQL/Translator/Parser/DBIx/Class.pm @@ -145,16 +145,18 @@ sub parse { #Decide if this is a foreign key based on whether the self #items are our primary columns. + $DB::single = 1 if $moniker eq 'Tests::MBTI::Result'; # If the sets are different, then we assume it's a foreign key from # us to another table. - # OR: If is_foreign_key attr is explicity set on one the local columns - if ( ! exists $created_FK_rels{$rel_table}->{$key_test} - && - ( !$source->compare_relationship_keys(\@keys, \@primary) || - grep { $source->column_info($_)->{is_foreign_key} } @keys - ) - ) { + # OR: If is_foreign_key_constraint attr is explicity set (or set to false) on the relation + if ( ! exists $created_FK_rels{$rel_table}->{$key_test} && + ( exists $rel_info->{attrs}{is_foreign_key_constraint} && + $rel_info->{attrs}{is_foreign_key_constraint} || + !$source->compare_relationship_keys(\@keys, \@primary) + ) + ) + { $created_FK_rels{$rel_table}->{$key_test} = 1; $table->add_constraint( type => 'foreign_key', diff --git a/t/92storage.t b/t/92storage.t index 67a594f..5994e2a 100644 --- a/t/92storage.t +++ b/t/92storage.t @@ -4,12 +4,30 @@ use warnings; use Test::More; use lib qw(t/lib); use DBICTest; +use DBICTest::ExplodingStorage; -plan tests => 1; +plan tests => 3; my $schema = DBICTest->init_schema(); is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite', 'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' ); + +my $storage = $schema->storage; +$storage->ensure_connected; + +bless $storage, "DBICTest::ExplodingStorage"; +$schema->storage($storage); + +eval { + $schema->resultset('Artist')->create({ name => "Exploding Sheep" }) +}; + +is($@, "", "Exploding \$sth->execute was caught"); + +is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count, + "And the STH was retired"); + + 1; diff --git a/t/lib/DBICTest/ExplodingStorage.pm b/t/lib/DBICTest/ExplodingStorage.pm new file mode 100644 index 0000000..e5dd455 --- /dev/null +++ b/t/lib/DBICTest/ExplodingStorage.pm @@ -0,0 +1,28 @@ +package DBICTest::ExplodingStorage::Sth; + +sub execute { + die "Kablammo!"; +} + +sub bind_param {} + +package DBICTest::ExplodingStorage; + +use strict; +use warnings; + +use base 'DBIx::Class::Storage::DBI::SQLite'; + +my $count = 0; +sub sth { + my ($self, $sql) = @_; + return bless {}, "DBICTest::ExplodingStorage::Sth" unless $count++; + return $self->next::method($sql); +} + +sub connected { + return 0 if $count == 1; + return shift->next::method(@_); +} + +1;