Revision history for DBIx::Class
+ - Fixed the has_many prefetch with limit/group deficiency -
+ it is now possible to select "top 5 commenters" while
+ prefetching all their comments
+ - New resultsed method count_rs, returns a ::ResultSetColumn
+ which in turn returns a single count value
+ - Even better support of count with limit
+ - count/all on related left-joined empty resultsets now correctly
+ returns 0/()
- Fixed regression when both page and offset are specified on
a resultset
- Fixed HRI returning too many empty results on multilevel
nonexisting prefetch
- - Fixed the prefetch with limit bug
- - New resultsed method count_rs, returns a ::ResultSetColumn
- which in turn returns a single count value
- make_column_dirty() now overwrites the deflated value with an
inflated one if such exists
- Fixed set_$rel with where restriction deleting rows outside
the restriction
+ - populate() returns the created objects or an arrayref of the
+ create dobjects depending on scalar vs. list context
+ - Fixed find_related on 'single' relationships - the former
+ implementation would overspecify the WHERE condition, reporting
+ no related objects when there in fact is one
+ - SQL::Translator::Parser::DBIx::Class now attaches tables to the
+ central schema object in relationship dependency order
+ - Fixed regression in set_column() preventing sourceless object
+ manipulations
+ - Fixed a bug in search_related doubling a join if the original
+ $rs already joins/prefetches the same relation
+ - Storage::DBI::connected() improvements for Oracle and Sybase
0.08107 2009-06-14 08:21:00 (UTC)
- Fix serialization regression introduced in 0.08103 (affects
- Update of numeric columns now properly uses != to determine
dirtyness instead of the usual eq
- Fixes to IC::DT tests
- - Fixed exception when undef_if_invalid and timezone are both set on
- an invalid datetime column
+ - Fixed exception when undef_if_invalid and timezone are both set
+ on an invalid datetime column
0.08104 2009-06-10 13:38:00 (UTC)
- order_by now can take \[$sql, @bind] as in
use strict;
use warnings;
use base qw/My::Schema::Result::User/;
+
+ # This line is important
+ __PACKAGE__->table('users');
sub hello
{
sub _construct_object {
my ($self, @row) = @_;
- my $info = $self->_collapse_result($self->{_attrs}{as}, \@row);
+
+ my $info = $self->_collapse_result($self->{_attrs}{as}, \@row)
+ or return ();
my @new = $self->result_class->inflate_result($self->result_source, @$info);
@new = $self->{_attrs}{record_filter}->(@new)
if exists $self->{_attrs}{record_filter};
sub _collapse_result {
my ($self, $as_proto, $row) = @_;
+ # if the first row that ever came in is totally empty - this means we got
+ # hit by a smooth^Wempty left-joined resultset. Just noop in that case
+ # instead of producing a {}
+ #
+ my $has_def;
+ for (@$row) {
+ if (defined $_) {
+ $has_def++;
+ last;
+ }
+ }
+ return undef unless $has_def;
+
my @copy = @$row;
# 'foo' => [ undef, 'foo' ]
$tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
$tmp_attrs->{as} = 'count';
+ # read the comment on top of the actual function to see what this does
+ $tmp_attrs->{from} = $self->_switch_to_inner_join_if_needed (
+ $tmp_attrs->{from}, $tmp_attrs->{alias}
+ );
+
my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
return $tmp_rs;
my $sub_attrs = { %$attrs };
- # these can not go in the subquery, and there is no point of ordering it
- delete $sub_attrs->{$_} for qw/collapse select as order_by/;
+ # extra selectors do not go in the subquery and there is no point of ordering it
+ delete $sub_attrs->{$_} for qw/collapse prefetch_select select as order_by/;
# if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all
# clobber old group_by regardless
$sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs);
+ # read the comment on top of the actual function to see what this does
+ $sub_attrs->{from} = $self->_switch_to_inner_join_if_needed (
+ $sub_attrs->{from}, $sub_attrs->{alias}
+ );
+
$attrs->{from} = [{
count_subq => $rsrc->resultset_class->new ($rsrc, $sub_attrs )->as_query
}];
}
+# The DBIC relationship chaining implementation is pretty simple - every
+# new related_relationship is pushed onto the {from} stack, and the {select}
+# window simply slides further in. This means that when we count somewhere
+# in the middle, we got to make sure that everything in the join chain is an
+# actual inner join, otherwise the count will come back with unpredictable
+# results (a resultset may be generated with _some_ rows regardless of if
+# the relation which the $rs currently selects has rows or not). E.g.
+# $artist_rs->cds->count - normally generates:
+# SELECT COUNT( * ) FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
+# which actually returns the number of artists * (number of cds || 1)
+#
+# So what we do here is crawl {from}, determine if the current alias is at
+# the top of the stack, and if not - make sure the chain is inner-joined down
+# to the root.
+#
+sub _switch_to_inner_join_if_needed {
+ my ($self, $from, $alias) = @_;
+
+ return $from if (
+ ref $from ne 'ARRAY'
+ ||
+ ref $from->[0] ne 'HASH'
+ ||
+ ! $from->[0]{-alias}
+ ||
+ $from->[0]{-alias} eq $alias
+ );
+
+ # this would be the case with a subquery - we'll never find
+ # the target as it is not in the parseable part of {from}
+ return $from if @$from == 1;
+
+ my $switch_branch;
+ JOINSCAN:
+ for my $j (@{$from}[1 .. $#$from]) {
+ if ($j->[0]{-alias} eq $alias) {
+ $switch_branch = $j->[0]{-join_path};
+ last JOINSCAN;
+ }
+ }
+
+ # something else went wrong
+ return $from unless $switch_branch;
+
+ # So it looks like we will have to switch some stuff around.
+ # local() is useless here as we will be leaving the scope
+ # anyway, and deep cloning is just too fucking expensive
+ # So replace the inner hashref manually
+ my @new_from = ($from->[0]);
+ my $sw_idx = { map { $_ => 1 } @$switch_branch };
+
+ for my $j (@{$from}[1 .. $#$from]) {
+ my $jalias = $j->[0]{-alias};
+
+ if ($sw_idx->{$jalias}) {
+ my %attrs = %{$j->[0]};
+ delete $attrs{-join_type};
+ push @new_from, [
+ \%attrs,
+ @{$j}[ 1 .. $#$j ],
+ ];
+ }
+ else {
+ push @new_from, $j;
+ }
+ }
+
+ return \@new_from;
+}
+
+
sub _bool {
return 1;
}
my @obj;
- # TODO: don't call resolve here
if (keys %{$self->_resolved_attrs->{collapse}}) {
-# if ($self->{attrs}{prefetch}) {
- # Using $self->cursor->all is really just an optimisation.
- # If we're collapsing has_many prefetches it probably makes
- # very little difference, and this is cleaner than hacking
- # _construct_object to survive the approach
+ # Using $self->cursor->all is really just an optimisation.
+ # If we're collapsing has_many prefetches it probably makes
+ # very little difference, and this is cleaner than hacking
+ # _construct_object to survive the approach
+ $self->cursor->reset;
my @row = $self->cursor->next;
while (@row) {
push(@obj, $self->_construct_object(@row));
}
$self->set_cache(\@obj) if $self->{attrs}{cache};
+
return @obj;
}
=back
Resets the resultset's cursor, so you can iterate through the elements again.
+Implicitly resets the storage cursor, so a subsequent L</next> will trigger
+another query.
=cut
# of the attributes supplied
#
# used to determine if a subquery is neccessary
+#
+# supports some virtual attributes:
+# -join
+# This will scan for any joins being present on the resultset.
+# It is not a mere key-search but a deep inspection of {from}
+#
sub _has_resolved_attr {
my ($self, @attr_names) = @_;
my $attrs = $self->_resolved_attrs;
- my $join_check_req;
+ my %extra_checks;
for my $n (@attr_names) {
- ++$join_check_req if $n eq '-join';
+ if (grep { $n eq $_ } (qw/-join/) ) {
+ $extra_checks{$n}++;
+ next;
+ }
my $attr = $attrs->{$n};
# a resolved join is expressed as a multi-level from
return 1 if (
- $join_check_req
+ $extra_checks{-join}
and
ref $attrs->{from} eq 'ARRAY'
and
"' has no such relationship $rel")
unless $rel_info;
- my ($from,$seen) = $self->_resolve_from($rel);
+ my ($from,$seen) = $self->_chain_relationship($rel);
my $join_count = $seen->{$rel};
my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
# in order to properly resolve prefetch aliases (any alias
# with a relation_chain_depth less than the depth of the
# current prefetch is not considered)
-sub _resolve_from {
+sub _chain_relationship {
my ($self, $rel) = @_;
my $source = $self->result_source;
my $attrs = $self->{attrs};
# ->_resolve_join as otherwise they get lost - captainL
my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
- push @$from, $source->_resolve_join($merged, $attrs->{alias}, $seen) if ($merged);
+ my @requested_joins = $source->_resolve_join($merged, $attrs->{alias}, $seen);
+
+ push @$from, @requested_joins;
++$seen->{-relation_chain_depth};
- push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen);
+ # if $self already had a join/prefetch specified on it, the requested
+ # $rel might very well be already included. What we do in this case
+ # is effectively a no-op (except that we bump up the chain_depth on
+ # the join in question so we could tell it *is* the search_related)
+ my $already_joined;
+
+
+ # we consider the last one thus reverse
+ for my $j (reverse @requested_joins) {
+ if ($rel eq $j->[0]{-join_path}[-1]) {
+ $j->[0]{-relation_chain_depth}++;
+ $already_joined++;
+ last;
+ }
+ }
+
+# alternative way to scan the entire chain - not backwards compatible
+# for my $j (reverse @$from) {
+# next unless ref $j eq 'ARRAY';
+# if ($j->[0]{-join_path} && $j->[0]{-join_path}[-1] eq $rel) {
+# $j->[0]{-relation_chain_depth}++;
+# $already_joined++;
+# last;
+# }
+# }
+
+ unless ($already_joined) {
+ push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen);
+ }
++$seen->{-relation_chain_depth};
: [ $attrs->{order_by} ]
);
}
- else {
- $attrs->{order_by} = [];
+
+ if ($attrs->{group_by} and ! ref $attrs->{group_by}) {
+ $attrs->{group_by} = [ $attrs->{group_by} ];
}
# If the order_by is otherwise empty - we will use this for TOP limit
my @prefetch =
$source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
- push( @{ $attrs->{select} }, map { $_->[0] } @prefetch );
- push( @{ $attrs->{as} }, map { $_->[1] } @prefetch );
+ $attrs->{prefetch_select} = [ map { $_->[0] } @prefetch ];
+ push @{ $attrs->{select} }, @{$attrs->{prefetch_select}};
+ push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
push( @{ $attrs->{order_by} }, @$prefetch_ordering );
$attrs->{_collapse_order_by} = \@$prefetch_ordering;
$rs->throw_exception("column must be supplied") unless $column;
- my $new_parent_rs = $rs->search_rs; # we don't want to mess up the original, so clone it
+ my $orig_attrs = $rs->_resolved_attrs;
+ my $new_parent_rs = $rs->search_rs;
# prefetch causes additional columns to be fetched, but we can not just make a new
# rs via the _resolved_attrs trick - we need to retain the separation between
# +select/+as and select/as. At the same time we want to preserve any joins that the
# prefetch would otherwise generate.
- my $init_attrs = $new_parent_rs->{attrs} ||= {};
- delete $init_attrs->{collapse};
- $init_attrs->{join} = $rs->_merge_attr( delete $init_attrs->{join}, delete $init_attrs->{prefetch} );
+
+ my $new_attrs = $new_parent_rs->{attrs} ||= {};
+ $new_attrs->{join} = $rs->_merge_attr( delete $new_attrs->{join}, delete $new_attrs->{prefetch} );
# If $column can be found in the 'as' list of the parent resultset, use the
# corresponding element of its 'select' list (to keep any custom column
# definition set up with 'select' or '+select' attrs), otherwise use $column
# (to create a new column definition on-the-fly).
- my $attrs = $new_parent_rs->_resolved_attrs;
- my $as_list = $attrs->{as} || [];
- my $select_list = $attrs->{select} || [];
+ my $as_list = $orig_attrs->{as} || [];
+ my $select_list = $orig_attrs->{select} || [];
my $as_index = List::Util::first { ($as_list->[$_] || "") eq $column } 0..$#$as_list;
my $select = defined $as_index ? $select_list->[$as_index] : $column;
+ # {collapse} would mean a has_many join was injected, which in turn means
+ # we need to group IF WE CAN (only if the column in question is unique)
+ if (!$new_attrs->{group_by} && keys %{$orig_attrs->{collapse}}) {
+
+ # scan for a constraint that would contain our column only - that'd be proof
+ # enough it is unique
+ my $constraints = { $rs->result_source->unique_constraints };
+ for my $constraint_columns ( values %$constraints ) {
+
+ next unless @$constraint_columns == 1;
+
+ my $col = $constraint_columns->[0];
+ my $fqcol = join ('.', $new_attrs->{alias}, $col);
+
+ if ($col eq $select or $fqcol eq $select) {
+ $new_attrs->{group_by} = [ $select ];
+ last;
+ }
+ }
+ }
+
my $new = bless { _select => $select, _as => $column, _parent_resultset => $new_parent_rs }, $class;
return $new;
}
}
return unless $f_source; # Can't test rel without f_source
- eval { $self->_resolve_join($rel, 'me') };
+ eval { $self->_resolve_join($rel, 'me', {}) };
if ($@) { # If the resolve failed, back out and re-throw the error
delete $rels{$rel}; #
$self->throw_exception("No idea how to resolve join reftype ".ref $join);
} else {
+ return() unless defined $join;
+
my $count = ++$seen->{$join};
my $as = ($count > 1 ? "${join}_${count}" : $join);
$self->store_column($column, $new_value);
my $dirty;
- if (defined $old_value xor defined $new_value) {
+ if (!$self->in_storage) { # no point tracking dirtyness on uninserted data
+ $dirty = 1;
+ }
+ elsif (defined $old_value xor defined $new_value) {
$dirty = 1;
}
elsif (not defined $old_value) { # both undef
else { # do a numeric comparison if datatype allows it
my $colinfo = $self->column_info ($column);
- # cache for speed
- if (not defined $colinfo->{is_numeric}) {
+ # cache for speed (the object may *not* have a resultsource instance)
+ if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
$colinfo->{is_numeric} =
$self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
? 1
} elsif ($accessor eq 'filter') {
$new->{_inflated_column}{$pre} = $fetched;
} else {
- $class->throw_exception("Prefetch not supported with accessor '$accessor'");
+ $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor '$accessor'");
}
$new->related_resultset($pre)->set_cache([ $fetched ]);
}
? ' AS col'.$self->{rownum_hack_count}++
: '')
} @$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 (
- '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 (
- 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
- ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
- );
- }
+ }
+ elsif ($ref eq 'HASH') {
+ my %hash = %$fields;
+ my ($select, $as);
+
+ if ($hash{-select}) {
+ $select = $self->_recurse_fields (delete $hash{-select});
+ $as = $self->_quote (delete $hash{-as});
+ }
+ else {
+ my ($func, $args) = each %hash;
+ delete $hash{$func};
+
+ if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
+ croak (
+ 'The select => { distinct => ... } syntax is not supported for multiple columns.'
+ .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
+ .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
+ );
}
- return $self->_sqlcase($func)
- .'( '.$self->_recurse_fields($fields->{$func}).' )';
+ $select = sprintf ('%s( %s )',
+ $self->_sqlcase($func),
+ $self->_recurse_fields($args)
+ );
}
+
+ # there should be nothing left
+ if (keys %hash) {
+ croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
+ }
+
+ $select .= " AS $as" if $as;
+ return $select;
}
# Is the second check absolutely necessary?
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
my $ret = '';
- if (defined $arg->{group_by}) {
- $ret = $self->_sqlcase(' group by ')
- .$self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 });
+ if (my $g = $self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }) ) {
+ $ret = $self->_sqlcase(' group by ') . $g;
}
if (defined $arg->{having}) {
$self->_verify_pid;
return 0 if !$self->_dbh;
}
- return ($dbh->FETCH('Active') && $dbh->ping);
+ return ($dbh->FETCH('Active') && $self->_ping);
}
return 0;
}
+sub _ping {
+ my $self = shift;
+
+ my $dbh = $self->_dbh or return 0;
+
+ return $dbh->ping;
+}
+
# handle pid changes correctly
# NOTE: assumes $self->_dbh is a valid $dbh
sub _verify_pid {
}
}
- my @limit;
- if ($attrs->{software_limit} ||
- $sql_maker->_default_limit_syntax eq "GenericSubQ") {
- $attrs->{software_limit} = 1;
- } else {
+ # adjust limits
+ if (
+ $attrs->{software_limit}
+ ||
+ $sql_maker->_default_limit_syntax eq "GenericSubQ"
+ ) {
+ $attrs->{software_limit} = 1;
+ }
+ else {
$self->throw_exception("rows attribute must be positive if present")
if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
# MySQL actually recommends this approach. I cringe.
$attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
+ }
- if ($attrs->{rows} && keys %{$attrs->{collapse}}) {
- ($ident, $select, $where, $attrs)
- = $self->_adjust_select_args_for_limited_prefetch ($ident, $select, $where, $attrs);
- }
- else {
- push @limit, $attrs->{rows}, $attrs->{offset};
- }
+ my @limit;
+
+ # see if we need to tear the prefetch apart (either limited has_many or grouped prefetch)
+ # otherwise delegate the limiting to the storage, unless software limit was requested
+ if (
+ ( $attrs->{rows} && keys %{$attrs->{collapse}} )
+ ||
+ ( $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->{software_limit} ) {
+ push @limit, $attrs->{rows}, $attrs->{offset};
}
###
(qw/order_by group_by having _virtual_order_by/ )
};
-
$sql_maker->{for} = delete $attrs->{for};
return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
}
-sub _adjust_select_args_for_limited_prefetch {
+sub _adjust_select_args_for_complex_prefetch {
my ($self, $from, $select, $where, $attrs) = @_;
- if ($attrs->{group_by} and @{$attrs->{group_by}}) {
- $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a group_by attribute');
- }
+ # copies for mangling
+ $from = [ @$from ];
+ $select = [ @$select ];
+ $attrs = { %$attrs };
- $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute')
+ $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
if (ref $from ne 'ARRAY');
-
# separate attributes
my $sub_attrs = { %$attrs };
- delete $attrs->{$_} for qw/where bind rows offset/;
- delete $sub_attrs->{$_} for qw/for collapse select order_by/;
+ delete $attrs->{$_} for qw/where bind rows offset group_by having/;
+ delete $sub_attrs->{$_} for qw/for collapse prefetch_select _collapse_order_by select as/;
my $alias = $attrs->{alias};
- # create subquery select list
- my $sub_select = [ grep { $_ =~ /^$alias\./ } @{$attrs->{select}} ];
+ # create subquery select list - loop only over primary columns
+ my $sub_select = [];
+ for my $i (0 .. @{$attrs->{select}} - @{$attrs->{prefetch_select}} - 1) {
+ my $sel = $attrs->{select}[$i];
+
+ # alias any functions to the dbic-side 'as' label
+ # adjust the outer select accordingly
+ if (ref $sel eq 'HASH' && !$sel->{-select}) {
+ $sel = { -select => $sel, -as => $attrs->{as}[$i] };
+ $select->[$i] = join ('.', $attrs->{alias}, $attrs->{as}[$i]);
+ }
+
+ push @$sub_select, $sel;
+ }
# bring over all non-collapse-induced order_by into the inner query (if any)
# the outer one will have to keep them all
+ delete $sub_attrs->{order_by};
if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
$sub_attrs->{order_by} = [
- @{$attrs->{order_by}}[ 0 .. ($#{$attrs->{order_by}} - $ord_cnt - 1) ]
+ @{$attrs->{order_by}}[ 0 .. $ord_cnt - 1]
];
}
# mangle {from}
- $from = [ @$from ];
my $select_root = shift @$from;
my @outer_from = @$from;
# away _any_ branches of the join tree that are:
# 1) not mentioned in the condition/order
# 2) left-join leaves (or left-join leaf chains)
- # Most of the join ocnditions will not satisfy this, but for real
+ # Most of the join conditions will not satisfy this, but for real
# complex queries some might, and we might make some RDBMS happy.
#
#
# the dot comes from some weirdness in collapse
# remove after the rewrite
if ($attrs->{collapse}{".$alias"}) {
- $sub_attrs->{group_by} = $sub_select;
+ $sub_attrs->{group_by} ||= $sub_select;
last;
}
}
my ($storage, $dbh, $self) = @_;
$self->_check_dbh_gen;
- if ($self->{attrs}{rows} && $self->{pos} >= $self->{attrs}{rows}) {
+ if (
+ $self->{attrs}{software_limit}
+ && $self->{attrs}{rows}
+ && $self->{pos} >= $self->{attrs}{rows}
+ ) {
$self->{sth}->finish if $self->{sth}->{Active};
delete $self->{sth};
$self->{done} = 1;
&& ($self->{attrs}{offset} || $self->{attrs}{rows})) {
return $self->next::method;
}
+
$self->{storage}->dbh_do($self->can('_dbh_all'), $self);
}
return $id;
}
-=head2 connected
-
-Returns true if we have an open (and working) database connection, false if it is not (yet)
-open (or does not work). (Executes a simple SELECT to make sure it works.)
-
-The reason this is needed is that L<DBD::Oracle>'s ping() does not do a real
-OCIPing but just gets the server version, which doesn't help if someone killed
-your session.
-
-=cut
-
-sub connected {
+sub _ping {
my $self = shift;
- if (not $self->next::method(@_)) {
- return 0;
- }
- else {
- my $dbh = $self->_dbh;
+ my $dbh = $self->_dbh or return 0;
- local $dbh->{RaiseError} = 1;
+ local $dbh->{RaiseError} = 1;
- eval {
- my $ping_sth = $dbh->prepare_cached("select 1 from dual");
- $ping_sth->execute;
- $ping_sth->finish;
- };
+ eval {
+ $dbh->do("select 1 from dual");
+ };
- return $@ ? 0 : 1;
- }
+ return $@ ? 0 : 1;
}
sub _dbh_execute {
use strict;
use warnings;
-
-use Class::C3;
-use base qw/DBIx::Class::Storage::DBI/;
-
+use mro 'c3';
+use base qw/
+ DBIx::Class::Storage::DBI::Sybase::Base
+ DBIx::Class::Storage::DBI
+/;
use Carp::Clan qw/^DBIx::Class/;
=head1 NAME
--- /dev/null
+package # hide from PAUSE
+ DBIx::Class::Storage::DBI::Sybase::Base;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::Base - Common functionality for drivers using
+DBD::Sybase
+
+=cut
+
+sub _ping {
+ my $self = shift;
+
+ my $dbh = $self->_dbh or return 0;
+
+ local $dbh->{RaiseError} = 1;
+ eval {
+ $dbh->do('select 1');
+ };
+
+ return $@ ? 0 : 1;
+}
+
+1;
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
use strict;
use warnings;
-
-use Class::C3;
+use mro 'c3';
use base qw/
+ DBIx::Class::Storage::DBI::Sybase::Base
DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server
DBIx::Class::Storage::DBI::NoBindVars
/;
$self->dbh->do('SET foreign_key_checks=1');
}
+sub connect_call_set_ansi_mode {
+ my $self = shift;
+ $self->dbh->do(q|SET sql_mode = 'ANSI,TRADITIONAL'|);
+ $self->dbh->do(q|SET sql_mode = 'ANSI,TRADITIONAL'|);
+}
+
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
$dbh->{mysql_insertid};
use warnings;
use Test::More;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 12 );
-}
+plan tests => 12;
use lib qw(t/lib);
my $schema = DBICTest->init_schema();
-plan tests => 106;
+plan tests => 103;
eval { require DateTime::Format::SQLite };
my $NO_DTFM = $@ ? 1 : 0;
is ($collapsed_or_rs->all, 4, 'Collapsed joined search with OR returned correct number of rows');
is ($collapsed_or_rs->count, 4, 'Collapsed search count with OR ok');
-my $pref_or_rs = $collapsed_or_rs->search ({}, { prefetch => [qw/tags/] });
-is_same_sql_bind (
- $pref_or_rs->as_query,
- '(SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, tags.tagid, tags.cd, tags.tag FROM cd me LEFT JOIN tags tags ON tags.cd = me.cdid WHERE ( ( tags.tag = ? OR tags.tag = ? ) ) GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, tags.tagid, tags.cd, tags.tag ORDER BY cdid, tags.cd, tags.tag)',
- [
- [ 'tags.tag' => 'Cheesy' ],
- [ 'tags.tag' => 'Blue' ],
- ],
- 'Prefetch + distinct resulted in correct group_by',
-);
-is ($pref_or_rs->all, 4, 'Prefetched grouped search with OR returned correct number of rows');
-is ($pref_or_rs->count, 4, 'Prefetched grouped count with OR ok');
-
-
{
my $tcount = $schema->resultset('Track')->search(
{},
}
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn);
-plan tests => 6;
+plan tests => 7;
my $schema = DBICTest::Schema->clone;
$schema->connection($dsn, $user, $pass);
-my $dbh = $schema->storage->dbh;
+# start disconnected to test reconnection
+$schema->storage->ensure_connected;
+$schema->storage->_dbh->disconnect;
isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server');
+my $dbh;
+lives_ok (sub {
+ $dbh = $schema->storage->dbh;
+}, 'reconnect works');
+
$dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
DROP TABLE artist");
$dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL
my $schema = DBICTest->init_schema();
my $queries;
-$schema->storage->debugcb( sub{ $queries++ } );
+my $debugcb = sub{ $queries++ };
+my $sdebug = $schema->storage->debug;
-eval "use DBD::SQLite";
-plan skip_all => 'needs DBD::SQLite for testing' if $@;
plan tests => 23;
my $rs = $schema->resultset("Artist")->search(
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
$rs = $schema->resultset('Artist')->search( undef, { cache => 1 } );
while( $artist = $rs->next ) {}
is( $queries, 1, 'revisiting a row does not issue a query when cache => 1' );
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
my @a = $schema->resultset("Artist")->search(
{ },
# start test for prefetch SELECT count
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
$artist = $rs->first;
$rs->reset();
is($queries, 1, 'only one SQL statement executed');
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
# make sure related_resultset is deleted after object is updated
$artist->set_column('name', 'New Name');
# SELECT count for nested has_many prefetch
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
$artist = ($rs->all)[0];
is($queries, 1, 'only one SQL statement executed');
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
my @objs;
#$artist = $rs->find(1);
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
my $cds = $artist->cds;
my $tags = $cds->next->tags;
is( $queries, 1, 'only one select statement on find with has_many prefetch on resultset' );
-$schema->storage->debug(0);
-
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
my $schema = DBICTest->init_schema();
my $queries;
-#$schema->storage->debugfh(IO::File->new('t/var/temp.trace', 'w'));
$schema->storage->debugcb( sub{ $queries++ } );
+my $sdebug = $schema->storage->debug;
-eval "use DBD::SQLite";
-plan skip_all => 'needs DBD::SQLite for testing' if $@;
plan tests => 2;
-
my $cd = $schema->resultset("CD")->find(1);
$cd->title('test');
is($queries, 1, 'liner_notes (might_have) not prefetched - do not load
liner_notes on update');
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
my $cd2 = $schema->resultset("CD")->find(2, {prefetch => 'liner_notes'});
is($queries, 1, 'liner_notes (might_have) prefetched - do not load
liner_notes on update');
-$schema->storage->debug(0);
-
+$schema->storage->debug($sdebug);
my $schema = DBICTest->init_schema();
-plan tests => 18;
+plan tests => 20;
-my $cd;
-my $rs = $cd = $schema->resultset("CD")->search({}, { order_by => 'cdid' });
+my $rs = $schema->resultset("CD")->search({}, { order_by => 'cdid' });
my $rs_title = $rs->get_column('title');
my $rs_year = $rs->get_column('year');
my $owner = $schema->resultset('Owners')->find ({ name => 'Newton' });
ok ($owner->books->count > 1, 'Owner Newton has multiple books');
is ($owner->search_related ('books')->get_column ('price')->sum, 60, 'Correctly calculated price of all owned books');
+
+
+# make sure joined/prefetched get_column of a PK dtrt
+
+$rs->reset;
+my $j_rs = $rs->search ({}, { join => 'tracks' })->get_column ('cdid');
+is_deeply (
+ [ $j_rs->all ],
+ [ map { my $c = $rs->next; ( ($c->id) x $c->tracks->count ) } (1 .. $rs->count) ],
+ 'join properly explodes amount of rows from get_column',
+);
+
+$rs->reset;
+my $p_rs = $rs->search ({}, { prefetch => 'tracks' })->get_column ('cdid');
+is_deeply (
+ [ $p_rs->all ],
+ [ $rs->get_column ('cdid')->all ],
+ 'prefetch properly collapses amount of rows from get_column',
+);
my $rs3 = $rs2->search_related('cds');
-cmp_ok(scalar($rs3->all), '==', 45, "All cds for artist returned");
+cmp_ok(scalar($rs3->all), '==', 15, "All cds for artist returned");
-cmp_ok($rs3->count, '==', 45, "All cds for artist returned via count");
+cmp_ok($rs3->count, '==', 15, "All cds for artist returned via count");
my $rs4 = $schema->resultset("CD")->search({ 'artist.artistid' => '1' }, { join => ['tracks', 'artist'], prefetch => 'artist' });
my @rs4_results = $rs4->all;
{
'artist.artistid' => 'me.artist'
}
- ]
+ ],
+ [
+ {
+ 'tracks' => 'tracks',
+ '-join_type' => 'left'
+ },
+ {
+ 'tracks.cd' => 'me.cdid'
+ }
+ ],
],
[
- {
- 'count' => '*'
- }
+ 'me.cdid',
+ { count => 'tracks.cd' },
+ { -select => 'me.artist' },
+ { -select => 'me.title', -as => 'name' },
+ { -select => { min => 'me.year' }, -as => 'me.minyear' },
],
{
'artist.name' => 'Caterwauler McCrae',
is_same_sql_bind(
$sql, \@bind,
- q/SELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
- 'got correct SQL and bind parameters for count query with quoting'
+ q/
+ SELECT `me`.`cdid`, COUNT( `tracks`.`cd` ), `me`.`artist`, `me`.`title` AS `name`, MIN( `me`.`year` ) AS `me`.`minyear`
+ FROM `cd` `me`
+ JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` )
+ LEFT JOIN `tracks` `tracks` ON ( `tracks`.`cd` = `me`.`cdid` )
+ WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )
+ /,
+ [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
+ 'got correct SQL and bind parameters for complex select query with quoting'
);
plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
next;
}
- eval "use DBD::SQLite";
- plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 98);
+ plan tests => 98;
}
INIT {
ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there');
{
my $deprecated = 0;
- #local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
+ local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
ok(
Film->delete(Director => 'Elaine May'),
"In fact, delete all films by Elaine May"
);
cmp_ok(Film->search(Director => 'Elaine May'), '==',
0, "0 Films by Elaine May");
- SKIP: {
- skip "No deprecated warnings from compat layer", 1;
- is $deprecated, 1, "Got a deprecated warning";
- }
+ is $deprecated, 0, "No deprecated warnings from compat layer";
}
};
is $@, '', "No problems with deletes";
\@bind,
'SELECT COUNT( * )
FROM cd me
- LEFT JOIN track tracks ON tracks.cd = me.cdid
+ JOIN track tracks ON tracks.cd = me.cdid
JOIN cd disc ON disc.cdid = tracks.cd
LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
WHERE ( ( position = ? OR position = ? ) )
FROM (
SELECT tracks.trackid
FROM cd me
- LEFT JOIN track tracks ON tracks.cd = me.cdid
+ JOIN track tracks ON tracks.cd = me.cdid
JOIN cd disc ON disc.cdid = tracks.cd
LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
WHERE ( ( position = ? OR position = ? ) )
FROM (
SELECT cds.cdid
FROM artist me
- LEFT JOIN cd cds ON cds.artist = me.artistid
+ JOIN cd cds ON cds.artist = me.artistid
LEFT JOIN track tracks ON tracks.cd = cds.cdid
JOIN artist artist ON artist.artistid = cds.artist
WHERE tracks.position = ? OR tracks.position = ?
FROM (
SELECT cds.cdid
FROM artist me
- LEFT JOIN cd cds ON cds.artist = me.artistid
+ JOIN cd cds ON cds.artist = me.artistid
LEFT JOIN track tracks ON tracks.cd = cds.cdid
JOIN artist artist ON artist.artistid = cds.artist
WHERE tracks.position = ? OR tracks.position = ?
my $schema = DBICTest->init_schema();
-plan tests => 58;
+plan tests => 56;
# The tag Blue is assigned to cds 1 2 3 and 5
# The tag Cheesy is assigned to cds 2 4 and 5
is($get_count->($rs), 3, 'Count by distinct function result as select literal');
}
-eval {
- my @warnings;
- local $SIG{__WARN__} = sub { $_[0] =~ /The select => { distinct => ... } syntax will be deprecated/
- ? push @warnings, @_
- : warn @_
- };
- my $row = $schema->resultset('Tag')->search({}, { select => { distinct => 'tag' } })->first;
- is (@warnings, 1, 'Warned about deprecated distinct') if $DBIx::Class::VERSION < 0.09;
-};
-ok ($@, 'Exception on deprecated distinct usage thrown') if $DBIx::Class::VERSION >= 0.09;
-
throws_ok(
sub { my $row = $schema->resultset('Tag')->search({}, { select => { distinct => [qw/tag cd/] } })->first },
qr/select => { distinct => \.\.\. } syntax is not supported for multiple columns/,
# These two rely on the database to throw an exception. This might not be the case one day. Please revise.
dies_ok(sub { my $count = $schema->resultset('Tag')->search({}, { '+select' => \'tagid AS tag_id', distinct => 1 })->count }, 'expecting to die');
-dies_ok(sub { my $count = $schema->resultset('Tag')->search({}, { select => { length => 'tag' }, distinct => 1 })->count }, 'expecting to die');
use DBICTest;
-plan tests => 3;
+plan tests => 7;
my $schema = DBICTest->init_schema();
"Count correct with requested distinct collapse of main table"
);
+# JOIN and LEFT JOIN issues mean that we've seen problems where counted rows and fetched rows are sometimes 1 higher than they should
+# be in the related resultset.
+my $artist=$schema->resultset('Artist')->create({name => 'xxx'});
+is($artist->related_resultset('cds')->count(), 0, "No CDs found for a shiny new artist");
+is(scalar($artist->related_resultset('cds')->all()), 0, "No CDs fetched for a shiny new artist");
-
-
+my $artist_rs = $schema->resultset('Artist')->search({artistid => $artist->id});
+is($artist_rs->related_resultset('cds')->count(), 0, "No CDs counted for a shiny new artist using a resultset search");
+is(scalar($artist_rs->related_resultset('cds')->all), 0, "No CDs fetched for a shiny new artist using a resultset search");
is_same_sql_bind (
$sql,
\@bind,
- 'SELECT COUNT( * ) FROM (SELECT cds.cdid FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid LEFT JOIN track tracks ON tracks.cd = cds.cdid JOIN artist artist ON artist.artistid = cds.artist WHERE tracks.position = ? OR tracks.position = ? GROUP BY cds.cdid) count_subq',
+ 'SELECT COUNT( * ) FROM (SELECT cds.cdid FROM artist me JOIN cd cds ON cds.artist = me.artistid LEFT JOIN track tracks ON tracks.cd = cds.cdid JOIN artist artist ON artist.artistid = cds.artist WHERE tracks.position = ? OR tracks.position = ? GROUP BY cds.cdid) count_subq',
[ qw/'1' '2'/ ],
);
}
is_same_sql_bind (
$sql,
\@bind,
- 'SELECT COUNT( * ) FROM cd me LEFT JOIN track tracks ON tracks.cd = me.cdid JOIN cd disc ON disc.cdid = tracks.cd LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid WHERE ( ( position = ? OR position = ? ) )',
+ 'SELECT COUNT( * ) FROM cd me JOIN track tracks ON tracks.cd = me.cdid JOIN cd disc ON disc.cdid = tracks.cd LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid WHERE ( ( position = ? OR position = ? ) )',
[ qw/'1' '2'/ ],
);
}
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+plan tests => 23;
+
+my $schema = DBICTest->init_schema();
+
+my $cd_rs = $schema->resultset('CD')->search (
+ { 'tracks.cd' => { '!=', undef } },
+ { prefetch => ['tracks', 'artist'] },
+);
+
+
+is($cd_rs->count, 5, 'CDs with tracks count');
+is($cd_rs->search_related('tracks')->count, 15, 'Tracks associated with CDs count (before SELECT()ing)');
+
+is($cd_rs->all, 5, 'Amount of CD objects with tracks');
+is($cd_rs->search_related('tracks')->count, 15, 'Tracks associated with CDs count (after SELECT()ing)');
+
+is($cd_rs->search_related ('tracks')->all, 15, 'Track objects associated with CDs (after SELECT()ing)');
+
+my $artist = $schema->resultset('Artist')->create({name => 'xxx'});
+
+my $artist_rs = $schema->resultset('Artist')->search(
+ {artistid => $artist->id},
+ {prefetch=>'cds', join => 'twokeys' }
+);
+
+is($artist_rs->count, 1, "New artist found with prefetch turned on");
+is(scalar($artist_rs->all), 1, "New artist fetched with prefetch turned on");
+is($artist_rs->related_resultset('cds')->count, 0, "No CDs counted on a brand new artist");
+is(scalar($artist_rs->related_resultset('cds')->all), 0, "No CDs fetched on a brand new artist (count == fetch)");
+
+# create a cd, and make sure the non-existing join does not skew the count
+$artist->create_related ('cds', { title => 'yyy', year => '1999' });
+is($artist_rs->related_resultset('cds')->count, 1, "1 CDs counted on a brand new artist");
+is(scalar($artist_rs->related_resultset('cds')->all), 1, "1 CDs prefetched on a brand new artist (count == fetch)");
+
+# Really fuck shit up with one more cd and some insanity
+# this doesn't quite work as there are the prefetch gets lost
+# on search_related. This however is too esoteric to fix right
+# now
+
+my $cd2 = $artist->create_related ('cds', {
+ title => 'zzz',
+ year => '1999',
+ tracks => [{ title => 'ping' }, { title => 'pong' }],
+});
+
+my $cds = $cd2->search_related ('artist', {}, { join => 'twokeys' })
+ ->search_related ('cds');
+my $tracks = $cds->search_related ('tracks');
+
+is($tracks->count, 2, "2 Tracks counted on cd via artist via one of the cds");
+is(scalar($tracks->all), 2, "2 Track objects on cd via artist via one of the cds");
+
+is($cds->count, 2, "2 CDs counted on artist via one of the cds");
+is(scalar($cds->all), 2, "2 CD objectson artist via one of the cds");
+
+# make sure the join collapses all the way
+is_same_sql_bind (
+ $tracks->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM artist me
+ LEFT JOIN twokeys twokeys ON twokeys.artist = me.artistid
+ JOIN cd cds ON cds.artist = me.artistid
+ JOIN track tracks ON tracks.cd = cds.cdid
+ WHERE ( me.artistid = ? )
+ )',
+ [ [ 'me.artistid' => 4 ] ],
+);
+
+
+TODO: {
+ local $TODO = "Chaining with prefetch is fundamentally broken";
+
+ my $queries;
+ $schema->storage->debugcb ( sub { $queries++ } );
+ $schema->storage->debug (1);
+
+ my $cds = $cd2->search_related ('artist', {}, { prefetch => { cds => 'tracks' }, join => 'twokeys' })
+ ->search_related ('cds');
+
+ my $tracks = $cds->search_related ('tracks');
+
+ is($tracks->count, 2, "2 Tracks counted on cd via artist via one of the cds");
+ is(scalar($tracks->all), 2, "2 Tracks prefetched on cd via artist via one of the cds");
+ is($tracks->count, 2, "Cached 2 Tracks counted on cd via artist via one of the cds");
+
+ is($cds->count, 2, "2 CDs counted on artist via one of the cds");
+ is(scalar($cds->all), 2, "2 CDs prefetched on artist via one of the cds");
+ is($cds->count, 2, "Cached 2 CDs counted on artist via one of the cds");
+
+ is ($queries, 3, '2 counts + 1 prefetch?');
+}
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+#plan tests => 6;
+plan 'no_plan';
+
+my $schema = DBICTest->init_schema();
+my $sdebug = $schema->storage->debug;
+
+my $cd_rs = $schema->resultset('CD')->search (
+ { 'tracks.cd' => { '!=', undef } },
+ { prefetch => 'tracks' },
+);
+
+# Database sanity check
+is($cd_rs->count, 5, 'CDs with tracks count');
+for ($cd_rs->all) {
+ is ($_->tracks->count, 3, '3 tracks for CD' . $_->id );
+}
+
+# Test a belongs_to prefetch of a has_many
+{
+ my $track_rs = $schema->resultset ('Track')->search (
+ { 'me.cd' => { -in => [ $cd_rs->get_column ('cdid')->all ] } },
+ {
+ # the select/as is deliberately silly to test both funcs and refs below
+ select => [
+ 'me.cd',
+ { count => 'me.trackid' },
+ ],
+ as => [qw/
+ cd
+ track_count
+ /],
+ group_by => [qw/me.cd/],
+ prefetch => 'cd',
+ },
+ );
+
+ # this used to fuck up ->all, do not remove!
+ ok ($track_rs->first, 'There is stuff in the rs');
+
+ is($track_rs->count, 5, 'Prefetched count with groupby');
+ is($track_rs->all, 5, 'Prefetched objects with groupby');
+
+ {
+ my $query_cnt = 0;
+ $schema->storage->debugcb ( sub { $query_cnt++ } );
+ $schema->storage->debug (1);
+
+ while (my $collapsed_track = $track_rs->next) {
+ my $cdid = $collapsed_track->get_column('cd');
+ is($collapsed_track->get_column('track_count'), 3, "Correct count of tracks for CD $cdid" );
+ ok($collapsed_track->cd->title, "Prefetched title for CD $cdid" );
+ }
+
+ is ($query_cnt, 1, 'Single query on prefetched titles');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
+ }
+
+ # Test sql by hand, as the sqlite db will simply paper over
+ # improper group/select combinations
+ #
+ # the exploded IN needs fixing below, coming in another branch
+ #
+ is_same_sql_bind (
+ $track_rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT me.cd
+ FROM track me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ GROUP BY me.cd
+ )
+ count_subq
+ )',
+ [ map { [ 'me.cd' => $_] } ($cd_rs->get_column ('cdid')->all) ],
+ 'count() query generated expected SQL',
+ );
+
+ is_same_sql_bind (
+ $track_rs->as_query,
+ '(
+ SELECT me.cd, me.track_count, cd.cdid, cd.artist, cd.title, cd.year, cd.genreid, cd.single_track
+ FROM (
+ SELECT me.cd, COUNT (me.trackid) AS track_count,
+ FROM track me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ GROUP BY me.cd
+ ) as me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ )',
+ [ map { [ 'me.cd' => $_] } ( ($cd_rs->get_column ('cdid')->all) x 2 ) ],
+ 'next() query generated expected SQL',
+ );
+
+
+ # add an extra track to one of the cds, and then make sure we can get it on top
+ # (check if limit works)
+ my $top_cd = $cd_rs->slice (1,1)->next;
+ $top_cd->create_related ('tracks', {
+ title => 'over the top',
+ });
+
+ my $top_cd_collapsed_track = $track_rs->search ({}, {
+ rows => 2,
+ order_by => [
+ { -desc => 'track_count' },
+ ],
+ });
+
+ is ($top_cd_collapsed_track->count, 2);
+
+ is (
+ $top_cd->title,
+ $top_cd_collapsed_track->first->cd->title,
+ 'Correct collapsed track with prefetched CD returned on top'
+ );
+}
+
+# test a has_many/might_have prefetch at the same level
+# Note that one of the CDs now has 4 tracks instead of 3
+{
+ my $most_tracks_rs = $cd_rs->search ({}, {
+ prefetch => 'liner_notes', # tracks are alredy prefetched
+ select => ['me.cdid', { count => 'tracks.trackid' } ],
+ as => [qw/cdid track_count/],
+ group_by => 'me.cdid',
+ order_by => { -desc => 'track_count' },
+ rows => 2,
+ });
+
+ is_same_sql_bind (
+ $most_tracks_rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT me.cdid
+ FROM cd me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ LEFT JOIN liner_notes liner_notes ON liner_notes.liner_id = me.cdid
+ WHERE ( tracks.cd IS NOT NULL )
+ GROUP BY me.cdid
+ LIMIT 2
+ ) count_subq
+ )',
+ [],
+ 'count() query generated expected SQL',
+ );
+
+ is_same_sql_bind (
+ $most_tracks_rs->as_query,
+ '(
+ SELECT me.cdid, me.track_count, tracks.trackid, tracks.cd, tracks.position, tracks.title, tracks.last_updated_on, tracks.last_updated_at, liner_notes.liner_id, liner_notes.notes
+ FROM (
+ SELECT me.cdid, COUNT( tracks.trackid ) AS track_count
+ FROM cd me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ WHERE ( tracks.cd IS NOT NULL )
+ GROUP BY me.cdid
+ ORDER BY track_count DESC
+ LIMIT 2
+ ) me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ LEFT JOIN liner_notes liner_notes ON liner_notes.liner_id = me.cdid
+ WHERE ( tracks.cd IS NOT NULL )
+ ORDER BY track_count DESC, tracks.cd
+ )',
+ [],
+ 'next() query generated expected SQL',
+ );
+
+ is ($most_tracks_rs->count, 2, 'Limit works');
+ my $top_cd = $most_tracks_rs->first;
+ is ($top_cd->id, 2, 'Correct cd fetched on top'); # 2 because of the slice(1,1) earlier
+
+ my $query_cnt = 0;
+ $schema->storage->debugcb ( sub { $query_cnt++ } );
+ $schema->storage->debug (1);
+
+ is ($top_cd->get_column ('track_count'), 4, 'Track count fetched correctly');
+ is ($top_cd->tracks->count, 4, 'Count of prefetched tracks rs still correct');
+ is ($top_cd->tracks->all, 4, 'Number of prefetched track objects still correct');
+ is (
+ $top_cd->liner_notes->notes,
+ 'Buy Whiskey!',
+ 'Correct liner pre-fetched with top cd',
+ );
+
+ is ($query_cnt, 0, 'No queries executed during prefetched data access');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
+}
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
-use Data::Dumper;
+use IO::File;
plan tests => 10;
my $schema = DBICTest->init_schema();
+my $sdebug = $schema->storage->debug;
-use IO::File;
# once the following TODO is complete, remove the 2 warning tests immediately
# after the TODO block
ok(! $o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (1 -> M + M)');
is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
+
is($pr_tracks_count, $tracks_count, 'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)');
for ($pr_tracks_rs, $tracks_rs) {
ok(! $m_o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (M -> 1 -> M + M)');
is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
is($pr_tags_count, $tags_count, 'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)');
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
use Data::Dumper;
+use IO::File;
my $schema = DBICTest->init_schema();
-
my $orig_debug = $schema->storage->debug;
-use IO::File;
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 45 );
-}
+plan tests => 44;
my $queries = 0;
$schema->storage->debugcb(sub { $queries++; });
$tree_like = eval { $schema->resultset('TreeLike')->search(
{ 'children.id' => 3, 'children_2.id' => 6 },
- { join => [qw/children children/] }
+ { join => [qw/children children children/] }
)->search_related('children', { 'children_4.id' => 7 }, { prefetch => 'children' }
)->first->children->first; };
is(eval { $tree_like->name }, 'fong', 'Tree with multiple has_many joins ok');
-# test that collapsed joins don't get a _2 appended to the alias
-
-my $sql = '';
-$schema->storage->debugcb(sub { $sql = $_[1] });
-$schema->storage->debug(1);
-
-eval {
- my $row = $schema->resultset('Artist')->search_related('cds', undef, {
- join => 'tracks',
- prefetch => 'tracks',
- })->search_related('tracks')->first;
-};
-
-like( $sql, qr/^SELECT tracks_2\.trackid/, "join not collapsed for search_related" );
-
-$schema->storage->debug($orig_debug);
-$schema->storage->debugobj->callback(undef);
-
$rs = $schema->resultset('Artist');
$rs->create({ artistid => 4, name => 'Unknown singer-songwriter' });
$rs->create({ artistid => 5, name => 'Emo 4ever' });
is($queries, 0, 'chained search_related after has_many->has_many prefetch ran no queries');
+$schema->storage->debug($orig_debug);
+$schema->storage->debugobj->callback(undef);
use DBICTest;
my $schema = DBICTest->init_schema();
+my $sdebug = $schema->storage->debug;
-plan tests => 78;
+plan tests => 79;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
is($queries, 0, 'No SELECT made for belongs_to if key IS NULL');
$big_flop_cd->genre_inefficient; #should trigger a select query
is($queries, 1, 'SELECT made for belongs_to if key IS NULL when undef_on_null_fk disabled');
- $schema->storage->debug(0);
+ $schema->storage->debug($sdebug);
$schema->storage->debugcb(undef);
}
cmp_ok($searched->count, '==', 2, "Both artist returned from map after adding another condition");
-# check join through cascaded has_many relationships
+# check join through cascaded has_many relationships (also empty has_many rels)
$artist = $schema->resultset("Artist")->find(1);
my $trackset = $artist->cds->search_related('tracks');
-# LEFT join means we also see the trackless additional album...
-cmp_ok($trackset->count, '==', 11, "Correct number of tracks for artist");
+is($trackset->count, 10, "Correct number of tracks for artist");
+is($trackset->all, 10, "Correct number of track objects for artist");
# now see about updating eveything that belongs to artist 2 to artist 3
$artist = $schema->resultset("Artist")->find(2);
use DBIC::SqlMakerTest;
my $schema = DBICTest->init_schema();
+my $sdebug = $schema->storage->debug;
-#plan tests => 4;
-plan 'no_plan';
+plan tests => 6;
my $artist = $schema->resultset ('Artist')->first;
});
$schema->storage->debugcb(undef);
+$schema->storage->debug ($sdebug);
is_same_sql (
$sql[0],
my $schema = DBICTest->init_schema();
-#plan tests => 4;
-plan 'no_plan';
+plan tests => 9;
my $artist = $schema->resultset ('Artist')->first;
for my $close (0,1) {
- my $tmp = File::Temp->new( UNLINK => 1, TMPDIR => 1, SUFFIX => '.sqlite' );
+ my $tmp = File::Temp->new(
+ UNLINK => 1,
+ TMPDIR => 1,
+ SUFFIX => '.sqlite',
+ EXLOCK => 0, # important for BSD and derivatives
+ );
+
my $tmp_fn = $tmp->filename;
close $tmp if $close;
lives_ok (sub {
my $schema = DBICTest::Schema->connect ("DBI:SQLite:$tmp_fn");
DBICTest->deploy_schema ($schema);
- DBICTest->populate_schema ($schema);
+ #DBICTest->populate_schema ($schema);
});
alarm 0;
projects / dbsrgits/DBIx-Class.git / commitdiff