Shipto: Methode zum Clonen in SL::DB::Shipto und nicht in DeliveryOrder->new_from

diff --git a/SL/DB/DeliveryOrder.pm b/SL/DB/DeliveryOrder.pm
index 284c15f..bc51801 100644 (file)
--- a/SL/DB/DeliveryOrder.pm
+++ b/SL/DB/DeliveryOrder.pm
@@ -136,16 +136,7 @@ sub new_from {
   # save it, too.
   my $custom_shipto;
   if (!$source->shipto_id && $source->id) {
-    my $old = $source->custom_shipto;
-    if ($old) {
-      $custom_shipto = SL::DB::Shipto->new(
-        map  { +($_ => $old->$_) }
-        grep { !m{^ (?: itime | mtime | shipto_id | trans_id ) $}x }
-        map  { $_->name }
-        @{ $old->meta->columns }
-      );
-      $custom_shipto->module('DO');
-    }
+    $custom_shipto = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 
   } else {
     $args{shipto_id} = $source->shipto_id;

diff --git a/SL/DB/Shipto.pm b/SL/DB/Shipto.pm
index 5e2813d..a0580e3 100644 (file)
--- a/SL/DB/Shipto.pm
+++ b/SL/DB/Shipto.pm
@@ -2,6 +2,8 @@ package SL::DB::Shipto;
 
 use strict;
 
+use Carp;
+
 use SL::DB::MetaSetup::Shipto;
 use SL::DB::Manager::Shipto;
 use SL::DB::Helper::CustomVariables (
@@ -43,4 +45,81 @@ sub detach {
   $_[0];
 }
 
+sub clone {
+  my ($self, $target) = @_;
+
+  my $type   = ref($target) || $target;
+  my $module = $type =~ m{::Order$}               ? 'OE'
+             : $type =~ m{::DeliveryOrder$}       ? 'DO'
+             : $type =~ m{::Invoice$}             ? 'AR'
+             : $type =~ m{::(?:Customer|Vendor)$} ? 'CT'
+             :                                      croak "Unsupported target class '$type'";
+
+  my $new_shipto = SL::DB::Shipto->new(
+    (map  { +($_ => $self->$_) }
+     grep { !m{^ (?: itime | mtime | shipto_id | trans_id ) $}x }
+     map  { $_->name }
+     @{ $self->meta->columns }),
+    module => $module,
+  );
+
+  return $new_shipto;
+}
+
 1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::DB::Shipto - Database model for shipping addresses
+
+=head1 SYNOPSIS
+
+  my $order = SL::DB::Order->new(id => …)->load;
+  if ($order->custom_shipto) {
+    my $cloned_shipto = $order->custom_shipto->clone('SL::DB::Invoice');
+  }
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<clone $target>
+
+Creates and returns a clone of the current object. The mandatory
+parameter C<$target> must be either an instance of a Rose DB class or
+the name of one. It's used for setting the new instance's C<module>
+attribute to the correct value.
+
+Currently the following classes are supported:
+
+=over 2
+
+=item C<SL::DB::Order>
+
+=item C<SL::DB::DeliveryOrder>
+
+=item C<SL::DB::Invoice>
+
+=item C<SL::DB::Customer>
+
+=item C<SL::DB::Vendor>
+
+=back
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut