From: Peter Rabbitson Date: Fri, 19 Jun 2009 16:41:45 +0000 (+0000) Subject: Merge 'trunk' into 'mssql_top_fixes' X-Git-Tag: v0.08108~12^2~29 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bc185c328c2881bbafb597ffba48a516f3f8bfeb;hp=ceb52d1911c9cad984a90bcd8debc8a166a9c054;p=dbsrgits%2FDBIx-Class.git Merge 'trunk' into 'mssql_top_fixes' r6690@Thesaurus (orig r6689): timbunce | 2009-06-16 15:06:07 +0200 Removed wording from txn_do that implies the coderef could be executed more than once. r6691@Thesaurus (orig r6690): timbunce | 2009-06-16 15:14:23 +0200 Added doc note that txn_commit does not perform an actual storage commit unless there's a DBIx::Class transaction currently in effect r6692@Thesaurus (orig r6691): timbunce | 2009-06-16 15:40:11 +0200 Reverted doc patch r6689 for now, sadly. I'll open a ticket to explain. r6694@Thesaurus (orig r6693): ribasushi | 2009-06-16 17:22:59 +0200 Fix possible regression with prefetch select resolution r6699@Thesaurus (orig r6698): wintrmute | 2009-06-17 10:32:30 +0200 Replace vague language around whether load_classes/namespaces is preferred, with an explanation that load_namespaces() is generally preferred, and explain when load_classes is appropriate. r6702@Thesaurus (orig r6701): caelum | 2009-06-17 19:50:47 +0200 fix page with offset bug r6704@Thesaurus (orig r6703): ribasushi | 2009-06-18 08:40:18 +0200 Cleanup attribute handling - I deal with resolved attributes throughout, no point in complicating things further r6705@Thesaurus (orig r6704): abraxxa | 2009-06-18 12:30:01 +0200 added test for nested has_many prefetch without entries r6707@Thesaurus (orig r6706): ribasushi | 2009-06-18 12:43:36 +0200 HRI fix r6708@Thesaurus (orig r6707): ribasushi | 2009-06-18 14:05:42 +0200 wtf r6714@Thesaurus (orig r6713): caelum | 2009-06-19 01:03:01 +0200 fix broken link in manual r6726@Thesaurus (orig r6725): ribasushi | 2009-06-19 17:25:19 +0200 r6706@Thesaurus (orig r6705): ribasushi | 2009-06-18 12:30:08 +0200 Branch to attempt prefetch with limit fix r6709@Thesaurus (orig r6708): ribasushi | 2009-06-18 15:54:38 +0200 This seems to be the prefetch+limit fix - ugly as hell but appears to work r6710@Thesaurus (orig r6709): ribasushi | 2009-06-18 16:13:31 +0200 More comments r6717@Thesaurus (orig r6716): ribasushi | 2009-06-19 15:39:43 +0200 single() throws with has_many prefetch r6718@Thesaurus (orig r6717): ribasushi | 2009-06-19 15:40:38 +0200 Rename test r6719@Thesaurus (orig r6718): ribasushi | 2009-06-19 15:44:26 +0200 cleanup svn attrs r6720@Thesaurus (orig r6719): ash | 2009-06-19 16:31:11 +0200 Add extra test for prefetch+has_many r6721@Thesaurus (orig r6720): ribasushi | 2009-06-19 16:33:49 +0200 no need to slice as use_prefetch already has a limit r6722@Thesaurus (orig r6721): ribasushi | 2009-06-19 16:36:08 +0200 throw in an extra limit, sophisticate test a bit r6723@Thesaurus (orig r6722): ribasushi | 2009-06-19 16:36:54 +0200 Fix the fix r6725@Thesaurus (orig r6724): ribasushi | 2009-06-19 17:24:23 +0200 Fix dubious optimization --- diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 6faf118..74940eb 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2605,8 +2605,10 @@ sub _resolved_attrs { # Although this is needed only if the order_by is not defined, it is # actually cheaper to just populate this rather than properly examining # order_by (stuf like [ {} ] and the like) - $attrs->{_virtual_order_by} = [ $self->result_source->primary_columns ]; - + my $prefix = $alias . ($source->schema->storage->_sql_maker_opts->{name_sep} || '.'); + $attrs->{_virtual_order_by} = [ + map { $prefix . $_ } ($source->primary_columns) + ]; $attrs->{collapse} ||= {}; if ( my $prefetch = delete $attrs->{prefetch} ) { diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index a454cd5..1498be1 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -116,37 +116,97 @@ SQL sub _Top { my ( $self, $sql, $order, $rows, $offset ) = @_; + # mangle the input sql so it can be properly aliased in the outer queries + $sql =~ s/^ \s* SELECT \s+ (.+?) \s+ (?=FROM)//ix + or croak "Unrecognizable SELECT: $sql"; + my $select = $1; + + my (@outer_select, %col_index); + for my $selected_col (@{$self->{_dbic_rs_attrs}{select}}) { + + my $new_colname; + + if (ref $selected_col) { + $new_colname = $self->_quote ('column_' . (@outer_select + 1) ); + } + else { + my $quoted_col = $self->_quote ($selected_col); + + my $name_sep = $self->name_sep || '.'; + $name_sep = "\Q$name_sep\E"; + + my ($table, $orig_colname) = ( $selected_col =~ / (?: (.+) $name_sep )? ([^$name_sep]+) $ /x ); + $new_colname = $self->_quote ("${table}__${orig_colname}"); + + $select =~ s/(\Q$quoted_col\E|\Q$selected_col\E)/"$1 AS $new_colname"/e; + + # record qualified name if available (should be) + $col_index{$selected_col} = $new_colname if $table; + + # record unqialified name, undef if a duplicate is found + if (exists $col_index{$orig_colname}) { + $col_index{$orig_colname} = undef; + } + else { + $col_index{$orig_colname} = $new_colname; + } + } + + push @outer_select, $new_colname; + } + + my $outer_select = join (', ', @outer_select ); + + + # deal with order croak '$order supplied to SQLAHacks limit emulators must be a hash' if (ref $order ne 'HASH'); $order = { %$order }; #copy - my $last = $rows + $offset; + my $req_order = [ $self->_order_by_chunks ($order->{order_by}) ]; + my $limit_order = [ @$req_order ? @$req_order : $self->_order_by_chunks ($order->{_virtual_order_by}) ]; - my $req_order = $self->_order_by ($order->{order_by}); - my $limit_order = $req_order ? $order->{order_by} : $order->{_virtual_order_by}; + # normalize all column names in order by + # no copies, just aliasing ($_) + for ($req_order, $limit_order) { + for ( @{$_ || []} ) { + $_ = $col_index{$_} if $col_index{$_}; + } + } + + # generate the rest delete $order->{$_} for qw/order_by _virtual_order_by/; my $grpby_having = $self->_order_by ($order); my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order); - $sql =~ s/^\s*(SELECT|select)//; + my $last = $rows + $offset; $sql = <<"SQL"; - SELECT * FROM - ( - SELECT TOP $rows * FROM + + SELECT TOP $rows $outer_select FROM ( - SELECT TOP $last $sql $grpby_having $order_by_inner - ) AS foo + SELECT TOP $last $select $sql $grpby_having $order_by_inner + ) AS inner_sel $order_by_outer - ) AS bar - $req_order +SQL + + if (@$req_order) { + my $order_by_requested = $self->_order_by ($req_order); + + $sql = <<"SQL"; + SELECT $outer_select FROM + ( $sql ) AS outer_sel + $order_by_requested; SQL - return $sql; + + } + + return $sql; } @@ -158,6 +218,10 @@ sub _find_syntax { return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax); } +my $for_syntax = { + update => 'FOR UPDATE', + shared => 'FOR SHARE', +}; sub select { my ($self, $table, $fields, $where, $order, @rest) = @_; @@ -177,15 +241,10 @@ sub select { my ($sql, @where_bind) = $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' : - '' - ) : - '' - ; + if (my $for = delete $self->{_dbic_rs_attrs}{for}) { + $sql .= " $for_syntax->{$for}" if $for_syntax->{$for}; + } + return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql; } diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index e0799df..db8d2f0 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI; use base 'DBIx::Class::Storage'; -use strict; +use strict; use warnings; use Carp::Clan qw/^DBIx::Class/; use DBI; @@ -89,8 +89,8 @@ recognized by DBIx::Class: =item * -A single code reference which returns a connected -L optionally followed by +A single code reference which returns a connected +L optionally followed by L recognized by DBIx::Class: @@ -109,7 +109,7 @@ mixed together: %extra_attributes, }]; -This is particularly useful for L based applications, allowing the +This is particularly useful for L based applications, allowing the following config (L style): @@ -128,7 +128,7 @@ Please note that the L docs recommend that you always explicitly set C to either I<0> or I<1>. L further recommends that it be set to I<1>, and that you perform transactions via our L method. L will set it -to I<1> if you do not do explicitly set it to zero. This is the default +to I<1> if you do not do explicitly set it to zero. This is the default for most DBDs. See L for details. =head3 DBIx::Class specific connection attributes @@ -182,7 +182,7 @@ storage object. If set to a true value, this option will disable the caching of statement handles via L. -=item limit_dialect +=item limit_dialect Sets the limit dialect. This is useful for JDBC-bridge among others where the remote SQL-dialect cannot be determined by the name of the @@ -190,7 +190,7 @@ driver alone. See also L. =item quote_char -Specifies what characters to use to quote table and column names. If +Specifies what characters to use to quote table and column names. If you use this you will want to specify L as well. C expects either a single character, in which case is it @@ -202,8 +202,8 @@ SQL Server you should use C<< quote_char => [qw/[ ]/] >>. =item name_sep -This only needs to be used in conjunction with C, and is used to -specify the charecter that seperates elements (schemas, tables, columns) from +This only needs to be used in conjunction with C, and is used to +specify the charecter that seperates elements (schemas, tables, columns) from each other. In most cases this is simply a C<.>. The consequences of not supplying this value is that L @@ -594,7 +594,7 @@ sub dbh { sub _sql_maker_args { my ($self) = @_; - + return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} ); } @@ -753,11 +753,11 @@ sub svp_begin { $self->throw_exception ("Your Storage implementation doesn't support savepoints") unless $self->can('_svp_begin'); - + push @{ $self->{savepoints} }, $name; $self->debugobj->svp_begin($name) if $self->debug; - + return $self->_svp_begin($name); } @@ -817,7 +817,7 @@ sub svp_rollback { } $self->debugobj->svp_rollback($name) if $self->debug; - + return $self->_svp_rollback($name); } @@ -955,7 +955,7 @@ sub _dbh_execute { my $sth = $self->sth($sql,$op); - my $placeholder_index = 1; + my $placeholder_index = 1; foreach my $bound (@$bind) { my $attributes = {}; @@ -1014,7 +1014,7 @@ sub insert { } ## Still not quite perfect, and EXPERIMENTAL -## Currently it is assumed that all values passed will be "normal", i.e. not +## Currently it is assumed that all values passed will be "normal", i.e. not ## scalar refs, or at least, all the same type as the first set, the statement is ## only prepped once. sub insert_bulk { @@ -1023,7 +1023,7 @@ sub insert_bulk { my $table = $source->from; @colvalues{@$cols} = (0..$#$cols); my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues); - + $self->_query_start( $sql, @bind ); my $sth = $self->sth($sql); @@ -1036,7 +1036,7 @@ sub insert_bulk { my $bind_attributes = $self->source_bind_attributes($source); ## Bind the values and execute - my $placeholder_index = 1; + my $placeholder_index = 1; foreach my $bound (@bind) { @@ -1084,7 +1084,7 @@ sub update { my $self = shift @_; my $source = shift @_; my $bind_attributes = $self->source_bind_attributes($source); - + return $self->_execute('update' => [], $source, $bind_attributes, @_); } @@ -1092,9 +1092,9 @@ sub update { sub delete { my $self = shift @_; my $source = shift @_; - + my $bind_attrs = $self->source_bind_attributes($source); - + return $self->_execute('delete' => [], $source, $bind_attrs, @_); } @@ -1193,10 +1193,10 @@ sub _select { my $self = shift; # localization is neccessary as - # 1) there is no infrastructure to pass this around (easy to do, but will wait) + # 1) there is no infrastructure to pass this around before SQLA2 # 2) _select_args sets it and _prep_for_execute consumes it my $sql_maker = $self->sql_maker; - local $sql_maker->{for}; + local $sql_maker->{_dbic_rs_attrs}; return $self->_execute($self->_select_args(@_)); } @@ -1205,10 +1205,10 @@ sub _select_args_to_query { my $self = shift; # localization is neccessary as - # 1) there is no infrastructure to pass this around (easy to do, but will wait) + # 1) there is no infrastructure to pass this around before SQLA2 # 2) _select_args sets it and _prep_for_execute consumes it my $sql_maker = $self->sql_maker; - local $sql_maker->{for}; + local $sql_maker->{_dbic_rs_attrs}; # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset) # = $self->_select_args($ident, $select, $cond, $attrs); @@ -1229,6 +1229,8 @@ sub _select_args { my ($self, $ident, $select, $where, $attrs) = @_; my $sql_maker = $self->sql_maker; + $sql_maker->{_dbic_rs_attrs} = $attrs; + my $alias2source = $self->_resolve_ident_sources ($ident); # calculate bind_attrs before possible $ident mangling @@ -1446,6 +1448,33 @@ sub _resolve_ident_sources { return $alias2source; } +# Takes $ident, \@column_names +# +# returns { $column_name => \%column_info, ... } +# also note: this adds -result_source => $rsrc to the column info +# +# usage: +# my $col_sources = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]); +sub _resolve_column_info { + my ($self, $ident, $colnames) = @_; + my $alias2src = $self->_resolve_ident_sources($ident); + + my $sep = $self->_sql_maker_opts->{name_sep} || '.'; + $sep = "\Q$sep\E"; + + my %return; + foreach my $col (@{$colnames}) { + $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x; + + my $alias = $1 || 'me'; + my $colname = $2; + + my $rsrc = $alias2src->{$alias}; + $return{$col} = $rsrc && { %{$rsrc->column_info($colname)}, -result_source => $rsrc }; + } + return \%return; +} + sub count { my ($self, $source, $attrs) = @_; @@ -1511,10 +1540,10 @@ sub _grouped_count_select { sub source_bind_attributes { my ($self, $source) = @_; - + my $bind_attributes; foreach my $column ($source->columns) { - + my $data_type = $source->column_info($column)->{data_type} || ''; $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type) if $data_type; @@ -1763,13 +1792,13 @@ By default, C<\%sqlt_args> will have { add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1 } -merged with the hash passed in. To disable any of those features, pass in a +merged with the hash passed in. To disable any of those features, pass in a hashref like the following { ignore_constraint_names => 0, # ... other options } -Note that this feature is currently EXPERIMENTAL and may not work correctly +Note that this feature is currently EXPERIMENTAL and may not work correctly across all databases, or fully handle complex relationships. WARNING: Please check all SQL files created, before applying them. @@ -1790,7 +1819,7 @@ sub create_ddl_dir { $version ||= $schema_version; $sqltargs = { - add_drop_table => 1, + add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1, %{$sqltargs || {}} @@ -1830,7 +1859,7 @@ sub create_ddl_dir { } print $file $output; close($file); - + next unless ($preversion); require SQL::Translator::Diff; @@ -1846,7 +1875,7 @@ sub create_ddl_dir { carp("Overwriting existing diff file - $difffile"); unlink($difffile); } - + my $source_schema; { my $t = SQL::Translator->new($sqltargs); @@ -1865,7 +1894,7 @@ sub create_ddl_dir { unless ( $source_schema->name ); } - # The "new" style of producers have sane normalization and can support + # The "new" style of producers have sane normalization and can support # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't # And we have to diff parsed SQL against parsed SQL. my $dest_schema = $sqlt_schema; @@ -1886,12 +1915,12 @@ sub create_ddl_dir { $dest_schema->name( $filename ) unless $dest_schema->name; } - + my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db, $dest_schema, $db, $sqltargs ); - if(!open $file, ">$difffile") { + if(!open $file, ">$difffile") { $self->throw_exception("Can't write to $difffile ($!)"); next; } @@ -1935,7 +1964,7 @@ sub deployment_statements { if(-f $filename) { my $file; - open($file, "<$filename") + open($file, "<$filename") or $self->throw_exception("Can't open $filename ($!)"); my @rows = <$file>; close($file); @@ -1950,7 +1979,7 @@ sub deployment_statements { eval qq{use SQL::Translator::Producer::${type}}; $self->throw_exception($@) if $@; - # sources needs to be a parser arg, but for simplicty allow at top level + # sources needs to be a parser arg, but for simplicty allow at top level # coming in $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources} if exists $sqltargs->{sources}; @@ -2055,7 +2084,7 @@ returned by databases that don't support replication. sub is_replicating { return; - + } =head2 lag_behind_master diff --git a/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm b/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm new file mode 100644 index 0000000..c848fc1 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm @@ -0,0 +1,43 @@ +package DBIx::Class::Storage::DBI::AmbiguousGlob; + +use strict; +use warnings; + +use base 'DBIx::Class::Storage::DBI'; + +=head1 NAME + +DBIx::Class::Storage::DBI::AmbiguousGlob - Storage component for RDBMS supporting multicolumn in clauses + +=head1 DESCRIPTION + +Some servers choke on things like: + + COUNT(*) FROM (SELECT tab1.col, tab2.col FROM tab1 JOIN tab2 ... ) + +claiming that col is a duplicate column (it loses the table specifiers by +the time it gets to the *). Thus for any subquery count we select only the +primary keys of the main table in the inner query. This hopefully still +hits the indexes and keeps the server happy. + +At this point the only overriden method is C<_grouped_count_select()> + +=cut + +sub _grouped_count_select { + my ($self, $source, $rs_args) = @_; + my @pcols = map { join '.', $rs_args->{alias}, $_ } ($source->primary_columns); + return @pcols ? \@pcols : $rs_args->{group_by}; +} + +=head1 AUTHORS + +See L + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 40afe76..c6b9360 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::MSSQL; use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI/; +use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/; sub _dbh_last_insert_id { my ($self, $dbh, $source, $col) = @_; diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm index 09a7c6b..40d12aa 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm @@ -11,9 +11,11 @@ sub _rebless { unless ( $@ ) { # Translate the backend name into a perl identifier $dbtype =~ s/\W/_/gi; - my $class = "DBIx::Class::Storage::DBI::ODBC::${dbtype}"; - eval "require $class"; - bless $self, $class unless $@; + my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}"; + if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { + bless $self, $subclass; + $self->_rebless; + } } } diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index 3a464fd..544e68c 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -4,14 +4,61 @@ use warnings; use base qw/DBIx::Class::Storage::DBI::MSSQL/; +sub insert_bulk { + my ($self, $source, $cols, $data) = @_; + + my $identity_insert = 0; + + COLUMNS: + foreach my $col (@{$cols}) { + if ($source->column_info($col)->{is_auto_increment}) { + $identity_insert = 1; + last COLUMNS; + } + } + + my $table = $source->from; + if ($identity_insert) { + $source->storage->dbh_do(sub { + my ($storage, $dbh, @cols) = @_; + $dbh->do("SET IDENTITY_INSERT $table ON;"); + }); + } + + next::method(@_); + + if ($identity_insert) { + $source->storage->dbh_do(sub { + my ($storage, $dbh, @cols) = @_; + $dbh->do("SET IDENTITY_INSERT $table OFF;"); + }); + } + +} + sub _prep_for_execute { - my $self = shift; - my ($op, $extra_bind, $ident, $args) = @_; + my $self = shift; + my ($op, $extra_bind, $ident, $args) = @_; + + my ($sql, $bind) = $self->next::method (@_); + $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert'; + + my %identity_insert_tables; + my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]); + + foreach my $bound (@{$bind}) { + my $col = $bound->[0]; + if ($col_info->{$col}->{is_auto_increment}) { + my $table = $col_info->{$col}->{-result_source}->from; + $identity_insert_tables{$table} = 1; + } + } - my ($sql, $bind) = $self->next::method (@_); - $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert'; + my $identity_insert_on = join '', map { "SET IDENTITY_INSERT $_ ON; " } keys %identity_insert_tables; + my $identity_insert_off = join '', map { "SET IDENTITY_INSERT $_ OFF; " } keys %identity_insert_tables; + $sql = "$identity_insert_on $sql $identity_insert_off"; - return ($sql, $bind); + return ($sql, $bind); } sub _execute { @@ -64,3 +111,4 @@ Marc Mims C<< >> You may distribute this code under the same terms as Perl itself. =cut +# vim: sw=2 sts=2 diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm index 221548a..e36b6d7 100644 --- a/lib/DBIx/Class/Storage/DBI/mysql.pm +++ b/lib/DBIx/Class/Storage/DBI/mysql.pm @@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::mysql; use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/; +use base qw/DBIx::Class::Storage::DBI::MultiColumnIn DBIx::Class::Storage::DBI::AmbiguousGlob/; __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MySQL'); @@ -41,7 +41,7 @@ sub _svp_rollback { $self->dbh->do("ROLLBACK TO SAVEPOINT $name") } - + sub is_replicating { my $status = shift->dbh->selectrow_hashref('show slave status'); return ($status->{Slave_IO_Running} eq 'Yes') && ($status->{Slave_SQL_Running} eq 'Yes'); @@ -57,19 +57,6 @@ sub _subq_update_delete { return shift->_per_row_update_delete (@_); } -# MySql chokes on things like: -# COUNT(*) FROM (SELECT tab1.col, tab2.col FROM tab1 JOIN tab2 ... ) -# claiming that col is a duplicate column (it loses the table specifiers by -# the time it gets to the *). Thus for any subquery count we select only the -# primary keys of the main table in the inner query. This hopefully still -# hits the indexes and keeps mysql happy. -# (mysql does not care if the SELECT and the GROUP BY match) -sub _grouped_count_select { - my ($self, $source, $rs_args) = @_; - my @pcols = map { join '.', $rs_args->{alias}, $_ } ($source->primary_columns); - return @pcols ? \@pcols : $rs_args->{group_by}; -} - 1; =head1 NAME diff --git a/t/746mssql.t b/t/746mssql.t index f53d49f..2f17dde 100644 --- a/t/746mssql.t +++ b/t/746mssql.t @@ -1,5 +1,5 @@ use strict; -use warnings; +use warnings; use Test::More; use lib qw(t/lib); @@ -10,7 +10,7 @@ my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PA plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test' unless ($dsn && $user); -plan tests => 13; +plan tests => 19; my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1}); @@ -73,10 +73,105 @@ $it->next; is( $it->next->name, "Artist 2", "iterator->next ok" ); is( $it->next, undef, "next past end of resultset ok" ); +$schema->storage->dbh_do (sub { + my ($storage, $dbh) = @_; + eval { $dbh->do("DROP TABLE Owners") }; + eval { $dbh->do("DROP TABLE Books") }; + $dbh->do(<<'SQL'); + + +CREATE TABLE Books ( + id INT IDENTITY (1, 1) NOT NULL, + source VARCHAR(100), + owner INT, + title VARCHAR(10), + price INT NULL +) + +CREATE TABLE Owners ( + id INT IDENTITY (1, 1) NOT NULL, + [name] VARCHAR(100), +) + +SQL + +}); +$schema->populate ('Owners', [ + [qw/id name /], + [qw/1 wiggle/], + [qw/2 woggle/], + [qw/3 boggle/], + [qw/4 fREW/], + [qw/5 fRIOUX/], + [qw/6 fROOH/], + [qw/7 fRUE/], + [qw/8 fISMBoC/], + [qw/9 station/], + [qw/10 mirror/], + [qw/11 dimly/], + [qw/12 face_to_face/], + [qw/13 icarus/], + [qw/14 dream/], + [qw/15 dyrstyggyr/], +]); + +$schema->populate ('BooksInLibrary', [ + [qw/source owner title /], + [qw/Library 1 secrets1/], + [qw/Eatery 1 secrets2/], + [qw/Library 2 secrets3/], + [qw/Library 3 secrets4/], + [qw/Eatery 3 secrets5/], + [qw/Library 4 secrets6/], + [qw/Library 5 secrets7/], + [qw/Eatery 5 secrets8/], + [qw/Library 6 secrets9/], + [qw/Library 7 secrets10/], + [qw/Eatery 7 secrets11/], + [qw/Library 8 secrets12/], +]); + +# +# try a distinct + prefetch on tables with identically named columns +# + +{ + # try a ->has_many direction (due to a 'multi' accessor the select/group_by group is collapsed) + my $owners = $schema->resultset ('Owners')->search ({ + 'books.id' => { '!=', undef } + }, { + prefetch => 'books', + distinct => 1, + order_by => 'name', + page => 2, + rows => 5, + }); + + is ($owners->all, 3, 'Prefetched grouped search returns correct number of rows'); + is ($owners->count, 3, 'Prefetched grouped search returns correct count'); + + # try a ->belongs_to direction (no select collapse) + my $books = $schema->resultset ('BooksInLibrary')->search ({ + 'owner.name' => 'wiggle' + }, { + prefetch => 'owner', + distinct => 1, + order_by => 'name', + rows => 5, + }); + + + is ($books->page(1)->all, 1, 'Prefetched grouped search returns correct number of rows'); + is ($books->page(1)->count, 1, 'Prefetched grouped search returns correct count'); + + is ($books->page(2)->all, 0, 'Prefetched grouped search returns correct number of rows'); + is ($books->page(2)->count, 0, 'Prefetched grouped search returns correct count'); + +} # clean up our mess END { my $dbh = eval { $schema->storage->_dbh }; $dbh->do('DROP TABLE artist') if $dbh; } - +# vim:sw=2 sts=2