Dogcows Code - chaz/p5-DBIx-Class-ResultSet-RecursiveUpdate/blob - lib/DBIx/Class/ResultSet/RecursiveUpdate.pm

   1 use strict;
   2 use warnings;
   3
   4 package DBIx::Class::ResultSet::RecursiveUpdate;
   5
   6 our $VERSION = '0.013';
   7
   8 use base qw(DBIx::Class::ResultSet);
   9
  10 sub recursive_update {
  11     my ( $self, $updates, $fixed_fields ) = @_;
  12     return
  13         DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update(
  14         resultset    => $self,
  15         updates      => $updates,
  16         fixed_fields => $fixed_fields
  17         );
  18 }
  19
  20 package DBIx::Class::ResultSet::RecursiveUpdate::Functions;
  21 use Carp;
  22 use Scalar::Util qw( blessed );
  23 use List::MoreUtils qw/ any /;
  24
  25 sub recursive_update {
  26     my %params = @_;
  27     my ( $self, $updates, $fixed_fields, $object, $resolved,
  28         $if_not_submitted )
  29         = @params{
  30         qw/resultset updates fixed_fields object resolved if_not_submitted/};
  31     $resolved ||= {};
  32
  33     # warn 'entering: ' . $self->result_source->from();
  34     carp 'fixed fields needs to be an array ref'
  35         if $fixed_fields && ref($fixed_fields) ne 'ARRAY';
  36     my %fixed_fields;
  37     %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields;
  38     if ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) {
  39         return $updates;
  40     }
  41     if ( $updates->{id} ) {
  42         $object = $self->find( $updates->{id}, { key => 'primary' } );
  43     }
  44     my @missing =
  45         grep { !exists $updates->{$_} && !exists $fixed_fields{$_} }
  46         $self->result_source->primary_columns;
  47     if ( !$object && !scalar @missing ) {
  48
  49         # warn 'finding by: ' . Dumper( $updates ); use Data::Dumper;
  50         $object = $self->find( $updates, { key => 'primary' } );
  51     }
  52     $updates = { %$updates, %$resolved };
  53     @missing =
  54         grep { !exists $resolved->{$_} } @missing;
  55     if ( !$object && !scalar @missing ) {
  56
  57        # warn 'finding by +resolved: ' . Dumper( $updates ); use Data::Dumper;
  58         $object = $self->find( $updates, { key => 'primary' } );
  59     }
  60     $object ||= $self->new( {} );
  61
  62     # warn Dumper( $updates ); use Data::Dumper;
  63     # direct column accessors
  64     my %columns;
  65
  66     # relations that that should be done before the row is inserted into the
  67     # database like belongs_to
  68     my %pre_updates;
  69
  70     # relations that that should be done after the row is inserted into the
  71     # database like has_many, might_have and has_one
  72     my %post_updates;
  73     my %other_methods;
  74     my %columns_by_accessor = _get_columns_by_accessor($self);
  75
  76     #    warn 'resolved: ' . Dumper( $resolved );
  77     #    warn 'updates: ' . Dumper( $updates ); use Data::Dumper;
  78     #    warn 'columns: ' . Dumper( \%columns_by_accessor );
  79     for my $name ( keys %$updates ) {
  80         my $source = $self->result_source;
  81
  82         # columns
  83         if ( exists $columns_by_accessor{$name}
  84             && !( $source->has_relationship($name)
  85                 && ref( $updates->{$name} ) ) )
  86         {
  87
  88             #warn "$name is a column\n";
  89             $columns{$name} = $updates->{$name};
  90             next;
  91         }
  92
  93         # relationships
  94         if ( $source->has_relationship($name) ) {
  95             if ( _master_relation_cond( $self, $name ) ) {
  96
  97                 #warn "$name is a pre-update rel\n";
  98                 $pre_updates{$name} = $updates->{$name};
  99                 next;
 100             }
 101             else {
 102
 103                 #warn "$name is a post-update rel\n";
 104                 $post_updates{$name} = $updates->{$name};
 105                 next;
 106             }
 107         }
 108
 109         # many-to-many helper accessors
 110         if ( is_m2m( $self, $name ) ) {
 111
 112             #warn "$name is a many-to-many helper accessor\n";
 113             $other_methods{$name} = $updates->{$name};
 114             next;
 115         }
 116
 117         # accessors
 118         if ( $object->can($name) && not $source->has_relationship($name) ) {
 119
 120             #warn "$name is an accessor";
 121             $other_methods{$name} = $updates->{$name};
 122             next;
 123         }
 124
 125         # unknown
 126         # TODO: don't throw a warning instead of an exception to give users
 127         #       time to adapt to the new API
 128         $self->throw_exception(
 129             "No such column, relationship, many-to-many helper accessor or generic accessor '$name'"
 130         );
 131     }
 132
 133     # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper;
 134
 135     # first update columns and other accessors
 136     # so that later related records can be found
 137     for my $name ( keys %columns ) {
 138
 139         #warn "update col $name\n";
 140         $object->$name( $columns{$name} );
 141     }
 142     for my $name ( keys %other_methods ) {
 143
 144         #warn "update other $name\n";
 145         $object->$name( $updates->{$name} );
 146     }
 147     for my $name ( keys %pre_updates ) {
 148
 149         #warn "pre_update $name\n";
 150         _update_relation( $self, $name, $pre_updates{$name}, $object,
 151             $if_not_submitted );
 152     }
 153
 154     # $self->_delete_empty_auto_increment($object);
 155     # don't allow insert to recurse to related objects
 156     # do the recursion ourselves
 157     # $object->{_rel_in_storage} = 1;
 158     #warn "CHANGED: " . $object->is_changed . "\n":
 159     #warn "IN STOR: " .  $object->in_storage . "\n";
 160     $object->update_or_insert if $object->is_changed;
 161     $object->discard_changes;
 162
 163     # updating many_to_many
 164     for my $name ( keys %$updates ) {
 165         next if exists $columns{$name};
 166         my $value = $updates->{$name};
 167
 168         if ( is_m2m( $self, $name ) ) {
 169
 170             #warn "update m2m $name\n";
 171             my ($pk) = _get_pk_for_related( $self, $name );
 172             my @rows;
 173             my $result_source = $object->$name->result_source;
 174             my @updates;
 175             if ( !defined $value ) {
 176                 next;
 177             }
 178             elsif ( ref $value ) {
 179                 @updates = @{$value};
 180             }
 181             else {
 182                 @updates = ($value);
 183             }
 184             for my $elem (@updates) {
 185                 if ( ref $elem ) {
 186                     push @rows,
 187                         recursive_update(
 188                         resultset => $result_source->resultset,
 189                         updates   => $elem
 190                         );
 191                 }
 192                 else {
 193                     push @rows,
 194                         $result_source->resultset->find( { $pk => $elem } );
 195                 }
 196             }
 197             my $set_meth = 'set_' . $name;
 198             $object->$set_meth( \@rows );
 199         }
 200     }
 201     for my $name ( keys %post_updates ) {
 202
 203         #warn "post_update $name\n";
 204         _update_relation( $self, $name, $post_updates{$name}, $object,
 205             $if_not_submitted );
 206     }
 207     return $object;
 208 }
 209
 210 # returns DBIx::Class::ResultSource::column_info as a hash indexed by column accessor || name
 211 sub _get_columns_by_accessor {
 212     my $self   = shift;
 213     my $source = $self->result_source;
 214     my %columns;
 215     for my $name ( $source->columns ) {
 216         my $info = $source->column_info($name);
 217         $info->{name} = $name;
 218         $columns{ $info->{accessor} || $name } = $info;
 219     }
 220     return %columns;
 221 }
 222
 223 # Arguments: $rs, $name, $updates, $row, $if_not_submitted
 224 sub _update_relation {
 225     my ( $self, $name, $updates, $object, $if_not_submitted ) = @_;
 226
 227     # this should never happen because we're checking the paramters passed to
 228     # recursive_update, but just to be sure...
 229     $object->throw_exception("No such relationship '$name'")
 230         unless $object->has_relationship($name);
 231
 232     #warn "_update_relation $name: OBJ: " . ref($object) . "\n";
 233
 234     my $info = $object->result_source->relationship_info($name);
 235
 236     # get a related resultset without a condition
 237     my $related_resultset =
 238         $self->related_resultset($name)->result_source->resultset;
 239     my $resolved;
 240     if ( $self->result_source->can('_resolve_condition') ) {
 241         $resolved =
 242             $self->result_source->_resolve_condition( $info->{cond}, $name,
 243             $object );
 244     }
 245     else {
 246         $self->throw_exception(
 247             "result_source must support _resolve_condition");
 248     }
 249
 250     # warn "$name resolved: " . Dumper( $resolved ); use Data::Dumper;
 251     $resolved = {}
 252         if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
 253             && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
 254             == $resolved;
 255
 256     my @rel_cols = keys %{ $info->{cond} };
 257     map {s/^foreign\.//} @rel_cols;
 258
 259     #warn "REL_COLS: " . Dumper(@rel_cols); use Data::Dumper;
 260     my $rel_col_cnt = scalar @rel_cols;
 261
 262     # find out if all related columns are nullable
 263     my $all_fks_nullable = 1;
 264     for my $rel_col (@rel_cols) {
 265         $all_fks_nullable = 0
 266             unless $related_resultset->result_source->column_info($rel_col)
 267                 ->{is_nullable};
 268     }
 269
 270     #warn "\tNULLABLE: $all_fks_nullable\n";
 271     $if_not_submitted = $all_fks_nullable ? 'nullify' : 'delete'
 272         unless defined $if_not_submitted;
 273
 274     # handle undef
 275     #if (not defined $updates && $if_not_submitted eq 'delete') {
 276     #    warn "$name " . ref $object;
 277     #    $object->related_resultset($name)->delete;
 278     #    return;
 279     #}
 280
 281     #warn "RELINFO for $name: " . Dumper($info); use Data::Dumper;
 282
 283     # the only valid datatype for a has_many rels is an arrayref
 284     if ( $info->{attrs}{accessor} eq 'multi' ) {
 285         $self->throw_exception(
 286             "data for has_many relationship '$name' must be an arrayref")
 287             unless ref $updates eq 'ARRAY';
 288
 289         my @updated_objs;
 290
 291         #warn "\tupdating has_many rel '$name' ($rel_col_cnt columns cols)\n";
 292         for my $sub_updates ( @{$updates} ) {
 293             my $sub_object = recursive_update(
 294                 resultset => $related_resultset,
 295                 updates   => $sub_updates,
 296                 resolved  => $resolved
 297             );
 298
 299             push @updated_objs, $sub_object;
 300         }
 301
 302         #warn "\tcreated and updated related rows\n";
 303
 304         my @cond;
 305         my @related_pks = $related_resultset->result_source->primary_columns;
 306         for my $obj (@updated_objs) {
 307             my %cond_for_obj;
 308             for my $col (@related_pks) {
 309                 $cond_for_obj{$col} = $obj->get_column($col);
 310             }
 311             push @cond, \%cond_for_obj;
 312         }
 313         my %cond = ( -not => [@cond] );
 314
 315         #warn "\tCOND: " . Dumper(\%cond);
 316         my $rs_rel_delist = $object->$name->search_rs( \%cond );
 317
 318         #my $rel_delist_cnt = $rs_rel_delist->count;
 319         my @foo = $rs_rel_delist->all;
 320         if ( $if_not_submitted eq 'delete' ) {
 321
 322             #warn "\tdeleting related rows: $rel_delist_cnt\n";
 323             $rs_rel_delist->delete;
 324
 325             # # only handles related result classes with single primary keys
 326             # if ( 1 == $rel_col_cnt ) {
 327             # $object->$name->search(
 328             # {   $rel_cols[0] =>
 329             # { -not_in => [ map ( $_->id, @updated_objs ) ] }
 330             # }
 331             # )->delete;
 332             # }
 333             # else {
 334             # warn "multi-column relationships aren't supported\n";
 335             # }
 336         }
 337         elsif ( $if_not_submitted eq 'set_to_null' ) {
 338
 339             #warn "\tnullifying related rows: $rel_delist_cnt\n";
 340             my %update = map { $_ => undef } @rel_cols;
 341             $rs_rel_delist->update( \%update );
 342
 343             # # only handles related result classes with single primary keys
 344             # if ( 1 == $rel_col_cnt ) {
 345             # $object->$name->search(
 346             # {   $rel_cols[0] =>
 347             # { -not_in => [ map ( $_->id, @updated_objs ) ] }
 348             # }
 349             # )->update( { $rel_cols[0] => undef } );
 350             # }
 351             # else {
 352             # warn "multi-column relationships aren't supported\n";
 353             # }
 354         }
 355     }
 356     elsif ($info->{attrs}{accessor} eq 'single'
 357         || $info->{attrs}{accessor} eq 'filter' )
 358     {
 359
 360         #warn "\tupdating rel '$name': $if_not_submitted\n";
 361         my $sub_object;
 362         if ( ref $updates ) {
 363
 364             # for might_have relationship
 365             if ( $info->{attrs}{accessor} eq 'single'
 366                 && defined $object->$name )
 367             {
 368                 $sub_object = recursive_update(
 369                     resultset => $related_resultset,
 370                     updates   => $updates,
 371                     object    => $object->$name
 372                 );
 373             }
 374             else {
 375                 $sub_object = recursive_update(
 376                     resultset => $related_resultset,
 377                     updates   => $updates,
 378                     resolved  => $resolved
 379                 );
 380             }
 381         }
 382         else {
 383             $sub_object = $related_resultset->find($updates)
 384                 unless (
 385                 !$updates
 386                 && ( exists $info->{attrs}{join_type}
 387                     && $info->{attrs}{join_type} eq 'LEFT' )
 388                 );
 389         }
 390         $object->set_from_related( $name, $sub_object )
 391             unless (
 392                !$sub_object
 393             && !$updates
 394             && ( exists $info->{attrs}{join_type}
 395                 && $info->{attrs}{join_type} eq 'LEFT' )
 396             );
 397     }
 398     else {
 399         $self->throw_exception(
 400             "recursive_update doesn't now how to handle relationship '$name' with accessor "
 401                 . $info->{attrs}{accessor} );
 402     }
 403 }
 404
 405 sub is_m2m {
 406     my ( $self, $relation ) = @_;
 407     my $rclass = $self->result_class;
 408
 409     # DBIx::Class::IntrospectableM2M
 410     if ( $rclass->can('_m2m_metadata') ) {
 411         return $rclass->_m2m_metadata->{$relation};
 412     }
 413     my $object = $self->new( {} );
 414     if (    $object->can($relation)
 415         and !$self->result_source->has_relationship($relation)
 416         and $object->can( 'set_' . $relation ) )
 417     {
 418         return 1;
 419     }
 420     return;
 421 }
 422
 423 sub get_m2m_source {
 424     my ( $self, $relation ) = @_;
 425     my $rclass = $self->result_class;
 426
 427     # DBIx::Class::IntrospectableM2M
 428     if ( $rclass->can('_m2m_metadata') ) {
 429         return $self->result_source->related_source(
 430             $rclass->_m2m_metadata->{$relation}{relation} )
 431             ->related_source(
 432             $rclass->_m2m_metadata->{$relation}{foreign_relation} );
 433     }
 434     my $object = $self->new( {} );
 435     my $r = $object->$relation;
 436     return $r->result_source;
 437 }
 438
 439 sub _delete_empty_auto_increment {
 440     my ( $self, $object ) = @_;
 441     for my $col ( keys %{ $object->{_column_data} } ) {
 442         if ($object->result_source->column_info($col)->{is_auto_increment}
 443             and ( !defined $object->{_column_data}{$col}
 444                 or $object->{_column_data}{$col} eq '' )
 445             )
 446         {
 447             delete $object->{_column_data}{$col};
 448         }
 449     }
 450 }
 451
 452 sub _get_pk_for_related {
 453     my ( $self, $relation ) = @_;
 454     my $result_source;
 455     if ( $self->result_source->has_relationship($relation) ) {
 456         $result_source = $self->result_source->related_source($relation);
 457     }
 458
 459     # many to many case
 460     if ( is_m2m( $self, $relation ) ) {
 461         $result_source = get_m2m_source( $self, $relation );
 462     }
 463     return $result_source->primary_columns;
 464 }
 465
 466 # This function determines wheter a relationship should be done before or
 467 # after the row is inserted into the database
 468 # relationships before: belongs_to
 469 # relationships after: has_many, might_have and has_one
 470 # true means before, false after
 471 sub _master_relation_cond {
 472     my ( $self, $name ) = @_;
 473
 474     my $source = $self->result_source;
 475     my $info   = $source->relationship_info($name);
 476
 477     #warn "INFO: " . Dumper($info) . "\n";
 478
 479     # has_many rels are always after
 480     return 0
 481         if $info->{attrs}->{accessor} eq 'multi';
 482
 483     my @foreign_ids = _get_pk_for_related( $self, $name );
 484
 485     #warn "IDS: " . join(', ', @foreign_ids) . "\n";
 486
 487     my $cond = $info->{cond};
 488
 489     sub _inner {
 490         my ( $source, $cond, @foreign_ids ) = @_;
 491
 492         while ( my ( $f_key, $col ) = each %{$cond} ) {
 493
 494             # might_have is not master
 495             $col   =~ s/^self\.//;
 496             $f_key =~ s/^foreign\.//;
 497             if ( $source->column_info($col)->{is_auto_increment} ) {
 498                 return 0;
 499             }
 500             if ( any { $_ eq $f_key } @foreign_ids ) {
 501                 return 1;
 502             }
 503         }
 504         return 0;
 505     }
 506
 507     if ( ref $cond eq 'HASH' ) {
 508         return _inner( $source, $cond, @foreign_ids );
 509     }
 510
 511     # arrayref of hashrefs
 512     elsif ( ref $cond eq 'ARRAY' ) {
 513         for my $new_cond (@$cond) {
 514             return _inner( $source, $new_cond, @foreign_ids );
 515         }
 516     }
 517     else {
 518         $source->throw_exception(
 519             "unhandled relation condition " . ref($cond) );
 520     }
 521     return;
 522 }
 523
 524 1;    # Magic true value required at end of module
 525 __END__
 526
 527 =head1 NAME
 528
 529 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
 530
 531 =head1 SYNOPSIS
 532
 533 The functional interface:
 534
 535     my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
 536         resultset => $schema->resultset( 'Dvd' ),
 537         updates => {
 538             id => 1,
 539             owned_dvds => [
 540                 {
 541                   title => 'One Flew Over the Cuckoo's Nest'
 542                 }
 543             ]
 544         }
 545     });
 546
 547
 548 As ResultSet subclass:
 549
 550     __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
 551
 552 in the Schema file (see t/lib/DBSchema.pm).  Or appriopriate 'use base' in the ResultSet classes.
 553
 554 Then:
 555
 556     my $user = $user_rs->recursive_update( {
 557         id => 1,
 558         owned_dvds => [
 559         {
 560           title => 'One Flew Over the Cuckoo's Nest'
 561         }
 562         ]
 563       }
 564     );
 565
 566
 567 =head1 DESCRIPTION
 568
 569 This is still experimental. I've added a functional interface so that it can be used
 570 in Form Processors and not require modification of the model.
 571
 572 You can feed the ->create method with a recursive datastructure and have the related records
 573 created.  Unfortunately you cannot do a similar thing with update_or_create - this module
 574 tries to fill that void.
 575
 576 It is a base class for ResultSets providing just one method: recursive_update
 577 which works just like update_or_create but can recursively update or create
 578 data objects composed of multiple rows. All rows need to be identified by primary keys
 579 - so you need to provide them in the update structure (unless they can be deduced from
 580 the parent row - for example when you have a belongs_to relationship).
 581 If not all colums comprising the primary key are specified - then a new row will be created,
 582 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
 583 primary keys).
 584
 585
 586 If the resultset itself stores an assignement for the primary key,
 587 like in the case of:
 588
 589     my $restricted_rs = $user_rs->search( { id => 1 } );
 590
 591 then you need to inform recursive_update about additional predicate with a second argument:
 592
 593     my $user = $restricted_rs->recursive_update( {
 594         owned_dvds => [
 595         {
 596           title => 'One Flew Over the Cuckoo's Nest'
 597         }
 598         ]
 599       },
 600       [ 'id' ]
 601     );
 602
 603 This will work with a new DBIC release.
 604
 605 For a many_to_many (pseudo) relation you can supply a list of primary keys
 606 from the other table - and it will link the record at hand to those and
 607 only those records identified by them.  This is convenient for handling web
 608 forms with check boxes (or a SELECT box with multiple choice) that let you
 609 update such (pseudo) relations.
 610
 611 For a description how to set up base classes for ResultSets see load_namespaces
 612 in DBIx::Class::Schema.
 613
 614 =head1 DESIGN CHOICES
 615
 616 Columns and relationships which are excluded from the updates hashref aren't
 617 touched at all.
 618
 619 =head2 Treatment of belongs_to relations
 620
 621 In case the relationship is included but undefined in the updates hashref,
 622 all columns forming the relationship will be set to null.
 623 If not all of them are nullable, DBIx::Class will throw an error.
 624
 625 Updating the relationship:
 626
 627     my $dvd = $dvd_rs->recursive_update( {
 628         id    => 1,
 629         owner => $user->id,
 630     });
 631
 632 Clearing the relationship (only works if cols are nullable!):
 633
 634     my $dvd = $dvd_rs->recursive_update( {
 635         id    => 1,
 636         owner => undef,
 637     });
 638
 639 =head2 Treatment of might_have relationships
 640
 641 In case the relationship is included but undefined in the updates hashref,
 642 all columns forming the relationship will be set to null.
 643
 644 Updating the relationship:
 645
 646     my $user = $user_rs->recursive_update( {
 647         id => 1,
 648         address => {
 649             street => "101 Main Street",
 650             city   => "Podunk",
 651             state  => "New York",
 652         }
 653     });
 654
 655 Clearing the relationship:
 656
 657     my $user = $user_rs->recursive_update( {
 658         id => 1,
 659         address => undef,
 660     });
 661
 662 =head2 Treatment of has_many relations
 663
 664 If a relationship key is included in the data structure with a value of undef
 665 or an empty array, all existing related rows will be deleted, or their foreign
 666 key columns will be set to null.
 667
 668 The exact behaviour depends on the nullability of the foreign key columns and
 669 the value of the "if_not_submitted" parameter. The parameter defaults to
 670 undefined which neither nullifies nor deletes.
 671
 672 When the array contains elements they are updated if they exist, created when
 673 not and deleted if not included.
 674
 675 =head3 All foreign table columns are nullable
 676
 677 In this case recursive_update defaults to nullifying the foreign columns.
 678
 679 =head3 Not all foreign table columns are nullable
 680
 681 In this case recursive_update deletes the foreign rows.
 682
 683 Updating the relationship:
 684
 685     Passing ids:
 686
 687     my $dvd = $dvd_rs->recursive_update( {
 688         id   => 1,
 689         tags => [1, 2],
 690     });
 691
 692     Passing hashrefs:
 693
 694     my $dvd = $dvd_rs->recursive_update( {
 695         id   => 1,
 696         tags => [
 697             {
 698                 id   => 1,
 699                 file => 'file0'
 700             },
 701             {
 702                 id   => 2,
 703                 file => 'file1',
 704             },
 705         ],
 706     });
 707
 708     Passing objects:
 709
 710     TODO
 711
 712     You can even mix them:
 713
 714     my $dvd = $dvd_rs->recursive_update( {
 715         id   => 1,
 716         tags => [ '2', { id => '3' } ],
 717     });
 718
 719 Clearing the relationship:
 720
 721     my $dvd = $dvd_rs->recursive_update( {
 722         id   => 1,
 723         tags => undef,
 724     });
 725
 726     This is the same as passing an empty array:
 727
 728     my $dvd = $dvd_rs->recursive_update( {
 729         id   => 1,
 730         tags => [],
 731     });
 732
 733 =head2 Treatment of many-to-many pseudo relations
 734
 735 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
 736 If it isn't loaded in the ResultSource classes the code relies on the fact that:
 737
 738     if($object->can($name) and
 739              !$object->result_source->has_relationship($name) and
 740              $object->can( 'set_' . $name )
 741          )
 742
 743 Then $name must be a many to many pseudo relation.
 744 And that in a similarly ugly was I find out what is the ResultSource of
 745 objects from that many to many pseudo relation.
 746
 747
 748 =head1 INTERFACE
 749
 750 =head1 METHODS
 751
 752 =head2 recursive_update
 753
 754 The method that does the work here.
 755
 756 =head2 is_m2m
 757
 758 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
 759 (pseudo) relation on $self.
 760
 761 =head2 get_m2m_source
 762
 763 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
 764 to many (pseudo) relation 'name' from $self.
 765
 766
 767 =head1 DIAGNOSTICS
 768
 769
 770 =head1 CONFIGURATION AND ENVIRONMENT
 771
 772 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
 773
 774 =head1 DEPENDENCIES
 775
 776     DBIx::Class
 777
 778 =head1 INCOMPATIBILITIES
 779
 780 None reported.
 781
 782
 783 =head1 BUGS AND LIMITATIONS
 784
 785 No bugs have been reported.
 786
 787 Please report any bugs or feature requests to
 788 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
 789 L<http://rt.cpan.org>.
 790
 791
 792 =head1 AUTHOR
 793
 794 Zbigniew Lukasiak  C<< <zby@cpan.org> >>
 795 Influenced by code by Pedro Melo.
 796
 797 =head1 LICENCE AND COPYRIGHT
 798
 799 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
 800
 801 This module is free software; you can redistribute it and/or
 802 modify it under the same terms as Perl itself. See L<perlartistic>.
 803
 804
 805 =head1 DISCLAIMER OF WARRANTY
 806
 807 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 808 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 809 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 810 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 811 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 812 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 813 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 814 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 815 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 816
 817 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 818 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 819 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 820 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 821 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 822 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 823 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 824 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 825 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 826 SUCH DAMAGES.