Functional interface

diff --git a/Changes b/Changes
index f845cd90a925438bd61ba3d19cf2b09de7eca784..7dde1832c79aabc7d6e157cd360d1ba3dcdd3491 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for DBIx-Class-RecursivePUT
 
 Revision history for DBIx-Class-RecursivePUT
 

+0.0.4  Sun Apr 19 11:15:57 CEST 2009
+       Added functional interface - for easy use in Form Processors
+

 0.0.1  Wed Jun 18 13:09:28 2008
        Initial release.
 
 0.0.1  Wed Jun 18 13:09:28 2008
        Initial release.
 

diff --git a/Makefile.PL b/Makefile.PL
index aa282a9716baf8b74c69796322865402af1f90d6..1eb3120621b205915e6feb875eda9048142e6ea8 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -15,6 +15,7 @@ WriteMakefile(
         'DBIx::Class::IntrospectableM2M' => 0,
         'SQL::Translator' => '0.08',
         'DateTime'   => 0,
         'DBIx::Class::IntrospectableM2M' => 0,
         'SQL::Translator' => '0.08',
         'DateTime'   => 0,

+        'DBD::SQLite' => 0,

     },
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean               => { FILES => 'DBIx-Class-ResultSet-RecursiveUpdate-*' },
     },
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean               => { FILES => 'DBIx-Class-ResultSet-RecursiveUpdate-*' },

diff --git a/README b/README
index 7802081f05585e227e7fd2bb2d3aba02e9bda73f..ebb1ab59ca0fe489ec330330f7a8db030968fd2f 100644 (file)
--- a/README
+++ b/README
@@ -1,19 +1,8 @@
 DBIx-Class-RecursiveUpdate version 0.0.1
 
 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.
-]
-
+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. 

 
 INSTALLATION
 
 
 INSTALLATION
 


@@ -27,8 +16,7 @@ To install this module, run the following commands:
 
 DEPENDENCIES
 
 
 DEPENDENCIES
 

-None.
-
+See Makefile.PL

 
 COPYRIGHT AND LICENCE
 
 
 COPYRIGHT AND LICENCE
 

diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
index f440967e4dc75e99ec5ece4631f5d030fba913a3..1bc5aaee4ea514fe245368b8b559d0765316790f 100644 (file)
--- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
+++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
@@ -1,22 +1,32 @@
+use strict;
+use warnings;

 package DBIx::Class::ResultSet::RecursiveUpdate;
 
 package DBIx::Class::ResultSet::RecursiveUpdate;
 

-use version; $VERSION = qv('0.002');
+use version; our $VERSION = qv('0.004');

 
 

-use warnings;
-use strict;
+use base qw(DBIx::Class::ResultSet);
+
+sub recursive_update {
+    my ( $self, $updates, $fixed_fields ) = @_;
+    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 Carp;
 use Scalar::Util qw( blessed );
 

-use base qw(DBIx::Class::ResultSet);

 
 sub recursive_update {
 
 sub recursive_update {

-    my ( $self, $updates, $fixed_fields ) = @_;
+    my %params = @_;
+    my ( $self, $updates, $fixed_fields, $object ) = @params{ qw/resultset updates fixed_fields object/ }; 

     # warn 'entering: ' . $self->result_source->from();
     # warn 'entering: ' . $self->result_source->from();

-

     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;
     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 ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) {
         return $updates;
     }


@@ -32,7 +42,7 @@ sub recursive_update {
     # relations that that should be done after the row is inserted into the database
     # like has_many and might_have
     my %post_updates;
     # relations that that should be done after the row is inserted into the database
     # like has_many and might_have
     my %post_updates;

-    my %columns_by_accessor = $self->_get_columns_by_accessor;
+    my %columns_by_accessor = _get_columns_by_accessor( $self );

 
     for my $name ( keys %$updates ) {
         my $source = $self->result_source;
 
     for my $name ( keys %$updates ) {
         my $source = $self->result_source;


@@ -47,7 +57,7 @@ sub recursive_update {
         my $info = $source->relationship_info($name);
         if (
             _master_relation_cond(
         my $info = $source->relationship_info($name);
         if (
             _master_relation_cond(

-                $source, $info->{cond}, $self->_get_pk_for_related($name)
+                $source, $info->{cond}, _get_pk_for_related( $self, $name)

             )
           )
         {
             )
           )
         {


@@ -59,10 +69,9 @@ sub recursive_update {
     }
     # warn 'columns: ' . Dumper( \%columns ); use Data::Dumper;
 
     }
     # warn 'columns: ' . Dumper( \%columns ); use Data::Dumper;
 

-    my $object;

     my @missing =
       grep { !exists $columns{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;
     my @missing =
       grep { !exists $columns{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;

-    if ( !scalar @missing ) {
+    if ( !$object && !scalar @missing ) {

         $object = $self->find( \%columns, { key => 'primary' } );
     }
     $object ||= $self->new( {} );
         $object = $self->find( \%columns, { key => 'primary' } );
     }
     $object ||= $self->new( {} );


@@ -73,7 +82,7 @@ sub recursive_update {
     }
     for my $name ( keys %pre_updates ) {
         my $info = $object->result_source->relationship_info($name);
     }
     for my $name ( keys %pre_updates ) {
         my $info = $object->result_source->relationship_info($name);

-        $self->_update_relation( $name, $updates, $object, $info );
+        _update_relation( $self, $name, $updates, $object, $info );

     }
 #    $self->_delete_empty_auto_increment($object);
 
     }
 #    $self->_delete_empty_auto_increment($object);
 


@@ -86,8 +95,8 @@ sub recursive_update {
         next if exists $columns{$name};
         my $value = $updates->{$name};
 
         next if exists $columns{$name};
         my $value = $updates->{$name};
 

-        if ( $self->is_m2m($name) ) {
-            my ($pk) = $self->_get_pk_for_related($name);
+        if ( is_m2m( $self, $name) ) {
+            my ($pk) = _get_pk_for_related( $self, $name);

             my @rows;
             my $result_source = $object->$name->result_source;
             for my $elem ( @{ $updates->{$name} } ) {
             my @rows;
             my $result_source = $object->$name->result_source;
             for my $elem ( @{ $updates->{$name} } ) {


@@ -105,7 +114,7 @@ sub recursive_update {
     }
     for my $name ( keys %post_updates ) {
         my $info = $object->result_source->relationship_info($name);
     }
     for my $name ( keys %post_updates ) {
         my $info = $object->result_source->relationship_info($name);

-        $self->_update_relation( $name, $updates, $object, $info );
+        _update_relation( $self, $name, $updates, $object, $info );

     }
     return $object;
 }
     }
     return $object;
 }


@@ -124,7 +133,6 @@ sub _get_columns_by_accessor {
 
 sub _update_relation {
     my ( $self, $name, $updates, $object, $info ) = @_;
 
 sub _update_relation {
     my ( $self, $name, $updates, $object, $info ) = @_;

-

     my $related_result =
       $self->related_resultset($name)->result_source->resultset;
     my $resolved =
     my $related_result =
       $self->related_resultset($name)->result_source->resultset;
     my $resolved =


@@ -137,14 +145,14 @@ sub _update_relation {
         for my $sub_updates ( @{ $updates->{$name} } ) {
             $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
             my $sub_object =
         for my $sub_updates ( @{ $updates->{$name} } ) {
             $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
             my $sub_object =

-              $related_result->recursive_update( $sub_updates );
+              recursive_update( resultset => $related_result, updates => $sub_updates );

         }
     }
     else {
         my $sub_updates = $updates->{$name};
         $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
         my $sub_object =
         }
     }
     else {
         my $sub_updates = $updates->{$name};
         $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
         my $sub_object =

-          $related_result->recursive_update( $sub_updates );
+          recursive_update( resultset => $related_result, updates => $sub_updates );

         $object->set_from_related( $name, $sub_object );
     }
 }
         $object->set_from_related( $name, $sub_object );
     }
 }


@@ -205,8 +213,8 @@ sub _get_pk_for_related {
     }
 
     # many to many case
     }
 
     # many to many case

-    if ( $self->is_m2m($relation) ) {
-        $result_source = $self->get_m2m_source($relation);
+    if ( is_m2m($self, $relation) ) {
+        $result_source = get_m2m_source($self, $relation);

     }
     return $result_source->primary_columns;
 }
     }
     return $result_source->primary_columns;
 }


@@ -242,16 +250,31 @@ __END__
 
 =head1 NAME
 
 
 =head1 NAME
 

-DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive 
+DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive

 
 
 =head1 VERSION
 
 
 
 =head1 VERSION
 

-This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.001
+This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.004

 
 
 =head1 SYNOPSIS
 
 
 
 =head1 SYNOPSIS
 

+The functional interface:
+
+    my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({ 
+        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. 
     __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. 


@@ -270,7 +293,8 @@ Then:
 
   
 =head1 DESCRIPTION
 
   
 =head1 DESCRIPTION

-This is the first release - so treat it as experimental.
+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
 
 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

diff --git a/t/lib/RunTests.pm b/t/lib/RunTests.pm
index 3ba2afc055cde3cafb152faaac33d0f8106bba51..4557e016975f31c21552dd7941ff862687bf14dd 100644 (file)
--- a/t/lib/RunTests.pm
+++ b/t/lib/RunTests.pm
@@ -9,7 +9,7 @@ use Test::More;
 sub run_tests{
     my $schema = shift;
 
 sub run_tests{
     my $schema = shift;
 

-    plan tests => 27;
+    plan tests => 28;

     
     my $dvd_rs = $schema->resultset( 'Dvd' );
     my $user_rs = $schema->resultset( 'User' );
     
     my $dvd_rs = $schema->resultset( 'Dvd' );
     my $user_rs = $schema->resultset( 'User' );


@@ -76,14 +76,14 @@ sub run_tests{
     ok ( $onekey, 'Onekey created' );
     ok ( $schema->resultset( 'Twokeys_belongsto' )->find( { key1 => $onekey->id, key2 => 1 } ), 'Twokeys created' );
 
     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 $num_of_users = $user_rs->count;
     $updates = {
             id => $dvd->id,
             aaaa => undef,
 # changing existing records
 
     my $num_of_users = $user_rs->count;
     $updates = {
             id => $dvd->id,
             aaaa => undef,

-            name => 'Test name',
+            name => undef,

             tags => [ ], 
             'owner' => $another_owner->id,
             current_borrower => {
             tags => [ ], 
             'owner' => $another_owner->id,
             current_borrower => {


@@ -99,7 +99,7 @@ sub run_tests{
     $dvd = $dvd_rs->recursive_update( $updates );
     
     is ( $schema->resultset( 'User' )->count, $initial_user_count + 1, "No new user created" );
     $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->name, undef, 'Dvd name deleted' );

     is ( $dvd->owner->id, $another_owner->id, 'Owner updated' );
     is ( $dvd->current_borrower->name, 'new name a', 'Related record modified' );
     is ( $dvd->tags->count, 0, 'Tags deleted' );
     is ( $dvd->owner->id, $another_owner->id, 'Owner updated' );
     is ( $dvd->current_borrower->name, 'new name a', 'Related record modified' );
     is ( $dvd->tags->count, 0, 'Tags deleted' );

diff --git a/t/var/dvdzbr.db b/t/var/dvdzbr.db
index 4d090fe07bdb742325bbf0ed942f47cba54591ee..9a0af95f433be0839af4d3eaa758a2d359d7b1e2 100644 (file)
Binary files a/t/var/dvdzbr.db and b/t/var/dvdzbr.db differ