From: Peter Rabbitson Date: Thu, 11 Feb 2010 11:21:52 +0000 (+0000) Subject: Merge 'trunk' into 'chaining_fixes' X-Git-Tag: v0.08119~18^2~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=35c73cf2e834508727b1268d88ead2236c5a0621;hp=3da3dd38e6742da6637ea69e845d4e9d2ca75578;p=dbsrgits%2FDBIx-Class.git Merge 'trunk' into 'chaining_fixes' r8580@Thesaurus (orig r8567): gshank | 2010-02-05 22:29:24 +0100 add doc on 'where' attribute r8587@Thesaurus (orig r8574): frew | 2010-02-07 21:07:03 +0100 add as_subselect_rs r8588@Thesaurus (orig r8575): frew | 2010-02-07 21:13:04 +0100 fix longstanding unmentioned bug ("me") r8589@Thesaurus (orig r8576): frew | 2010-02-08 06:17:43 +0100 another example of as_subselect_rs r8590@Thesaurus (orig r8577): frew | 2010-02-08 06:23:58 +0100 fix bug in UTF8Columns r8591@Thesaurus (orig r8578): ribasushi | 2010-02-08 09:31:01 +0100 Extend utf8columns test to trap fixed bug r8592@Thesaurus (orig r8579): ribasushi | 2010-02-08 12:03:23 +0100 Cleanup rel accessor type handling r8593@Thesaurus (orig r8580): ribasushi | 2010-02-08 12:20:47 +0100 Fix some fallout r8595@Thesaurus (orig r8582): ribasushi | 2010-02-08 12:38:19 +0100 Merge some obsolete code cleanup from the prefetch branch r8596@Thesaurus (orig r8583): ribasushi | 2010-02-08 12:42:09 +0100 Merge fix of RT54039 from prefetch branch r8598@Thesaurus (orig r8585): ribasushi | 2010-02-08 12:48:31 +0100 Release 0.08118 r8600@Thesaurus (orig r8587): ribasushi | 2010-02-08 12:52:33 +0100 Bump trunk version r8606@Thesaurus (orig r8593): ribasushi | 2010-02-08 16:16:44 +0100 cheaper lookup r8609@Thesaurus (orig r8596): ribasushi | 2010-02-10 12:40:37 +0100 Consolidate last_insert_id handling with a fallback-attempt on DBI::last_insert_id r8614@Thesaurus (orig r8601): caelum | 2010-02-10 21:29:51 +0100 workaround for Moose bug affecting Replicated storage r8615@Thesaurus (orig r8602): caelum | 2010-02-10 21:40:07 +0100 revert Moose bug workaround, bump Moose dep for Replicated to 0.98 r8616@Thesaurus (orig r8603): caelum | 2010-02-10 22:48:34 +0100 add a couple proxy methods to Replicated so it can run r8628@Thesaurus (orig r8615): caelum | 2010-02-11 11:35:01 +0100 r21090@hlagh (orig r7836): caelum | 2009-11-02 06:40:52 -0500 new branch to fix unhandled methods in Storage::DBI::Replicated r21091@hlagh (orig r7837): caelum | 2009-11-02 06:42:00 -0500 add test to display unhandled methods r21092@hlagh (orig r7838): caelum | 2009-11-02 06:55:34 -0500 minor fix to last committed test r21093@hlagh (orig r7839): caelum | 2009-11-02 09:26:00 -0500 minor test code cleanup r23125@hlagh (orig r8607): caelum | 2010-02-10 19:25:51 -0500 add unimplemented Storage::DBI methods to ::DBI::Replicated r23130@hlagh (orig r8612): ribasushi | 2010-02-11 05:12:48 -0500 Podtesting exclusion r8630@Thesaurus (orig r8617): frew | 2010-02-11 11:45:54 +0100 Changes (from a while ago) r8631@Thesaurus (orig r8618): caelum | 2010-02-11 11:46:58 +0100 savepoints for SQLAnywhere --- diff --git a/Changes b/Changes index 3146e10..efb7481 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,13 @@ Revision history for DBIx::Class + - Add as_subselect_rs to DBIC::ResultSet from + DBIC::Helper::ResultSet::VirtualView::as_virtual_view + +0.08118 2010-02-08 11:53:00 (UTC) + - Fix a bug causing UTF8 columns not to be decoded (RT#54395) + - Fix bug in One->Many->One prefetch-collapse handling (RT#54039) + - Cleanup handling of relationship accessor types + 0.08117 2010-02-05 17:10:00 (UTC) - Perl 5.8.1 is now the minimum supported version - Massive optimization of the join resolution code - now joins diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index 2723dd8..60a4f75 100644 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@ -25,7 +25,7 @@ sub component_base_class { 'DBIx::Class' } # Always remember to do all digits for the version even if they're 0 # 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.08117_01'; +$VERSION = '0.08118_01'; $VERSION = eval $VERSION; # numify for warning-free dev releases diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm index 06f6ffc..5dec97d 100644 --- a/lib/DBIx/Class/InflateColumn.pm +++ b/lib/DBIx/Class/InflateColumn.pm @@ -79,7 +79,8 @@ sub inflate_column { $self->throw_exception("inflate_column needs attr hashref") unless ref $attrs eq 'HASH'; $self->column_info($col)->{_inflate_info} = $attrs; - $self->mk_group_accessors('inflated_column' => [$self->column_info($col)->{accessor} || $col, $col]); + my $acc = $self->column_info($col)->{accessor}; + $self->mk_group_accessors('inflated_column' => [ (defined $acc ? $acc : $col), $col]); return 1; } diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 7cd3214..daf853d 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -30,6 +30,8 @@ methods, for predefined ones, look in L. __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs); +=head3 condition + The condition needs to be an L-style representation of the join between the tables. When resolving the condition for use in a C, keys using the pseudo-table C are resolved to mean "the Table on the @@ -67,9 +69,18 @@ Each key-value pair provided in a hashref will be used as Ced conditions. To add an Ced condition, use an arrayref of hashrefs. See the L documentation for more details. -In addition to the -L, -the following attributes are also valid: +=head3 attributes + +The L may +be used as relationship attributes. In particular, the 'where' attribute is +useful for filtering relationships: + + __PACKAGE__->has_many( 'valid_users', 'MyApp::Schema::User', + { 'foreign.user_id' => 'self.user_id' }, + { where => { valid => 1 } } + ); + +The following attributes are also valid: =over 4 @@ -195,7 +206,7 @@ sub related_resultset { if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) { my $reverse = $source->reverse_relationship_info($rel); foreach my $rev_rel (keys %$reverse) { - if ($reverse->{$rev_rel}{attrs}{accessor} eq 'multi') { + if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') { $attrs->{related_objects}{$rev_rel} = [ $self ]; Scalar::Util::weaken($attrs->{related_object}{$rev_rel}[0]); } else { diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm index e5afd35..c3a66ea 100644 --- a/lib/DBIx/Class/Relationship/CascadeActions.pm +++ b/lib/DBIx/Class/Relationship/CascadeActions.pm @@ -39,8 +39,11 @@ sub update { my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels; foreach my $rel (@cascade) { next if ( + $rels{$rel}{attrs}{accessor} + && $rels{$rel}{attrs}{accessor} eq 'single' - && !exists($self->{_relationship_data}{$rel}) + && + !exists($self->{_relationship_data}{$rel}) ); $_->update for grep defined, $self->$rel; } diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 06ea0ff..813ed89 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2592,6 +2592,68 @@ sub current_source_alias { return ($self->{attrs} || {})->{alias} || 'me'; } +=head2 as_subselect_rs + +=over 4 + +=item Arguments: none + +=item Return Value: $resultset + +=back + +Act as a barrier to SQL symbols. The resultset provided will be made into a +"virtual view" by including it as a subquery within the from clause. From this +point on, any joined tables are inaccessible to ->search on the resultset (as if +it were simply where-filtered without joins). For example: + + my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' }); + + # 'x' now pollutes the query namespace + + # So the following works as expected + my $ok_rs = $rs->search({'x.other' => 1}); + + # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and + # def) we look for one row with contradictory terms and join in another table + # (aliased 'x_2') which we never use + my $broken_rs = $rs->search({'x.name' => 'def'}); + + my $rs2 = $rs->as_subselect_rs; + + # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away + my $not_joined_rs = $rs2->search({'x.other' => 1}); + + # works as expected: finds a 'table' row related to two x rows (abc and def) + my $correctly_joined_rs = $rs2->search({'x.name' => 'def'}); + +Another example of when one might use this would be to select a subset of +columns in a group by clause: + + my $rs = $schema->resultset('Bar')->search(undef, { + group_by => [qw{ id foo_id baz_id }], + })->as_subselect_rs->search(undef, { + columns => [qw{ id foo_id }] + }); + +In the above example normally columns would have to be equal to the group by, +but because we isolated the group by into a subselect the above works. + +=cut + +sub as_subselect_rs { + my $self = shift; + + return $self->result_source->resultset->search( undef, { + alias => $self->current_source_alias, + from => [{ + $self->current_source_alias => $self->as_query, + -alias => $self->current_source_alias, + -source_handle => $self->result_source->handle, + }] + }); +} + # This code is called by search_related, and makes sure there # is clear separation between the joins before, during, and # after the relationship. This information is needed later diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 824c34d..1b9baa8 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -1188,12 +1188,6 @@ sub _compare_relationship_keys { return $found; } -sub resolve_join { - carp 'resolve_join is a private method, stop calling it'; - my $self = shift; - $self->_resolve_join (@_); -} - # Returns the {from} structure used to express JOIN conditions sub _resolve_join { my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_; @@ -1262,7 +1256,11 @@ sub _resolve_join { : $rel_info->{attrs}{join_type} , -join_path => [@$jpath, { $join => $as } ], - -is_single => (List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/) ), + -is_single => ( + $rel_info->{attrs}{accessor} + && + List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/) + ), -alias => $as, -relation_chain_depth => $seen->{-relation_chain_depth} || 0, }, @@ -1373,77 +1371,6 @@ sub _resolve_condition { } } -# Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch) -sub resolve_prefetch { - carp 'resolve_prefetch is a private method, stop calling it'; - - my ($self, $pre, $alias, $seen, $order, $collapse) = @_; - $seen ||= {}; - if( ref $pre eq 'ARRAY' ) { - return - map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) } - @$pre; - } - elsif( ref $pre eq 'HASH' ) { - my @ret = - map { - $self->resolve_prefetch($_, $alias, $seen, $order, $collapse), - $self->related_source($_)->resolve_prefetch( - $pre->{$_}, "${alias}.$_", $seen, $order, $collapse) - } keys %$pre; - return @ret; - } - elsif( ref $pre ) { - $self->throw_exception( - "don't know how to resolve prefetch reftype ".ref($pre)); - } - else { - my $count = ++$seen->{$pre}; - my $as = ($count > 1 ? "${pre}_${count}" : $pre); - my $rel_info = $self->relationship_info( $pre ); - $self->throw_exception( $self->name . " has no such relationship '$pre'" ) - unless $rel_info; - my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : ''); - my $rel_source = $self->related_source($pre); - - if (exists $rel_info->{attrs}{accessor} - && $rel_info->{attrs}{accessor} eq 'multi') { - $self->throw_exception( - "Can't prefetch has_many ${pre} (join cond too complex)") - unless ref($rel_info->{cond}) eq 'HASH'; - my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}" - if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots } - keys %{$collapse}) { - my ($last) = ($fail =~ /([^\.]+)$/); - carp ( - "Prefetching multiple has_many rels ${last} and ${pre} " - .(length($as_prefix) - ? "at the same level (${as_prefix}) " - : "at top level " - ) - . 'will explode the number of row objects retrievable via ->next or ->all. ' - . 'Use at your own risk.' - ); - } - #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); } - # values %{$rel_info->{cond}}; - $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ]; - # action at a distance. prepending the '.' allows simpler code - # in ResultSet->_collapse_result - my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); } - keys %{$rel_info->{cond}}; - my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY' - ? @{$rel_info->{attrs}{order_by}} - : (defined $rel_info->{attrs}{order_by} - ? ($rel_info->{attrs}{order_by}) - : ())); - push(@$order, map { "${as}.$_" } (@key, @ord)); - } - - return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } - $rel_source->columns; - } -} # Accepts one or more relationships for the current source and returns an # array of column names for each of those relationships. Column names are @@ -1492,8 +1419,7 @@ sub _resolve_prefetch { my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : ''); my $rel_source = $self->related_source($pre); - if (exists $rel_info->{attrs}{accessor} - && $rel_info->{attrs}{accessor} eq 'multi') { + if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') { $self->throw_exception( "Can't prefetch has_many ${pre} (join cond too complex)") unless ref($rel_info->{cond}) eq 'HASH'; @@ -1520,7 +1446,8 @@ sub _resolve_prefetch { keys %{$rel_info->{cond}}; my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY' ? @{$rel_info->{attrs}{order_by}} - : (defined $rel_info->{attrs}{order_by} + + : (defined $rel_info->{attrs}{order_by} ? ($rel_info->{attrs}{order_by}) : ())); push(@$order, map { "${as}.$_" } (@key, @ord)); diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index a77615b..eafafe9 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -171,9 +171,8 @@ sub new { $new->throw_exception("Can't do multi-create without result source") unless $source; my $info = $source->relationship_info($key); - if ($info && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'single') - { + my $acc_type = $info->{attrs}{accessor} || ''; + if ($acc_type eq 'single') { my $rel_obj = delete $attrs->{$key}; if(!Scalar::Util::blessed($rel_obj)) { $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj); @@ -188,9 +187,8 @@ sub new { $related->{$key} = $rel_obj; next; - } elsif ($info && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'multi' - && ref $attrs->{$key} eq 'ARRAY') { + } + elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) { my $others = delete $attrs->{$key}; my $total = @$others; my @objects; @@ -210,9 +208,8 @@ sub new { } $related->{$key} = \@objects; next; - } elsif ($info && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'filter') - { + } + elsif ($acc_type eq 'filter') { ## 'filter' should disappear and get merged in with 'single' above! my $rel_obj = delete $attrs->{$key}; if(!Scalar::Util::blessed($rel_obj)) { @@ -763,9 +760,7 @@ sub get_inflated_columns { for my $col (keys %loaded_colinfo) { if (exists $loaded_colinfo{$col}{accessor}) { my $acc = $loaded_colinfo{$col}{accessor}; - if (defined $acc) { - $inflated{$col} = $self->$acc; - } + $inflated{$col} = $self->$acc if defined $acc; } else { $inflated{$col} = $self->$col; @@ -917,21 +912,18 @@ sub set_inflated_columns { foreach my $key (keys %$upd) { if (ref $upd->{$key}) { my $info = $self->relationship_info($key); - if ($info && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'single') - { + my $acc_type = $info->{attrs}{accessor} || ''; + if ($acc_type eq 'single') { my $rel = delete $upd->{$key}; $self->set_from_related($key => $rel); $self->{_relationship_data}{$key} = $rel; - } elsif ($info && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'multi') { - $self->throw_exception( - "Recursive update is not supported over relationships of type multi ($key)" - ); } - elsif ($self->has_column($key) - && exists $self->column_info($key)->{_inflate_info}) - { + elsif ($acc_type eq 'multi') { + $self->throw_exception( + "Recursive update is not supported over relationships of type '$acc_type' ($key)" + ); + } + elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) { $self->set_inflated_column($key, delete $upd->{$key}); } } @@ -1070,9 +1062,10 @@ sub inflate_result { my ($source_handle) = $source; if ($source->isa('DBIx::Class::ResultSourceHandle')) { - $source = $source_handle->resolve - } else { - $source_handle = $source->handle + $source = $source_handle->resolve + } + else { + $source_handle = $source->handle } my $new = { @@ -1081,17 +1074,29 @@ sub inflate_result { }; bless $new, (ref $class || $class); - my $schema; foreach my $pre (keys %{$prefetch||{}}) { - my $pre_val = $prefetch->{$pre}; - my $pre_source = $source->related_source($pre); - $class->throw_exception("Can't prefetch non-existent relationship ${pre}") - unless $pre_source; - if (ref($pre_val->[0]) eq 'ARRAY') { # multi - my @pre_objects; - for my $me_pref (@$pre_val) { + my $pre_source = $source->related_source($pre) + or $class->throw_exception("Can't prefetch non-existent relationship ${pre}"); + + my $accessor = $source->relationship_info($pre)->{attrs}{accessor} + or $class->throw_exception("No accessor for prefetched $pre"); + + my @pre_vals; + if (ref $prefetch->{$pre}[0] eq 'ARRAY') { + @pre_vals = @{$prefetch->{$pre}}; + } + elsif ($accessor eq 'multi') { + $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor 'multi'"); + } + else { + @pre_vals = $prefetch->{$pre}; + } + + my @pre_objects; + for my $me_pref (@pre_vals) { + # FIXME - this should not be necessary # the collapser currently *could* return bogus elements with all # columns set to undef my $has_def; @@ -1106,29 +1111,16 @@ sub inflate_result { push @pre_objects, $pre_source->result_class->inflate_result( $pre_source, @$me_pref ); - } + } - $new->related_resultset($pre)->set_cache(\@pre_objects); - } elsif (defined $pre_val->[0]) { - my $fetched; - unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_} - and !defined $pre_val->[0]{$_} } $pre_source->primary_columns) - { - $fetched = $pre_source->result_class->inflate_result( - $pre_source, @{$pre_val}); - } - my $accessor = $source->relationship_info($pre)->{attrs}{accessor}; - $class->throw_exception("No accessor for prefetched $pre") - unless defined $accessor; - if ($accessor eq 'single') { - $new->{_relationship_data}{$pre} = $fetched; - } elsif ($accessor eq 'filter') { - $new->{_inflated_column}{$pre} = $fetched; - } else { - $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor '$accessor'"); - } - $new->related_resultset($pre)->set_cache([ $fetched ]); + if ($accessor eq 'single') { + $new->{_relationship_data}{$pre} = $pre_objects[0]; } + elsif ($accessor eq 'filter') { + $new->{_inflated_column}{$pre} = $pre_objects[0]; + } + + $new->related_resultset($pre)->set_cache(\@pre_objects); } $new->in_storage (1); diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 4333c4e..32c6ed1 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -2053,18 +2053,14 @@ Return the row id of the last insert. =cut sub _dbh_last_insert_id { - # All Storage's need to register their own _dbh_last_insert_id - # the old SQLite-based method was highly inappropriate + my ($self, $dbh, $source, $col) = @_; - my $self = shift; - my $class = ref $self; - $self->throw_exception (<last_insert_id (undef, undef, $source->name, $col) }; -No _dbh_last_insert_id() method found in $class. -Since the method of obtaining the autoincrement id of the last insert -operation varies greatly between different databases, this method must be -individually implemented for every storage class. -EOE + return $id if defined $id; + + my $class = ref $self; + $self->throw_exception ("No storage specific _dbh_last_insert_id() method implemented in $class, and the generic DBI::last_insert_id() failed"); } sub last_insert_id { diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm index 2b7790d..f8e9209 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm @@ -21,15 +21,6 @@ sub _rebless { } } -sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col) = @_; - - # punt: if there is no derived class for the specific backend, attempt - # to use the DBI->last_insert_id, which may not be sufficient (see the - # discussion of last_insert_id in perldoc DBI) - return $dbh->last_insert_id(undef, undef, $source->from, $col); -} - 1; =head1 NAME diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 3275de2..64198da 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -7,7 +7,7 @@ BEGIN { ## use, so we explicitly test for these. my %replication_required = ( - 'Moose' => '0.90', + 'Moose' => '0.98', 'MooseX::Types' => '0.21', 'namespace::clean' => '0.11', 'Hash::Merge' => '0.11' @@ -33,6 +33,7 @@ use DBIx::Class::Storage::DBI::Replicated::Types qw/BalancerClassNamePart DBICSc use MooseX::Types::Moose qw/ClassName HashRef Object/; use Scalar::Util 'reftype'; use Hash::Merge 'merge'; +use List::Util qw/min max/; use namespace::clean -except => 'meta'; @@ -120,7 +121,7 @@ to force a query to run against Master when needed. Replicated Storage has additional requirements not currently part of L - Moose => '0.90', + Moose => '0.98', MooseX::Types => '0.21', namespace::clean => '0.11', Hash::Merge => '0.11' @@ -276,12 +277,17 @@ has 'read_handler' => ( select select_single columns_info_for + _dbh_columns_info_for + _select /], ); =head2 write_handler -Defines an object that implements the write side of L. +Defines an object that implements the write side of L, +as well as methods that don't write or read that can be called on only one +storage, methods that return a C<$dbh>, and any methods that don't make sense to +run on a replicant. =cut @@ -292,7 +298,10 @@ has 'write_handler' => ( handles=>[qw/ on_connect_do on_disconnect_do + on_connect_call + on_disconnect_call connect_info + _connect_info throw_exception sql_maker sqlt_type @@ -328,6 +337,59 @@ has 'write_handler' => ( svp_rollback svp_begin svp_release + relname_to_table_alias + _straight_join_to_node + _dbh_last_insert_id + _fix_bind_params + _default_dbi_connect_attributes + _dbi_connect_info + auto_savepoint + _sqlt_version_ok + _query_end + bind_attribute_by_data_type + transaction_depth + _dbh + _select_args + _dbh_execute_array + _sql_maker_args + _sql_maker + _query_start + _sqlt_version_error + _per_row_update_delete + _dbh_begin_work + _dbh_execute_inserts_with_no_binds + _select_args_to_query + _svp_generate_name + _multipk_update_delete + source_bind_attributes + _normalize_connect_info + _parse_connect_do + _dbh_commit + _execute_array + _placeholders_supported + _verify_pid + savepoints + _sqlt_minimum_version + _sql_maker_opts + _conn_pid + _typeless_placeholders_supported + _conn_tid + _dbh_autocommit + _native_data_type + _get_dbh + sql_maker_class + _dbh_rollback + _adjust_select_args_for_complex_prefetch + _resolve_ident_sources + _resolve_column_info + _prune_unused_joins + _strip_cond_qualifiers + _parse_order_by + _resolve_aliastypes_from_select_args + _execute + _do_query + _dbh_sth + _dbh_execute /], ); @@ -391,8 +453,12 @@ around connect_info => sub { my $master = $self->master; $master->_determine_driver; Moose::Meta::Class->initialize(ref $master); + DBIx::Class::Storage::DBI::Replicated::WithDSN->meta->apply($master); + # link pool back to master + $self->pool->master($master); + $wantarray ? @res : $res; }; @@ -744,50 +810,35 @@ sub debug { =head2 debugobj -set a debug object across all storages +set a debug object =cut sub debugobj { my $self = shift @_; - if(@_) { - foreach my $source ($self->all_storages) { - $source->debugobj(@_); - } - } - return $self->master->debugobj; + return $self->master->debugobj(@_); } =head2 debugfh -set a debugfh object across all storages +set a debugfh object =cut sub debugfh { my $self = shift @_; - if(@_) { - foreach my $source ($self->all_storages) { - $source->debugfh(@_); - } - } - return $self->master->debugfh; + return $self->master->debugfh(@_); } =head2 debugcb -set a debug callback across all storages +set a debug callback =cut sub debugcb { my $self = shift @_; - if(@_) { - foreach my $source ($self->all_storages) { - $source->debugcb(@_); - } - } - return $self->master->debugcb; + return $self->master->debugcb(@_); } =head2 disconnect @@ -818,6 +869,165 @@ sub cursor_class { $self->master->cursor_class; } +=head2 cursor + +set cursor class on all storages, or return master's, alias for L +above. + +=cut + +sub cursor { + my ($self, $cursor_class) = @_; + + if ($cursor_class) { + $_->cursor($cursor_class) for $self->all_storages; + } + $self->master->cursor; +} + +=head2 unsafe + +sets the L option on all storages or returns +master's current setting + +=cut + +sub unsafe { + my $self = shift; + + if (@_) { + $_->unsafe(@_) for $self->all_storages; + } + + return $self->master->unsafe; +} + +=head2 disable_sth_caching + +sets the L option on all storages +or returns master's current setting + +=cut + +sub disable_sth_caching { + my $self = shift; + + if (@_) { + $_->disable_sth_caching(@_) for $self->all_storages; + } + + return $self->master->disable_sth_caching; +} + +=head2 lag_behind_master + +returns the highest Replicant L +setting + +=cut + +sub lag_behind_master { + my $self = shift; + + return max map $_->lag_behind_master, $self->replicants; +} + +=head2 is_replicating + +returns true if all replicants return true for +L + +=cut + +sub is_replicating { + my $self = shift; + + return (grep $_->is_replicating, $self->replicants) == ($self->replicants); +} + +=head2 connect_call_datetime_setup + +calls L for all storages + +=cut + +sub connect_call_datetime_setup { + my $self = shift; + $_->connect_call_datetime_setup for $self->all_storages; +} + +sub _populate_dbh { + my $self = shift; + $_->_populate_dbh for $self->all_storages; +} + +sub _connect { + my $self = shift; + $_->_connect for $self->all_storages; +} + +sub _rebless { + my $self = shift; + $_->_rebless for $self->all_storages; +} + +sub _determine_driver { + my $self = shift; + $_->_determine_driver for $self->all_storages; +} + +sub _driver_determined { + my $self = shift; + + if (@_) { + $_->_driver_determined(@_) for $self->all_storages; + } + + return $self->master->_driver_determined; +} + +sub _init { + my $self = shift; + + $_->_init for $self->all_storages; +} + +sub _run_connection_actions { + my $self = shift; + + $_->_run_connection_actions for $self->all_storages; +} + +sub _do_connection_actions { + my $self = shift; + + if (@_) { + $_->_do_connection_actions(@_) for $self->all_storages; + } +} + +sub connect_call_do_sql { + my $self = shift; + $_->connect_call_do_sql(@_) for $self->all_storages; +} + +sub disconnect_call_do_sql { + my $self = shift; + $_->disconnect_call_do_sql(@_) for $self->all_storages; +} + +sub _seems_connected { + my $self = shift; + + return min map $_->_seems_connected, $self->all_storages; +} + +sub _ping { + my $self = shift; + + return min map $_->_ping, $self->all_storages; +} + =head1 GOTCHAS Due to the fact that replicants can lag behind a master, you must take care to diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm index a496512..500f739 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -7,6 +7,7 @@ use Scalar::Util 'reftype'; use DBI (); use Carp::Clan qw/^DBIx::Class/; use MooseX::Types::Moose qw/Num Int ClassName HashRef/; +use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI'; use namespace::clean -except => 'meta'; @@ -152,6 +153,14 @@ has next_unknown_replicant_id => ( }, ); +=head2 master + +Reference to the master Storage. + +=cut + +has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1); + =head1 METHODS This class defines the following methods. @@ -243,7 +252,13 @@ sub connect_replicant { $replicant->_determine_driver }); - DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant); + Moose::Meta::Class->initialize(ref $replicant); + + DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant); + + # link back to master + $replicant->master($self->master); + return $replicant; } diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm index 08a95ef..f5b4f34 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm @@ -4,6 +4,7 @@ use Moose::Role; requires qw/_query_start/; with 'DBIx::Class::Storage::DBI::Replicated::WithDSN'; use MooseX::Types::Moose qw/Bool Str/; +use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI'; use namespace::clean -except => 'meta'; @@ -55,6 +56,14 @@ has 'active' => ( has dsn => (is => 'rw', isa => Str); has id => (is => 'rw', isa => Str); +=head2 master + +Reference to the master Storage. + +=cut + +has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1); + =head1 METHODS This class defines the following methods. @@ -66,7 +75,9 @@ Override the debugobj method to redirect this method call back to the master. =cut sub debugobj { - return shift->schema->storage->debugobj; + my $self = shift; + + return $self->master->debugobj; } =head1 ALSO SEE diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm index 936edb1..1de7706 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm @@ -43,6 +43,16 @@ sub insert { $source->column_info($_)->{is_auto_increment} } $source->columns; +# user might have an identity PK without is_auto_increment + if (not $identity_col) { + foreach my $pk_col ($source->primary_columns) { + if (not exists $to_insert->{$pk_col}) { + $identity_col = $pk_col; + last; + } + } + } + if ($identity_col && (not exists $to_insert->{$identity_col})) { my $dbh = $self->_get_dbh; my $table_name = $source->from; @@ -112,6 +122,21 @@ sub connect_call_datetime_setup { ); } +sub _svp_begin { + my ($self, $name) = @_; + + $self->_get_dbh->do("SAVEPOINT $name"); +} + +# can't release savepoints that have been rolled back +sub _svp_release { 1 } + +sub _svp_rollback { + my ($self, $name) = @_; + + $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name") +} + 1; =head1 AUTHOR diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm index 95122b1..f7977bb 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLite.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm @@ -10,11 +10,6 @@ use POSIX 'strftime'; use File::Copy; use File::Spec; -sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col) = @_; - $dbh->func('last_insert_rowid'); -} - sub backup { my ($self, $dir) = @_; diff --git a/lib/DBIx/Class/UTF8Columns.pm b/lib/DBIx/Class/UTF8Columns.pm index 7e21502..a25ac39 100644 --- a/lib/DBIx/Class/UTF8Columns.pm +++ b/lib/DBIx/Class/UTF8Columns.pm @@ -2,7 +2,6 @@ package DBIx::Class::UTF8Columns; use strict; use warnings; use base qw/DBIx::Class/; -use utf8; __PACKAGE__->mk_classdata( '_utf8_columns' ); @@ -114,7 +113,8 @@ sub store_column { # override this if you want to force everything to be encoded/decoded sub _is_utf8_column { - return (shift->utf8_columns || {})->{shift}; + # my ($self, $col) = @_; + return ($_[0]->utf8_columns || {})->{$_[1]}; } =head1 AUTHORS diff --git a/t/03podcoverage.t b/t/03podcoverage.t index b060014..bcda97d 100644 --- a/t/03podcoverage.t +++ b/t/03podcoverage.t @@ -86,6 +86,13 @@ my $exceptions = { /] }, + 'DBIx::Class::Storage::DBI::Replicated*' => { + ignore => [ qw/ + connect_call_do_sql + disconnect_call_do_sql + /] + }, + 'DBIx::Class::ClassResolver::PassThrough' => { skip => 1 }, 'DBIx::Class::Componentised' => { skip => 1 }, 'DBIx::Class::Relationship::*' => { skip => 1 }, @@ -95,7 +102,6 @@ my $exceptions = { 'DBIx::Class::Storage::DBI::Replicated::Types' => { skip => 1 }, # test some specific components whose parents are exempt below - 'DBIx::Class::Storage::DBI::Replicated*' => {}, 'DBIx::Class::Relationship::Base' => {}, # internals diff --git a/t/60core.t b/t/60core.t index b1503ca..03fe3b6 100644 --- a/t/60core.t +++ b/t/60core.t @@ -421,9 +421,9 @@ SKIP: { # make sure we got rid of the compat shims SKIP: { - skip "Remove in 0.09", 5 if $DBIx::Class::VERSION < 0.09; + skip "Remove in 0.082", 3 if $DBIx::Class::VERSION < 0.082; - for (qw/compare_relationship_keys pk_depends_on resolve_condition resolve_join resolve_prefetch/) { + for (qw/compare_relationship_keys pk_depends_on resolve_condition/) { ok (! DBIx::Class::ResultSource->can ($_), "$_ no longer provided by DBIx::Class::ResultSource"); } } diff --git a/t/749sybase_asa.t b/t/749sybase_asa.t index 78efdeb..5656b4c 100644 --- a/t/749sybase_asa.t +++ b/t/749sybase_asa.t @@ -28,7 +28,9 @@ foreach my $info (@info) { next unless $dsn; - my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { + auto_savepoint => 1 + }); my $dbh = $schema->storage->dbh; @@ -58,6 +60,28 @@ EOF $new->discard_changes; is($new->artistid, 66, 'Explicit PK assigned'); +# test savepoints + eval { + $schema->txn_do(sub { + eval { + $schema->txn_do(sub { + $ars->create({ name => 'in_savepoint' }); + die "rolling back savepoint"; + }); + }; + ok ((not $ars->search({ name => 'in_savepoint' })->first), + 'savepoint rolled back'); + $ars->create({ name => 'in_outer_txn' }); + die "rolling back outer txn"; + }); + }; + + like $@, qr/rolling back outer txn/, + 'correct exception for rollback'; + + ok ((not $ars->search({ name => 'in_outer_txn' })->first), + 'outer txn rolled back'); + # test populate lives_ok (sub { my @pop; diff --git a/t/85utf8.t b/t/85utf8.t index fbba764..9f1ab0f 100644 --- a/t/85utf8.t +++ b/t/85utf8.t @@ -5,7 +5,6 @@ use Test::More; use Test::Warn; use lib qw(t/lib); use DBICTest; -use utf8; warning_like ( sub { @@ -28,15 +27,16 @@ DBICTest::Schema::CD->load_components('UTF8Columns'); DBICTest::Schema::CD->utf8_columns('title'); Class::C3->reinitialize(); -my $cd = $schema->resultset('CD')->create( { artist => 1, title => 'øni', year => '2048' } ); -my $utf8_char = 'uniuni'; - +my $cd = $schema->resultset('CD')->create( { artist => 1, title => "weird\x{466}stuff", year => '2048' } ); ok( utf8::is_utf8( $cd->title ), 'got title with utf8 flag' ); +ok(! utf8::is_utf8( $cd->{_column_data}{title} ), 'store title without utf8' ); + ok(! utf8::is_utf8( $cd->year ), 'got year without utf8 flag' ); +ok(! utf8::is_utf8( $cd->{_column_data}{year} ), 'store year without utf8' ); -utf8::decode($utf8_char); -$cd->title($utf8_char); +$cd->title('nonunicode'); +ok(! utf8::is_utf8( $cd->title ), 'got title without utf8 flag' ); ok(! utf8::is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' ); diff --git a/t/multi_create/standard.t b/t/multi_create/standard.t index 703f1d6..7aca7a4 100644 --- a/t/multi_create/standard.t +++ b/t/multi_create/standard.t @@ -72,7 +72,7 @@ throws_ok ( ], }); }, - qr/Recursive update is not supported over relationships of type multi/, + qr/Recursive update is not supported over relationships of type 'multi'/, 'create via update of multi relationships throws an exception' ); diff --git a/t/prefetch/one_to_many_to_one.t b/t/prefetch/one_to_many_to_one.t new file mode 100644 index 0000000..daa76bd --- /dev/null +++ b/t/prefetch/one_to_many_to_one.t @@ -0,0 +1,35 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +use lib qw(t/lib); +use DBICTest; + +my $schema = DBICTest->init_schema(); + +my $artist = $schema->resultset ('Artist')->find ({artistid => 1}); +is ($artist->cds->count, 3, 'Correct number of CDs'); +is ($artist->cds->search_related ('genre')->count, 1, 'Only one of the cds has a genre'); + +my $queries = 0; +my $orig_cb = $schema->storage->debugcb; +$schema->storage->debugcb(sub { $queries++ }); +$schema->storage->debug(1); + + +my $pref = $schema->resultset ('Artist') + ->search ({ 'me.artistid' => $artist->id }, { prefetch => { cds => 'genre' } }) + ->next; + +is ($pref->cds->count, 3, 'Correct number of CDs prefetched'); +is ($pref->cds->search_related ('genre')->count, 1, 'Only one of the prefetched cds has a prefetched genre'); + + +is ($queries, 1, 'All happened within one query only'); +$schema->storage->debugcb($orig_cb); +$schema->storage->debug(0); + + +done_testing; diff --git a/t/resultset/as_subselect_rs.t b/t/resultset/as_subselect_rs.t new file mode 100644 index 0000000..c143d11 --- /dev/null +++ b/t/resultset/as_subselect_rs.t @@ -0,0 +1,25 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +use lib qw(t/lib); +use DBICTest; +use DBIC::SqlMakerTest; + +my $schema = DBICTest->init_schema(); + +my $new_rs = $schema->resultset('Artist')->search({ + 'artwork_to_artist.artist_id' => 1 +}, { + join => 'artwork_to_artist' +}); +lives_ok { $new_rs->count } 'regular search works'; +lives_ok { $new_rs->search({ 'artwork_to_artist.artwork_cd_id' => 1})->count } + '... and chaining off that using join works'; +lives_ok { $new_rs->search({ 'artwork_to_artist.artwork_cd_id' => 1})->as_subselect_rs->count } + '... and chaining off the virtual view works'; +dies_ok { $new_rs->as_subselect_rs->search({'artwork_to_artist.artwork_cd_id'=> 1})->count } + q{... but chaining off of a virtual view using join doesn't work}; +done_testing; diff --git a/t/storage/replication.t b/t/storage/replication.t index c7485b4..5b74ab9 100644 --- a/t/storage/replication.t +++ b/t/storage/replication.t @@ -266,6 +266,56 @@ for my $method (qw/by_connect_info by_storage_type/) { => 'configured balancer_type'; } +### check that all Storage::DBI methods are handled by ::Replicated +{ + my @storage_dbi_methods = Class::MOP::Class + ->initialize('DBIx::Class::Storage::DBI')->get_all_method_names; + + my @replicated_methods = DBIx::Class::Storage::DBI::Replicated->meta + ->get_all_method_names; + +# remove constants and OTHER_CRAP + @storage_dbi_methods = grep !/^[A-Z_]+\z/, @storage_dbi_methods; + +# remove CAG accessors + @storage_dbi_methods = grep !/_accessor\z/, @storage_dbi_methods; + +# remove DBIx::Class (the root parent, with CAG and stuff) methods + my @root_methods = Class::MOP::Class->initialize('DBIx::Class') + ->get_all_method_names; + my %count; + $count{$_}++ for (@storage_dbi_methods, @root_methods); + + @storage_dbi_methods = grep $count{$_} != 2, @storage_dbi_methods; + +# make hashes + my %storage_dbi_methods; + @storage_dbi_methods{@storage_dbi_methods} = (); + my %replicated_methods; + @replicated_methods{@replicated_methods} = (); + +# remove ::Replicated-specific methods + for my $method (@replicated_methods) { + delete $replicated_methods{$method} + unless exists $storage_dbi_methods{$method}; + } + @replicated_methods = keys %replicated_methods; + +# check that what's left is implemented + %count = (); + $count{$_}++ for (@storage_dbi_methods, @replicated_methods); + + if ((grep $count{$_} == 2, @storage_dbi_methods) == @storage_dbi_methods) { + pass 'all DBIx::Class::Storage::DBI methods implemented'; + } + else { + my @unimplemented = grep $count{$_} == 1, @storage_dbi_methods; + + fail 'the following DBIx::Class::Storage::DBI methods are unimplemented: ' + . "@unimplemented"; + } +} + ok $replicated->schema->storage->meta => 'has a meta object';