use Scalar::Util();
use List::Util();
use Data::Dumper::Concise();
+use Sub::Name ();
# what version of sqlt do we require if deploy() without a ddl_dir is invoked
# when changing also adjust the corresponding author_require in Makefile.PL
no strict qw/refs/;
no warnings qw/redefine/;
- *{__PACKAGE__ ."::$meth"} = sub {
+ *{__PACKAGE__ ."::$meth"} = Sub::Name::subname $meth => sub {
if (not $_[0]->_driver_determined) {
$_[0]->_determine_driver;
goto $_[0]->can($meth);
return $self->_execute('delete' => [], $source, $bind_attrs, @args);
}
-# Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
-# a condition containing 'me' or other table prefixes will not work
-# at all. What this code tries to do (badly) is introspect the condition
-# and remove all column qualifiers. If it bails out early (returns undef)
-# the calling code should try another approach (e.g. a subquery)
-sub _strip_cond_qualifiers {
- my ($self, $where) = @_;
-
- my $cond = {};
-
- # No-op. No condition, we're updating/deleting everything
- return $cond unless $where;
-
- if (ref $where eq 'ARRAY') {
- $cond = [
- map {
- my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }
- \%hash;
- } @$where
- ];
- }
- elsif (ref $where eq 'HASH') {
- if ( (keys %$where) == 1 && ( (keys %{$where})[0] eq '-and' )) {
- $cond->{-and} = [];
- my @cond = @{$where->{-and}};
- for (my $i = 0; $i < @cond; $i++) {
- my $entry = $cond[$i];
- my $hash;
- if (ref $entry eq 'HASH') {
- $hash = $self->_strip_cond_qualifiers($entry);
- }
- else {
- $entry =~ /([^.]+)$/;
- $hash->{$1} = $cond[++$i];
- }
- push @{$cond->{-and}}, $hash;
- }
- }
- else {
- foreach my $key (keys %$where) {
- $key =~ /([^.]+)$/;
- $cond->{$1} = $where->{$key};
- }
- }
- }
- else {
- return undef;
- }
-
- return $cond;
-}
-
# We were sent here because the $rs contains a complex search
# which will require a subquery to select the correct rows
# (i.e. joined or limited resultsets, or non-introspectable conditions)
my $rsrc = $rs->result_source;
+ # quick check if we got a sane rs on our hands
my @pcols = $rsrc->primary_columns;
+ unless (@pcols) {
+ $self->throw_exception (
+ sprintf (
+ "You must declare primary key(s) on source '%s' (via set_primary_key) in order to update or delete complex resultsets",
+ $rsrc->source_name || $rsrc->from
+ )
+ );
+ }
+
+ my $sel = $rs->_resolved_attrs->{select};
+ $sel = [ $sel ] unless ref $sel eq 'ARRAY';
+
+ if (
+ join ("\x00", map { join '.', $rs->{attrs}{alias}, $_ } sort @pcols)
+ ne
+ join ("\x00", sort @$sel )
+ ) {
+ $self->throw_exception (
+ '_subq_update_delete can not be called on resultsets selecting columns other than the primary keys'
+ );
+ }
if (@pcols == 1) {
return $self->$op (
if (
( $attrs->{rows} && keys %{$attrs->{collapse}} )
||
- ( $attrs->{group_by} && @{$attrs->{group_by}} &&
- $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} )
+ ( $attrs->{group_by}
+ &&
+ @{$attrs->{group_by}}
+ &&
+ $attrs->{_prefetch_select}
+ &&
+ @{$attrs->{_prefetch_select}}
+ )
) {
+
($ident, $select, $where, $attrs)
= $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
}
+
+ elsif (
+ ($attrs->{rows} || $attrs->{offset})
+ &&
+ $sql_maker->limit_dialect eq 'RowNumberOver'
+ &&
+ (ref $ident eq 'ARRAY' && @$ident > 1) # indicates a join
+ &&
+ scalar $sql_maker->_order_by_chunks ($attrs->{order_by})
+ ) {
+ # the RNO limit dialect above mangles the SQL such that the join gets lost
+ # wrap a subquery here
+
+ push @limit, delete @{$attrs}{qw/rows offset/};
+
+ my $subq = $self->_select_args_to_query (
+ $ident,
+ $select,
+ $where,
+ $attrs,
+ );
+
+ $ident = {
+ -alias => $attrs->{alias},
+ -source_handle => $ident->[0]{-source_handle},
+ $attrs->{alias} => $subq,
+ };
+
+ # all part of the subquery now
+ delete @{$attrs}{qw/order_by group_by having/};
+ $where = undef;
+ }
+
elsif (! $attrs->{software_limit} ) {
push @limit, $attrs->{rows}, $attrs->{offset};
}
This API is B<EXPERIMENTAL>, will almost definitely change in the future, and
currently only used by L<::AutoCast|DBIx::Class::Storage::DBI::AutoCast> and
-L<::Sybase|DBIx::Class::Storage::DBI::Sybase>.
+L<::Sybase::ASE|DBIx::Class::Storage::DBI::Sybase::ASE>.
The default implementation returns C<undef>, implement in your Storage driver if
you need this functionality.
data => $schema,
);
- my $ret = $tr->translate
- or $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error);
+ my @ret;
+ my $wa = wantarray;
+ if ($wa) {
+ @ret = $tr->translate;
+ }
+ else {
+ $ret[0] = $tr->translate;
+ }
+
+ $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
+ unless (@ret && defined $ret[0]);
- return $ret;
+ return $wa ? @ret : $ret[0];
}
sub deploy {
sub _sqlt_minimum_version { $minimum_sqlt_version };
}
+=head2 relname_to_table_alias
+
+=over 4
+
+=item Arguments: $relname, $join_count
+
+=back
+
+L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
+queries.
+
+This hook is to allow specific L<DBIx::Class::Storage> drivers to change the
+way these aliases are named.
+
+The default behavior is C<"$relname_$join_count" if $join_count > 1>, otherwise
+C<"$relname">.
+
+=cut
+
+sub relname_to_table_alias {
+ my ($self, $relname, $join_count) = @_;
+
+ my $alias = ($join_count && $join_count > 1 ?
+ join('_', $relname, $join_count) : $relname);
+
+ return $alias;
+}
+
sub DESTROY {
my $self = shift;