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
 307         my $rs_rel_delist = $object->$name;
 308
 309         # foreign table has a single pk column
 310         if ( scalar @related_pks == 1 ) {
 311             $rs_rel_delist = $rs_rel_delist->search_rs(
 312                 {   $related_pks[0] =>
 313                         { -not_in => [ map ( $_->id, @updated_objs ) ] }
 314                 }
 315             );
 316         }
 317         # foreign table has multiple pk columns
 318         else {
 319             for my $obj (@updated_objs) {
 320                 my %cond_for_obj;
 321                 for my $col (@related_pks) {
 322                     $cond_for_obj{$col} = $obj->get_column($col);
 323                 }
 324                 push @cond, \%cond_for_obj;
 325             }
 326             $rs_rel_delist = $rs_rel_delist->search_rs({ -not => [@cond] });
 327         }
 328
 329         #warn "\tCOND: " . Dumper(\%cond);
 330         #my $rel_delist_cnt = $rs_rel_delist->count;
 331         if ( $if_not_submitted eq 'delete' ) {
 332
 333             #warn "\tdeleting related rows: $rel_delist_cnt\n";
 334             $rs_rel_delist->delete;
 335
 336             # # only handles related result classes with single primary keys
 337             # if ( 1 == $rel_col_cnt ) {
 338             # $object->$name->search(
 339             # {   $rel_cols[0] =>
 340             # { -not_in => [ map ( $_->id, @updated_objs ) ] }
 341             # }
 342             # )->delete;
 343             # }
 344             # else {
 345             # warn "multi-column relationships aren't supported\n";
 346             # }
 347         }
 348         elsif ( $if_not_submitted eq 'set_to_null' ) {
 349
 350             #warn "\tnullifying related rows: $rel_delist_cnt\n";
 351             my %update = map { $_ => undef } @rel_cols;
 352             $rs_rel_delist->update( \%update );
 353
 354             # # only handles related result classes with single primary keys
 355             # if ( 1 == $rel_col_cnt ) {
 356             # $object->$name->search(
 357             # {   $rel_cols[0] =>
 358             # { -not_in => [ map ( $_->id, @updated_objs ) ] }
 359             # }
 360             # )->update( { $rel_cols[0] => undef } );
 361             # }
 362             # else {
 363             # warn "multi-column relationships aren't supported\n";
 364             # }
 365         }
 366     }
 367     elsif ($info->{attrs}{accessor} eq 'single'
 368         || $info->{attrs}{accessor} eq 'filter' )
 369     {
 370
 371         #warn "\tupdating rel '$name': $if_not_submitted\n";
 372         my $sub_object;
 373         if ( ref $updates ) {
 374
 375             # for might_have relationship
 376             if ( $info->{attrs}{accessor} eq 'single'
 377                 && defined $object->$name )
 378             {
 379                 $sub_object = recursive_update(
 380                     resultset => $related_resultset,
 381                     updates   => $updates,
 382                     object    => $object->$name
 383                 );
 384             }
 385             else {
 386                 $sub_object = recursive_update(
 387                     resultset => $related_resultset,
 388                     updates   => $updates,
 389                     resolved  => $resolved
 390                 );
 391             }
 392         }
 393         else {
 394             $sub_object = $related_resultset->find($updates)
 395                 unless (
 396                 !$updates
 397                 && ( exists $info->{attrs}{join_type}
 398                     && $info->{attrs}{join_type} eq 'LEFT' )
 399                 );
 400         }
 401         $object->set_from_related( $name, $sub_object )
 402             unless (
 403                !$sub_object
 404             && !$updates
 405             && ( exists $info->{attrs}{join_type}
 406                 && $info->{attrs}{join_type} eq 'LEFT' )
 407             );
 408     }
 409     else {
 410         $self->throw_exception(
 411             "recursive_update doesn't now how to handle relationship '$name' with accessor "
 412                 . $info->{attrs}{accessor} );
 413     }
 414 }
 415
 416 sub is_m2m {
 417     my ( $self, $relation ) = @_;
 418     my $rclass = $self->result_class;
 419
 420     # DBIx::Class::IntrospectableM2M
 421     if ( $rclass->can('_m2m_metadata') ) {
 422         return $rclass->_m2m_metadata->{$relation};
 423     }
 424     my $object = $self->new( {} );
 425     if (    $object->can($relation)
 426         and !$self->result_source->has_relationship($relation)
 427         and $object->can( 'set_' . $relation ) )
 428     {
 429         return 1;
 430     }
 431     return;
 432 }
 433
 434 sub get_m2m_source {
 435     my ( $self, $relation ) = @_;
 436     my $rclass = $self->result_class;
 437
 438     # DBIx::Class::IntrospectableM2M
 439     if ( $rclass->can('_m2m_metadata') ) {
 440         return $self->result_source->related_source(
 441             $rclass->_m2m_metadata->{$relation}{relation} )
 442             ->related_source(
 443             $rclass->_m2m_metadata->{$relation}{foreign_relation} );
 444     }
 445     my $object = $self->new( {} );
 446     my $r = $object->$relation;
 447     return $r->result_source;
 448 }
 449
 450 sub _delete_empty_auto_increment {
 451     my ( $self, $object ) = @_;
 452     for my $col ( keys %{ $object->{_column_data} } ) {
 453         if ($object->result_source->column_info($col)->{is_auto_increment}
 454             and ( !defined $object->{_column_data}{$col}
 455                 or $object->{_column_data}{$col} eq '' )
 456             )
 457         {
 458             delete $object->{_column_data}{$col};
 459         }
 460     }
 461 }
 462
 463 sub _get_pk_for_related {
 464     my ( $self, $relation ) = @_;
 465     my $result_source;
 466     if ( $self->result_source->has_relationship($relation) ) {
 467         $result_source = $self->result_source->related_source($relation);
 468     }
 469
 470     # many to many case
 471     if ( is_m2m( $self, $relation ) ) {
 472         $result_source = get_m2m_source( $self, $relation );
 473     }
 474     return $result_source->primary_columns;
 475 }
 476
 477 # This function determines wheter a relationship should be done before or
 478 # after the row is inserted into the database
 479 # relationships before: belongs_to
 480 # relationships after: has_many, might_have and has_one
 481 # true means before, false after
 482 sub _master_relation_cond {
 483     my ( $self, $name ) = @_;
 484
 485     my $source = $self->result_source;
 486     my $info   = $source->relationship_info($name);
 487
 488     #warn "INFO: " . Dumper($info) . "\n";
 489
 490     # has_many rels are always after
 491     return 0
 492         if $info->{attrs}->{accessor} eq 'multi';
 493
 494     my @foreign_ids = _get_pk_for_related( $self, $name );
 495
 496     #warn "IDS: " . join(', ', @foreign_ids) . "\n";
 497
 498     my $cond = $info->{cond};
 499
 500     sub _inner {
 501         my ( $source, $cond, @foreign_ids ) = @_;
 502
 503         while ( my ( $f_key, $col ) = each %{$cond} ) {
 504
 505             # might_have is not master
 506             $col   =~ s/^self\.//;
 507             $f_key =~ s/^foreign\.//;
 508             if ( $source->column_info($col)->{is_auto_increment} ) {
 509                 return 0;
 510             }
 511             if ( any { $_ eq $f_key } @foreign_ids ) {
 512                 return 1;
 513             }
 514         }
 515         return 0;
 516     }
 517
 518     if ( ref $cond eq 'HASH' ) {
 519         return _inner( $source, $cond, @foreign_ids );
 520     }
 521
 522     # arrayref of hashrefs
 523     elsif ( ref $cond eq 'ARRAY' ) {
 524         for my $new_cond (@$cond) {
 525             return _inner( $source, $new_cond, @foreign_ids );
 526         }
 527     }
 528     else {
 529         $source->throw_exception(
 530             "unhandled relation condition " . ref($cond) );
 531     }
 532     return;
 533 }
 534
 535 1;    # Magic true value required at end of module
 536 __END__
 537
 538 =head1 NAME
 539
 540 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
 541
 542 =head1 SYNOPSIS
 543
 544 The functional interface:
 545
 546     my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
 547         resultset => $schema->resultset( 'Dvd' ),
 548         updates => {
 549             id => 1,
 550             owned_dvds => [
 551                 {
 552                   title => 'One Flew Over the Cuckoo's Nest'
 553                 }
 554             ]
 555         }
 556     });
 557
 558
 559 As ResultSet subclass:
 560
 561     __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
 562
 563 in the Schema file (see t/lib/DBSchema.pm).  Or appriopriate 'use base' in the ResultSet classes.
 564
 565 Then:
 566
 567     my $user = $user_rs->recursive_update( {
 568         id => 1,
 569         owned_dvds => [
 570         {
 571           title => 'One Flew Over the Cuckoo's Nest'
 572         }
 573         ]
 574       }
 575     );
 576
 577
 578 =head1 DESCRIPTION
 579
 580 This is still experimental. I've added a functional interface so that it can be used
 581 in Form Processors and not require modification of the model.
 582
 583 You can feed the ->create method with a recursive datastructure and have the related records
 584 created.  Unfortunately you cannot do a similar thing with update_or_create - this module
 585 tries to fill that void.
 586
 587 It is a base class for ResultSets providing just one method: recursive_update
 588 which works just like update_or_create but can recursively update or create
 589 data objects composed of multiple rows. All rows need to be identified by primary keys
 590 - so you need to provide them in the update structure (unless they can be deduced from
 591 the parent row - for example when you have a belongs_to relationship).
 592 If not all colums comprising the primary key are specified - then a new row will be created,
 593 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
 594 primary keys).
 595
 596
 597 If the resultset itself stores an assignement for the primary key,
 598 like in the case of:
 599
 600     my $restricted_rs = $user_rs->search( { id => 1 } );
 601
 602 then you need to inform recursive_update about additional predicate with a second argument:
 603
 604     my $user = $restricted_rs->recursive_update( {
 605         owned_dvds => [
 606         {
 607           title => 'One Flew Over the Cuckoo's Nest'
 608         }
 609         ]
 610       },
 611       [ 'id' ]
 612     );
 613
 614 This will work with a new DBIC release.
 615
 616 For a many_to_many (pseudo) relation you can supply a list of primary keys
 617 from the other table - and it will link the record at hand to those and
 618 only those records identified by them.  This is convenient for handling web
 619 forms with check boxes (or a SELECT box with multiple choice) that let you
 620 update such (pseudo) relations.
 621
 622 For a description how to set up base classes for ResultSets see load_namespaces
 623 in DBIx::Class::Schema.
 624
 625 =head1 DESIGN CHOICES
 626
 627 Columns and relationships which are excluded from the updates hashref aren't
 628 touched at all.
 629
 630 =head2 Treatment of belongs_to relations
 631
 632 In case the relationship is included but undefined in the updates hashref,
 633 all columns forming the relationship will be set to null.
 634 If not all of them are nullable, DBIx::Class will throw an error.
 635
 636 Updating the relationship:
 637
 638     my $dvd = $dvd_rs->recursive_update( {
 639         id    => 1,
 640         owner => $user->id,
 641     });
 642
 643 Clearing the relationship (only works if cols are nullable!):
 644
 645     my $dvd = $dvd_rs->recursive_update( {
 646         id    => 1,
 647         owner => undef,
 648     });
 649
 650 =head2 Treatment of might_have relationships
 651
 652 In case the relationship is included but undefined in the updates hashref,
 653 all columns forming the relationship will be set to null.
 654
 655 Updating the relationship:
 656
 657     my $user = $user_rs->recursive_update( {
 658         id => 1,
 659         address => {
 660             street => "101 Main Street",
 661             city   => "Podunk",
 662             state  => "New York",
 663         }
 664     });
 665
 666 Clearing the relationship:
 667
 668     my $user = $user_rs->recursive_update( {
 669         id => 1,
 670         address => undef,
 671     });
 672
 673 =head2 Treatment of has_many relations
 674
 675 If a relationship key is included in the data structure with a value of undef
 676 or an empty array, all existing related rows will be deleted, or their foreign
 677 key columns will be set to null.
 678
 679 The exact behaviour depends on the nullability of the foreign key columns and
 680 the value of the "if_not_submitted" parameter. The parameter defaults to
 681 undefined which neither nullifies nor deletes.
 682
 683 When the array contains elements they are updated if they exist, created when
 684 not and deleted if not included.
 685
 686 =head3 All foreign table columns are nullable
 687
 688 In this case recursive_update defaults to nullifying the foreign columns.
 689
 690 =head3 Not all foreign table columns are nullable
 691
 692 In this case recursive_update deletes the foreign rows.
 693
 694 Updating the relationship:
 695
 696     Passing ids:
 697
 698     my $dvd = $dvd_rs->recursive_update( {
 699         id   => 1,
 700         tags => [1, 2],
 701     });
 702
 703     Passing hashrefs:
 704
 705     my $dvd = $dvd_rs->recursive_update( {
 706         id   => 1,
 707         tags => [
 708             {
 709                 id   => 1,
 710                 file => 'file0'
 711             },
 712             {
 713                 id   => 2,
 714                 file => 'file1',
 715             },
 716         ],
 717     });
 718
 719     Passing objects:
 720
 721     TODO
 722
 723     You can even mix them:
 724
 725     my $dvd = $dvd_rs->recursive_update( {
 726         id   => 1,
 727         tags => [ '2', { id => '3' } ],
 728     });
 729
 730 Clearing the relationship:
 731
 732     my $dvd = $dvd_rs->recursive_update( {
 733         id   => 1,
 734         tags => undef,
 735     });
 736
 737     This is the same as passing an empty array:
 738
 739     my $dvd = $dvd_rs->recursive_update( {
 740         id   => 1,
 741         tags => [],
 742     });
 743
 744 =head2 Treatment of many-to-many pseudo relations
 745
 746 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
 747 If it isn't loaded in the ResultSource classes the code relies on the fact that:
 748
 749     if($object->can($name) and
 750              !$object->result_source->has_relationship($name) and
 751              $object->can( 'set_' . $name )
 752          )
 753
 754 Then $name must be a many to many pseudo relation.
 755 And that in a similarly ugly was I find out what is the ResultSource of
 756 objects from that many to many pseudo relation.
 757
 758
 759 =head1 INTERFACE
 760
 761 =head1 METHODS
 762
 763 =head2 recursive_update
 764
 765 The method that does the work here.
 766
 767 =head2 is_m2m
 768
 769 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
 770 (pseudo) relation on $self.
 771
 772 =head2 get_m2m_source
 773
 774 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
 775 to many (pseudo) relation 'name' from $self.
 776
 777
 778 =head1 DIAGNOSTICS
 779
 780
 781 =head1 CONFIGURATION AND ENVIRONMENT
 782
 783 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
 784
 785 =head1 DEPENDENCIES
 786
 787     DBIx::Class
 788
 789 =head1 INCOMPATIBILITIES
 790
 791 None reported.
 792
 793
 794 =head1 BUGS AND LIMITATIONS
 795
 796 No bugs have been reported.
 797
 798 Please report any bugs or feature requests to
 799 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
 800 L<http://rt.cpan.org>.
 801
 802
 803 =head1 AUTHOR
 804
 805 Zbigniew Lukasiak  C<< <zby@cpan.org> >>
 806 Influenced by code by Pedro Melo.
 807
 808 =head1 LICENCE AND COPYRIGHT
 809
 810 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
 811
 812 This module is free software; you can redistribute it and/or
 813 modify it under the same terms as Perl itself. See L<perlartistic>.
 814
 815
 816 =head1 DISCLAIMER OF WARRANTY
 817
 818 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
 819 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
 820 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
 821 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
 822 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 823 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
 824 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
 825 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
 826 NECESSARY SERVICING, REPAIR, OR CORRECTION.
 827
 828 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
 829 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
 830 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
 831 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
 832 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
 833 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
 834 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
 835 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
 836 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
 837 SUCH DAMAGES.