From 305abeadc52a6b04637ecf4ad6c57b15979a671e Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 5 Oct 2010 19:58:36 +0200 Subject: [PATCH 01/16] refactored _master_relation_cond for less parameters --- lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 65 +++++++++++++++------ 1 file changed, 48 insertions(+), 17 deletions(-) diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 2fcba9e..68532ce 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -20,6 +20,7 @@ sub recursive_update { package DBIx::Class::ResultSet::RecursiveUpdate::Functions; use Carp; use Scalar::Util qw( blessed ); +use List::MoreUtils qw/ any /; sub recursive_update { my %params = @_; @@ -91,13 +92,7 @@ sub recursive_update { # relationships if ( $source->has_relationship($name) ) { - my $info = $source->relationship_info($name); - if (_master_relation_cond( - $source, $info->{cond}, - _get_pk_for_related( $self, $name ) - ) - ) - { + if ( _master_relation_cond( $self, $name ) ) { #warn "$name is a pre-update rel\n"; $pre_updates{$name} = $updates->{$name}; @@ -140,14 +135,17 @@ sub recursive_update { # first update columns and other accessors # so that later related records can be found for my $name ( keys %columns ) { + #warn "update col $name\n"; $object->$name( $columns{$name} ); } for my $name ( keys %other_methods ) { + #warn "update other $name\n"; $object->$name( $updates->{$name} ); } for my $name ( keys %pre_updates ) { + #warn "pre_update $name\n"; _update_relation( $self, $name, $pre_updates{$name}, $object, $if_not_submitted ); @@ -166,6 +164,7 @@ sub recursive_update { my $value = $updates->{$name}; if ( is_m2m( $self, $name ) ) { + #warn "update m2m $name\n"; my ($pk) = _get_pk_for_related( $self, $name ); my @rows; @@ -198,6 +197,7 @@ sub recursive_update { } } for my $name ( keys %post_updates ) { + #warn "post_update $name\n"; _update_relation( $self, $name, $post_updates{$name}, $object, $if_not_submitted ); @@ -219,7 +219,6 @@ sub _get_columns_by_accessor { } # Arguments: $rs, $name, $updates, $row, $if_not_submitted - sub _update_relation { my ( $self, $name, $updates, $object, $if_not_submitted ) = @_; @@ -228,7 +227,7 @@ sub _update_relation { $object->throw_exception("No such relationship '$name'") unless $object->has_relationship($name); - #warn "_update_relation $name: OBJ: " . ref($object) . " IN STOR: " . $object->in_storage . "\n"; + #warn "_update_relation $name: OBJ: " . ref($object) . "\n"; my $info = $object->result_source->relationship_info($name); @@ -241,6 +240,10 @@ sub _update_relation { $self->result_source->_resolve_condition( $info->{cond}, $name, $object ); } + else { + $self->throw_exception( + "result_source must support _resolve_condition"); + } # warn "$name resolved: " . Dumper( $resolved ); use Data::Dumper; $resolved = {} @@ -408,27 +411,55 @@ sub _get_pk_for_related { # relationships after: has_many, might_have and has_one # true means before, false after sub _master_relation_cond { - my ( $source, $cond, @foreign_ids ) = @_; - my $foreign_ids_re = join '|', @foreign_ids; - if ( ref $cond eq 'HASH' ) { - for my $f_key ( keys %{$cond} ) { + my ( $self, $name ) = @_; + + my $source = $self->result_source; + my $info = $source->relationship_info($name); + + #warn "INFO: " . Dumper($info) . "\n"; + + # has_many rels are always after + return 0 + if $info->{attrs}->{accessor} eq 'multi'; + + my @foreign_ids = _get_pk_for_related( $self, $name ); + + #warn "IDS: " . join(', ', @foreign_ids) . "\n"; + + my $cond = $info->{cond}; + + sub _inner { + my ( $source, $cond, @foreign_ids ) = @_; + + while ( my ( $f_key, $col ) = each %{$cond} ) { # might_have is not master - my $col = $cond->{$f_key}; - $col =~ s/self\.//; + $col =~ s/^self\.//; + $f_key =~ s/^foreign\.//; if ( $source->column_info($col)->{is_auto_increment} ) { return 0; } - if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) { + if ( any { $_ eq $f_key } @foreign_ids ) { return 1; } } + return 0; } + + if ( ref $cond eq 'HASH' ) { + return _inner( $source, $cond, @foreign_ids ); + } + + # arrayref of hashrefs elsif ( ref $cond eq 'ARRAY' ) { for my $new_cond (@$cond) { - return _master_relation_cond( $source, $new_cond, @foreign_ids ); + return _inner( $source, $new_cond, @foreign_ids ); } } + else { + $source->throw_exception( + "unhandled relation condition " . ref($cond) ); + } return; } -- 2.43.0 From 6ce63ba71e40f5b301e32a3ade6d70f67948ee10 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 5 Oct 2010 20:02:13 +0200 Subject: [PATCH 02/16] added support for multi-column has_many relationships --- lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 110 +++++++++++++++----- 1 file changed, 84 insertions(+), 26 deletions(-) diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 68532ce..27395cc 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -155,8 +155,10 @@ sub recursive_update { # don't allow insert to recurse to related objects # do the recursion ourselves # $object->{_rel_in_storage} = 1; - #warn "CHANGED: " . $object->is_changed . " IN STOR: " . $object->in_storage . "\n"; + #warn "CHANGED: " . $object->is_changed . "\n": + #warn "IN STOR: " . $object->in_storage . "\n"; $object->update_or_insert if $object->is_changed; + $object->discard_changes; # updating many_to_many for my $name ( keys %$updates ) { @@ -251,12 +253,32 @@ sub _update_relation { && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $resolved; - my $rel_col_cnt = scalar keys %{ $info->{cond} }; - use Data::Dumper; - warn "RELINFO for $name: " . Dumper($info); - warn "REL_COL_CNT: $rel_col_cnt"; + my @rel_cols = keys %{ $info->{cond} }; + map {s/^foreign\.//} @rel_cols; - #warn "REV RELINFO for $name: " . Dumper($revrelinfo); + #warn "REL_COLS: " . Dumper(@rel_cols); use Data::Dumper; + my $rel_col_cnt = scalar @rel_cols; + + # find out if all related columns are nullable + my $all_fks_nullable = 1; + for my $rel_col (@rel_cols) { + $all_fks_nullable = 0 + unless $related_resultset->result_source->column_info($rel_col) + ->{is_nullable}; + } + + #warn "\tNULLABLE: $all_fks_nullable\n"; + $if_not_submitted = $all_fks_nullable ? 'nullify' : 'delete' + unless defined $if_not_submitted; + + # handle undef + #if (not defined $updates && $if_not_submitted eq 'delete') { + # warn "$name " . ref $object; + # $object->related_resultset($name)->delete; + # return; + #} + + #warn "RELINFO for $name: " . Dumper($info); use Data::Dumper; # the only valid datatype for a has_many rels is an arrayref if ( $info->{attrs}{accessor} eq 'multi' ) { @@ -264,41 +286,77 @@ sub _update_relation { "data for has_many relationship '$name' must be an arrayref") unless ref $updates eq 'ARRAY'; - my @updated_ids; + my @updated_objs; + + #warn "\tupdating has_many rel '$name' ($rel_col_cnt columns cols)\n"; for my $sub_updates ( @{$updates} ) { my $sub_object = recursive_update( resultset => $related_resultset, updates => $sub_updates, resolved => $resolved ); - push @updated_ids, $sub_object->id; - } - my @related_pks = $related_resultset->result_source->primary_columns; - if ( defined $if_not_submitted && $if_not_submitted eq 'delete' ) { - # only handles related result classes with single primary keys - if ( 1 == scalar @related_pks ) { - $object->$name->search( - { $related_pks[0] => { -not_in => \@updated_ids } } ) - ->delete; - } + push @updated_objs, $sub_object; } - elsif ( defined $if_not_submitted - && $if_not_submitted eq 'set_to_null' ) - { - # only handles related result classes with single primary keys - if ( 1 == scalar @related_pks ) { - my @fk = keys %$resolved; - $object->$name->search( - { $related_pks[0] => { -not_in => \@updated_ids } } ) - ->update( { $fk[0] => undef } ); + #warn "\tcreated and updated related rows\n"; + + my @cond; + my @related_pks = $related_resultset->result_source->primary_columns; + for my $obj (@updated_objs) { + my %cond_for_obj; + for my $col (@related_pks) { + $cond_for_obj{$col} = $obj->get_column($col); } + push @cond, \%cond_for_obj; + } + my %cond = ( -not => [@cond] ); + + #warn "\tCOND: " . Dumper(\%cond); + my $rs_rel_delist = $object->$name->search_rs( \%cond ); + + #my $rel_delist_cnt = $rs_rel_delist->count; + my @foo = $rs_rel_delist->all; + if ( $if_not_submitted eq 'delete' ) { + + #warn "\tdeleting related rows: $rel_delist_cnt\n"; + $rs_rel_delist->delete; + + # # only handles related result classes with single primary keys + # if ( 1 == $rel_col_cnt ) { + # $object->$name->search( + # { $rel_cols[0] => + # { -not_in => [ map ( $_->id, @updated_objs ) ] } + # } + # )->delete; + # } + # else { + # warn "multi-column relationships aren't supported\n"; + # } + } + elsif ( $if_not_submitted eq 'set_to_null' ) { + + #warn "\tnullifying related rows: $rel_delist_cnt\n"; + my %update = map { $_ => undef } @rel_cols; + $rs_rel_delist->update( \%update ); + + # # only handles related result classes with single primary keys + # if ( 1 == $rel_col_cnt ) { + # $object->$name->search( + # { $rel_cols[0] => + # { -not_in => [ map ( $_->id, @updated_objs ) ] } + # } + # )->update( { $rel_cols[0] => undef } ); + # } + # else { + # warn "multi-column relationships aren't supported\n"; + # } } } elsif ($info->{attrs}{accessor} eq 'single' || $info->{attrs}{accessor} eq 'filter' ) { + #warn "\tupdating rel '$name': $if_not_submitted\n"; my $sub_object; if ( ref $updates ) { -- 2.43.0 From 74accb85b2d8b520018566a4170b9e1289c13f66 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 5 Oct 2010 20:03:05 +0200 Subject: [PATCH 03/16] require List::MoreUtils 0.22 for refactored _master_relation_cond --- Makefile.PL | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile.PL b/Makefile.PL index a2f957f..e6b6618 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -16,6 +16,7 @@ requires 'SQL::Translator' => '0.11005'; requires 'DateTime'; requires 'DBD::SQLite' => '1.21'; requires 'Readonly' => '1.03'; +requires 'List::MoreUtils' => '0.22'; # things the tests need test_requires 'Test::More' => '0.88'; -- 2.43.0 From b09b840cdf99eb0279eba29f46b2a98fd67b8c82 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Wed, 6 Oct 2010 13:25:41 +0200 Subject: [PATCH 04/16] added special handling of has_many rels to tables with a single column pk --- lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 29 ++++++++++++++------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 27395cc..fcc3b0a 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -303,20 +303,31 @@ sub _update_relation { my @cond; my @related_pks = $related_resultset->result_source->primary_columns; - for my $obj (@updated_objs) { - my %cond_for_obj; - for my $col (@related_pks) { - $cond_for_obj{$col} = $obj->get_column($col); + + my $rs_rel_delist = $object->$name; + + # foreign table has a single pk column + if ( scalar @related_pks == 1 ) { + $rs_rel_delist = $rs_rel_delist->search_rs( + { $related_pks[0] => + { -not_in => [ map ( $_->id, @updated_objs ) ] } + } + ); + } + # foreign table has multiple pk columns + else { + for my $obj (@updated_objs) { + my %cond_for_obj; + for my $col (@related_pks) { + $cond_for_obj{$col} = $obj->get_column($col); + } + push @cond, \%cond_for_obj; } - push @cond, \%cond_for_obj; + $rs_rel_delist = $rs_rel_delist->search_rs({ -not => [@cond] }); } - my %cond = ( -not => [@cond] ); #warn "\tCOND: " . Dumper(\%cond); - my $rs_rel_delist = $object->$name->search_rs( \%cond ); - #my $rel_delist_cnt = $rs_rel_delist->count; - my @foo = $rs_rel_delist->all; if ( $if_not_submitted eq 'delete' ) { #warn "\tdeleting related rows: $rel_delist_cnt\n"; -- 2.43.0 From 8e1de6061ef232bdc77fa2ac15c7afb447cf3552 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Wed, 6 Oct 2010 13:52:03 +0200 Subject: [PATCH 05/16] tainted mode doesn't search for module in PERL5LIB path which skips the tests if local::lib or perlbrew is used --- t/pod-coverage.t | 2 +- t/pod.t | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/t/pod-coverage.t b/t/pod-coverage.t index 703f91d..14bc1ca 100644 --- a/t/pod-coverage.t +++ b/t/pod-coverage.t @@ -1,4 +1,4 @@ -#!perl -T +#!perl use Test::More; eval "use Test::Pod::Coverage 1.04"; diff --git a/t/pod.t b/t/pod.t index 976d7cd..4909b92 100644 --- a/t/pod.t +++ b/t/pod.t @@ -1,4 +1,4 @@ -#!perl -T +#!perl use Test::More; eval "use Test::Pod 1.14"; -- 2.43.0 From d8872310da4a3846416bcdfdf1d24366ad65d20e Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Wed, 6 Oct 2010 14:20:50 +0200 Subject: [PATCH 06/16] gitignore t/var directory contents --- .gitignore | 1 + t/var/dvdzbr.db | Bin 38912 -> 0 bytes 2 files changed, 1 insertion(+) create mode 100644 .gitignore delete mode 100644 t/var/dvdzbr.db diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..dbfa294 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/t/var/* diff --git a/t/var/dvdzbr.db b/t/var/dvdzbr.db deleted file mode 100644 index 251fbc21384b42b02e192eb976395d5f9db4618c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 38912 zcmeHQ-)|Jh9iQ2`-8&y~2pnYX80O#-}!#WP8}~+ZR1?UnX{_K5K177(bo+FA^bZewhnMG>>qfp zpbDDrU)5D1l#m-N&XeRba+BO3AECdjn&h4YCMGmZA8Nyk#d5*EWEBdI?Yfi2!llW1 z*LJ|;k&=f;hx6mZ#?g@@!>5gyc*YAOKH126X-zt&CiS*9{Q7HEYiic^l6j8iWjUTd zbbNR@ZQAhtP&$-1KKza0QRC$3(G&U6GsdyuGsegZ!@pO!z$X|+;w55U_D`|MN=XDH0`~y{m0+x5_Wmd2CL;eMx4@B`L_i|Y;0P#0L5c!9RuCWm zqiYCV!+HEOWry+`@)Pm~|9!tM4Br}RgRl$wGZ{=b@yYeVLV-`LPtQA!U9L_}RUD_X zXgfgHy$MS(yIwCMn_`DBBfByO6G|G^_hj%yq#!o*fshG3*M?mlvQV^PqJM^0qcB5v z+~WyUJ|oWuT;VBOm=&fwzqo1P5^etiC%kD7?btxV0CbER4JeT@K|AlG6pI-De~QSb zb-7&zNCYGTjex)wOu8`}`H$Of)fjG=YPZ0T}5gI7lAQ6xV)I%VX=*BD9pO62W z&=`XMFYyWd8va1}uJUVgi2RoPocu!MRQk@kI-Td}uB6`8g=vNhFJ81A7v>vgK_WHe zO+~~QLjhctai!#IoP;dMsy5Ru-r=J!^OCBI6%dnjJtrM0!6WkA*%+jzCm#`?g=_|m zV!3M1*iIxMT#>AwPp`q^n`yI;?$-2t8%BIU;=T-RwkNImYK5OqdUcr0d7e$*rh7Df ze;a;!V8*D6j09l@PYx;}*cY-XaUjW{6oi@Khvq?PwVOJL+K>6g-&=yj#Wl{{{l_{7t~^>{Mw-LGBkPViN zk_boy;t)_V%>Q9;{C^9PTXB&jO(Gx>XhZ~(3C8_C|8x1DMr@{RlSDuw5Q_kl|H1tG zpIrYJ3y>sA1R5Rz{=rYK|84l|EE^~hh(kc~e;g{3CJ}fz5Rm-;a9n5EN{K)m0*wE? z^?yvJzZLct*mc++Pqzr^8X-I4$=7?%j)+WyM>NiE(ezx0Cy*Zq8E}z&b{0^!MdU65 z^08Mn-E76vT#N%mU_f~rPYbR%+s)I>(9Owpu01$L+t!q|uLLk!xVJcg>ym?mDOVS) zLHA#cgw+aldUAEam#goQegD%mG5`M-B5#rT@DKQ3ZW4ipK!BV;edc!1Ym3nMdD}Q* z+s^rU5bktxgF{bYl|XoNH&=0sMr`s^RDf3^i>#<{@=XX~ClRrE9`Xz*17#tj_5~Mm z+7D_t5XyFmjJQq@{sa(~B9nD}ogwV<2bh$WPGUh?qtz%T7q0d?68CVf#j8>*g5M5OV2L^`v26BD51IFOc z!Q9}%fn1tggZKZR5}=p&ui+mQDL09LMBsr(02p|Ss={%Ts=$#yEm)i&pmH-^PX!o7wXs&7Kvik{~byS^oYIK^f^+v*4e5GxhCMhnF@$+vsl5!$EBm^&r1r8}g>TCW z#cEZMeaYI(mcRd_cHsM+uaNi&gF>aDux86YgRqEnM8h z`u{0%1?>Nko8$&O0X~FP09Sz^H;I5mV8bE6-uS5$KPLIxA0+*u55Ri@i3IZ#F8Pns z%pc-^!TW3#&{cR6NdDh&S6)_FA^>8&jKewqE1dro&i|P6Kj!?8IsYpj|1tr8UK!?ej=zQJv|Bx!-e}@MH2!q1l#~3$&Fk39!&Lk5uazoy>h{Axg zw5P77fQapcOuVK5t`>lsNC3MRf&Ks^%Pk?CrM-1CUyB-oKwkk{_aDlfc}==N`?xuj z?}^rerU3Xq9%&sA0z)HryHdV5SD1o|7-4IJYz2K~5zvjb7_riFq92K+ns#ifTC9{O z3$WtEV25gP&SoLjEG&erC3~Oq&z1aK(xCNV-+I+9j2sz0&CEJ-L~H6-*W}|N+ONf% ze1yDOB6ozJIbTBKXUI;>Q*=Pn`!iS=U-9Dw?E*q;Y)(N8PwRt`4JhU?&1rgf22c7L zDtN>AC4u~&h|N!2Fu!X2jM)rXH_L>0iQin}d@Z*Zs+Hf3~%rwGzOSssG3cch>}cI%EYgZ0nOVXtCg{AUQ_A zb`Ldu9HR&0bAxJ$nsu$b=&aV>Bv@E)2*frkbO<;IEF%e{si7;%Q}|ajMBg6CJrod0 zz{&}Q8CgFklcwoYbsyq0@k(5>@Ko?X^_f4oVb~J`S^}lV21U#xd3p4D3AlZv{j1qW z@~>*n^XxoL55R*w*1#*TgBPzo0+OGLKM@I41$aEFu#HqKm}|bD>gMf36wchEnM?F5 s!u;$B{zepcia2(98H%Z6LGxc0v6wQgGk3HD1o`wDOf^l~TpwTk9}@+t)c^nh -- 2.43.0 From 11512e7c3673e8467fd7a743a455defcf1f71c41 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Wed, 6 Oct 2010 15:03:32 +0200 Subject: [PATCH 07/16] allow undef for has_many rels in addition to empty arrayref + tests --- lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 39 ++++----------------- t/lib/DBSchema.pm | 2 +- t/lib/RunTests.pm | 26 +++++++------- 3 files changed, 22 insertions(+), 45 deletions(-) diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index fcc3b0a..2d3efb8 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -267,21 +267,19 @@ sub _update_relation { ->{is_nullable}; } - #warn "\tNULLABLE: $all_fks_nullable\n"; $if_not_submitted = $all_fks_nullable ? 'nullify' : 'delete' unless defined $if_not_submitted; - # handle undef - #if (not defined $updates && $if_not_submitted eq 'delete') { - # warn "$name " . ref $object; - # $object->related_resultset($name)->delete; - # return; - #} + #warn "\tNULLABLE: $all_fks_nullable ACTION: $if_not_submitted\n"; #warn "RELINFO for $name: " . Dumper($info); use Data::Dumper; # the only valid datatype for a has_many rels is an arrayref if ( $info->{attrs}{accessor} eq 'multi' ) { + + # handle undef like empty arrayref + $updates = [] + unless defined $updates; $self->throw_exception( "data for has_many relationship '$name' must be an arrayref") unless ref $updates eq 'ARRAY'; @@ -314,6 +312,7 @@ sub _update_relation { } ); } + # foreign table has multiple pk columns else { for my $obj (@updated_objs) { @@ -323,7 +322,7 @@ sub _update_relation { } push @cond, \%cond_for_obj; } - $rs_rel_delist = $rs_rel_delist->search_rs({ -not => [@cond] }); + $rs_rel_delist = $rs_rel_delist->search_rs( { -not => [@cond] } ); } #warn "\tCOND: " . Dumper(\%cond); @@ -332,36 +331,12 @@ sub _update_relation { #warn "\tdeleting related rows: $rel_delist_cnt\n"; $rs_rel_delist->delete; - - # # only handles related result classes with single primary keys - # if ( 1 == $rel_col_cnt ) { - # $object->$name->search( - # { $rel_cols[0] => - # { -not_in => [ map ( $_->id, @updated_objs ) ] } - # } - # )->delete; - # } - # else { - # warn "multi-column relationships aren't supported\n"; - # } } elsif ( $if_not_submitted eq 'set_to_null' ) { #warn "\tnullifying related rows: $rel_delist_cnt\n"; my %update = map { $_ => undef } @rel_cols; $rs_rel_delist->update( \%update ); - - # # only handles related result classes with single primary keys - # if ( 1 == $rel_col_cnt ) { - # $object->$name->search( - # { $rel_cols[0] => - # { -not_in => [ map ( $_->id, @updated_objs ) ] } - # } - # )->update( { $rel_cols[0] => undef } ); - # } - # else { - # warn "multi-column relationships aren't supported\n"; - # } } } elsif ($info->{attrs}{accessor} eq 'single' diff --git a/t/lib/DBSchema.pm b/t/lib/DBSchema.pm index 3d01f23..af80fbf 100644 --- a/t/lib/DBSchema.pm +++ b/t/lib/DBSchema.pm @@ -20,7 +20,7 @@ sub tables_exist { sub get_test_schema { my ( $dsn, $user, $pass ) = @_; $dsn ||= 'dbi:SQLite:dbname=t/var/dvdzbr.db'; - warn "testing $dsn"; + warn "testing $dsn\n"; my $schema = __PACKAGE__->connect( $dsn, $user, $pass, {} ); my $deploy_attrs; $deploy_attrs->{add_drop_table} = 1 if tables_exist( $dsn, $user, $pass ); diff --git a/t/lib/RunTests.pm b/t/lib/RunTests.pm index b5eef51..defb701 100644 --- a/t/lib/RunTests.pm +++ b/t/lib/RunTests.pm @@ -9,7 +9,7 @@ use DBIx::Class::ResultSet::RecursiveUpdate; sub run_tests { my $schema = shift; - plan tests => 42; + plan tests => 45; my $dvd_rs = $schema->resultset('Dvd'); my $user_rs = $schema->resultset('User'); @@ -100,8 +100,8 @@ sub run_tests { # changing existing records my $num_of_users = $user_rs->count; $updates = { - id => $dvd->dvd_id, # id instead of dvd_id - ####aaaa => undef, + id => $dvd->dvd_id, # id instead of dvd_id + #aaaa => undef, name => undef, tags => [], 'owner' => $another_owner->id, @@ -194,14 +194,6 @@ sub run_tests { $dvd = $dvd_rs->find(1); is( $dvd->get_column('owner'), $user->id, 'foreign key set' ); - # # delete has_many where foreign cols aren't nullable - # $updates = { - # id => $user->id, - # owned_dvds => undef, - # }; - # $user = $user_rs->recursive_update( $updates ); - # ok ( !$dvd_rs->find( 1 ), 'owned dvd deleted'); - $dvd_rs->update( { current_borrower => $user->id } ); ok( $user->borrowed_dvds->count > 1, 'Precond' ); $updates = { @@ -257,7 +249,17 @@ sub run_tests { }; ok( my $new_user = $user_rs->recursive_update($new_person) ); - #print STDERR Dumper $new_user; + # delete has_many where foreign cols aren't nullable + my $rs_user_dvd = $user->owned_dvds; + my @user_dvd_ids = map { $_->id } $rs_user_dvd->all; + is( $rs_user_dvd->count, 1, 'user owns 1 dvd'); + $updates = { + id => $user->id, + owned_dvds => undef, + }; + $user = $user_rs->recursive_update($updates); + is( $user->owned_dvds->count, 0, 'user owns no dvds'); + is( $dvd_rs->search({ dvd_id => {-in => \@user_dvd_ids }})->count, 0, 'owned dvds deleted' ); # $updates = { # name => 'Test name 1', -- 2.43.0 From cd5644fd54c9502c46edebf92f04f3ec88c6af9f Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Wed, 6 Oct 2010 16:18:20 +0200 Subject: [PATCH 08/16] gitignore Module::Install temp files --- .gitignore | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.gitignore b/.gitignore index dbfa294..4bcb346 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,8 @@ /t/var/* +# perl Makefile.PL +/META.yml +/Makefile +/inc/ +# make +/blib/ +/pm_to_blib -- 2.43.0 From 466cc540e89c785bed08c55062efc250b743f00d Mon Sep 17 00:00:00 2001 From: Gerda Shank Date: Wed, 6 Oct 2010 14:37:51 -0400 Subject: [PATCH 09/16] test fails, requiring SQL::Translator >= 0.11006 --- Makefile.PL | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.PL b/Makefile.PL index 697eb3b..8d4130c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -12,7 +12,7 @@ repository 'http://github.com/zby/DBIx--Class--ResultSet--RecursiveUpdate/tree/m # prereqs requires 'DBIx::Class' => '0.08100'; requires 'DBIx::Class::IntrospectableM2M'; -requires 'SQL::Translator' => '0.11005'; +requires 'SQL::Translator' => '0.11006'; requires 'DateTime'; requires 'DBD::SQLite' => '1.21'; requires 'Readonly' => '1.03'; -- 2.43.0 From ecbe0c373c166ca05e805f1a459751b5a1040577 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Mon, 11 Oct 2010 16:29:08 +0200 Subject: [PATCH 10/16] only limit resultset if there are related rows left --- lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 2d3efb8..c0be5cd 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -299,7 +299,6 @@ sub _update_relation { #warn "\tcreated and updated related rows\n"; - my @cond; my @related_pks = $related_resultset->result_source->primary_columns; my $rs_rel_delist = $object->$name; @@ -315,6 +314,7 @@ sub _update_relation { # foreign table has multiple pk columns else { + my @cond; for my $obj (@updated_objs) { my %cond_for_obj; for my $col (@related_pks) { @@ -322,7 +322,10 @@ sub _update_relation { } push @cond, \%cond_for_obj; } - $rs_rel_delist = $rs_rel_delist->search_rs( { -not => [@cond] } ); + # only limit resultset if there are related rows left + if (scalar @cond) { + $rs_rel_delist = $rs_rel_delist->search_rs( { -not => [@cond] } ); + } } #warn "\tCOND: " . Dumper(\%cond); -- 2.43.0 From f3ef41031535349b6582bbf59638ac3b1cc8e3e0 Mon Sep 17 00:00:00 2001 From: Zbigniew Lukasiak Date: Wed, 13 Oct 2010 19:53:51 +0200 Subject: [PATCH 11/16] TODO - value of fk from a multi relationship --- t/lib/RunTests.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/t/lib/RunTests.pm b/t/lib/RunTests.pm index defb701..d3a4f7b 100644 --- a/t/lib/RunTests.pm +++ b/t/lib/RunTests.pm @@ -9,7 +9,7 @@ use DBIx::Class::ResultSet::RecursiveUpdate; sub run_tests { my $schema = shift; - plan tests => 45; + plan tests => 46; my $dvd_rs = $schema->resultset('Dvd'); my $user_rs = $schema->resultset('User'); @@ -95,6 +95,10 @@ sub run_tests { ->find( { key1 => $onekey->id, key2 => 1 } ), 'Twokeys_belongsto created' ); + TODO: { + local $TODO = 'value of fk from a multi relationship'; + is( $dvd->twokeysfk, $onekey->id, 'twokeysfk in Dvd' ); + }; is( $dvd->name, 'Test name', 'Dvd name set' ); # changing existing records -- 2.43.0 From 525b900f8cd814ea1c1294987bfbe8cd7543c040 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 19 Oct 2010 08:54:06 +0200 Subject: [PATCH 12/16] converted to Dist::Zilla --- Makefile.PL | 29 ---- README | 159 -------------------- dist.ini | 44 ++++++ lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 40 +---- 4 files changed, 45 insertions(+), 227 deletions(-) delete mode 100644 Makefile.PL delete mode 100644 README create mode 100644 dist.ini diff --git a/Makefile.PL b/Makefile.PL deleted file mode 100644 index c342803..0000000 --- a/Makefile.PL +++ /dev/null @@ -1,29 +0,0 @@ -use strict; -use warnings; -use inc::Module::Install 0.91; - -name 'DBIx-Class-ResultSet-RecursiveUpdate'; -author 'Zbigniew Lukasiak'; -all_from 'lib/DBIx/Class/ResultSet/RecursiveUpdate.pm'; -license 'perl'; - -repository 'http://github.com/zby/DBIx--Class--ResultSet--RecursiveUpdate/tree/master'; - -# prereqs -requires 'DBIx::Class' => '0.08103'; -requires 'DBIx::Class::IntrospectableM2M'; -requires 'SQL::Translator' => '0.11006'; -requires 'DateTime'; -requires 'DBD::SQLite' => '1.21'; -requires 'Readonly' => '1.03'; -requires 'List::MoreUtils' => '0.22'; - -# things the tests need -test_requires 'Test::More' => '0.88'; - -tests(); - -auto_install(); - -WriteAll(); - diff --git a/README b/README deleted file mode 100644 index 8a741c9..0000000 --- a/README +++ /dev/null @@ -1,159 +0,0 @@ -NAME - DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but - recursive - -SYNOPSIS - The functional interface: - - my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({ - resultset => $schema->resultset( 'Dvd' ), - updates => { - id => 1, - owned_dvds => [ - { - title => 'One Flew Over the Cuckoo's Nest' - } - ] - } - }); - - As ResultSet subclass: - - __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' ); - - in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' - in the ResultSet classes. - - Then: - - my $user = $user_rs->recursive_update( { - id => 1, - owned_dvds => [ - { - title => 'One Flew Over the Cuckoo's Nest' - } - ] - } - ); - -DESCRIPTION -This is still experimental. I've added a functional interface so that it can be used -in Form Processors and not require modification of the model. - You can feed the ->create method with a recursive datastructure and have - the related records created. Unfortunately you cannot do a similar thing - with update_or_create - this module tries to fill that void. - - It is a base class for ResultSets providing just one method: - recursive_update which works just like update_or_create but can - recursively update or create data objects composed of multiple rows. All - rows need to be identified by primary keys - so you need to provide them - in the update structure (unless they can be deduced from the parent row - - for example when you have a belongs_to relationship). If not all - colums comprising the primary key are specified - then a new row will be - created, with the expectation that the missing columns will be filled by - it (as in the case of auto_increment primary keys). - - If the resultset itself stores an assignement for the primary key, like - in the case of: - - my $restricted_rs = $user_rs->search( { id => 1 } ); - - then you need to inform recursive_update about additional predicate with - a second argument: - - my $user = $restricted_rs->recursive_update( { - owned_dvds => [ - { - title => 'One Flew Over the Cuckoo's Nest' - } - ] - }, - [ 'id' ] - ); - - This will work with a new DBIC release. - - For a many_to_many (pseudo) relation you can supply a list of primary - keys from the other table - and it will link the record at hand to those - and only those records identified by them. This is convenient for - handling web forms with check boxes (or a SELECT box with multiple - choice) that let you update such (pseudo) relations. - - For a description how to set up base classes for ResultSets see - load_namespaces in DBIx::Class::Schema. - -DESIGN CHOICES - Treatment of many to many pseudo relations - The function gets the information about m2m relations from - DBIx::Class::IntrospectableM2M. If it is not loaded in the ResultSource - classes - then the code relies on the fact that: if($object->can($name) - and !$object->result_source->has_relationship($name) and $object->can( - 'set_' . $name ) ) - - then $name must be a many to many pseudo relation. And that in a - similarly ugly was I find out what is the ResultSource of objects from - that many to many pseudo relation. - -INTERFACE -METHODS - recursive_update - The method that does the work here. - - is_m2m - $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to - many (pseudo) relation on $self. - - get_m2m_source - $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by - the many to many (pseudo) relation 'name' from $self. - -DIAGNOSTICS -CONFIGURATION AND ENVIRONMENT - DBIx::Class::RecursiveUpdate requires no configuration files or - environment variables. - -DEPENDENCIES - DBIx::Class - -INCOMPATIBILITIES - None reported. - -BUGS AND LIMITATIONS - No bugs have been reported. - - Please report any bugs or feature requests to - "bug-dbix-class-recursiveput@rt.cpan.org", or through the web interface - at . - -AUTHOR - Zbigniew Lukasiak "" Influenced by code by Pedro Melo. - -LICENCE AND COPYRIGHT - Copyright (c) 2008, Zbigniew Lukasiak "". All rights - reserved. - - This module is free software; you can redistribute it and/or modify it - under the same terms as Perl itself. See perlartistic. - -DISCLAIMER OF WARRANTY - BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY - FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN - OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES - PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER - EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED - WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE - ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH - YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL - NECESSARY SERVICING, REPAIR, OR CORRECTION. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING - WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR - REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE - TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR - CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE - SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING - RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A - FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF - SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH - DAMAGES. - diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..94c9f5d --- /dev/null +++ b/dist.ini @@ -0,0 +1,44 @@ +name = DBIx-Class-ResultSet-RecursiveUpdate +author = Zbigniew Lukasiak +author = Alexander Hartmaier +license = Perl_5 +copyright_holder = Zbigniew Lukasiak, Alexander Hartmaier +copyright_year = 2010 + +version = 0.199901 + +[@Basic] + +[PodWeaver] +[PkgVersion] +[NextRelease] +[MetaConfig] +[MetaJSON] + +[MetaNoIndex] +directory = t/lib + +[MetaResources] +repository.type = git +repository.url = git://github.com/zby/DBIx--Class--ResultSet--RecursiveUpdate.git +repository.web = http://github.com/zby/DBIx--Class--ResultSet--RecursiveUpdate + +[PodSyntaxTests] +[PodCoverageTests] +[PortabilityTests] +[DistManifestTests] +[SynopsisTests] +[UnusedVarsTests] +[HasVersionTests] + +[Prereqs] +DBIx::Class = 0.08103 +DBIx::Class::IntrospectableM2M = 0 +SQL::Translator = 0.11006 +DateTime = 0 +DBD::SQLite = 1.21 +Readonly = 1.03 +List::MoreUtils = 0.22 + +[Prereqs / TestRequires] +Test::More = 0.88 \ No newline at end of file diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index c0be5cd..84b61c4 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -2,8 +2,7 @@ use strict; use warnings; package DBIx::Class::ResultSet::RecursiveUpdate; - -our $VERSION = '0.013'; +# ABSTRACT: like update_or_create - but recursive use base qw(DBIx::Class::ResultSet); @@ -776,40 +775,3 @@ No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. - - -=head1 AUTHOR - -Zbigniew Lukasiak C<< >> -Influenced by code by Pedro Melo. - -=head1 LICENCE AND COPYRIGHT - -Copyright (c) 2008, Zbigniew Lukasiak C<< >>. All rights reserved. - -This module is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. See L. - - -=head1 DISCLAIMER OF WARRANTY - -BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER -EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE -ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH -YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL -NECESSARY SERVICING, REPAIR, OR CORRECTION. - -IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE -LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, -OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE -THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. -- 2.43.0 From 01dacb7255703eed25d7737a6dca0bf895d4c778 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 19 Oct 2010 08:55:52 +0200 Subject: [PATCH 13/16] satisfy PortabilityTests --- t/{00.load.t => 00load.t} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename t/{00.load.t => 00load.t} (100%) diff --git a/t/00.load.t b/t/00load.t similarity index 100% rename from t/00.load.t rename to t/00load.t -- 2.43.0 From a23e8bc6b8dfa2849761c292adb704b577623416 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 19 Oct 2010 08:57:58 +0200 Subject: [PATCH 14/16] fixed t/sqlite.t which failed because of missing t/var dir --- .gitignore | 1 - t/var/placeholder | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) create mode 100644 t/var/placeholder diff --git a/.gitignore b/.gitignore index 4bcb346..d579e14 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ -/t/var/* # perl Makefile.PL /META.yml /Makefile diff --git a/t/var/placeholder b/t/var/placeholder new file mode 100644 index 0000000..e9b57c8 --- /dev/null +++ b/t/var/placeholder @@ -0,0 +1 @@ +placeholder for git and dzil which both ignore empty directories -- 2.43.0 From ed628ca39e643b5962c70cd7d07e4186b4958d93 Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 19 Oct 2010 08:58:46 +0200 Subject: [PATCH 15/16] satisfy UnusedVarsTests --- lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 84b61c4..6b41701 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -256,7 +256,7 @@ sub _update_relation { map {s/^foreign\.//} @rel_cols; #warn "REL_COLS: " . Dumper(@rel_cols); use Data::Dumper; - my $rel_col_cnt = scalar @rel_cols; + #my $rel_col_cnt = scalar @rel_cols; # find out if all related columns are nullable my $all_fks_nullable = 1; -- 2.43.0 From 4ce61ffeb9482993f7c0fb5c09e39f04ec11dbea Mon Sep 17 00:00:00 2001 From: Alexander Hartmaier Date: Tue, 19 Oct 2010 08:59:14 +0200 Subject: [PATCH 16/16] satisfy SynopsisTests --- lib/DBIx/Class/ResultSet/RecursiveUpdate.pm | 44 +++++++++------------ 1 file changed, 19 insertions(+), 25 deletions(-) diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 6b41701..8193fb6 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -512,46 +512,40 @@ sub _master_relation_cond { 1; # Magic true value required at end of module __END__ -=head1 NAME - -DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive - =head1 SYNOPSIS -The functional interface: + # The functional interface: + my $schema = MyDB::Schema->connect(); my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({ - resultset => $schema->resultset( 'Dvd' ), + resultset => $schema->resultset('User'), updates => { - id => 1, - owned_dvds => [ - { - title => 'One Flew Over the Cuckoo's Nest' - } - ] + id => 1, + owned_dvds => [ + { + title => "One Flew Over the Cuckoo's Nest" + } + ] } }); -As ResultSet subclass: + # As ResultSet subclass: __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' ); -in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes. + # in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes. -Then: + my $user = $schema->resultset('User')->recursive_update({ + id => 1, + owned_dvds => [ + { + title => "One Flew Over the Cuckoo's Nest" + } + ] + }); - my $user = $user_rs->recursive_update( { - id => 1, - owned_dvds => [ - { - title => 'One Flew Over the Cuckoo's Nest' - } - ] - } - ); - =head1 DESCRIPTION This is still experimental. I've added a functional interface so that it can be used -- 2.43.0