eol adjustments

[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / SQLAHacks.pm

diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm
index d2f96bf..b38dbf5 100644 (file)
--- a/lib/DBIx/Class/SQLAHacks.pm
+++ b/lib/DBIx/Class/SQLAHacks.pm
@@ -1,7 +1,9 @@
 package # Hide from PAUSE
-  DBIx::Class::SQLAHacks; # Would merge upstream, but nate doesn't reply :(
+  DBIx::Class::SQLAHacks;
 
 use base qw/SQL::Abstract::Limit/;
+use strict;
+use warnings;
 use Carp::Clan qw/^DBIx::Class/;
 
 sub new {
@@ -17,7 +19,6 @@ sub new {
 }
 
 
-
 # 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.
@@ -75,7 +76,7 @@ sub _RowNumberOver {
   my ($self, $sql, $order, $rows, $offset ) = @_;
 
   $offset += 1;
-  my $last = $rows + $offset;
+  my $last = $rows + $offset - 1;
   my ( $order_by ) = $self->_order_by( $order );
 
   $sql = <<"SQL";
@@ -104,8 +105,10 @@ sub _find_syntax {
   # 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';
+  if(ref($self) && $dbhname) {
+    if ($dbhname eq 'DB2') {
+      return 'RowNumberOver';
+    }
   }
   
   $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
@@ -125,7 +128,7 @@ sub select {
   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;
+  croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
     # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
   my ($sql, @where_bind) = $self->SUPER::select(
     $table, $self->_recurse_fields($fields), $where, $order, @rest
@@ -190,20 +193,20 @@ sub _recurse_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 }";
+          croak (
+            'The select => { distinct => ... } syntax is not supported for multiple columns.'
+           .' Instead 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 }";
+          carp (
+            'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
+           ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
+          );
         }
       }
-      
       return $self->_sqlcase($func)
         .'( '.$self->_recurse_fields($fields->{$func}).' )';
     }
@@ -213,7 +216,7 @@ sub _recurse_fields {
     return $self->_fold_sqlbind( $fields );
   }
   else {
-    Carp::croak($ref . qq{ unexpected in _recurse_fields()})
+    croak($ref . qq{ unexpected in _recurse_fields()})
   }
 }
 
@@ -257,9 +260,41 @@ sub _order_by {
 sub _order_directions {
   my ($self, $order) = @_;
   $order = $order->{order_by} if ref $order eq 'HASH';
+  if (ref $order eq 'HASH') {
+    $order = [$self->_order_directions_hash($order)];
+  } elsif (ref $order eq 'ARRAY') {
+    $order = [map {
+      if (ref $_ eq 'HASH') {
+        $self->_order_directions_hash($_);
+      } else {
+        $_;
+      }
+    } @{ $order }];
+  }
   return $self->SUPER::_order_directions($order);
 }
 
+sub _order_directions_hash {
+  my ($self, $order) = @_;
+  my @new_order;
+  foreach my $key (keys %{ $order }) {
+    if ($key =~ /^-(desc|asc)/i ) {
+      my $direction = $1;
+      my $type = ref $order->{ $key };
+      if ($type eq 'ARRAY') {
+        push @new_order, map( "$_ $direction", @{ $order->{ $key } } );
+      } elsif (!$type) {
+        push @new_order, "$order->{$key} $direction";
+      } else {
+        croak "hash order_by can only contain Scalar or Array, not $type";
+      }
+    } else {
+      croak "$key is not a valid direction, use -asc or -desc";
+    }
+  }
+  return @new_order;
+}
+
 sub _table {
   my ($self, $from) = @_;
   if (ref $from eq 'ARRAY') {
@@ -305,8 +340,11 @@ sub _recurse_from {
 
 sub _fold_sqlbind {
   my ($self, $sqlbind) = @_;
-  my $sql = shift @$$sqlbind;
-  push @{$self->{from_bind}}, @$$sqlbind;
+
+  my @sqlbind = @$$sqlbind; # copy
+  my $sql = shift @sqlbind;
+  push @{$self->{from_bind}}, @sqlbind;
+
   return $sql;
 }
 
@@ -333,8 +371,7 @@ sub _join_condition {
     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'})
+        croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
             if ref($v) ne 'SCALAR';
         $j{$_} = $v;
       }
@@ -392,7 +429,9 @@ __END__
 
 =head1 NAME
 
-DBIx::Class::SQLAHacks - Things desired to be merged into SQL::Abstract
+DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
+and includes a number of DBIC-specific workarounds, not yet suitable for
+inclusion into SQLA proper.
 
 =head1 METHODS