From: zby Date: Mon, 22 Sep 2008 17:10:13 +0000 (+0000) Subject: Initial X-Git-Url: https://git.brokenzipper.com/gitweb?a=commitdiff_plain;h=424363ed169eae916480670bea2363322285855a;p=chaz%2Fp5-DBIx-Class-ResultSet-RecursiveUpdate Initial --- diff --git a/Changes b/Changes new file mode 100644 index 0000000..f845cd9 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for DBIx-Class-RecursivePUT + +0.0.1 Wed Jun 18 13:09:28 2008 + Initial release. + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..d205cfc --- /dev/null +++ b/MANIFEST @@ -0,0 +1,23 @@ +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) diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..cd56128 --- /dev/null +++ b/META.yml @@ -0,0 +1,16 @@ +--- #YAML:1.0 +name: DBIx-Class-ResultSet-RecursiveUpdate +version: 0.0.1 +abstract: like update_or_create - but recursive +license: ~ +author: + - Zbigniew Lukasiak +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 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..ca2968a --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'DBIx::Class::ResultSet::RecursiveUpdate', + AUTHOR => 'Zbigniew Lukasiak ', + 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-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..7802081 --- /dev/null +++ b/README @@ -0,0 +1,38 @@ +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. diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm new file mode 100644 index 0000000..5934bc4 --- /dev/null +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -0,0 +1,284 @@ +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, 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. diff --git a/t/00.load.t b/t/00.load.t new file mode 100644 index 0000000..b63e069 --- /dev/null +++ b/t/00.load.t @@ -0,0 +1,7 @@ +use Test::More tests => 1; + +BEGIN { +use_ok( 'DBIx::Class::ResultSet::RecursiveUpdate' ); +} + +diag( "Testing DBIx::Class::ResultSet::RecursiveUpdate $DBIx::Class::ResultSet::RecursiveUpdate::VERSION" ); diff --git a/t/lib/DBSchema.pm b/t/lib/DBSchema.pm new file mode 100644 index 0000000..e729155 --- /dev/null +++ b/t/lib/DBSchema.pm @@ -0,0 +1,54 @@ +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; + diff --git a/t/lib/DBSchema/Result/Dvd.pm b/t/lib/DBSchema/Result/Dvd.pm new file mode 100644 index 0000000..d87147c --- /dev/null +++ b/t/lib/DBSchema/Result/Dvd.pm @@ -0,0 +1,56 @@ +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; + diff --git a/t/lib/DBSchema/Result/Dvdtag.pm b/t/lib/DBSchema/Result/Dvdtag.pm new file mode 100644 index 0000000..77521bc --- /dev/null +++ b/t/lib/DBSchema/Result/Dvdtag.pm @@ -0,0 +1,21 @@ +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; + diff --git a/t/lib/DBSchema/Result/LinerNotes.pm b/t/lib/DBSchema/Result/LinerNotes.pm new file mode 100644 index 0000000..b7c8d6e --- /dev/null +++ b/t/lib/DBSchema/Result/LinerNotes.pm @@ -0,0 +1,21 @@ +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; diff --git a/t/lib/DBSchema/Result/Role.pm b/t/lib/DBSchema/Result/Role.pm new file mode 100644 index 0000000..c393d25 --- /dev/null +++ b/t/lib/DBSchema/Result/Role.pm @@ -0,0 +1,28 @@ +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; + diff --git a/t/lib/DBSchema/Result/Tag.pm b/t/lib/DBSchema/Result/Tag.pm new file mode 100644 index 0000000..5ec084c --- /dev/null +++ b/t/lib/DBSchema/Result/Tag.pm @@ -0,0 +1,34 @@ +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; + diff --git a/t/lib/DBSchema/Result/User.pm b/t/lib/DBSchema/Result/User.pm new file mode 100644 index 0000000..b8f53a5 --- /dev/null +++ b/t/lib/DBSchema/Result/User.pm @@ -0,0 +1,42 @@ +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; + diff --git a/t/lib/DBSchema/Result/UserRole.pm b/t/lib/DBSchema/Result/UserRole.pm new file mode 100644 index 0000000..ef858c7 --- /dev/null +++ b/t/lib/DBSchema/Result/UserRole.pm @@ -0,0 +1,21 @@ +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; + diff --git a/t/lib/MySchema.pm b/t/lib/MySchema.pm new file mode 100644 index 0000000..98a6792 --- /dev/null +++ b/t/lib/MySchema.pm @@ -0,0 +1,10 @@ +package MySchema; +use strict; +use warnings; + +use base 'DBIx::Class::Schema'; + +__PACKAGE__->load_classes; + +1; + diff --git a/t/lib/MySchema/Test.pm b/t/lib/MySchema/Test.pm new file mode 100644 index 0000000..6fb60ad --- /dev/null +++ b/t/lib/MySchema/Test.pm @@ -0,0 +1,32 @@ +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; + diff --git a/t/lib/RunTests.pm b/t/lib/RunTests.pm new file mode 100644 index 0000000..e38d1f1 --- /dev/null +++ b/t/lib/RunTests.pm @@ -0,0 +1,104 @@ +# -*- 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' ); +} diff --git a/t/pg.t b/t/pg.t new file mode 100644 index 0000000..8765d41 --- /dev/null +++ b/t/pg.t @@ -0,0 +1,18 @@ +# -*- 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 ); + diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..703f91d --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,6 @@ +#!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(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..976d7cd --- /dev/null +++ b/t/pod.t @@ -0,0 +1,6 @@ +#!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(); diff --git a/t/sqlite.t b/t/sqlite.t new file mode 100644 index 0000000..835ecd1 --- /dev/null +++ b/t/sqlite.t @@ -0,0 +1,11 @@ +# -*- perl -*- + +use lib 't/lib'; +use DBSchema; +use RunTests; +use Test::More; +plan tests => 15; + +my $schema = DBSchema::get_test_schema(); +run_tests( $schema ); + diff --git a/t/var/dvdzbr.db b/t/var/dvdzbr.db new file mode 100644 index 0000000..c464946 Binary files /dev/null and b/t/var/dvdzbr.db differ