From: Matt S Trout Date: Tue, 11 Apr 2006 16:01:09 +0000 (+0000) Subject: Merge 'trunk' into 'DBIx-Class-current' X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fed966517e558cfc9ee505d44add2d04e77a7d3d;hp=-c;p=dbsrgits%2FDBIx-Class-Historic.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 --- fed966517e558cfc9ee505d44add2d04e77a7d3d diff --combined Changes index b1d2c80,d7e4333..c33cc68 --- a/Changes +++ b/Changes @@@ -1,12 -1,15 +1,20 @@@ Revision history for DBIx::Class + - added remove_column(s) to ResultSource/ResultSourceProxy + - added add_column alias to ResultSourceProxy + - added source_name to ResultSource + - 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 @@@ -71,7 -74,7 +79,7 @@@ - remove build dependency on version.pm 0.05004 2006-02-13 20:59:00 - - allow specification of related columns via cols attr when primary + - allow specification of related columns via cols attr when primary keys of the related table are not fetched - fix count for group_by as scalar - add horrific fix to make Oracle's retarded limit syntax work diff --combined lib/DBIx/Class/Manual/Component.pod index 4de2536,2607e36..9bbe684 --- a/lib/DBIx/Class/Manual/Component.pod +++ b/lib/DBIx/Class/Manual/Component.pod @@@ -1,7 -1,14 +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 +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 +25,7 @@@ it and just include the rest. If you d 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 +38,45 @@@ docs for the components you are using a 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 @@@ -44,8 -90,6 +90,8 @@@ L - Build form L - Like FromForm but with DBIx::Class and HTML::Widget. +L - Modify the position of objects in an ordered list. + L - Retrieve automatically created primary keys upon insert. L - Display the amount of time it takes to run queries. @@@ -92,51 -136,10 +138,10 @@@ 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 --combined lib/DBIx/Class/ResultSet.pm index 191151f,08e81b5..0289c0f --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@@ -10,7 -10,6 +10,7 @@@ use Data::Page use Storable; use Scalar::Util qw/weaken/; +use DBIx::Class::ResultSetColumn; use base qw/DBIx::Class/; __PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/); @@@ -415,28 -414,6 +415,28 @@@ sub single return (@data ? $self->_construct_object(@data) : ()); } +=head2 get_column + +=over 4 + +=item Arguments: $cond? + +=item Return Value: $resultsetcolumn + +=back + + my $max_length = $rs->get_column('length')->max; + +Returns a ResultSetColumn instance for $column based on $self + +=cut + +sub get_column { + my ($self, $column) = @_; + + my $new = DBIx::Class::ResultSetColumn->new($self, $column); + return $new; +} =head2 search_like @@@ -487,12 -464,13 +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 -492,10 +515,10 @@@ Can be used to efficiently iterate ove 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 -783,59 +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 -856,11 +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 -909,9 +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 -1608,20 +1631,20 @@@ A arrayref of columns to group by. Can 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 --combined lib/DBIx/Class/Storage/DBI.pm index 9d17a04,8bcb424..6e27725 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@@ -240,7 -240,7 +240,7 @@@ use base qw/DBIx::Class/ __PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => - qw/connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh + qw/_connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh cursor on_connect_do transaction_depth/); sub new { @@@ -277,25 -277,6 +277,25 @@@ This class represents the connection t =cut +=head2 connect_info + +Connection information arrayref. Can either be the same arguments +one would pass to DBI->connect, or a code-reference which returns +a connected database handle. In either case, there is an optional +final element in the arrayref, which can hold a hashref of +connection-specific Storage::DBI options. These include +C, and the sql_maker options C, +C, and C. Examples: + + ->connect_info([ 'dbi:SQLite:./foo.db' ]); + ->connect_info(sub { DBI->connect(...) }); + ->connect_info([ 'dbi:Pg:dbname=foo', + 'postgres', + '', + { AutoCommit => 0 }, + { quote_char => q{`}, name_sep => q{@} }, + ]); + =head2 on_connect_do Executes the sql statements given as a listref on every db connect. @@@ -379,40 -360,9 +379,40 @@@ sub sql_maker return $self->_sql_maker; } +sub connect_info { + my ($self, $info_arg) = @_; + + if($info_arg) { + my $info = [ @$info_arg ]; # copy because we can alter it + my $last_info = $info->[-1]; + if(ref $last_info eq 'HASH') { + my $used; + if(my $on_connect_do = $last_info->{on_connect_do}) { + $used = 1; + $self->on_connect_do($on_connect_do); + } + for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) { + if(my $opt_val = $last_info->{$sql_maker_opt}) { + $used = 1; + $self->sql_maker->$sql_maker_opt($opt_val); + } + } + + # remove our options hashref if it was there, to avoid confusing + # DBI in the case the user didn't use all 4 DBI options, as in: + # [ 'dbi:SQLite:foo.db', { quote_char => q{`} } ] + pop(@$info) if $used; + } + + $self->_connect_info($info); + } + + $self->_connect_info; +} + sub _populate_dbh { my ($self) = @_; - my @info = @{$self->connect_info || []}; + my @info = @{$self->_connect_info || []}; $self->_dbh($self->_connect(@info)); my $driver = $self->_dbh->{Driver}->{Name}; eval "require DBIx::Class::Storage::DBI::${driver}"; @@@ -441,17 -391,20 +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 -420,11 +470,11 @@@ an entire code block to be executed tra 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 -436,18 +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 -464,21 +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 -499,20 +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 --combined t/run/01core.tl index d2fcd24,9ef60a0..5d04001 --- a/t/run/01core.tl +++ b/t/run/01core.tl @@@ -1,7 -1,20 +1,20 @@@ sub run_tests { my $schema = shift; - plan tests => 46; -plan tests => 44; ++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 +146,22 @@@ my $or_rs = $schema->resultset("CD")->s 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 +170,8 @@@ my $rel_rs = $tag_rs->search_related('c 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 +181,12 @@@ cmp_ok($tag->has_column_loaded('tag'), 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'); @@@ -161,21 -194,6 +194,21 @@@ is($typeinfo->{data_type}, 'INTEGER', ' $schema->source("Artist")->column_info('artistid'); ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info flag set'); +# source_name should be set for normal modules +is($schema->source('CD')->source_name, 'CD', 'source_name is set to moniker'); + +# test the result source that uses source_name +ok($schema->source('SourceNameArtists'), 'SourceNameArtists result source exists'); + +my @artsn = $schema->resultset("SourceNameArtists")->search({ }, { order_by => 'name DESC'}); +cmp_ok(@artsn, '==', 4, "Four artists returned"); + + +# test removed columns +is_deeply([$schema->source('CD')->columns], [qw/cdid artist title year/]); +$schema->source('CD')->remove_columns('year'); +is_deeply([$schema->source('CD')->columns], [qw/cdid artist title/]); + } 1;