Moved DBIC::SQL::Abstract inner classes to DBIx::Class::SQLAHacks namespace to decoup...
Ron "Quinn" Straight [Mon, 11 May 2009 14:24:27 +0000 (14:24 +0000)]
lib/DBIx/Class/SQLAHacks.pm [new file with mode: 0644]
lib/DBIx/Class/SQLAHacks/OracleJoins.pm [new file with mode: 0644]
lib/DBIx/Class/Storage.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
t/41orrible.t
t/42toplimit.t
t/76joins.t

diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm
new file mode 100644 (file)
index 0000000..e57e926
--- /dev/null
@@ -0,0 +1,415 @@
+
+package # Hide from PAUSE
+DBIx::Class::SQLAHacks; # Would merge upstream, but nate doesn't reply :(
+
+
+use base qw/SQL::Abstract::Limit/;
+
+sub new {
+  my $self = shift->SUPER::new(@_);
+
+  # This prevents the caching of $dbh in S::A::L, I believe
+  # If limit_dialect is a ref (like a $dbh), go ahead and replace
+  #   it with what it resolves to:
+  $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
+    if ref $self->{limit_dialect};
+
+  $self;
+}
+
+
+
+# Some databases (sqlite) do not handle multiple parenthesis
+# around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
+# is interpreted as x IN 1 or something similar.
+#
+# Since we currently do not have access to the SQLA AST, resort
+# to barbaric mutilation of any SQL supplied in literal form
+
+sub _strip_outer_paren {
+  my ($self, $arg) = @_;
+
+  return $self->_SWITCH_refkind ($arg, {
+    ARRAYREFREF => sub {
+      $$arg->[0] = __strip_outer_paren ($$arg->[0]);
+      return $arg;
+    },
+    SCALARREF => sub {
+      return \__strip_outer_paren( $$arg );
+    },
+    FALLBACK => sub {
+      return $arg
+    },
+  });
+}
+
+sub __strip_outer_paren {
+  my $sql = shift;
+
+  if ($sql and not ref $sql) {
+    while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
+      $sql = $1;
+    }
+  }
+
+  return $sql;
+}
+
+sub _where_field_IN {
+  my ($self, $lhs, $op, $rhs) = @_;
+  $rhs = $self->_strip_outer_paren ($rhs);
+  return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
+}
+
+sub _where_field_BETWEEN {
+  my ($self, $lhs, $op, $rhs) = @_;
+  $rhs = $self->_strip_outer_paren ($rhs);
+  return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
+}
+
+
+
+# DB2 is the only remaining DB using this. Even though we are not sure if
+# RowNumberOver is still needed here (should be part of SQLA) leave the 
+# code in place
+sub _RowNumberOver {
+  my ($self, $sql, $order, $rows, $offset ) = @_;
+
+  $offset += 1;
+  my $last = $rows + $offset;
+  my ( $order_by ) = $self->_order_by( $order );
+
+  $sql = <<"SQL";
+SELECT * FROM
+(
+   SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
+      $sql
+      $order_by
+   ) Q1
+) Q2
+WHERE ROW_NUM BETWEEN $offset AND $last
+
+SQL
+
+  return $sql;
+}
+
+
+# While we're at it, this should make LIMIT queries more efficient,
+#  without digging into things too deeply
+use Scalar::Util 'blessed';
+sub _find_syntax {
+  my ($self, $syntax) = @_;
+  
+  # DB2 is the only remaining DB using this. Even though we are not sure if
+  # RowNumberOver is still needed here (should be part of SQLA) leave the 
+  # code in place
+  my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
+  if(ref($self) && $dbhname && $dbhname eq 'DB2') {
+    return 'RowNumberOver';
+  }
+  
+  $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
+}
+
+sub select {
+  my ($self, $table, $fields, $where, $order, @rest) = @_;
+  if (ref $table eq 'SCALAR') {
+    $table = $$table;
+  }
+  elsif (not ref $table) {
+    $table = $self->_quote($table);
+  }
+  local $self->{rownum_hack_count} = 1
+    if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
+  @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(
+    $table, $self->_recurse_fields($fields), $where, $order, @rest
+  );
+  $sql .= 
+    $self->{for} ?
+    (
+      $self->{for} eq 'update' ? ' FOR UPDATE' :
+      $self->{for} eq 'shared' ? ' FOR SHARE'  :
+      ''
+    ) :
+    ''
+  ;
+  return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
+}
+
+sub insert {
+  my $self = shift;
+  my $table = shift;
+  $table = $self->_quote($table) unless ref($table);
+  $self->SUPER::insert($table, @_);
+}
+
+sub update {
+  my $self = shift;
+  my $table = shift;
+  $table = $self->_quote($table) unless ref($table);
+  $self->SUPER::update($table, @_);
+}
+
+sub delete {
+  my $self = shift;
+  my $table = shift;
+  $table = $self->_quote($table) unless ref($table);
+  $self->SUPER::delete($table, @_);
+}
+
+sub _emulate_limit {
+  my $self = shift;
+  if ($_[3] == -1) {
+    return $_[1].$self->_order_by($_[2]);
+  } else {
+    return $self->SUPER::_emulate_limit(@_);
+  }
+}
+
+sub _recurse_fields {
+  my ($self, $fields, $params) = @_;
+  my $ref = ref $fields;
+  return $self->_quote($fields) unless $ref;
+  return $$fields if $ref eq 'SCALAR';
+
+  if ($ref eq 'ARRAY') {
+    return join(', ', map {
+      $self->_recurse_fields($_)
+        .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
+          ? ' AS col'.$self->{rownum_hack_count}++
+          : '')
+      } @$fields);
+  } elsif ($ref eq 'HASH') {
+    foreach my $func (keys %$fields) {
+      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 );
+  }
+  else {
+    Carp::croak($ref . qq{ unexpected in _recurse_fields()})
+  }
+}
+
+sub _order_by {
+  my $self = shift;
+  my $ret = '';
+  my @extra;
+  if (ref $_[0] eq 'HASH') {
+    if (defined $_[0]->{group_by}) {
+      $ret = $self->_sqlcase(' group by ')
+        .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
+    }
+    if (defined $_[0]->{having}) {
+      my $frag;
+      ($frag, @extra) = $self->_recurse_where($_[0]->{having});
+      push(@{$self->{having_bind}}, @extra);
+      $ret .= $self->_sqlcase(' having ').$frag;
+    }
+    if (defined $_[0]->{order_by}) {
+      $ret .= $self->_order_by($_[0]->{order_by});
+    }
+    if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
+      return $self->SUPER::_order_by($_[0]);
+    }
+  } elsif (ref $_[0] eq 'SCALAR') {
+    $ret = $self->_sqlcase(' order by ').${ $_[0] };
+  } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
+    my @order = @{+shift};
+    $ret = $self->_sqlcase(' order by ')
+          .join(', ', map {
+                        my $r = $self->_order_by($_, @_);
+                        $r =~ s/^ ?ORDER BY //i;
+                        $r;
+                      } @order);
+  } else {
+    $ret = $self->SUPER::_order_by(@_);
+  }
+  return $ret;
+}
+
+sub _order_directions {
+  my ($self, $order) = @_;
+  $order = $order->{order_by} if ref $order eq 'HASH';
+  return $self->SUPER::_order_directions($order);
+}
+
+sub _table {
+  my ($self, $from) = @_;
+  if (ref $from eq 'ARRAY') {
+    return $self->_recurse_from(@$from);
+  } elsif (ref $from eq 'HASH') {
+    return $self->_make_as($from);
+  } else {
+    return $from; # would love to quote here but _table ends up getting called
+                  # twice during an ->select without a limit clause due to
+                  # the way S::A::Limit->select works. should maybe consider
+                  # bypassing this and doing S::A::select($self, ...) in
+                  # our select method above. meantime, quoting shims have
+                  # been added to select/insert/update/delete here
+  }
+}
+
+sub _recurse_from {
+  my ($self, $from, @join) = @_;
+  my @sqlf;
+  push(@sqlf, $self->_make_as($from));
+  foreach my $j (@join) {
+    my ($to, $on) = @$j;
+
+    # check whether a join type exists
+    my $join_clause = '';
+    my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
+    if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
+      $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
+    } else {
+      $join_clause = ' JOIN ';
+    }
+    push(@sqlf, $join_clause);
+
+    if (ref $to eq 'ARRAY') {
+      push(@sqlf, '(', $self->_recurse_from(@$to), ')');
+    } else {
+      push(@sqlf, $self->_make_as($to));
+    }
+    push(@sqlf, ' ON ', $self->_join_condition($on));
+  }
+  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 _make_as {
+  my ($self, $from) = @_;
+  return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ 
+                        : ref $_ eq 'REF'    ? $self->_bind_to_sql($_) 
+                        : $self->_quote($_)) 
+                       } reverse each %{$self->_skip_options($from)});
+}
+
+sub _skip_options {
+  my ($self, $hash) = @_;
+  my $clean_hash = {};
+  $clean_hash->{$_} = $hash->{$_}
+    for grep {!/^-/} keys %$hash;
+  return $clean_hash;
+}
+
+sub _join_condition {
+  my ($self, $cond) = @_;
+  if (ref $cond eq 'HASH') {
+    my %j;
+    for (keys %$cond) {
+      my $v = $cond->{$_};
+      if (ref $v) {
+        # XXX no throw_exception() in this package and croak() fails with strange results
+        Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
+            if ref($v) ne 'SCALAR';
+        $j{$_} = $v;
+      }
+      else {
+        my $x = '= '.$self->_quote($v); $j{$_} = \$x;
+      }
+    };
+    return scalar($self->_recurse_where(\%j));
+  } elsif (ref $cond eq 'ARRAY') {
+    return join(' OR ', map { $self->_join_condition($_) } @$cond);
+  } else {
+    die "Can't handle this yet!";
+  }
+}
+
+sub _quote {
+  my ($self, $label) = @_;
+  return '' unless defined $label;
+  return "*" if $label eq '*';
+  return $label unless $self->{quote_char};
+  if(ref $self->{quote_char} eq "ARRAY"){
+    return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
+      if !defined $self->{name_sep};
+    my $sep = $self->{name_sep};
+    return join($self->{name_sep},
+        map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1]  }
+       split(/\Q$sep\E/,$label));
+  }
+  return $self->SUPER::_quote($label);
+}
+
+sub limit_dialect {
+    my $self = shift;
+    $self->{limit_dialect} = shift if @_;
+    return $self->{limit_dialect};
+}
+
+sub quote_char {
+    my $self = shift;
+    $self->{quote_char} = shift if @_;
+    return $self->{quote_char};
+}
+
+sub name_sep {
+    my $self = shift;
+    $self->{name_sep} = shift if @_;
+    return $self->{name_sep};
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::SQLAHacks - Things desired to be merged into SQL::Abstract
+
+=head1 METHODS
+
+=head2 new
+
+Tries to determine limit dialect.
+
+=head2 select
+
+Quotes table names, handles "limit" dialects (e.g. where rownum between x and
+y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
+
+=head2 insert update delete
+
+Just quotes table names.
+
+=head2 limit_dialect
+
+Specifies the dialect of used for implementing an SQL "limit" clause for
+restricting the number of query results returned.  Valid values are: RowNum.
+
+See L<DBIx::Class::Storage::DBI/connect_info> for details.
+
+=head2 name_sep
+
+Character separating quoted table names.
+
+See L<DBIx::Class::Storage::DBI/connect_info> for details.
+
+=head2 quote_char
+
+Set to an array-ref to specify separate left and right quotes for table names.
+
+See L<DBIx::Class::Storage::DBI/connect_info> for details.
+
+=cut
+
diff --git a/lib/DBIx/Class/SQLAHacks/OracleJoins.pm b/lib/DBIx/Class/SQLAHacks/OracleJoins.pm
new file mode 100644 (file)
index 0000000..c9ca81d
--- /dev/null
@@ -0,0 +1,170 @@
+package # Hide from PAUSE
+DBIx::Class::SQLAHacks::OracleJoins;
+
+use base qw( DBIx::Class::SQLAHacks );
+
+sub select {
+  my ($self, $table, $fields, $where, $order, @rest) = @_;
+
+  if (ref($table) eq 'ARRAY') {
+    $where = $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) = @_;
+  my $join_where = {};
+  $self->_recurse_oracle_joins($join_where, $from, @join);
+  if (keys %$join_where) {
+    if (!defined($where)) {
+      $where = $join_where;
+    } else {
+      if (ref($where) eq 'ARRAY') {
+        $where = { -or => $where };
+      }
+      $where = { -and => [ $join_where, $where ] };
+    }
+  }
+  return $where;
+}
+
+sub _recurse_oracle_joins {
+  my ($self, $where, $from, @join) = @_;
+
+  foreach my $j (@join) {
+    my ($to, $on) = @{ $j };
+
+    if (ref $to eq 'ARRAY') {
+      $self->_recurse_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} =~ /left/i
+        && $to_jt->{-join_type} !~ /inner/i;
+
+      $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
+        && $to_jt->{-join_type} !~ /inner/i;
+    }
+
+    foreach my $lhs (keys %{ $on }) {
+      $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join";
+    }
+  }
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::SQLAHacks::OracleJoins - Pre-ANSI Joins-via-Where-Clause Syntax
+
+=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
+
+Not intended for use directly; used as the sql_maker_class for schemas and components.
+
+=head1 DESCRIPTION
+
+Implements pre-ANSI joins specified in the where clause.  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
+
+=over
+
+=item select ($\@$;$$@)
+
+Replaces DBIx::Class::SQLAHacks'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<DBIx::Class::Storage::DBI::Oracle::WhereJoins> - Storage class using this
+
+=item L<DBIx::Class::SQLAHacks> - Parent module
+
+=item L<DBIx::Class> - Duh
+
+=back
+
+=head1 AUTHOR
+
+Justin Wheeler C<< <jwheeler@datademons.com> >>
+
+=head1 CONTRIBUTORS
+
+David Jack Olrik C<< <djo@cpan.org> >>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
+
+=cut
+
index eb87d4f..a38cf47 100644 (file)
@@ -328,7 +328,7 @@ sub txn_scope_guard {
 =head2 sql_maker
 
 Returns a C<sql_maker> object - normally an object of class
-C<DBIC::SQL::Abstract>.
+C<DBIx::Class::SQLAHacks>.
 
 =cut
 
index e4f5c49..7cb026d 100644 (file)
@@ -7,7 +7,7 @@ use strict;
 use warnings;
 use Carp::Clan qw/^DBIx::Class/;
 use DBI;
-use SQL::Abstract::Limit;
+use DBIx::Class::SQLAHacks;
 use DBIx::Class::Storage::DBI::Cursor;
 use DBIx::Class::Storage::Statistics;
 use Scalar::Util qw/blessed weaken/;
@@ -29,378 +29,8 @@ __PACKAGE__->mk_group_accessors('simple' => @storage_options);
 __PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
 
 __PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/);
-__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks');
 
-BEGIN {
-
-package # Hide from PAUSE
-  DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
-
-use base qw/SQL::Abstract::Limit/;
-
-sub new {
-  my $self = shift->SUPER::new(@_);
-
-  # This prevents the caching of $dbh in S::A::L, I believe
-  # If limit_dialect is a ref (like a $dbh), go ahead and replace
-  #   it with what it resolves to:
-  $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
-    if ref $self->{limit_dialect};
-
-  $self;
-}
-
-
-
-# Some databases (sqlite) do not handle multiple parenthesis
-# around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
-# is interpreted as x IN 1 or something similar.
-#
-# Since we currently do not have access to the SQLA AST, resort
-# to barbaric mutilation of any SQL supplied in literal form
-
-sub _strip_outer_paren {
-  my ($self, $arg) = @_;
-
-  return $self->_SWITCH_refkind ($arg, {
-    ARRAYREFREF => sub {
-      $$arg->[0] = __strip_outer_paren ($$arg->[0]);
-      return $arg;
-    },
-    SCALARREF => sub {
-      return \__strip_outer_paren( $$arg );
-    },
-    FALLBACK => sub {
-      return $arg
-    },
-  });
-}
-
-sub __strip_outer_paren {
-  my $sql = shift;
-
-  if ($sql and not ref $sql) {
-    while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
-      $sql = $1;
-    }
-  }
-
-  return $sql;
-}
-
-sub _where_field_IN {
-  my ($self, $lhs, $op, $rhs) = @_;
-  $rhs = $self->_strip_outer_paren ($rhs);
-  return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
-}
-
-sub _where_field_BETWEEN {
-  my ($self, $lhs, $op, $rhs) = @_;
-  $rhs = $self->_strip_outer_paren ($rhs);
-  return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
-}
-
-
-
-# DB2 is the only remaining DB using this. Even though we are not sure if
-# RowNumberOver is still needed here (should be part of SQLA) leave the 
-# code in place
-sub _RowNumberOver {
-  my ($self, $sql, $order, $rows, $offset ) = @_;
-
-  $offset += 1;
-  my $last = $rows + $offset;
-  my ( $order_by ) = $self->_order_by( $order );
-
-  $sql = <<"SQL";
-SELECT * FROM
-(
-   SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
-      $sql
-      $order_by
-   ) Q1
-) Q2
-WHERE ROW_NUM BETWEEN $offset AND $last
-
-SQL
-
-  return $sql;
-}
-
-
-# While we're at it, this should make LIMIT queries more efficient,
-#  without digging into things too deeply
-use Scalar::Util 'blessed';
-sub _find_syntax {
-  my ($self, $syntax) = @_;
-  
-  # DB2 is the only remaining DB using this. Even though we are not sure if
-  # RowNumberOver is still needed here (should be part of SQLA) leave the 
-  # code in place
-  my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
-  if(ref($self) && $dbhname && $dbhname eq 'DB2') {
-    return 'RowNumberOver';
-  }
-  
-  $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
-}
-
-sub select {
-  my ($self, $table, $fields, $where, $order, @rest) = @_;
-  if (ref $table eq 'SCALAR') {
-    $table = $$table;
-  }
-  elsif (not ref $table) {
-    $table = $self->_quote($table);
-  }
-  local $self->{rownum_hack_count} = 1
-    if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
-  @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(
-    $table, $self->_recurse_fields($fields), $where, $order, @rest
-  );
-  $sql .= 
-    $self->{for} ?
-    (
-      $self->{for} eq 'update' ? ' FOR UPDATE' :
-      $self->{for} eq 'shared' ? ' FOR SHARE'  :
-      ''
-    ) :
-    ''
-  ;
-  return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
-}
-
-sub insert {
-  my $self = shift;
-  my $table = shift;
-  $table = $self->_quote($table) unless ref($table);
-  $self->SUPER::insert($table, @_);
-}
-
-sub update {
-  my $self = shift;
-  my $table = shift;
-  $table = $self->_quote($table) unless ref($table);
-  $self->SUPER::update($table, @_);
-}
-
-sub delete {
-  my $self = shift;
-  my $table = shift;
-  $table = $self->_quote($table) unless ref($table);
-  $self->SUPER::delete($table, @_);
-}
-
-sub _emulate_limit {
-  my $self = shift;
-  if ($_[3] == -1) {
-    return $_[1].$self->_order_by($_[2]);
-  } else {
-    return $self->SUPER::_emulate_limit(@_);
-  }
-}
-
-sub _recurse_fields {
-  my ($self, $fields, $params) = @_;
-  my $ref = ref $fields;
-  return $self->_quote($fields) unless $ref;
-  return $$fields if $ref eq 'SCALAR';
-
-  if ($ref eq 'ARRAY') {
-    return join(', ', map {
-      $self->_recurse_fields($_)
-        .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
-          ? ' AS col'.$self->{rownum_hack_count}++
-          : '')
-      } @$fields);
-  } elsif ($ref eq 'HASH') {
-    foreach my $func (keys %$fields) {
-      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 );
-  }
-  else {
-    Carp::croak($ref . qq{ unexpected in _recurse_fields()})
-  }
-}
-
-sub _order_by {
-  my $self = shift;
-  my $ret = '';
-  my @extra;
-  if (ref $_[0] eq 'HASH') {
-    if (defined $_[0]->{group_by}) {
-      $ret = $self->_sqlcase(' group by ')
-        .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
-    }
-    if (defined $_[0]->{having}) {
-      my $frag;
-      ($frag, @extra) = $self->_recurse_where($_[0]->{having});
-      push(@{$self->{having_bind}}, @extra);
-      $ret .= $self->_sqlcase(' having ').$frag;
-    }
-    if (defined $_[0]->{order_by}) {
-      $ret .= $self->_order_by($_[0]->{order_by});
-    }
-    if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
-      return $self->SUPER::_order_by($_[0]);
-    }
-  } elsif (ref $_[0] eq 'SCALAR') {
-    $ret = $self->_sqlcase(' order by ').${ $_[0] };
-  } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
-    my @order = @{+shift};
-    $ret = $self->_sqlcase(' order by ')
-          .join(', ', map {
-                        my $r = $self->_order_by($_, @_);
-                        $r =~ s/^ ?ORDER BY //i;
-                        $r;
-                      } @order);
-  } else {
-    $ret = $self->SUPER::_order_by(@_);
-  }
-  return $ret;
-}
-
-sub _order_directions {
-  my ($self, $order) = @_;
-  $order = $order->{order_by} if ref $order eq 'HASH';
-  return $self->SUPER::_order_directions($order);
-}
-
-sub _table {
-  my ($self, $from) = @_;
-  if (ref $from eq 'ARRAY') {
-    return $self->_recurse_from(@$from);
-  } elsif (ref $from eq 'HASH') {
-    return $self->_make_as($from);
-  } else {
-    return $from; # would love to quote here but _table ends up getting called
-                  # twice during an ->select without a limit clause due to
-                  # the way S::A::Limit->select works. should maybe consider
-                  # bypassing this and doing S::A::select($self, ...) in
-                  # our select method above. meantime, quoting shims have
-                  # been added to select/insert/update/delete here
-  }
-}
-
-sub _recurse_from {
-  my ($self, $from, @join) = @_;
-  my @sqlf;
-  push(@sqlf, $self->_make_as($from));
-  foreach my $j (@join) {
-    my ($to, $on) = @$j;
-
-    # check whether a join type exists
-    my $join_clause = '';
-    my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
-    if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
-      $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
-    } else {
-      $join_clause = ' JOIN ';
-    }
-    push(@sqlf, $join_clause);
-
-    if (ref $to eq 'ARRAY') {
-      push(@sqlf, '(', $self->_recurse_from(@$to), ')');
-    } else {
-      push(@sqlf, $self->_make_as($to));
-    }
-    push(@sqlf, ' ON ', $self->_join_condition($on));
-  }
-  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 _make_as {
-  my ($self, $from) = @_;
-  return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ 
-                        : ref $_ eq 'REF'    ? $self->_bind_to_sql($_) 
-                        : $self->_quote($_)) 
-                       } reverse each %{$self->_skip_options($from)});
-}
-
-sub _skip_options {
-  my ($self, $hash) = @_;
-  my $clean_hash = {};
-  $clean_hash->{$_} = $hash->{$_}
-    for grep {!/^-/} keys %$hash;
-  return $clean_hash;
-}
-
-sub _join_condition {
-  my ($self, $cond) = @_;
-  if (ref $cond eq 'HASH') {
-    my %j;
-    for (keys %$cond) {
-      my $v = $cond->{$_};
-      if (ref $v) {
-        # XXX no throw_exception() in this package and croak() fails with strange results
-        Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
-            if ref($v) ne 'SCALAR';
-        $j{$_} = $v;
-      }
-      else {
-        my $x = '= '.$self->_quote($v); $j{$_} = \$x;
-      }
-    };
-    return scalar($self->_recurse_where(\%j));
-  } elsif (ref $cond eq 'ARRAY') {
-    return join(' OR ', map { $self->_join_condition($_) } @$cond);
-  } else {
-    die "Can't handle this yet!";
-  }
-}
-
-sub _quote {
-  my ($self, $label) = @_;
-  return '' unless defined $label;
-  return "*" if $label eq '*';
-  return $label unless $self->{quote_char};
-  if(ref $self->{quote_char} eq "ARRAY"){
-    return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
-      if !defined $self->{name_sep};
-    my $sep = $self->{name_sep};
-    return join($self->{name_sep},
-        map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1]  }
-       split(/\Q$sep\E/,$label));
-  }
-  return $self->SUPER::_quote($label);
-}
-
-sub limit_dialect {
-    my $self = shift;
-    $self->{limit_dialect} = shift if @_;
-    return $self->{limit_dialect};
-}
-
-sub quote_char {
-    my $self = shift;
-    $self->{quote_char} = shift if @_;
-    return $self->{quote_char};
-}
-
-sub name_sep {
-    my $self = shift;
-    $self->{name_sep} = shift if @_;
-    return $self->{name_sep};
-}
-
-} # End of BEGIN block
 
 =head1 NAME
 
@@ -1976,37 +1606,6 @@ cases if you choose the C<< AutoCommit => 0 >> path, just as you would
 be with raw DBI.
 
 
-=head1 SQL METHODS
-
-The module defines a set of methods within the DBIC::SQL::Abstract
-namespace.  These build on L<SQL::Abstract::Limit> to provide the
-SQL query functions.
-
-The following methods are extended:-
-
-=over 4
-
-=item delete
-
-=item insert
-
-=item select
-
-=item update
-
-=item limit_dialect
-
-See L</connect_info> for details.
-
-=item quote_char
-
-See L</connect_info> for details.
-
-=item name_sep
-
-See L</connect_info> for details.
-
-=back
 
 =head1 AUTHORS
 
index 730c73b..d4e7385 100644 (file)
@@ -5,94 +5,7 @@ use base qw( DBIx::Class::Storage::DBI::Oracle::Generic );
 use strict;
 use warnings;
 
-__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract::Oracle');
-
-BEGIN {
-  package # Hide from PAUSE
-    DBIC::SQL::Abstract::Oracle;
-
-  use base qw( DBIC::SQL::Abstract );
-
-  sub select {
-    my ($self, $table, $fields, $where, $order, @rest) = @_;
-
-    if (ref($table) eq 'ARRAY') {
-      $where = $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) = @_;
-    my $join_where = {};
-    $self->_recurse_oracle_joins($join_where, $from, @join);
-    if (keys %$join_where) {
-      if (!defined($where)) {
-        $where = $join_where;
-      } else {
-        if (ref($where) eq 'ARRAY') {
-          $where = { -or => $where };
-        }
-        $where = { -and => [ $join_where, $where ] };
-      }
-    }
-    return $where;
-  }
-
-  sub _recurse_oracle_joins {
-    my ($self, $where, $from, @join) = @_;
-
-    foreach my $j (@join) {
-      my ($to, $on) = @{ $j };
-
-      if (ref $to eq 'ARRAY') {
-        $self->_recurse_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} =~ /left/i
-                             && $to_jt->{-join_type} !~ /inner/i;
-
-        $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
-                             && $to_jt->{-join_type} !~ /inner/i;
-      }
-
-      foreach my $lhs (keys %{ $on }) {
-        $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join";
-      }
-    }
-  }
-}
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::OracleJoins');
 
 1;
 
@@ -135,33 +48,7 @@ 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
+See L<DBIx::Class::SQLAHacks::OracleJoins> for implementation details.
 
 =head1 BUGS
 
@@ -172,7 +59,9 @@ Probably lots more.
 
 =over
 
-=item L<DBIC::SQL::Abstract>
+=item L<DBIx::Class::SQLAHacks>
+
+=item L<DBIx::Class::SQLAHacks::OracleJoins>
 
 =item L<DBIx::Class::Storage::DBI::Oracle::Generic>
 
index 660ee40..8c91929 100644 (file)
@@ -2,14 +2,14 @@ use strict;
 use warnings;
 
 use Test::More;
-use DBIx::Class::Storage::DBI::Oracle::WhereJoins;
+use DBIx::Class::SQLAHacks::OracleJoins;
 
 use lib qw(t/lib);
 use DBIC::SqlMakerTest;
 
 plan tests => 4;
 
-my $sa = new DBIC::SQL::Abstract::Oracle;
+my $sa = new DBIx::Class::SQLAHacks::OracleJoins;
 
 $sa->limit_dialect('RowNum');
 
index 4fad29c..5ad3c9f 100644 (file)
@@ -6,7 +6,7 @@ use DBIx::Class::Storage::DBI;
 \r
 plan tests => 1;\r
 \r
-my $sa = new DBIC::SQL::Abstract;\r
+my $sa = new DBIx::Class::SQLAHacks;\r
 \r
 $sa->limit_dialect( 'Top' );\r
 \r
index 39a51d3..23336b8 100644 (file)
@@ -33,7 +33,7 @@ if( $schema->storage->dbh->get_info(17) eq 'SQLite' &&
 }
 
 # test the abstract join => SQL generator
-my $sa = new DBIC::SQL::Abstract;
+my $sa = new DBIx::Class::SQLAHacks;
 
 my @j = (
     { child => 'person' },