SL::DB::Object: Methode update_collections für One-To-Many-Relationships

Der große Nachteil einer direkten Zuweisung wie
z.B. `$customer->shiptos($::form->{shiptos} // [])` ist, dass Rose
erst mal alle Objekte der Relationship löscht (auch wenn die neuen
Werte Primärschlüsselattribute enthalten) und anschließend neu
INSERTed, was nicht nur deutlich zu aufwändig ist, sondern auch mal
nicht funktionieren kann, wenn es da noch weitere Objekte mit
Fremdschlüsseln auf die zu aktualisierenden Objekte verweisen.

Daher muss man die Behandlung (neu hinzuzufügende, zu löschende & zu
aktualisierende Objekte) selber vornehmen. Das macht nun diese
Methode.

Die Methode gleicht eine Liste von existierenden Objekten einer
One-To-Many-Relationship (z.B. Kunde zu Lieferadressen) mit einer
neuen Liste von Hashrefs ab, die z.B. aus `$::form` stammen können.

Für alle Einträge aus der neuen Liste, die kein Attribut für den
Primärschlüssel enthalten, werden neue Einträge in der Datenbank
angelegt.

Für alle Einträge aus der neuen Liste mit Primärschlüsselattribut wird
das korrespondierende Objekt mit den Werten aus `$::form`
aktualisiert.

Alle existierenden Objekte in `$self->$attribute`, für die es keinen
korrespondierenden Eintrag in der neuen Liste mehr gibt, werden
gelöscht.

diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
index 3e0fca6..89d15c6 100755 (executable)
--- a/SL/DB/Object.pm
+++ b/SL/DB/Object.pm
@@ -7,6 +7,7 @@ use English qw(-no_match_vars);
 use Rose::DB::Object;
 use Rose::DB::Object::Constants qw();
 use List::MoreUtils qw(any pairwise);
+use List::Util qw(first);
 
 use SL::DB;
 use SL::DB::Helper::Attr;
@@ -105,6 +106,50 @@ sub update_attributes {
   return $self;
 }
 
+sub update_collection {
+  my ($self, $attribute, $entries) = @_;
+
+  my $self_primary_key = "" . ($self->meta->primary_key_columns)[0];
+
+  croak "\$self hasn't been saved yet" if !$self->$self_primary_key;
+
+  my $relationship = first { $_->name eq $attribute } @{ $self->meta->relationships };
+
+  croak "No relationship found for attribute '$attribute'" if !$relationship;
+
+  my @primary_key_columns = $relationship->class->meta->primary_key_columns;
+
+  croak "Classes with multiple primary key columns are not supported" if scalar(@primary_key_columns) > 1;
+
+  my $class             = $relationship->class;
+  my $manager_class     = "SL::DB::Manager::" . substr($class, 8);
+  my $other_primary_key = "" . $primary_key_columns[0];
+  my $column_map        = $relationship->column_map;
+  my @new_entries       = @{ $entries          // [] };
+  my @existing_entries  = @{ $self->$attribute // [] };
+  my @to_delete         = grep { my $value = $_->$other_primary_key; !any { $_->{$other_primary_key} == $value } @new_entries } @existing_entries;
+
+  $_->delete for @to_delete;
+
+  foreach my $entry (@new_entries) {
+    if (!$entry->{$other_primary_key}) {
+      my $new_instance = $class->new(%{ $entry });
+
+      foreach my $self_attribute (keys %{ $column_map }) {
+        my $other_attribute = $column_map->{$self_attribute};
+        $new_instance->$other_attribute($self->$self_attribute);
+      }
+
+      $new_instance->save;
+
+      next;
+    }
+
+    my $existing = first { $_->$other_primary_key == $entry->{$other_primary_key} } @existing_entries;
+    $existing->update_attributes(%{ $entry }) if $existing;
+  }
+}
+
 sub call_sub {
   my $self = shift;
   my $sub  = shift;
@@ -318,6 +363,28 @@ Assigns the attributes from C<%attributes> by calling the
 C<assign_attributes> function and saves the object afterwards. Returns
 the object itself.
 
+=item C<update_collection $attribute, $entries, %params>
+
+Updates a one-to-many relationship named C<$attribute> to match the
+entries in C<$entries>. C<$entries> is supposed to be an array ref of
+hash refs.
+
+For each hash ref in C<$entries> that does not contain a field for the
+relationship's primary key column, this function creates a new entry
+in the database with its attributes set to the data in the entry.
+
+For each hash ref in C<$entries> that contains a field for the
+relationship's primary key column, this function looks up the
+corresponding entry in C<$self-&gt;$attribute> & updates its
+attributes with the data in the entry.
+
+All objects in C<$self-&gt;$attribute> for which no corresponding
+entry exists in C<$entries> are deleted by calling the object's
+C<delete> method.
+
+In all cases the relationship itself C<$self-&gt;$attribute> is not
+changed.
+
 =item _get_manager_class
 
 Returns the manager package for the object or class that it is called