- 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
# 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) = @_;
=head1 WHERE TO GO NEXT
-=over 4
-
-=item L<DBIx::Class::Manual> - user's manual
-
-=item L<DBIx::Class::Core> - DBIC Core Classes
-
-=item L<DBIx::Class::CDBICompat> - L<Class::DBI> Compat layer
-
-=item L<DBIx::Class::Schema> - schema and connection container
-
-=item L<DBIx::Class::ResultSource> - tables and table-like things
-
-=item L<DBIx::Class::ResultSet> - encapsulates a query and its results
-
-=item L<DBIx::Class::Row> - row-level methods
-
-=item L<DBIx::Class::PK> - primary key methods
-
-=item L<DBIx::Class::Relationship> - relationships between tables
-
-=back
+L<DBIx::Class::Manual::DocMap> lists each task you might want help on, and
+the modules where you will find documentation.
=head1 AUTHOR
sszabo: Stephan Szabo <sszabo@bigpanda.com>
+captainL: Luke Saunders <luke.saunders@gmail.com>
+
Todd Lipcon
wdh: Will Hawes
=head2 L<DBIx::Class::Manual::Cookbook>
-Convenient reciepes for DBIC usage.
+Convenient recipes for DBIC usage.
-=head2 L<DBIx::Class::Manual::FAQ>
+=head2 L<DBIx::Class::Manual::DocMap>
-Frequently asked questions about DBIC.
+Lists of modules by task to help you find the correct document.
=head2 L<DBIx::Class::Manual::Troubleshooting>
=head2 L<DBIx::Class::Manual::Component>
-Listing of existing components, and documentation and example on how to
+Existing components, and documentation and example on how to
develop new ones.
=cut
=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
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
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.
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<Class::C3>. As well as
+providing custom utility methods, a component may also
+override methods provided by other core components, like
+L<DBIx::Class::Row> 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<Class::C3> docs for more information about inheritance.
+
=head1 EXISTING COMPONENTS
=head2 Extra
L<DBIx::Class::Row> - 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<Class::C3>. As well as
-providing custom utility methods, a component may also
-override methods provided by other core components, like
-L<DBIx::Class::Row> 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<Class::C3> docs for more information about inheritance.
-
=head1 SEE ALSO
L<DBIx::Class::Manual::Cookbook>
-L<DBIx::Class::Manual::FAQ>
-
=head1 AUTHOR
Aran Clary Deltac <bluefeet@cpan.org>
}
);
+ my $count = $rs->next->get_column('count');
+
=head3 SELECT COUNT(DISTINCT colname)
my $rs = $schema->resultset('Foo')->search(
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<join> attribute to allow searching on, or sorting your
$class->next::method($attrs);
}
+For more information about C<next::method>, look in the L<Class::C3>
+documentation. See also L<DBIx::Class::Manual::Component> 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<overload>
--- /dev/null
+=head1 NAME DBIx::Class::Manual::DocMap - What documentation do we have?
+
+=head1 Manuals
+
+=over 4
+
+=item L<DBIx::Class::Manual> - User's Manual overview.
+
+=item L<DBIx::Class::Manual::Intro> - Introduction to setting up and using DBIx::Class.
+
+=item L<DBIx::Class::Manual::Example> - Full example Schema.
+
+=item L<DBIx::Class::Manual::Cookbook> - Various short recipes on how to do things.
+
+=item L<DBIx::Class::Manual::Troubleshooting> - What to do if things go wrong (diagnostics of known error messages).
+
+=item L<DBIx::Class::Manual::Component> - How to write your own DBIx::Class components.
+
+=item L<DBIx::Class::Manual::Glossary> - What do all those terms mean?
+
+=back
+
+=head1 Setting up
+
+=over 4
+
+=item L<DBIx::Class::Schema> - Overall schemas, and connection container.
+
+=item L<DBIx::Class::ResultSource> - Source/Table definition functions.
+
+=item L<DBIx::Class::Relationship> - Simple relationships.
+
+=item L<DBIx::Class::Relationship::Base> - Relationship details.
+
+=item L<DBIx::Class::PK::Auto> - Magically retrieve auto-incrementing fields.
+
+=item L<DBIx::Class::Core> - Set of standard components.
+
+=item L<DBIx::Class::Serialize::Storable> - ?
+
+=item L<DBIx::Class::InflateColumn> - Making objects out of your columns.
+
+=item L<DBIx::Class::PK> - Dealing with primary keys.
+
+=item L<DBIx::Class::ResultSourceProxy::Table> - Turns the resultsource into a table.
+
+=item L<DBIx::Class::AccessorGroup> - Accessor grouping.
+
+
+=back
+
+=head1 Retrieving and creating data
+
+=over 4
+
+=item L<DBIx::Class::ResultSet> - Selecting and manipulating sets.
+
+=item L<DBIx::Class::Row> - Dealing with actual data.
+
+=item L<DBIx::Class::Storage> - Virtual methods for all storage types.
+
+=item L<DBIx::Class::Storage::DBI> - Storage using L<DBI> and L<SQL::Abstract>.
+
+=back
\ No newline at end of file
=item * L<DBIx::Class::Manual::Cookbook>
-=item * L<DBIx::Class::Manual::FAQ>
-
=back
=cut
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;
}
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;
}
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
print $cd->title;
}
+Note that you need to store the resultset object, and call C<next> on it.
+Calling C<< resultset('Table')->next >> repeatedly will always return the
+first record from the resultset.
+
=cut
sub next {
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
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
);
}
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;
}
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
$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;
}
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
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;
+ }
}
}
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;
+ }
}
};
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.");
}
my ($self) = @_;
$self->_check_forks_threads;
- $self->{sth}->finish if $self->{sth}->{Active};
+ $self->{sth}->finish if $self->{sth} && $self->{sth}->{Active};
}
1;
--- /dev/null
+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 <luke.saunders@gmail.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
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/);
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');
[ 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;
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'});
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' } ]);
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;
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');
use strict;
use warnings;
-plan tests => 20;
+plan tests => 25;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
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");
}
'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);
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) {
projects / dbsrgits/DBIx-Class.git / commitdiff