From: Matt S Trout Date: Tue, 11 Apr 2006 16:01:09 +0000 (+0000) Subject: Merge 'trunk' into 'DBIx-Class-current' X-Git-Tag: v0.07002~75^2~245 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fed966517e558cfc9ee505d44add2d04e77a7d3d;hp=5dbda2161168cd2122786bdd0fda166a4bca755c;p=dbsrgits%2FDBIx-Class.git Merge 'trunk' into 'DBIx-Class-current' r9411@obrien (orig r1386): castaway | 2006-03-29 16:30:55 +0100 ResultSetManager example from CaptainCarlos r9412@obrien (orig r1387): nigel | 2006-03-30 14:20:42 +0100 Cleaned up reference to DBIx::Class::Manual::FAQ which no longer exists r9413@obrien (orig r1388): nigel | 2006-03-30 14:23:04 +0100 Cleaned up reference to DBIx::Class::Manual::FAQ which no longer exists r9414@obrien (orig r1389): castaway | 2006-03-30 18:53:26 +0100 Typo fixups and small documentation expansions r9426@obrien (orig r1396): matthewt | 2006-04-01 01:10:06 +0100 Storage::DBI error reporting improvement from Dan Sully r9443@obrien (orig r1397): castaway | 2006-04-01 18:05:24 +0100 added "having" r9444@obrien (orig r1398): castaway | 2006-04-01 22:28:34 +0100 New doc r9447@obrien (orig r1401): purge | 2006-04-03 18:25:18 +0100 New tests for cascade_delete, including fail. r9449@obrien (orig r1403): dsully | 2006-04-03 23:16:35 +0100 Wrap DBI->connnect and ->sth calls in eval to properly throw an exception. r9453@obrien (orig r1407): nigel | 2006-04-04 13:48:50 +0100 Added some track test data and a cascading relationship test r9454@obrien (orig r1408): purge | 2006-04-04 13:52:56 +0100 Fix to cascade_delete courtesy mst. r9458@obrien (orig r1412): castaway | 2006-04-04 20:52:05 +0100 Use DocMap r9461@obrien (orig r1414): matthewt | 2006-04-05 01:16:49 +0100 Rid of a wantarray r9497@obrien (orig r1418): nigel | 2006-04-06 15:20:32 +0100 Applied mst fixes for delete on resultsetin [839] to update. Factored out common code r9498@obrien (orig r1419): matthewt | 2006-04-06 16:54:56 +0100 Fixup to Cursor, updated Changes r9520@obrien (orig r1420): captainL | 2006-04-06 18:36:57 +0100 fixed multiple column count distincts in SQLite and Oracle r9528@obrien (orig r1423): nigel | 2006-04-07 12:03:36 +0100 Made storage txn_* functions log DBI operations to SQL debug trace r9534@obrien (orig r1429): matthewt | 2006-04-08 18:43:08 +0100 fix to update with undefined relations r9558@obrien (orig r1434): castaway | 2006-04-08 22:27:33 +0100 Skip distinct tests on old sqlite versions r9568@obrien (orig r1435): matthewt | 2006-04-08 22:53:55 +0100 0.06001 changes --- diff --git a/Changes b/Changes index b1d2c80..c33cc68 100644 --- a/Changes +++ b/Changes @@ -6,7 +6,15 @@ Revision history for DBIx::Class - load_classes now uses source_name and sets it if necessary 0.06001 + - minor fix to update in case of undefined rels + - fixes for cascade delete + - substantial improvements and fixes to deploy - Added fix for quoting with single table + - Substantial fixes and improvements to deploy + - slice now uses search directly + - fixes for update() on resultset + - bugfix to Cursor to avoid error during DESTROY + - transaction DBI operations now in debug trace output 0.06000 - Lots of documentation improvements diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index 64bec50..784c131 100644 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@ -13,7 +13,7 @@ sub component_base_class { 'DBIx::Class' } # i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports # brain damage and presumably various other packaging systems too -$VERSION = '0.06000'; +$VERSION = '0.06001'; sub MODIFY_CODE_ATTRIBUTES { my ($class,$code,@attrs) = @_; @@ -165,27 +165,8 @@ The community can be found via: =head1 WHERE TO GO NEXT -=over 4 - -=item L - user's manual - -=item L - DBIC Core Classes - -=item L - L Compat layer - -=item L - schema and connection container - -=item L - tables and table-like things - -=item L - encapsulates a query and its results - -=item L - row-level methods - -=item L - primary key methods - -=item L - relationships between tables - -=back +L lists each task you might want help on, and +the modules where you will find documentation. =head1 AUTHOR @@ -241,6 +222,8 @@ scotty: Scotty Allen sszabo: Stephan Szabo +captainL: Luke Saunders + Todd Lipcon wdh: Will Hawes diff --git a/lib/DBIx/Class/Manual.pod b/lib/DBIx/Class/Manual.pod index 47d8559..ed4c3d0 100644 --- a/lib/DBIx/Class/Manual.pod +++ b/lib/DBIx/Class/Manual.pod @@ -21,11 +21,11 @@ An example of slightly more complex usage. =head2 L -Convenient reciepes for DBIC usage. +Convenient recipes for DBIC usage. -=head2 L +=head2 L -Frequently asked questions about DBIC. +Lists of modules by task to help you find the correct document. =head2 L @@ -36,7 +36,7 @@ documentation. It should behave the same way. =head2 L -Listing of existing components, and documentation and example on how to +Existing components, and documentation and example on how to develop new ones. =cut diff --git a/lib/DBIx/Class/Manual/Component.pod b/lib/DBIx/Class/Manual/Component.pod index 4de2536..9bbe684 100644 --- a/lib/DBIx/Class/Manual/Component.pod +++ b/lib/DBIx/Class/Manual/Component.pod @@ -1,7 +1,14 @@ =head1 NAME -DBIx::Class::Manual::Component - Existing components and how to develop new ones. +DBIx::Class::Manual::Component - Developing DBIx::Class Components + +=head1 WHAT IS A COMPONENT + +A component is a module that can be added in to your DBIx::Class +classes to provide extra functionality. A good example is the PK::Auto +component which automatically retrieves primary keys that the database +itself creates, after the insert has happened. =head1 USING @@ -10,7 +17,7 @@ DBIx::Class classes. package My::Thing; use base qw( DBIx::Class ); - __PACKAGE__->load_components(qw( PK::Auto Core )); + __PACKAGE__->load_components(qw/ PK::Auto Core /); Generally you do not want to specify the full package name of a component, instead take off the DBIx::Class:: part of @@ -18,7 +25,7 @@ it and just include the rest. If you do want to load a component outside of the normal namespace you can do so by prepending the component name with a +. - __PACKAGE__->load_components(qw( +My::Component )); + __PACKAGE__->load_components(qw/ +My::Component /); Once a component is loaded all of it's methods, or otherwise, that it provides will be available in your class. @@ -31,6 +38,45 @@ docs for the components you are using and see if they mention anything about the order in which you should load them. +=head1 CREATING COMPONENTS + +Making your own component is very easy. + + package DBIx::Class::MyComp; + use base qw(DBIx::Class); + # Create methods, accessors, load other components, etc. + 1; + +When a component is loaded it is included in the calling +class' inheritance chain using L. As well as +providing custom utility methods, a component may also +override methods provided by other core components, like +L and others. For example, you +could override the insert and delete methods. + + sub insert { + my $self = shift; + # Do stuff with $self, like set default values. + return $self->next::method( @_ ); + } + + sub delete { + my $self = shift; + # Do stuff with $self. + return $self->next::method( @_ ); + } + +Now, the order that a component is loaded is very important. Components +that are loaded first are the first ones in the inheritance stack. So, if +you override insert() but the DBIx::Class::Row component is loaded first +then your insert() will never be called, since the DBIx::Class::Row insert() +will be called first. If you are unsure as to why a given method is not +being called try printing out the Class::C3 inheritance stack. + + print join ', ' => Class::C3::calculateMRO('YourClass::Name'); + +Check out the L docs for more information about inheritance. + =head1 EXISTING COMPONENTS =head2 Extra @@ -92,51 +138,10 @@ L - Provides a classdata table object and L - Basic row methods. -=head1 CREATEING COMPONENTS - -Making your own component is very easy. - - package DBIx::Class::MyComp; - use base qw(DBIx::Class); - # Create methods, accessors, load other components, etc. - 1; - -When a component is loaded it is included in the calling -class' inheritance chain using L. As well as -providing custom utility methods, a component may also -override methods provided by other core components, like -L and others. For example, you -could override the insert and delete methods. - - sub insert { - my $self = shift; - # Do stuff with $self, like set default values. - return $self->nest::method( @_ ); - } - - sub delete { - my $self = shift; - # Do stuff with $self. - return $self->nest::method( @_ ); - } - -Now, the order that a component is loaded is very important. Components -that are loaded first are the first ones in the inheritance stack. So, if -you override insert() but the DBIx::Class::Row component is loaded first -then your insert() will never be called, since the DBIx::Class::Row insert() -will be called first. If you are unsure as to why a given method is not -being called try printing out the Class::C3 inheritance stack. - - print join ', ' => Class::C3::calculateMRO('YourClass::Name'); - -Check out the L docs for more information about inheritance. - =head1 SEE ALSO L -L - =head1 AUTHOR Aran Clary Deltac diff --git a/lib/DBIx/Class/Manual/Cookbook.pod b/lib/DBIx/Class/Manual/Cookbook.pod index 5690f43..ed00d46 100644 --- a/lib/DBIx/Class/Manual/Cookbook.pod +++ b/lib/DBIx/Class/Manual/Cookbook.pod @@ -138,6 +138,8 @@ any of your aliases using either of these: } ); + my $count = $rs->next->get_column('count'); + =head3 SELECT COUNT(DISTINCT colname) my $rs = $schema->resultset('Foo')->search( @@ -200,6 +202,26 @@ Then call your new method in your code: my $ordered_cds = $schema->resultset('CD')->search_cds_ordered(); +=head3 Predefined searches without writing a ResultSet class + +Alternatively you can automatically generate a DBIx::Class::ResultSet +class by using the ResultSetManager component and tagging your method +as ResultSet: + + __PACKAGE__->load_components(qw/ ResultSetManager Core /); + + sub search_cds_ordered : ResultSet { + my ($self) = @_; + return $self->search( + {}, + { order_by => 'name DESC' }, + ); + } + +Then call your method in the same way from your code: + + my $ordered_cds = $schema->resultset('CD')->search_cds_ordered(); + =head2 Using joins and prefetch You can use the C attribute to allow searching on, or sorting your @@ -469,6 +491,13 @@ C. $class->next::method($attrs); } +For more information about C, look in the L +documentation. See also L for more +ways to write your own base classes to do this. + +People looking for ways to do "triggers" with DBIx::Class are probably +just looking for this. + =head2 Stringification Employ the standard stringification technique by using the C diff --git a/lib/DBIx/Class/Manual/DocMap.pod b/lib/DBIx/Class/Manual/DocMap.pod new file mode 100644 index 0000000..86a6050 --- /dev/null +++ b/lib/DBIx/Class/Manual/DocMap.pod @@ -0,0 +1,64 @@ +=head1 NAME DBIx::Class::Manual::DocMap - What documentation do we have? + +=head1 Manuals + +=over 4 + +=item L - User's Manual overview. + +=item L - Introduction to setting up and using DBIx::Class. + +=item L - Full example Schema. + +=item L - Various short recipes on how to do things. + +=item L - What to do if things go wrong (diagnostics of known error messages). + +=item L - How to write your own DBIx::Class components. + +=item L - What do all those terms mean? + +=back + +=head1 Setting up + +=over 4 + +=item L - Overall schemas, and connection container. + +=item L - Source/Table definition functions. + +=item L - Simple relationships. + +=item L - Relationship details. + +=item L - Magically retrieve auto-incrementing fields. + +=item L - Set of standard components. + +=item L - ? + +=item L - Making objects out of your columns. + +=item L - Dealing with primary keys. + +=item L - Turns the resultsource into a table. + +=item L - Accessor grouping. + + +=back + +=head1 Retrieving and creating data + +=over 4 + +=item L - Selecting and manipulating sets. + +=item L - Dealing with actual data. + +=item L - Virtual methods for all storage types. + +=item L - Storage using L and L. + +=back \ No newline at end of file diff --git a/lib/DBIx/Class/Manual/Intro.pod b/lib/DBIx/Class/Manual/Intro.pod index cad4693..737848f 100644 --- a/lib/DBIx/Class/Manual/Intro.pod +++ b/lib/DBIx/Class/Manual/Intro.pod @@ -324,8 +324,6 @@ L. =item * L -=item * L - =back =cut diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm index e4564c1..aa88043 100644 --- a/lib/DBIx/Class/Relationship/CascadeActions.pm +++ b/lib/DBIx/Class/Relationship/CascadeActions.pm @@ -17,7 +17,7 @@ sub delete { my %rels = map { $_ => $source->relationship_info($_) } $source->relationships; my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels; foreach my $rel (@cascade) { - $self->search_related($rel)->delete; + $self->search_related($rel)->delete_all; } return $ret; } @@ -33,7 +33,7 @@ sub update { my %rels = map { $_ => $source->relationship_info($_) } $source->relationships; my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels; foreach my $rel (@cascade) { - $_->update for $self->$rel; + $_->update for grep defined, $self->$rel; } return $ret; } diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 191151f..0289c0f 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -487,12 +487,13 @@ three records, call: sub slice { my ($self, $min, $max) = @_; - my $attrs = { %{ $self->{attrs} || {} } }; - $attrs->{offset} ||= 0; + my $attrs = {}; # = { %{ $self->{attrs} || {} } }; + $attrs->{offset} = $self->{attrs}{offset} || 0; $attrs->{offset} += $min; $attrs->{rows} = ($max ? ($max - $min + 1) : 1); - my $slice = (ref $self)->new($self->result_source, $attrs); - return (wantarray ? $slice->all : $slice); + return $self->search(undef(), $attrs); + #my $slice = (ref $self)->new($self->result_source, $attrs); + #return (wantarray ? $slice->all : $slice); } =head2 next @@ -514,6 +515,10 @@ Can be used to efficiently iterate over records in the resultset: print $cd->title; } +Note that you need to store the resultset object, and call C on it. +Calling C<< resultset('Table')->next >> repeatedly will always return the +first record from the resultset. + =cut sub next { @@ -801,6 +806,59 @@ sub first { return $_[0]->reset->next; } +# _cond_for_update_delete +# +# update/delete require the condition to be modified to handle +# the differing SQL syntax available. This transforms the $self->{cond} +# appropriately, returning the new condition + +sub _cond_for_update_delete { + my ($self) = @_; + my $cond = {}; + + if (!ref($self->{cond})) { + # No-op. No condition, we're update/deleting everything + } + elsif (ref $self->{cond} eq 'ARRAY') { + $cond = [ + map { + my %hash; + foreach my $key (keys %{$_}) { + $key =~ /([^.]+)$/; + $hash{$1} = $_->{$key}; + } + \%hash; + } @{$self->{cond}} + ]; + } + elsif (ref $self->{cond} eq 'HASH') { + if ((keys %{$self->{cond}})[0] eq '-and') { + $cond->{-and} = [ + map { + my %hash; + foreach my $key (keys %{$_}) { + $key =~ /([^.]+)$/; + $hash{$1} = $_->{$key}; + } + \%hash; + } @{$self->{cond}{-and}} + ]; + } + else { + foreach my $key (keys %{$self->{cond}}) { + $key =~ /([^.]+)$/; + $cond->{$1} = $self->{cond}{$key}; + } + } + } + else { + $self->throw_exception( + "Can't update/delete on resultset with condition unless hash or array"); + } + return $cond; +} + + =head2 update =over 4 @@ -821,8 +879,11 @@ sub update { my ($self, $values) = @_; $self->throw_exception("Values for update must be a hash") unless ref $values eq 'HASH'; + + my $cond = $self->_cond_for_update_delete; + return $self->result_source->storage->update( - $self->result_source->from, $values, $self->{cond} + $self->result_source->from, $values, $cond ); } @@ -871,43 +932,9 @@ sub delete { my ($self) = @_; my $del = {}; - if (!ref($self->{cond})) { - - # No-op. No condition, we're deleting everything - - } elsif (ref $self->{cond} eq 'ARRAY') { + my $cond = $self->_cond_for_update_delete; - $del = [ map { my %hash; - foreach my $key (keys %{$_}) { - $key =~ /([^.]+)$/; - $hash{$1} = $_->{$key}; - }; \%hash; } @{$self->{cond}} ]; - - } elsif (ref $self->{cond} eq 'HASH') { - - if ((keys %{$self->{cond}})[0] eq '-and') { - - $del->{-and} = [ map { my %hash; - foreach my $key (keys %{$_}) { - $key =~ /([^.]+)$/; - $hash{$1} = $_->{$key}; - }; \%hash; } @{$self->{cond}{-and}} ]; - - } else { - - foreach my $key (keys %{$self->{cond}}) { - $key =~ /([^.]+)$/; - $del->{$1} = $self->{cond}{$key}; - } - } - - } else { - $self->throw_exception( - "Can't delete on resultset with condition unless hash or array" - ); - } - - $self->result_source->storage->delete($self->result_source->from, $del); + $self->result_source->storage->delete($self->result_source->from, $cond); return 1; } @@ -1604,6 +1631,20 @@ A arrayref of columns to group by. Can include columns of joined tables. group_by => [qw/ column1 column2 ... /] +=head2 having + +=over 4 + +=item Value: $condition + +=back + +HAVING is a select statement attribute that is applied between GROUP BY and +ORDER BY. It is applied to the after the grouping calculations have been +done. + + having => { 'count(employee)' => { '>=', 100 } } + =head2 distinct =over 4 diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 9d17a04..6e27725 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -441,17 +441,20 @@ sub _connect { $DBI::connect_via = 'connect'; } - if(ref $info[0] eq 'CODE') { - $dbh = &{$info[0]}; - } - else { - $dbh = DBI->connect(@info); - } + eval { + if(ref $info[0] eq 'CODE') { + $dbh = &{$info[0]}; + } + else { + $dbh = DBI->connect(@info); + } + }; $DBI::connect_via = $old_connect_via if $old_connect_via; - $self->throw_exception("DBI Connection failed: $DBI::errstr") - unless $dbh; + if (!$dbh || $@) { + $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr)); + } $dbh; } @@ -467,8 +470,11 @@ an entire code block to be executed transactionally. sub txn_begin { my $self = shift; - $self->dbh->begin_work - if $self->{transaction_depth}++ == 0 and $self->dbh->{AutoCommit}; + if (($self->{transaction_depth}++ == 0) and ($self->dbh->{AutoCommit})) { + $self->debugfh->print("BEGIN WORK\n") + if ($self->debug); + $self->dbh->begin_work; + } } =head2 txn_commit @@ -480,10 +486,18 @@ Issues a commit against the current dbh. sub txn_commit { my $self = shift; if ($self->{transaction_depth} == 0) { - $self->dbh->commit unless $self->dbh->{AutoCommit}; + unless ($self->dbh->{AutoCommit}) { + $self->debugfh->print("COMMIT\n") + if ($self->debug); + $self->dbh->commit; + } } else { - $self->dbh->commit if --$self->{transaction_depth} == 0; + if (--$self->{transaction_depth} == 0) { + $self->debugfh->print("COMMIT\n") + if ($self->debug); + $self->dbh->commit; + } } } @@ -500,12 +514,21 @@ sub txn_rollback { eval { if ($self->{transaction_depth} == 0) { - $self->dbh->rollback unless $self->dbh->{AutoCommit}; + unless ($self->dbh->{AutoCommit}) { + $self->debugfh->print("ROLLBACK\n") + if ($self->debug); + $self->dbh->rollback; + } } else { - --$self->{transaction_depth} == 0 ? - $self->dbh->rollback : + if (--$self->{transaction_depth} == 0) { + $self->debugfh->print("ROLLBACK\n") + if ($self->debug); + $self->dbh->rollback; + } + else { die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new; + } } }; @@ -526,13 +549,20 @@ sub _execute { my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind; $self->debugfh->print("$sql: " . join(', ', @debug_bind) . "\n"); } - my $sth = $self->sth($sql,$op); - $self->throw_exception('no sth generated via sql (' . $self->_dbh->errstr . "): $sql") unless $sth; + my $sth = eval { $self->sth($sql,$op) }; + + if (!$sth || $@) { + $self->throw_exception('no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"); + } + @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args my $rv; if ($sth) { - $rv = $sth->execute(@bind) - or $self->throw_exception("Error executing '$sql': " . $sth->errstr); + $rv = eval { $sth->execute(@bind) }; + + if ($@ || !$rv) { + $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)); + } } else { $self->throw_exception("'$sql' did not generate a statement."); } diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm index 2550adc..770608c 100644 --- a/lib/DBIx/Class/Storage/DBI/Cursor.pm +++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm @@ -160,7 +160,7 @@ sub DESTROY { my ($self) = @_; $self->_check_forks_threads; - $self->{sth}->finish if $self->{sth}->{Active}; + $self->{sth}->finish if $self->{sth} && $self->{sth}->{Active}; } 1; diff --git a/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm b/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm new file mode 100644 index 0000000..f38c03b --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm @@ -0,0 +1,51 @@ +package DBIx::Class::Storage::DBI::MultiDistinctEmulation; + +use strict; +use warnings; + +use base qw/DBIx::Class::Storage::DBI/; + +sub _select { + my ($self, $ident, $select, $condition, $attrs) = @_; + + # hack to make count distincts with multiple columns work in SQLite and Oracle + if (ref $select eq 'ARRAY') { + @{$select} = map {$self->replace_distincts($_)} @{$select}; + } else { + $select = $self->replace_distincts($select); + } + + return $self->next::method($ident, $select, $condition, $attrs); +} + +sub replace_distincts { + my ($self, $select) = @_; + + $select->{count}->{distinct} = join("||", @{$select->{count}->{distinct}}) + if (ref $select eq 'HASH' && $select->{count} && ref $select->{count} eq 'HASH' && + $select->{count}->{distinct} && ref $select->{count}->{distinct} eq 'ARRAY'); + + return $select; +} + +1; + +=head1 NAME + +DBIx::Class::Storage::DBI::Retarded - Some databases can't handle count distincts with multiple cols. They should use base on this. + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +This class allows count distincts with multiple columns for retarded databases (Oracle and SQLite) + +=head1 AUTHORS + +Luke Saunders + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm index 53d657a..cd5449b 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm @@ -5,7 +5,7 @@ use warnings; use Carp qw/croak/; -use base qw/DBIx::Class::Storage::DBI/; +use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; # __PACKAGE__->load_components(qw/PK::Auto/); diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm index 6b7e749..091b5e7 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLite.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm @@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::SQLite; use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI/; +use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; sub last_insert_id { return $_[0]->dbh->func('last_insert_rowid'); diff --git a/t/lib/DBICTest/Setup.pm b/t/lib/DBICTest/Setup.pm index a7efea5..816a64c 100755 --- a/t/lib/DBICTest/Setup.pm +++ b/t/lib/DBICTest/Setup.pm @@ -118,4 +118,23 @@ $schema->populate('TreeLike', [ [ 4, 3, 'quux' ], ]); +$schema->populate('Track', [ + [ qw/trackid cd position title/ ], + [ 4, 2, 1, "Stung with Success"], + [ 5, 2, 2, "Stripy"], + [ 6, 2, 3, "Sticky Honey"], + [ 7, 3, 1, "Yowlin"], + [ 8, 3, 2, "Howlin"], + [ 9, 3, 3, "Fowlin"], + [ 10, 4, 1, "Boring Name"], + [ 11, 4, 2, "Boring Song"], + [ 12, 4, 3, "No More Ideas"], + [ 13, 5, 1, "Sad"], + [ 14, 5, 2, "Under The Weather"], + [ 15, 5, 3, "Suicidal"], + [ 16, 1, 1, "The Bees Knees"], + [ 17, 1, 2, "Apiary"], + [ 18, 1, 3, "Beehind You"], +]); + 1; diff --git a/t/run/01core.tl b/t/run/01core.tl index d2fcd24..5d04001 100644 --- a/t/run/01core.tl +++ b/t/run/01core.tl @@ -1,7 +1,20 @@ sub run_tests { my $schema = shift; -plan tests => 46; +plan tests => 49; + +# figure out if we've got a version of sqlite that is older than 3.2.6, in +# which case COUNT(DISTINCT()) doesn't work +my $is_broken_sqlite = 0; +my ($sqlite_major_ver,$sqlite_minor_ver,$sqlite_patch_ver) = + split /\./, $schema->storage->dbh->get_info(18); +if( $schema->storage->dbh->get_info(17) eq 'SQLite' && + ( ($sqlite_major_ver < 3) || + ($sqlite_major_ver == 3 && $sqlite_minor_ver < 2) || + ($sqlite_major_ver == 3 && $sqlite_minor_ver == 2 && $sqlite_patch_ver < 6) ) ) { + $is_broken_sqlite = 1; +} + my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'}); @@ -133,9 +146,22 @@ my $or_rs = $schema->resultset("CD")->search($search, { join => 'tags', cmp_ok($or_rs->count, '==', 5, 'Search with OR ok'); my $distinct_rs = $schema->resultset("CD")->search($search, { join => 'tags', distinct => 1 }); - cmp_ok($distinct_rs->all, '==', 4, 'DISTINCT search with OR ok'); +SKIP: { + skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1 + if $is_broken_sqlite; + + my $tcount = $schema->resultset("Track")->search( + {}, + { + select => {count => {distinct => ['position', 'title']}}, + as => ['count'] + } + ); + cmp_ok($tcount->next->get_column('count'), '==', 13, 'multiple column COUNT DISTINCT ok'); + +} my $tag_rs = $schema->resultset('Tag')->search( [ { 'me.tag' => 'Cheesy' }, { 'me.tag' => 'Blue' } ]); @@ -144,7 +170,8 @@ my $rel_rs = $tag_rs->search_related('cd'); cmp_ok($rel_rs->count, '==', 5, 'Related search ok'); cmp_ok($or_rs->next->cdid, '==', $rel_rs->next->cdid, 'Related object ok'); - +$or_rs->reset; +$rel_rs->reset; my $tag = $schema->resultset('Tag')->search( [ { 'me.tag' => 'Blue' } ], { cols=>[qw/tagid/] } )->next; @@ -154,6 +181,12 @@ cmp_ok($tag->has_column_loaded('tag'), '==', 0, 'Has not tag loaded'); ok($schema->storage(), 'Storage available'); +#test cascade_delete thru many_many relations +my $art_del = $schema->resultset("Artist")->find({ artistid => 1 }); +$art_del->delete; +cmp_ok( $schema->resultset("CD")->search({artist => 1}), '==', 0, 'Cascading through has_many top level.'); +cmp_ok( $schema->resultset("CD_to_Producer")->search({cd => 1}), '==', 0, 'Cascading through has_many children.'); + $schema->source("Artist")->{_columns}{'artistid'} = {}; my $typeinfo = $schema->source("Artist")->column_info('artistid'); diff --git a/t/run/06relationship.tl b/t/run/06relationship.tl index 65a2419..04d1e36 100644 --- a/t/run/06relationship.tl +++ b/t/run/06relationship.tl @@ -3,7 +3,7 @@ my $schema = shift; use strict; use warnings; -plan tests => 20; +plan tests => 25; # has_a test my $cd = $schema->resultset("CD")->find(4); @@ -131,6 +131,20 @@ my $searched = $mapped_rs->search({'mapped_artists.artistid' => {'!=', undef}}); cmp_ok($searched->count, '==', 2, "Both artist returned from map after adding another condition"); +# check join through cascaded has_many relationships +$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"); + +# now see about updating eveything that belongs to artist 2 to artist 3 +$artist = $schema->resultset("Artist")->find(2); +my $nartist = $schema->resultset("Artist")->find(3); +cmp_ok($artist->cds->count, '==', 1, "Correct orig #cds for artist"); +cmp_ok($nartist->cds->count, '==', 1, "Correct orig #cds for artist"); +$artist->cds->update({artist => $nartist->id}); +cmp_ok($artist->cds->count, '==', 0, "Correct new #cds for artist"); +cmp_ok($nartist->cds->count, '==', 2, "Correct new #cds for artist"); } diff --git a/t/run/13oracle.tl b/t/run/13oracle.tl index 278e663..f38b767 100644 --- a/t/run/13oracle.tl +++ b/t/run/13oracle.tl @@ -7,7 +7,7 @@ plan skip_all, 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' 'Warning: This test drops and creates tables called \'artist\', \'cd\' and \'track\'' unless ($dsn && $user && $pass); -plan tests => 5; +plan tests => 6; DBICTest::Schema->compose_connection('OraTest' => $dsn, $user, $pass); @@ -56,6 +56,17 @@ my $tjoin = OraTest::Track->search({ 'me.title' => 'Track1'}, is($tjoin->next->title, 'Track1', "ambiguous column ok"); +# check count distinct with multiple columns +my $other_track = OraTest::Track->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' }); +my $tcount = OraTest::Track->search( + {}, + { + select => [{count => {distinct => ['position', 'title']}}], + as => ['count'] + } + ); + +is($tcount->next->get_column('count'), 2, "multiple column select distinct ok"); # test LIMIT support for (1..6) {