From: Zbigniew Lukasiak Date: Wed, 13 Oct 2010 17:12:51 +0000 (+0200) Subject: Merge branch 'master' of http://github.com/abraxxa/DBIx--Class--ResultSet--RecursiveU... X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-DBIx-Class-ResultSet-RecursiveUpdate;a=commitdiff_plain;h=26d2267b2b938a7b6ee683d1b8e6e500bbb893d1;hp=466cc540e89c785bed08c55062efc250b743f00d Merge branch 'master' of http://github.com/abraxxa/DBIx--Class--ResultSet--RecursiveUpdate --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4bcb346 --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +/t/var/* +# perl Makefile.PL +/META.yml +/Makefile +/inc/ +# make +/blib/ +/pm_to_blib diff --git a/Makefile.PL b/Makefile.PL index 8d4130c..c342803 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -10,12 +10,13 @@ license 'perl'; repository 'http://github.com/zby/DBIx--Class--ResultSet--RecursiveUpdate/tree/master'; # prereqs -requires 'DBIx::Class' => '0.08100'; +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'; diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 6ab316e..c0be5cd 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -1,5 +1,6 @@ use strict; use warnings; + package DBIx::Class::ResultSet::RecursiveUpdate; our $VERSION = '0.013'; @@ -8,133 +9,189 @@ use base qw(DBIx::Class::ResultSet); sub recursive_update { my ( $self, $updates, $fixed_fields ) = @_; - return DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( + return + DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( resultset => $self, updates => $updates, fixed_fields => $fixed_fields - ); + ); } package DBIx::Class::ResultSet::RecursiveUpdate::Functions; use Carp; use Scalar::Util qw( blessed ); - +use List::MoreUtils qw/ any /; sub recursive_update { my %params = @_; - my ( $self, $updates, $fixed_fields, $object, $resolved, $if_not_submitted ) = @params{ qw/resultset updates fixed_fields object resolved if_not_submitted/ }; + my ( $self, $updates, $fixed_fields, $object, $resolved, + $if_not_submitted ) + = @params{ + qw/resultset updates fixed_fields object resolved if_not_submitted/}; $resolved ||= {}; + # warn 'entering: ' . $self->result_source->from(); - carp 'fixed fields needs to be an array ref' if $fixed_fields && ref($fixed_fields) ne 'ARRAY'; + carp 'fixed fields needs to be an array ref' + if $fixed_fields && ref($fixed_fields) ne 'ARRAY'; my %fixed_fields; %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields; if ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) { return $updates; } - if ( $updates->{id} ){ + if ( $updates->{id} ) { $object = $self->find( $updates->{id}, { key => 'primary' } ); } my @missing = - grep { !exists $updates->{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns; + grep { !exists $updates->{$_} && !exists $fixed_fields{$_} } + $self->result_source->primary_columns; if ( !$object && !scalar @missing ) { -# warn 'finding by: ' . Dumper( $updates ); use Data::Dumper; + + # warn 'finding by: ' . Dumper( $updates ); use Data::Dumper; $object = $self->find( $updates, { key => 'primary' } ); } $updates = { %$updates, %$resolved }; @missing = - grep { !exists $resolved->{$_} } @missing; + grep { !exists $resolved->{$_} } @missing; if ( !$object && !scalar @missing ) { -# warn 'finding by +resolved: ' . Dumper( $updates ); use Data::Dumper; + + # warn 'finding by +resolved: ' . Dumper( $updates ); use Data::Dumper; $object = $self->find( $updates, { key => 'primary' } ); } $object ||= $self->new( {} ); + # warn Dumper( $updates ); use Data::Dumper; # direct column accessors my %columns; - # relations that that should be done before the row is inserted into the database - # like belongs_to + # relations that that should be done before the row is inserted into the + # database like belongs_to my %pre_updates; - # relations that that should be done after the row is inserted into the database - # like has_many and might_have + # relations that that should be done after the row is inserted into the + # database like has_many, might_have and has_one my %post_updates; my %other_methods; - my %columns_by_accessor = _get_columns_by_accessor( $self ); -# warn 'resolved: ' . Dumper( $resolved ); -# warn 'updates: ' . Dumper( $updates ); use Data::Dumper; -# warn 'columns: ' . Dumper( \%columns_by_accessor ); + my %columns_by_accessor = _get_columns_by_accessor($self); + + # warn 'resolved: ' . Dumper( $resolved ); + # warn 'updates: ' . Dumper( $updates ); use Data::Dumper; + # warn 'columns: ' . Dumper( \%columns_by_accessor ); for my $name ( keys %$updates ) { my $source = $self->result_source; - if ( $columns_by_accessor{$name} - && !( $source->has_relationship($name) && ref( $updates->{$name} ) ) - ) + + # columns + if ( exists $columns_by_accessor{$name} + && !( $source->has_relationship($name) + && ref( $updates->{$name} ) ) ) { + + #warn "$name is a column\n"; $columns{$name} = $updates->{$name}; next; } - if( !( $source->has_relationship($name) ) ){ + + # relationships + if ( $source->has_relationship($name) ) { + if ( _master_relation_cond( $self, $name ) ) { + + #warn "$name is a pre-update rel\n"; + $pre_updates{$name} = $updates->{$name}; + next; + } + else { + + #warn "$name is a post-update rel\n"; + $post_updates{$name} = $updates->{$name}; + next; + } + } + + # many-to-many helper accessors + if ( is_m2m( $self, $name ) ) { + + #warn "$name is a many-to-many helper accessor\n"; $other_methods{$name} = $updates->{$name}; next; } - my $info = $source->relationship_info($name); - if ( - _master_relation_cond( - $source, $info->{cond}, _get_pk_for_related( $self, $name) - ) - ) - { - $pre_updates{$name} = $updates->{$name}; - } - else { - $post_updates{$name} = $updates->{$name}; + + # accessors + if ( $object->can($name) && not $source->has_relationship($name) ) { + + #warn "$name is an accessor"; + $other_methods{$name} = $updates->{$name}; + next; } + + # unknown + # TODO: don't throw a warning instead of an exception to give users + # time to adapt to the new API + $self->throw_exception( + "No such column, relationship, many-to-many helper accessor or generic accessor '$name'" + ); } + # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper; - # first update columns and other accessors - so that later related records can be found + # 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) { - $object->$name( $updates->{$name} ) if $object->can( $name ); + for my $name ( keys %other_methods ) { + + #warn "update other $name\n"; + $object->$name( $updates->{$name} ); } for my $name ( keys %pre_updates ) { - my $info = $object->result_source->relationship_info($name); - _update_relation( $self, $name, $updates, $object, $info, $if_not_submitted ); + + #warn "pre_update $name\n"; + _update_relation( $self, $name, $pre_updates{$name}, $object, + $if_not_submitted ); } -# $self->_delete_empty_auto_increment($object); -# don't allow insert to recurse to related objects - we do the recursion ourselves -# $object->{_rel_in_storage} = 1; + # $self->_delete_empty_auto_increment($object); + # don't allow insert to recurse to related objects + # do the recursion ourselves + # $object->{_rel_in_storage} = 1; + #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 ) { next if exists $columns{$name}; my $value = $updates->{$name}; - if ( is_m2m( $self, $name) ) { - my ($pk) = _get_pk_for_related( $self, $name); + if ( is_m2m( $self, $name ) ) { + + #warn "update m2m $name\n"; + my ($pk) = _get_pk_for_related( $self, $name ); my @rows; my $result_source = $object->$name->result_source; my @updates; - if( ! defined $value ){ + if ( !defined $value ) { next; } - elsif( ref $value ){ - @updates = @{ $value }; + elsif ( ref $value ) { + @updates = @{$value}; } - else{ - @updates = ( $value ); + else { + @updates = ($value); } - for my $elem ( @updates ) { + for my $elem (@updates) { if ( ref $elem ) { - push @rows, recursive_update( resultset => $result_source->resultset, updates => $elem ); + push @rows, + recursive_update( + resultset => $result_source->resultset, + updates => $elem + ); } else { push @rows, - $result_source->resultset->find( { $pk => $elem } ); + $result_source->resultset->find( { $pk => $elem } ); } } my $set_meth = 'set_' . $name; @@ -142,12 +199,15 @@ sub recursive_update { } } for my $name ( keys %post_updates ) { - my $info = $object->result_source->relationship_info($name); - _update_relation( $self, $name, $updates, $object, $info, $if_not_submitted ); + + #warn "post_update $name\n"; + _update_relation( $self, $name, $post_updates{$name}, $object, + $if_not_submitted ); } return $object; } +# returns DBIx::Class::ResultSource::column_info as a hash indexed by column accessor || name sub _get_columns_by_accessor { my $self = shift; my $source = $self->result_source; @@ -160,64 +220,174 @@ sub _get_columns_by_accessor { return %columns; } +# Arguments: $rs, $name, $updates, $row, $if_not_submitted sub _update_relation { - my ( $self, $name, $updates, $object, $info, $if_not_submitted ) = @_; - my $related_result = - $self->related_resultset($name)->result_source->resultset; + my ( $self, $name, $updates, $object, $if_not_submitted ) = @_; + + # this should never happen because we're checking the paramters passed to + # recursive_update, but just to be sure... + $object->throw_exception("No such relationship '$name'") + unless $object->has_relationship($name); + + #warn "_update_relation $name: OBJ: " . ref($object) . "\n"; + + my $info = $object->result_source->relationship_info($name); + + # get a related resultset without a condition + my $related_resultset = + $self->related_resultset($name)->result_source->resultset; my $resolved; - if( $self->result_source->can( '_resolve_condition' ) ){ - $resolved = $self->result_source->_resolve_condition( $info->{cond}, $name, $object ); + if ( $self->result_source->can('_resolve_condition') ) { + $resolved = + $self->result_source->_resolve_condition( $info->{cond}, $name, + $object ); } - else{ - $resolved = $self->result_source->resolve_condition( $info->{cond}, $name, $object ); + else { + $self->throw_exception( + "result_source must support _resolve_condition"); } - # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper; + # warn "$name resolved: " . Dumper( $resolved ); use Data::Dumper; $resolved = {} - if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $resolved; - if ( ref $updates->{$name} eq 'ARRAY' ) { - my @updated_ids; - for my $sub_updates ( @{ $updates->{$name} } ) { - my $sub_object = - recursive_update( resultset => $related_result, updates => $sub_updates, resolved => $resolved ); - push @updated_ids, $sub_object->id; + if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION + && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION + == $resolved; + + my @rel_cols = keys %{ $info->{cond} }; + map {s/^foreign\.//} @rel_cols; + + #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}; + } + + $if_not_submitted = $all_fks_nullable ? 'nullify' : 'delete' + unless defined $if_not_submitted; + + #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'; + + 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_objs, $sub_object; } - my @related_pks = $related_result->result_source->primary_columns; - if( defined $if_not_submitted && $if_not_submitted eq 'delete' ){ - if ( 1 == scalar @related_pks ){ - $object->$name->search( { $related_pks[0] => { -not_in => \@updated_ids } } )->delete; - } + + #warn "\tcreated and updated related rows\n"; + + my @related_pks = $related_resultset->result_source->primary_columns; + + 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 ) ] } + } + ); } - elsif( defined $if_not_submitted && $if_not_submitted eq 'set_to_null' ){ - if ( 1 == scalar @related_pks ){ - my @fk = keys %$resolved; - $object->$name->search( { $related_pks[0] => { -not_in => \@updated_ids } } )->update( { $fk[0] => undef } ); + + # foreign table has multiple pk columns + else { + my @cond; + 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; + } + # 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); + #my $rel_delist_cnt = $rs_rel_delist->count; + if ( $if_not_submitted eq 'delete' ) { + + #warn "\tdeleting related rows: $rel_delist_cnt\n"; + $rs_rel_delist->delete; + } + 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 ); + } } - else { - my $sub_updates = $updates->{$name}; + elsif ($info->{attrs}{accessor} eq 'single' + || $info->{attrs}{accessor} eq 'filter' ) + { + + #warn "\tupdating rel '$name': $if_not_submitted\n"; my $sub_object; - if( ref $sub_updates ){ + if ( ref $updates ) { + # for might_have relationship - if( $info->{attrs}{accessor} eq 'single' && defined $object->$name ){ - $sub_object = recursive_update( - resultset => $related_result, - updates => $sub_updates, - object => $object->$name + if ( $info->{attrs}{accessor} eq 'single' + && defined $object->$name ) + { + $sub_object = recursive_update( + resultset => $related_resultset, + updates => $updates, + object => $object->$name ); } - else{ - $sub_object = - recursive_update( resultset => $related_result, updates => $sub_updates, resolved => $resolved ); + else { + $sub_object = recursive_update( + resultset => $related_resultset, + updates => $updates, + resolved => $resolved + ); } } - elsif( ! ref $sub_updates ){ - $sub_object = $related_result->find( $sub_updates ) - unless (!$sub_updates && (exists $info->{attrs}{join_type} && $info->{attrs}{join_type} eq 'LEFT')); + else { + $sub_object = $related_resultset->find($updates) + unless ( + !$updates + && ( exists $info->{attrs}{join_type} + && $info->{attrs}{join_type} eq 'LEFT' ) + ); } $object->set_from_related( $name, $sub_object ) - unless (!$sub_object && !$sub_updates && (exists $info->{attrs}{join_type} && $info->{attrs}{join_type} eq 'LEFT')); + unless ( + !$sub_object + && !$updates + && ( exists $info->{attrs}{join_type} + && $info->{attrs}{join_type} eq 'LEFT' ) + ); + } + else { + $self->throw_exception( + "recursive_update doesn't now how to handle relationship '$name' with accessor " + . $info->{attrs}{accessor} ); } } @@ -247,7 +417,7 @@ sub get_m2m_source { if ( $rclass->can('_m2m_metadata') ) { return $self->result_source->related_source( $rclass->_m2m_metadata->{$relation}{relation} ) - ->related_source( + ->related_source( $rclass->_m2m_metadata->{$relation}{foreign_relation} ); } my $object = $self->new( {} ); @@ -258,11 +428,10 @@ sub get_m2m_source { sub _delete_empty_auto_increment { my ( $self, $object ) = @_; for my $col ( keys %{ $object->{_column_data} } ) { - if ( - $object->result_source->column_info($col)->{is_auto_increment} + if ($object->result_source->column_info($col)->{is_auto_increment} and ( !defined $object->{_column_data}{$col} or $object->{_column_data}{$col} eq '' ) - ) + ) { delete $object->{_column_data}{$col}; } @@ -277,35 +446,67 @@ sub _get_pk_for_related { } # many to many case - if ( is_m2m($self, $relation) ) { - $result_source = get_m2m_source($self, $relation); + if ( is_m2m( $self, $relation ) ) { + $result_source = get_m2m_source( $self, $relation ); } return $result_source->primary_columns; } +# This function determines wheter a relationship should be done before or +# after the row is inserted into the database +# relationships before: belongs_to +# 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 1 - if _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; } @@ -353,6 +554,7 @@ Then: =head1 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. @@ -400,18 +602,136 @@ in DBIx::Class::Schema. =head1 DESIGN CHOICES -=head2 Treatment of many to many pseudo relations +Columns and relationships which are excluded from the updates hashref aren't +touched at all. + +=head2 Treatment of belongs_to relations + +In case the relationship is included but undefined in the updates hashref, +all columns forming the relationship will be set to null. +If not all of them are nullable, DBIx::Class will throw an error. + +Updating the relationship: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + owner => $user->id, + }); + +Clearing the relationship (only works if cols are nullable!): + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + owner => undef, + }); + +=head2 Treatment of might_have relationships + +In case the relationship is included but undefined in the updates hashref, +all columns forming the relationship will be set to null. + +Updating the relationship: + + my $user = $user_rs->recursive_update( { + id => 1, + address => { + street => "101 Main Street", + city => "Podunk", + state => "New York", + } + }); + +Clearing the relationship: + + my $user = $user_rs->recursive_update( { + id => 1, + address => undef, + }); + +=head2 Treatment of has_many relations + +If a relationship key is included in the data structure with a value of undef +or an empty array, all existing related rows will be deleted, or their foreign +key columns will be set to null. + +The exact behaviour depends on the nullability of the foreign key columns and +the value of the "if_not_submitted" parameter. The parameter defaults to +undefined which neither nullifies nor deletes. + +When the array contains elements they are updated if they exist, created when +not and deleted if not included. + +=head3 All foreign table columns are nullable + +In this case recursive_update defaults to nullifying the foreign columns. + +=head3 Not all foreign table columns are nullable + +In this case recursive_update deletes the foreign rows. + +Updating the relationship: + + Passing ids: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [1, 2], + }); + + Passing hashrefs: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [ + { + id => 1, + file => 'file0' + }, + { + id => 2, + file => 'file1', + }, + ], + }); + + Passing objects: + + TODO + + You can even mix them: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [ '2', { id => '3' } ], + }); + +Clearing the relationship: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => undef, + }); + + This is the same as passing an empty array: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [], + }); + +=head2 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 it isn't loaded in the ResultSource classes 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. +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. =head1 INTERFACE @@ -446,15 +766,11 @@ DBIx::Class::RecursiveUpdate requires no configuration files or environment vari =head1 INCOMPATIBILITIES -=for author to fill in: - None reported. =head1 BUGS AND LIMITATIONS -=for author to fill in: - No bugs have been reported. Please report any bugs or feature requests to 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/DBSchema/Result/Dvd.pm b/t/lib/DBSchema/Result/Dvd.pm index 0020109..e9d6627 100644 --- a/t/lib/DBSchema/Result/Dvd.pm +++ b/t/lib/DBSchema/Result/Dvd.pm @@ -45,8 +45,8 @@ __PACKAGE__->add_columns( }, ); __PACKAGE__->set_primary_key('dvd_id'); -__PACKAGE__->belongs_to('owner', 'DBSchema::Result::User', { id => 'owner' }); -__PACKAGE__->belongs_to('current_borrower', 'DBSchema::Result::User', { id => 'current_borrower' }); +__PACKAGE__->belongs_to('owner', 'DBSchema::Result::User', 'owner'); +__PACKAGE__->belongs_to('current_borrower', 'DBSchema::Result::User', 'current_borrower'); __PACKAGE__->has_many('dvdtags', 'Dvdtag', { 'foreign.dvd' => 'self.dvd_id' }); __PACKAGE__->has_many('viewings', 'DBSchema::Result::Viewing', { 'foreign.dvd_id' => 'self.dvd_id' }); __PACKAGE__->many_to_many('tags', 'dvdtags' => 'tag'); @@ -54,9 +54,10 @@ __PACKAGE__->might_have( liner_notes => 'DBSchema::Result::LinerNotes', undef, { proxy => [ qw/notes/ ] }, ); -__PACKAGE__->add_relationship('like_has_many', 'DBSchema::Result::Twokeys', { 'foreign.dvd_name' => 'self.name' }, { accessor_name => 'like_has_many' } ); +__PACKAGE__->add_relationship('like_has_many', 'DBSchema::Result::Twokeys', { 'foreign.dvd_name' => 'self.name' }, { accessor => 'multi', accessor_name => 'like_has_many' } ); __PACKAGE__->add_relationship('like_has_many2', 'DBSchema::Result::Twokeys_belongsto', { 'foreign.key1' => 'self.twokeysfk' }, + { accessor => 'multi' }, ); 1; diff --git a/t/lib/DBSchema/Result/Twokeys.pm b/t/lib/DBSchema/Result/Twokeys.pm index 7d71d01..ff27f92 100644 --- a/t/lib/DBSchema/Result/Twokeys.pm +++ b/t/lib/DBSchema/Result/Twokeys.pm @@ -15,8 +15,7 @@ __PACKAGE__->add_columns( ); __PACKAGE__->set_primary_key("dvd_name", "key2"); -__PACKAGE__->add_relationship('like_belongs_to', 'DBSchema::Result::Dvd', { 'foreign.name' => 'self.dvd_name' }, ); +__PACKAGE__->add_relationship('like_belongs_to', 'DBSchema::Result::Dvd', { 'foreign.name' => 'self.dvd_name' }, { accessor => 'single' }); -1; - +1; \ No newline at end of file diff --git a/t/lib/DBSchema/Result/Twokeys_belongsto.pm b/t/lib/DBSchema/Result/Twokeys_belongsto.pm index 3f35aa0..4c5a8ae 100644 --- a/t/lib/DBSchema/Result/Twokeys_belongsto.pm +++ b/t/lib/DBSchema/Result/Twokeys_belongsto.pm @@ -20,5 +20,4 @@ __PACKAGE__->add_relationship('like_belongs_to', 'DBSchema::Result::Dvd', { 'for __PACKAGE__->belongs_to('onekey', 'DBSchema::Result::Onekey', { 'foreign.id' => 'self.key1' }, ); -1; - +1; \ No newline at end of file diff --git a/t/lib/RunTests.pm b/t/lib/RunTests.pm index 88ec1c9..defb701 100644 --- a/t/lib/RunTests.pm +++ b/t/lib/RunTests.pm @@ -1,230 +1,269 @@ # -*- perl -*- package RunTests; -use Exporter 'import'; # gives you Exporter's import() method directly +use Exporter 'import'; # gives you Exporter's import() method directly @EXPORT = qw(run_tests); use strict; -use Test::More; +use Test::More; use DBIx::Class::ResultSet::RecursiveUpdate; -sub run_tests{ +sub run_tests { my $schema = shift; - plan tests => 41; - - my $dvd_rs = $schema->resultset( 'Dvd' ); - my $user_rs = $schema->resultset( 'User' ); + plan tests => 45; - my $owner = $user_rs->next; - my $another_owner = $user_rs->next; + my $dvd_rs = $schema->resultset('Dvd'); + my $user_rs = $schema->resultset('User'); + + my $owner = $user_rs->next; + my $another_owner = $user_rs->next; my $initial_user_count = $user_rs->count; - my $initial_dvd_count = $dvd_rs->count; + my $initial_dvd_count = $dvd_rs->count; my $updates; + # try to create with a not existing rel + $updates = { + name => 'Test name for nonexisting rel', + username => 'nonexisting_rel', + password => 'whatever', + nonexisting => { foo => 'bar' }, + }; + eval { my $nonexisting_user = $user_rs->recursive_update($updates); }; + like( + $@, + qr/No such column, relationship, many-to-many helper accessor or generic accessor 'nonexisting'/, + 'nonexisting column, accessor, relationship fails' + ); + # creating new record linked to some old record $updates = { - name => 'Test name 2', - viewings => [ { user_id => $owner->id } ], - owner => { id => $another_owner->id }, + name => 'Test name 2', + viewings => [ { user_id => $owner->id } ], + owner => { id => $another_owner->id }, }; - - my $new_dvd = $dvd_rs->recursive_update( $updates ); -# my $new_dvd = $dvd_rs->create( $updates ); - - is ( $dvd_rs->count, $initial_dvd_count + 1, 'Dvd created' ); - is ( $schema->resultset( 'User' )->count, $initial_user_count, "No new user created" ); - is ( $new_dvd->name, 'Test name 2', 'Dvd name set' ); - is ( $new_dvd->owner->id, $another_owner->id, 'Owner set' ); - is ( $new_dvd->viewings->count, 1, 'Viewing created' ); + + my $new_dvd = $dvd_rs->recursive_update($updates); + + is( $dvd_rs->count, $initial_dvd_count + 1, 'Dvd created' ); + is( $schema->resultset('User')->count, + $initial_user_count, "No new user created" ); + is( $new_dvd->name, 'Test name 2', 'Dvd name set' ); + is( $new_dvd->owner->id, $another_owner->id, 'Owner set' ); + is( $new_dvd->viewings->count, 1, 'Viewing created' ); # creating new records $updates = { - aaaa => undef, - tags => [ '2', { id => '3' } ], - name => 'Test name', - owner => $owner, - current_borrower => { - name => 'temp name', - username => 'temp name', - password => 'temp name', - }, - liner_notes => { - notes => 'test note', - }, - like_has_many => [ - { key2 => 1 } - ], - like_has_many2 => [ - { - onekey => { name => 'aaaaa' }, - key2 => 1 - } - ], + + #aaaa => undef, + tags => [ '2', { id => '3' } ], + name => 'Test name', + owner => $owner, + current_borrower => { + name => 'temp name', + username => 'temp name', + password => 'temp name', + }, + liner_notes => { notes => 'test note', }, + like_has_many => [ { key2 => 1 } ], + like_has_many2 => [ + { onekey => { name => 'aaaaa' }, + key2 => 1 + } + ], }; - - my $dvd = $dvd_rs->recursive_update( $updates ); -; - is ( $dvd_rs->count, $initial_dvd_count + 2, 'Dvd created' ); - is ( $schema->resultset( 'User' )->count, $initial_user_count + 1, "One new user created" ); - is ( $dvd->name, 'Test name', 'Dvd name set' ); - is_deeply ( [ map {$_->id} $dvd->tags ], [ '2', '3' ], 'Tags set' ); - is ( $dvd->owner->id, $owner->id, 'Owner set' ); - - is ( $dvd->current_borrower->name, 'temp name', 'Related record created' ); - is ( $dvd->liner_notes->notes, 'test note', 'might_have record created' ); - ok ( $schema->resultset( 'Twokeys' )->find( { dvd_name => 'Test name', key2 => 1 } ), 'Twokeys created' ); - my $onekey = $schema->resultset( 'Onekey' )->search( name => 'aaaaa' )->first; - ok ( $onekey, 'Onekey created' ); - ok ( $schema->resultset( 'Twokeys_belongsto' )->find( { key1 => $onekey->id, key2 => 1 } ), 'Twokeys created' ); - - is ( $dvd->name, 'Test name', 'Dvd name set' ); -# changing existing records + my $dvd = $dvd_rs->recursive_update($updates); + + is( $dvd_rs->count, $initial_dvd_count + 2, 'Dvd created' ); + is( $schema->resultset('User')->count, + $initial_user_count + 1, + "One new user created" + ); + is( $dvd->name, 'Test name', 'Dvd name set' ); + is_deeply( [ map { $_->id } $dvd->tags ], [ '2', '3' ], 'Tags set' ); + is( $dvd->owner->id, $owner->id, 'Owner set' ); + + is( $dvd->current_borrower->name, 'temp name', 'Related record created' ); + is( $dvd->liner_notes->notes, 'test note', 'might_have record created' ); + ok( $schema->resultset('Twokeys') + ->find( { dvd_name => 'Test name', key2 => 1 } ), + 'Twokeys created' + ); + my $onekey = + $schema->resultset('Onekey')->search( name => 'aaaaa' )->first; + ok( $onekey, 'Onekey created' ); + ok( $schema->resultset('Twokeys_belongsto') + ->find( { key1 => $onekey->id, key2 => 1 } ), + 'Twokeys_belongsto created' + ); + is( $dvd->name, 'Test name', 'Dvd name set' ); + + # changing existing records my $num_of_users = $user_rs->count; $updates = { - id => $dvd->dvd_id, # id instead of dvd_id - aaaa => undef, - name => undef, - tags => [ ], - 'owner' => $another_owner->id, - current_borrower => { - username => 'new name a', - name => 'new name a', - password => 'new password a', - }, - liner_notes => { - notes => 'test note changed', - }, + id => $dvd->dvd_id, # id instead of dvd_id + #aaaa => undef, + name => undef, + tags => [], + 'owner' => $another_owner->id, + current_borrower => { + username => 'new name a', + name => 'new name a', + password => 'new password a', + }, + liner_notes => { notes => 'test note changed', }, }; - my $dvd_updated = $dvd_rs->recursive_update( $updates ); - - is ( $dvd_updated->dvd_id, $dvd->dvd_id, 'Pk from "id"' ); - is ( $schema->resultset( 'User' )->count, $initial_user_count + 1, "No new user created" ); - is ( $dvd_updated->name, undef, 'Dvd name deleted' ); - is ( $dvd_updated->owner->id, $another_owner->id, 'Owner updated' ); - is ( $dvd_updated->current_borrower->name, 'new name a', 'Related record modified' ); - is ( $dvd_updated->tags->count, 0, 'Tags deleted' ); - is ( $dvd_updated->liner_notes->notes, 'test note changed', 'might_have record changed' ); + my $dvd_updated = $dvd_rs->recursive_update($updates); + + is( $dvd_updated->dvd_id, $dvd->dvd_id, 'Pk from "id"' ); + is( $schema->resultset('User')->count, + $initial_user_count + 1, + "No new user created" + ); + is( $dvd_updated->name, undef, 'Dvd name deleted' ); + is( $dvd_updated->owner->id, $another_owner->id, 'Owner updated' ); + is( $dvd_updated->current_borrower->name, + 'new name a', 'Related record modified' ); + is( $dvd_updated->tags->count, 0, 'Tags deleted' ); + is( $dvd_updated->liner_notes->notes, + 'test note changed', + 'might_have record changed' + ); $new_dvd->update( { name => 'New Test Name' } ); $updates = { - id => $new_dvd->dvd_id, # id instead of dvd_id - like_has_many => [ - { dvd_name => $dvd->name, key2 => 1 } - ], + id => $new_dvd->dvd_id, # id instead of dvd_id + like_has_many => [ { dvd_name => $dvd->name, key2 => 1 } ], }; - $dvd_updated = $dvd_rs->recursive_update( $updates ); - ok ( $schema->resultset( 'Twokeys' )->find( { dvd_name => 'New Test Name', key2 => 1 } ), 'Twokeys updated' ); - ok ( !$schema->resultset( 'Twokeys' )->find( { dvd_name => $dvd->name, key2 => 1 } ), 'Twokeys updated' ); - -# repeatable - + $dvd_updated = $dvd_rs->recursive_update($updates); + ok( $schema->resultset('Twokeys') + ->find( { dvd_name => 'New Test Name', key2 => 1 } ), + 'Twokeys updated' + ); + ok( !$schema->resultset('Twokeys') + ->find( { dvd_name => $dvd->name, key2 => 1 } ), + 'Twokeys updated' + ); + + # repeatable $updates = { - name => 'temp name', - username => 'temp username', - password => 'temp username', - owned_dvds =>[ - { - 'name' => 'temp name 1', - 'tags' => [ 1, 2 ], - }, - { - 'name' => 'temp name 2', - 'tags' => [ 2, 3 ], - } + name => 'temp name', + username => 'temp username', + password => 'temp username', + owned_dvds => [ + { 'name' => 'temp name 1', + 'tags' => [ 1, 2 ], + }, + { 'name' => 'temp name 2', + 'tags' => [ 2, 3 ], + } ] }; - - my $user = $user_rs->recursive_update( $updates ); - is ( $schema->resultset( 'User' )->count, $initial_user_count + 2, "New user created" ); - is ( $dvd_rs->count, $initial_dvd_count + 4, 'Dvds created' ); + + my $user = $user_rs->recursive_update($updates); + is( $schema->resultset('User')->count, + $initial_user_count + 2, + "New user created" + ); + is( $dvd_rs->count, $initial_dvd_count + 4, 'Dvds created' ); my %owned_dvds = map { $_->name => $_ } $user->owned_dvds; is( scalar keys %owned_dvds, 2, 'Has many relations created' ); - ok( $owned_dvds{'temp name 1'}, 'Name in a has_many related record saved' ); + ok( $owned_dvds{'temp name 1'}, + 'Name in a has_many related record saved' ); my @tags = $owned_dvds{'temp name 1'}->tags; is( scalar @tags, 2, 'Tags in has_many related record saved' ); - ok( $owned_dvds{'temp name 2'}, 'Second name in a has_many related record saved' ); + ok( $owned_dvds{'temp name 2'}, + 'Second name in a has_many related record saved' ); + # update has_many where foreign cols aren't nullable $updates = { - id => $user->id, + id => $user->id, address => { street => "101 Main Street", - city => "Podunk", - state => "New York" + city => "Podunk", + state => "New York" }, - owned_dvds =>[ - { - id => 1, - }, - ] + owned_dvds => [ { id => 1, }, ] }; - $user = $user_rs->recursive_update( $updates ); - $user = $user_rs->recursive_update( $updates ); - is( $schema->resultset( 'Address' )->search({ user_id => $user->id })->count, 1, - 'the right number of addresses' ); - $dvd = $dvd_rs->find( 1 ); - is( $dvd->get_column( 'owner' ), $user->id, 'foreign key set' ); + $user = $user_rs->recursive_update($updates); + is( $schema->resultset('Address')->search( { user_id => $user->id } ) + ->count, + 1, + 'the right number of addresses' + ); + $dvd = $dvd_rs->find(1); + is( $dvd->get_column('owner'), $user->id, 'foreign key set' ); $dvd_rs->update( { current_borrower => $user->id } ); ok( $user->borrowed_dvds->count > 1, 'Precond' ); $updates = { - id => $user->id, - borrowed_dvds =>[ - { - id => $dvd->id - }, - ] + id => $user->id, + borrowed_dvds => [ { id => $dvd->id }, ] }; - $user = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( - resultset => $user_rs, - updates => $updates, + $user = + DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( + resultset => $user_rs, + updates => $updates, if_not_submitted => 'set_to_null', - ); + ); is( $user->borrowed_dvds->count, 1, 'set_to_null' ); + # has_many where foreign cols are nullable $dvd_rs->update( { current_borrower => $user->id } ); $updates = { - id => $user->id, - borrowed_dvds =>[ - { - id => $dvd->id - }, - ] + id => $user->id, + borrowed_dvds => [ { id => $dvd->id }, ] }; - $user = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( - resultset => $user_rs, - updates => $updates, + $user = + DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( + resultset => $user_rs, + updates => $updates, if_not_submitted => 'delete', - ); + ); is( $user->borrowed_dvds->count, 1, 'if_not_submitted delete' ); - @tags = $schema->resultset( 'Tag' )->search(); - $dvd_updated = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( - resultset => $schema->resultset( 'Dvd' ), - updates => { - id => $dvd->dvd_id, # id instead of dvd_id - tags => [ { id => $tags[0]->id, file => 'file0'}, { id => $tags[1]->id, file => 'file1' } ], + @tags = $schema->resultset('Tag')->search(); + $dvd_updated = + DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( + resultset => $schema->resultset('Dvd'), + updates => { + id => $dvd->dvd_id, # id instead of dvd_id + tags => [ + { id => $tags[0]->id, file => 'file0' }, + { id => $tags[1]->id, file => 'file1' } + ], } - ); + ); $tags[$_]->discard_changes for 0 .. 1; is( $tags[0]->file, 'file0', 'file set in tag' ); is( $tags[1]->file, 'file1', 'file set in tag' ); my @rel_tags = $dvd_updated->tags; is( scalar @rel_tags, 2, 'tags related' ); - ok( $rel_tags[0]->file eq 'file0' || $rel_tags[0]->file eq 'file1', 'tags related' ); + ok( $rel_tags[0]->file eq 'file0' || $rel_tags[0]->file eq 'file1', + 'tags related' ); my $new_person = { - name => 'Amiri Barksdale', + name => 'Amiri Barksdale', username => 'amiri', password => 'amiri', }; - ok(my $new_user = $user_rs->recursive_update( $new_person )); - - #print STDERR Dumper $new_user; + ok( my $new_user = $user_rs->recursive_update($new_person) ); + + # 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', # }; # $dvd = $dvd_rs->search( { id => $dvd->id } )->recursive_update( $updates, [ 'id' ] ); # is ( $dvd->name, 'Test name 1', 'Dvd name set in a resultset with restricted id' ); -} +} 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"; diff --git a/t/var/dvdzbr.db b/t/var/dvdzbr.db deleted file mode 100644 index 251fbc2..0000000 Binary files a/t/var/dvdzbr.db and /dev/null differ