X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLAHacks.pm;h=9fb3c242788171545f05d1ab233bfbcfb1d9e4f7;hb=b88b85e73de8ca03cfd1f7bc2ee43d6403302986;hp=e57e926c2d119a390b65ac1e6edc2fd7b0f1bcc6;hpb=6f4ddea126a20d67bc599a804d097ed8d3c086aa;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index e57e926..9fb3c24 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -1,9 +1,8 @@ - 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 Carp::Clan qw/^DBIx::Class/; sub new { my $self = shift->SUPER::new(@_); @@ -18,7 +17,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. @@ -114,6 +112,9 @@ sub _find_syntax { sub select { my ($self, $table, $fields, $where, $order, @rest) = @_; + local $self->{having_bind} = []; + local $self->{from_bind} = []; + if (ref $table eq 'SCALAR') { $table = $$table; } @@ -123,10 +124,9 @@ 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 - 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 +138,7 @@ sub select { ) : '' ; - return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql; + return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql; } sub insert { @@ -186,16 +186,33 @@ sub _recurse_fields { } @$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) { + croak "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()}) + croak($ref . qq{ unexpected in _recurse_fields()}) } } @@ -285,19 +302,18 @@ sub _recurse_from { 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)}); } @@ -316,8 +332,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; } @@ -375,7 +390,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