--- /dev/null
+Revision history for DBIx-Class-RecursivePUT
+
+0.0.1 Wed Jun 18 13:09:28 2008
+ Initial release.
+
--- /dev/null
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
+t/00.load.t
+t/pod-coverage.t
+t/pod.t
+t/lib/MySchema/Test.pm
+t/lib/DBSchema.pm
+t/lib/RunTests.pm
+t/lib/DBSchema/Result/User.pm
+t/lib/DBSchema/Result/Dvd.pm
+t/lib/DBSchema/Result/Tag.pm
+t/lib/DBSchema/Result/LinerNotes.pm
+t/lib/DBSchema/Result/Dvdtag.pm
+t/lib/DBSchema/Result/UserRole.pm
+t/lib/DBSchema/Result/Role.pm
+t/lib/MySchema.pm
+t/var/dvdzbr.db
+t/pg.t
+t/sqlite.t
+META.yml Module meta-data (added by MakeMaker)
--- /dev/null
+--- #YAML:1.0
+name: DBIx-Class-ResultSet-RecursiveUpdate
+version: 0.0.1
+abstract: like update_or_create - but recursive
+license: ~
+author:
+ - Zbigniew Lukasiak <zby@cpan.org>
+generated_by: ExtUtils::MakeMaker version 6.40
+distribution_type: module
+requires:
+ DBIx::Class: 0
+ Test::More: 0
+ version: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
--- /dev/null
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'DBIx::Class::ResultSet::RecursiveUpdate',
+ AUTHOR => 'Zbigniew Lukasiak <zby@cpan.org>',
+ VERSION_FROM => 'lib/DBIx/Class/ResultSet/RecursiveUpdate.pm',
+ ABSTRACT_FROM => 'lib/DBIx/Class/ResultSet/RecursiveUpdate.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'version' => 0,
+ 'DBIx::Class' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'DBIx-Class-ResultSet-RecursiveUpdate-*' },
+);
--- /dev/null
+DBIx-Class-RecursiveUpdate version 0.0.1
+
+[ REPLACE THIS...
+
+ The README is used to introduce the module and provide instructions on
+ how to install the module, any machine dependencies it may have (for
+ example C compilers and installed libraries) and any other information
+ that should be understood before the module is installed.
+
+ A README file is required for CPAN modules since CPAN extracts the
+ README file from a module distribution so that people browsing the
+ archive can use it get an idea of the modules uses. It is usually a
+ good idea to provide version information here so that people can
+ decide whether fixes for the module are worth downloading.
+]
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+DEPENDENCIES
+
+None.
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008, Zbigniew Lukasiak
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
--- /dev/null
+package DBIx::Class::ResultSet::RecursiveUpdate;
+
+use version; $VERSION = qv('0.0.1');
+
+use warnings;
+use strict;
+use Carp;
+
+use base qw(DBIx::Class::ResultSet);
+
+sub recursive_update {
+ my( $self, $updates ) = @_;
+ my $object;
+ # this is a workaround for a bug in the svn version 4794
+ if ( ref $self->{cond} eq 'ARRAY' and ref $self->{cond}[0] eq 'SCALAR' ){
+ $self->{cond} = {};
+ $object = $self->new( {} );
+ }
+ else {
+ $object = $self->find( $updates, { key => 'primary' } ) || $self->new( {} );
+ }
+
+ for my $name ( keys %$updates ){ if($object->can($name)){
+ my $value = $updates->{$name};
+ # updating relations that that should be done before the row is inserted into the database
+ # like belongs_to
+ if( $object->result_source->has_relationship($name)
+ and
+ ref $value
+ ){
+ my $info = $object->result_source->relationship_info( $name );
+ if( $info and not $info->{attrs}{accessor} eq 'multi'
+ and
+ _master_relation_cond( $object, $info->{cond}, _get_pk_for_related( $object, $name ) )
+ ){
+ my $related_result = $object->related_resultset( $name );
+ $DB::single = 1;
+ my $sub_object = $related_result->recursive_update( $value );
+ $object->set_from_related( $name, $sub_object );
+ }
+ }
+ # columns and other accessors
+ elsif( $object->result_source->has_column($name)
+ or
+ !$object->can( 'set_' . $name )
+ ) {
+ $object->$name($value);
+ }
+ }
+ #warn Dumper($object->{_column_data}); use Data::Dumper;
+ }
+ _delete_empty_auto_increment($object);
+ $object->update_or_insert;
+
+ # updating relations that can be done only after the row is inserted into the database
+ # like has_many and many_to_many
+ for my $name ( keys %$updates ){
+ my $value = $updates->{$name};
+ # many to many case
+ if($object->can($name) and
+ !$object->result_source->has_relationship($name) and
+ $object->can( 'set_' . $name )
+ ) {
+ my ( $pk ) = _get_pk_for_related( $object, $name );
+ my @values = @{$updates->{$name}};
+ my @rows;
+ my $result_source = $object->$name->result_source;
+ @rows = $result_source->resultset->search({ $pk => [ @values ] } ) if @values;
+ my $set_meth = 'set_' . $name;
+ $object->$set_meth( \@rows );
+ }
+ elsif( $object->result_source->has_relationship($name) ){
+ my $info = $object->result_source->relationship_info( $name );
+ # has many case
+ if( ref $updates->{$name} eq 'ARRAY' ){
+ for my $sub_updates ( @{$updates->{$name}} ) {
+ my $sub_object = $object->search_related( $name )->recursive_update( $sub_updates );
+ }
+ }
+ # might_have and has_one case
+ elsif ( ! _master_relation_cond( $object, $info->{cond}, _get_pk_for_related( $object, $name ) ) ){
+ my $sub_object = $object->search_related( $name )->recursive_update( $value );
+ #$object->set_from_related( $name, $sub_object );
+ }
+ }
+ }
+ return $object;
+}
+
+sub _delete_empty_auto_increment {
+ my ( $object ) = @_;
+ for my $col ( keys %{$object->{_column_data}}){
+ 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}
+ }
+ }
+}
+
+sub _get_pk_for_related {
+ my ( $object, $relation ) = @_;
+
+ my $rs = $object->result_source->resultset;
+ my $result_source = _get_related_source( $rs, $relation );
+ return $result_source->primary_columns;
+}
+
+sub _get_related_source {
+ my ( $rs, $name ) = @_;
+ if( $rs->result_source->has_relationship( $name ) ){
+ return $rs->result_source->related_source( $name );
+ }
+ # many to many case
+ my $row = $rs->new({});
+ if ( $row->can( $name ) and $row->can( 'add_to_' . $name ) and $row->can( 'set_' . $name ) ){
+ my $r = $row->$name;
+ return $r->result_source;
+ }
+ return;
+}
+
+sub _master_relation_cond {
+ my ( $object, $cond, @foreign_ids ) = @_;
+ my $foreign_ids_re = join '|', @foreign_ids;
+ if ( ref $cond eq 'HASH' ){
+ for my $f_key ( keys %{$cond} ) {
+ # might_have is not master
+ my $col = $cond->{$f_key};
+ $col =~ s/self\.//;
+ if( $object->column_info( $col )->{is_auto_increment} ){
+ return 0;
+ }
+ if( $f_key =~ /^foreign\.$foreign_ids_re/ ){
+ return 1;
+ }
+ }
+ }elsif ( ref $cond eq 'ARRAY' ){
+ for my $new_cond ( @$cond ) {
+ return 1 if _master_relation_cond( $object, $new_cond, @foreign_ids );
+ }
+ }
+ return;
+}
+
+# Module implementation here
+
+
+1; # Magic true value required at end of module
+__END__
+
+=head1 NAME
+
+DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
+
+
+=head1 VERSION
+
+This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.0.1
+
+
+=head1 SYNOPSIS
+
+ __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:
+
+=for author to fill in:
+
+ my $user = $user_rs->recursive_update( {
+ id => 1,
+ owned_dvds => [
+ {
+ id => undef,
+ title => 'One Flew Over the Cuckoo's Nest'
+ }
+ ]
+ }
+ );
+
+
+=head1 DESCRIPTION
+
+=for author to fill in:
+ 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).
+ When creating new rows in a table with auto_increment primary keys you need to
+ put 'undef' for the key value - this is then removed
+ and a correct INSERT statement is generated.
+
+ For a description how to set up base classes for ResultSets see load_namespaces
+ in DBIx::Class::Schema.
+
+=head1 INTERFACE
+
+=for author to fill in:
+
+=head1 METHODS
+
+=head2 recursive_update
+
+The only method here.
+
+=head1 DIAGNOSTICS
+
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+=for author to fill in:
+
+DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
+
+
+=head1 DEPENDENCIES
+
+=for author to fill in:
+
+ DBIx::Class
+
+None.
+
+
+=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
+C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>.
+
+
+=head1 AUTHOR
+
+Zbigniew Lukasiak C<< <zby@cpan.org> >>
+Influenced by code by Pedro Melo.
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. 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<perlartistic>.
+
+
+=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.
--- /dev/null
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'DBIx::Class::ResultSet::RecursiveUpdate' );
+}
+
+diag( "Testing DBIx::Class::ResultSet::RecursiveUpdate $DBIx::Class::ResultSet::RecursiveUpdate::VERSION" );
--- /dev/null
+package DBSchema;
+
+# Created by DBIx::Class::Schema::Loader v0.03000 @ 2006-10-02 08:24:09
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Schema';
+use DateTime;
+
+__PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
+
+sub get_test_schema {
+ my ( $dsn, $user, $pass ) = @_;
+ $dsn ||= 'dbi:SQLite:dbname=t/var/dvdzbr.db';
+ warn "testing $dsn";
+ my $schema = __PACKAGE__->connect( $dsn, $user, $pass, {} );
+ $schema->deploy({ add_drop_table => 1, });
+ $schema->populate('User', [
+ [ qw/username name password / ],
+ [ 'jgda', 'Jonas Alves', ''],
+ [ 'isa' , 'Isa', '', ],
+ [ 'zby' , 'Zbyszek Lukasiak', ''],
+ ]
+ );
+ $schema->populate('Tag', [
+ [ qw/name file / ],
+ [ 'comedy', '' ],
+ [ 'dramat', '' ],
+ [ 'australian', '' ],
+ ]
+ );
+ $schema->populate('Dvd', [
+ [ qw/name imdb_id owner current_borrower creation_date alter_date / ],
+ [ 'Picnick under the Hanging Rock', 123, 1, 3, '2003-01-16 23:12:01', undef ],
+ [ 'The Deerhunter', 1234, 1, 1, undef, undef ],
+ [ 'Rejs', 1235, 3, 1, undef, undef ],
+ [ 'Seksmisja', 1236, 3, 1, undef, undef ],
+ ]
+ );
+ $schema->populate( 'Dvdtag', [
+ [ qw/ dvd tag / ],
+ [ 1, 2 ],
+ [ 1, 3 ],
+ [ 3, 1 ],
+ [ 4, 1 ],
+ ]
+ );
+ return $schema;
+}
+
+
+1;
+
--- /dev/null
+package DBSchema::Result::Dvd;
+
+# Created by DBIx::Class::Schema::Loader v0.03000 @ 2006-10-02 08:24:09
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class';
+use overload '""' => sub {$_[0]->name}, fallback => 1;
+
+use lib '../../DBIx-Class-HTML-FormFu/lib/';
+__PACKAGE__->load_components('Core');
+__PACKAGE__->table('dvd');
+__PACKAGE__->add_columns(
+ 'id' => {
+ data_type => 'integer',
+ is_auto_increment => 1
+ },
+ 'name' => {
+ data_type => 'varchar',
+ size => 100,
+ is_nullable => 1,
+ },
+ 'imdb_id' => {
+ data_type => 'varchar',
+ size => 100,
+ is_nullable => 1,
+ },
+ 'owner' => { data_type => 'integer' },
+ 'current_borrower' => {
+ data_type => 'integer',
+ is_nullable => 1,
+ },
+
+ 'creation_date' => {
+ data_type => 'datetime',
+ is_nullable => 1,
+ },
+ 'alter_date' => {
+ data_type => 'datetime',
+ is_nullable => 1,
+ },
+);
+__PACKAGE__->set_primary_key('id');
+__PACKAGE__->belongs_to('owner', 'User', { id => 'owner' });
+__PACKAGE__->belongs_to('current_borrower', 'User', { id => 'current_borrower' });
+__PACKAGE__->has_many('dvdtags', 'Dvdtag', { 'foreign.dvd' => 'self.id' });
+__PACKAGE__->many_to_many('tags', 'dvdtags' => 'tag');
+__PACKAGE__->might_have(
+ liner_notes => 'DBSchema::Result::LinerNotes', undef,
+ { proxy => [ qw/notes/ ] },
+);
+
+
+1;
+
--- /dev/null
+package DBSchema::Result::Dvdtag;
+
+# Created by DBIx::Class::Schema::Loader v0.03000 @ 2006-10-02 08:24:09
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components("PK::Auto", "Core");
+__PACKAGE__->table("dvdtag");
+__PACKAGE__->add_columns(
+ "dvd" => { data_type => 'integer' },
+ "tag" => { data_type => 'integer' },
+);
+__PACKAGE__->set_primary_key("dvd", "tag");
+__PACKAGE__->belongs_to("dvd", "Dvd", { id => "dvd" });
+__PACKAGE__->belongs_to("tag", "Tag", { id => "tag" });
+
+1;
+
--- /dev/null
+package # hide from PAUSE
+ DBSchema::Result::LinerNotes;
+
+use base qw/DBIx::Class::Core/;
+
+__PACKAGE__->table('liner_notes');
+__PACKAGE__->add_columns(
+ 'liner_id' => {
+ data_type => 'integer',
+ },
+ 'notes' => {
+ data_type => 'varchar',
+ size => 100,
+ },
+);
+__PACKAGE__->set_primary_key('liner_id');
+__PACKAGE__->belongs_to(
+ 'dvd', 'DBSchema::Result::Dvd', 'liner_id'
+);
+
+1;
--- /dev/null
+package DBSchema::Result::Role;
+
+# Created by DBIx::Class::Schema::Loader v0.03000 @ 2006-10-02 08:24:09
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class';
+use overload '""' => sub {$_[0]->id}, fallback => 1;
+
+__PACKAGE__->load_components("PK::Auto", "Core");
+__PACKAGE__->table("role");
+__PACKAGE__->add_columns(
+ "id" => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ "role" => {
+ data_type => 'varchar',
+ size => '100',
+ }
+ );
+__PACKAGE__->set_primary_key("id");
+__PACKAGE__->has_many("user_roles", "UserRole", { "foreign.role" => "self.id" });
+__PACKAGE__->many_to_many('users', 'user_roles' => 'user');
+
+1;
+
--- /dev/null
+package DBSchema::Result::Tag;
+
+# Created by DBIx::Class::Schema::Loader v0.03000 @ 2006-10-02 08:24:09
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class';
+use overload '""' => sub {$_[0]->name}, fallback => 1;
+
+__PACKAGE__->load_components("PK::Auto", "Core");
+__PACKAGE__->table("tag");
+__PACKAGE__->add_columns(
+ "id" => {
+ data_type => 'integer',
+ is_auto_increment => 1
+ },
+ 'name' => {
+ data_type => 'varchar',
+ size => 100,
+ is_nullable => 1,
+ },
+ 'file' => {
+ data_type => 'text',
+ is_nullable => 1,
+ }
+);
+
+__PACKAGE__->set_primary_key("id");
+__PACKAGE__->has_many("dvdtags", "Dvdtag", { "foreign.tag" => "self.id" });
+__PACKAGE__->many_to_many('dvds', 'dvdtags' => 'dvd');
+
+1;
+
--- /dev/null
+package DBSchema::Result::User;
+
+# Created by DBIx::Class::Schema::Loader v0.03000 @ 2006-10-02 08:24:09
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class';
+#use overload '""' => sub {$_[0]->name}, fallback => 1;
+
+__PACKAGE__->load_components('Core');
+__PACKAGE__->table("usr");
+__PACKAGE__->add_columns(
+ "id" => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ "username" => {
+ data_type => 'varchar',
+ size => '100',
+ },
+ "password" => {
+ data_type => 'varchar',
+ size => '100',
+ },
+ "name" => {
+ data_type => 'varchar',
+ size => '100',
+ },
+ );
+__PACKAGE__->set_primary_key("id");
+__PACKAGE__->has_many("user_roles", "UserRole", { "foreign.user" => "self.id" });
+__PACKAGE__->has_many("owned_dvds", "Dvd", { "foreign.owner" => "self.id" });
+__PACKAGE__->has_many(
+ "borrowed_dvds",
+ "Dvd",
+ { "foreign.current_borrower" => "self.id" },
+);
+__PACKAGE__->many_to_many('roles', 'user_roles' => 'role');
+
+1;
+
--- /dev/null
+package DBSchema::Result::UserRole;
+
+# Created by DBIx::Class::Schema::Loader v0.03000 @ 2006-10-02 08:24:09
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components("PK::Auto", "Core");
+__PACKAGE__->table("user_role");
+__PACKAGE__->add_columns(
+ "user" => { data_type => 'integer' } ,
+ "role" => { data_type => 'integer' }
+);
+__PACKAGE__->set_primary_key("user", "role");
+__PACKAGE__->belongs_to("user", "User", { id => "user" });
+__PACKAGE__->belongs_to("role", "Role", { id => "role" });
+
+1;
+
--- /dev/null
+package MySchema;
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Schema';
+
+__PACKAGE__->load_classes;
+
+1;
+
--- /dev/null
+package MySchema::Test;
+use strict;
+use warnings;
+
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components(qw/
+ InflateColumn::DateTime PK::Auto Core
+/);
+
+__PACKAGE__->table("test");
+
+__PACKAGE__->add_columns(
+ hidden_col => { data_type => "INTEGER" },
+ text_col => { data_type => "TEXT" },
+ password_col => { data_type => "TEXT" },
+ checkbox_col => {
+ data_type => "TEXT",
+ default_value => 0,
+ is_nullable => 0,
+ },
+ select_col => { data_type => "TEXT" },
+ radio_col => { data_type => "TEXT" },
+ radiogroup_col => { data_type => "TEXT" },
+ date_col => { data_type => "DATE" },
+ not_in_form => { data_type => "TEXT" },
+);
+
+__PACKAGE__->set_primary_key("hidden_col");
+
+1;
+
--- /dev/null
+# -*- perl -*-
+package RunTests;
+use Exporter 'import'; # gives you Exporter's import() method directly
+@EXPORT = qw(run_tests);
+use strict;
+use Test::More;
+
+
+sub run_tests{
+ my $schema = shift;
+
+ my $dvd_rs = $schema->resultset( 'Dvd' );
+ my $owner = $schema->resultset( 'User' )->first;
+ my $initial_user_count = $schema->resultset( 'User' )->count;
+
+ # creating new records
+
+ my $updates = {
+ id => undef,
+ aaaa => undef,
+ tags => [ '2', '3' ],
+ name => 'Test name',
+ # 'creation_date.year' => 2002,
+ # 'creation_date.month' => 1,
+ # 'creation_date.day' => 3,
+ # 'creation_date.hour' => 4,
+ # 'creation_date.minute' => 33,
+ # 'creation_date.pm' => 1,
+ owner => $owner->id,
+ current_borrower => {
+ name => 'temp name',
+ username => 'temp name',
+ password => 'temp name',
+ },
+ liner_notes => {
+
+ notes => 'test note',
+ }
+ };
+
+ my $dvd = $dvd_rs->recursive_update( $updates );
+
+ 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' );
+ #my $value = $dvd->creation_date;
+ #is( "$value", '2002-01-03T16:33:00', 'Date 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' );
+
+ # changing existing records
+
+ $updates = {
+ id => $dvd->id,
+ aaaa => undef,
+ name => 'Test name',
+ tags => [ ],
+ 'owner' => $owner->id,
+ current_borrower => {
+ username => 'new name a',
+ name => 'new name a',
+ password => 'new password a',
+ }
+ };
+ $dvd = $dvd_rs->recursive_update( $updates );
+
+ is ( $schema->resultset( 'User' )->count, $initial_user_count + 1, "No new user created" );
+ is ( $dvd->name, 'Test name', 'Dvd name set' );
+ is ( $dvd->owner->id, $owner->id, 'Owner set' );
+ is ( $dvd->current_borrower->name, 'new name a', 'Related record modified' );
+ is ( $dvd->tags->count, 0, 'Tags deleted' );
+
+ # repeatable
+
+ $updates = {
+ id => undef,
+ name => 'temp name',
+ username => 'temp username',
+ password => 'temp username',
+ owned_dvds =>[
+ {
+ 'id' => undef,
+ 'name' => 'temp name 1',
+ 'tags' => [ 1, 2 ],
+ },
+ {
+ 'id' => undef,
+ 'name' => 'temp name 2',
+ 'tags' => [ 2, 3 ],
+ }
+ ]
+ };
+
+ my $user_rs = $schema->resultset( 'User' );
+ my $user = $user_rs->recursive_update( $updates );
+ 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' );
+ 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' );
+}
--- /dev/null
+# -*- perl -*-
+
+use lib 't/lib';
+use DBSchema;
+use RunTests;
+use Test::More;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
+
+plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
+ . ' (note: creates and tables!)' unless ($dsn && $user);
+
+plan tests => 15;
+
+my $schema = DBSchema::get_test_schema( $dsn, $user, $pass );
+
+run_tests( $schema );
+
--- /dev/null
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
--- /dev/null
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
--- /dev/null
+# -*- perl -*-
+
+use lib 't/lib';
+use DBSchema;
+use RunTests;
+use Test::More;
+plan tests => 15;
+
+my $schema = DBSchema::get_test_schema();
+run_tests( $schema );
+
projects / chaz / p5-DBIx-Class-ResultSet-RecursiveUpdate / commitdiff
