From: David Jack Olrik Date: Wed, 24 Jan 2007 09:38:54 +0000 (+0000) Subject: Added Justin Wheeler's Oracle 8 support X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=18360aedd6dca521ddd229d246c1e693438d7fd7;p=dbsrgits%2FDBIx-Class-Historic.git Added Justin Wheeler's Oracle 8 support --- diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index efd0727..5645d6d 100644 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@ -199,6 +199,8 @@ claco: Christopher H. Laco clkao: CL Kao +da5id: David Jack Olrik + dkubb: Dan Kubb draven: Marcus Ramberg diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 04dd140..d39b3a7 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -701,6 +701,16 @@ 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'}; } diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm index 77cedf3..2b28247 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm @@ -1,54 +1,27 @@ package DBIx::Class::Storage::DBI::Oracle; - use strict; use warnings; -use Carp::Clan qw/^DBIx::Class/; - -use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; +use base qw/DBIx::Class::Storage::DBI/; -# __PACKAGE__->load_components(qw/PK::Auto/); - -sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col) = @_; - my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col)); - my $sql = 'SELECT ' . $seq . '.currval FROM DUAL'; - my ($id) = $dbh->selectrow_array($sql); - return $id; -} +sub _rebless { + my ($self) = @_; -sub _dbh_get_autoinc_seq { - my ($self, $dbh, $source, $col) = @_; - - # look up the correct sequence automatically - my $sql = q{ - SELECT trigger_body FROM ALL_TRIGGERS t - WHERE t.table_name = ? - AND t.triggering_event = 'INSERT' - AND t.status = 'ENABLED' - }; - - # trigger_body is a LONG - $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024); - - my $sth = $dbh->prepare($sql); - $sth->execute( uc($source->name) ); - while (my ($insert_trigger) = $sth->fetchrow_array) { - return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here??? - } - croak "Unable to find a sequence INSERT trigger on table '" . $source->name . "'."; -} + my $version = eval { $self->_dbh->get_info(18); }; + unless ( $@ ) { + my ($major,$minor,$patchlevel) = split(/\./,$version); -sub get_autoinc_seq { - my ($self, $source, $col) = @_; - - $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col); -} + # Default driver + my $class = "DBIx::Class::Storage::DBI::Oracle::Generic"; -sub columns_info_for { - my ($self, $table) = @_; + # Version specific drivers + $class = "DBIx::Class::Storage::DBI::Oracle::8" + if $major == 8; - $self->next::method(uc($table)); + # Load and rebless + eval "require $class"; + bless $self, $class unless $@; + } } @@ -56,24 +29,22 @@ sub columns_info_for { =head1 NAME -DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle +DBIx::Class::Storage::DBI::Oracle - Base class for Oracle driver =head1 SYNOPSIS # In your table classes - __PACKAGE__->load_components(qw/PK::Auto Core/); - __PACKAGE__->set_primary_key('id'); - __PACKAGE__->sequence('mysequence'); + __PACKAGE__->load_components(qw/Core/); =head1 DESCRIPTION -This class implements autoincrements for Oracle. +This class simply provides a mechanism for discovering and loading a sub-class +for a specific version Oracle backend. It should be transparent to the user. -=head1 AUTHORS -Andy Grundman +=head1 AUTHORS -Scott Connelly +David Jack Olrik C<< >> =head1 LICENSE diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/8.pm b/lib/DBIx/Class/Storage/DBI/Oracle/8.pm new file mode 100644 index 0000000..407c5bd --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Oracle/8.pm @@ -0,0 +1,181 @@ +package DBIx::Class::Storage::DBI::Oracle::8; + +use base qw( DBIx::Class::Storage::DBI::Oracle::Generic ); + +use strict; +use warnings; + +BEGIN { + package DBIC::SQL::Abstract::Oracle8; + + 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::Oracle8( $self->_sql_maker_args ) + ); + } + + return $self->_sql_maker; +} + +1; + +__END__ + +=pod + +=head1 NAME + +DBIx::Class::Storage::DBI::Oracle::8 + +=head1 SYNOPSIS + +When initialising your code in the base DBIx module, simply tell DBIx to use +this as a storage class, and you're set: + + use base qw( DBIx::Class::Schema ); + + __PACKAGE__->load_classes(); + +=head1 DESCRIPTION + +This class implements support specific to Oracle 8, as Oracle does not support: + + SELECT x FROM y JOIN z ON y.id = z.id + +Oracle requires the query by written as: + + SELECT x FROM y, z WHERE y.id = z.id + +This module attempts to support that. + +It should properly support left joins, and right joins. Full outer joins are +not possible due to the fact that Oracle 8 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::Oracle8 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 + +=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/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm new file mode 100644 index 0000000..6f0693b --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -0,0 +1,82 @@ +package DBIx::Class::Storage::DBI::Oracle::Generic; + +use strict; +use warnings; + +use Carp::Clan qw/^DBIx::Class/; + +use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; + +# __PACKAGE__->load_components(qw/PK::Auto/); + +sub _dbh_last_insert_id { + my ($self, $dbh, $source, $col) = @_; + my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col)); + my $sql = 'SELECT ' . $seq . '.currval FROM DUAL'; + my ($id) = $dbh->selectrow_array($sql); + return $id; +} + +sub _dbh_get_autoinc_seq { + my ($self, $dbh, $source, $col) = @_; + + # look up the correct sequence automatically + my $sql = q{ + SELECT trigger_body FROM ALL_TRIGGERS t + WHERE t.table_name = ? + AND t.triggering_event = 'INSERT' + AND t.status = 'ENABLED' + }; + + # trigger_body is a LONG + $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024); + + my $sth = $dbh->prepare($sql); + $sth->execute( uc($source->name) ); + while (my ($insert_trigger) = $sth->fetchrow_array) { + return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here??? + } + croak "Unable to find a sequence INSERT trigger on table '" . $source->name . "'."; +} + +sub get_autoinc_seq { + my ($self, $source, $col) = @_; + + $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col); +} + +sub columns_info_for { + my ($self, $table) = @_; + + $self->next::method(uc($table)); +} + + +1; + +=head1 NAME + +DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle + +=head1 SYNOPSIS + + # In your table classes + __PACKAGE__->load_components(qw/PK::Auto Core/); + __PACKAGE__->set_primary_key('id'); + __PACKAGE__->sequence('mysequence'); + +=head1 DESCRIPTION + +This class implements autoincrements for Oracle. + +=head1 AUTHORS + +Andy Grundman + +Scott Connelly + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut