[Bast-commits] r6222 - in
DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class: .
Storage/DBI/Oracle
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Tue May 12 06:12:50 GMT 2009
Author: ribasushi
Date: 2009-05-12 06:12:50 +0000 (Tue, 12 May 2009)
New Revision: 6222
Modified:
DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
Log:
Whops, forgotten post-merge tweaks
Modified: DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/SQLAHacks.pm 2009-05-12 06:11:27 UTC (rev 6221)
+++ DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/SQLAHacks.pm 2009-05-12 06:12:50 UTC (rev 6222)
@@ -1,9 +1,8 @@
-
package # Hide from PAUSE
-DBIx::Class::SQLAHacks; # Would merge upstream, but nate doesn't reply :(
+ DBIx::Class::SQLAHacks; # Would merge upstream, but nate doesn't reply :(
-
use base qw/SQL::Abstract::Limit/;
+use Carp::Clan qw/^DBIx::Class/;
sub new {
my $self = shift->SUPER::new(@_);
@@ -114,6 +113,9 @@
sub select {
my ($self, $table, $fields, $where, $order, @rest) = @_;
+ local $self->{having_bind} = [];
+ local $self->{from_bind} = [];
+
if (ref $table eq 'SCALAR') {
$table = $$table;
}
@@ -125,8 +127,7 @@
@rest = (-1) unless defined $rest[0];
die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
# and anyway, SQL::Abstract::Limit will cause a barf if we don't first
- local $self->{having_bind} = [];
- my ($sql, @ret) = $self->SUPER::select(
+ my ($sql, @where_bind) = $self->SUPER::select(
$table, $self->_recurse_fields($fields), $where, $order, @rest
);
$sql .=
@@ -138,7 +139,7 @@
) :
''
;
- return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
+ return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
}
sub insert {
@@ -186,13 +187,30 @@
} @$fields);
} elsif ($ref eq 'HASH') {
foreach my $func (keys %$fields) {
+ if ($func eq 'distinct') {
+ my $_fields = $fields->{$func};
+ if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
+ die "Unsupported syntax, please use " .
+ "{ group_by => [ qw/" . (join ' ', @$_fields) . "/ ] }" .
+ " or " .
+ "{ select => [ qw/" . (join ' ', @$_fields) . "/ ], distinct => 1 }";
+ }
+ else {
+ $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
+ carp "This syntax will be deprecated in 09, please use " .
+ "{ group_by => '${_fields}' }" .
+ " or " .
+ "{ select => '${_fields}', distinct => 1 }";
+ }
+ }
+
return $self->_sqlcase($func)
.'( '.$self->_recurse_fields($fields->{$func}).' )';
}
}
# Is the second check absolutely necessary?
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
- return $self->_bind_to_sql( $fields );
+ return $self->_fold_sqlbind( $fields );
}
else {
Carp::croak($ref . qq{ unexpected in _recurse_fields()})
@@ -285,19 +303,18 @@
return join('', @sqlf);
}
-sub _bind_to_sql {
- my $self = shift;
- my $arr = shift;
- my $sql = shift @$$arr;
- $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg;
- return $sql
+sub _fold_sqlbind {
+ my ($self, $sqlbind) = @_;
+ my $sql = shift @$$sqlbind;
+ push @{$self->{from_bind}}, @$$sqlbind;
+ return $sql;
}
sub _make_as {
my ($self, $from) = @_;
- return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
- : ref $_ eq 'REF' ? $self->_bind_to_sql($_)
- : $self->_quote($_))
+ return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
+ : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
+ : $self->_quote($_))
} reverse each %{$self->_skip_options($from)});
}
Modified: DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-05-12 06:11:27 UTC (rev 6221)
+++ DBIx-Class/0.08/branches/oracle-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-05-12 06:12:50 UTC (rev 6222)
@@ -1,5 +1,4 @@
package DBIx::Class::Storage::DBI::Oracle::Generic;
-# -*- mode: cperl; cperl-indent-level: 2 -*-
use strict;
use warnings;
@@ -24,15 +23,12 @@
=cut
+use base qw/DBIx::Class::Storage::DBI/;
use Carp::Clan qw/^DBIx::Class/;
# For ORA_BLOB => 113, ORA_CLOB => 112
use DBD::Oracle qw( :ora_types );
-use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
-
-# __PACKAGE__->load_components(qw/PK::Auto/);
-
sub _dbh_last_insert_id {
my ($self, $dbh, $source, @columns) = @_;
my @ids = ();
More information about the Bast-commits
mailing list