Doku: Update nach Auth-Erweiterung auf multiple Module
[kivitendo-erp.git] / SL / DB / Order.pm
index ec12125..bba7fc8 100644 (file)
@@ -6,6 +6,7 @@ use strict;
 use Carp;
 use DateTime;
 use List::Util qw(max);
 use Carp;
 use DateTime;
 use List::Util qw(max);
+use List::MoreUtils qw(any);
 
 use SL::DB::MetaSetup::Order;
 use SL::DB::Manager::Order;
 
 use SL::DB::MetaSetup::Order;
 use SL::DB::Manager::Order;
@@ -202,12 +203,29 @@ sub new_from {
   my ($class, $source, %params) = @_;
 
   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
   my ($class, $source, %params) = @_;
 
   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
-  croak("A destination type must be given parameter")            unless $params{destination_type};
+  croak("A destination type must be given as parameter")         unless $params{destination_type};
 
   my $destination_type  = delete $params{destination_type};
 
   my $destination_type  = delete $params{destination_type};
-  my $src_dst_allowed   = ('sales_quotation'   eq $source->type && 'sales_order'    eq $destination_type)
-                       || ('request_quotation' eq $source->type && 'purchase_order' eq $destination_type);
-  croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") unless $src_dst_allowed;
+
+  my @from_tos = (
+    { from => 'sales_quotation',   to => 'sales_order',       abbr => 'sqso' },
+    { from => 'request_quotation', to => 'purchase_order',    abbr => 'rqpo' },
+    { from => 'sales_quotation',   to => 'sales_quotation',   abbr => 'sqsq' },
+    { from => 'sales_order',       to => 'sales_order',       abbr => 'soso' },
+    { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
+    { from => 'purchase_order',    to => 'purchase_order',    abbr => 'popo' },
+    { from => 'sales_order',       to => 'purchase_order',    abbr => 'sopo' },
+    { from => 'purchase_order',    to => 'sales_order',       abbr => 'poso' },
+  );
+  my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
+  croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
+
+  my $is_abbr_any = sub {
+    # foreach my $abbr (@_) {
+    #   croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
+    # }
+    any { $from_to->{abbr} eq $_ } @_;
+  };
 
   my ($item_parent_id_column, $item_parent_column);
 
 
   my ($item_parent_id_column, $item_parent_column);
 
@@ -221,15 +239,33 @@ sub new_from {
                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
                                                 transaction_description vendor_id
                                              )),
                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
                                                 transaction_description vendor_id
                                              )),
-               quotation => 0,
+               quotation => !!($destination_type =~ m{quotation$}),
                closed    => 0,
                delivered => 0,
                transdate => DateTime->today_local,
             );
 
                closed    => 0,
                delivered => 0,
                transdate => DateTime->today_local,
             );
 
+  if ( $is_abbr_any->(qw(sopo poso)) ) {
+    $args{ordnumber} = undef;
+    $args{reqdate}   = DateTime->today_local->next_workday();
+    $args{employee}  = SL::DB::Manager::Employee->current;
+  }
+  if ( $is_abbr_any->(qw(sopo)) ) {
+    $args{customer_id}      = undef;
+    $args{salesman_id}      = undef;
+    $args{payment_id}       = undef;
+    $args{delivery_term_id} = undef;
+  }
+  if ( $is_abbr_any->(qw(poso)) ) {
+    $args{vendor_id} = undef;
+  }
+  if ( $is_abbr_any->(qw(soso)) ) {
+    $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
+  }
+
   # Custom shipto addresses (the ones specific to the sales/purchase
   # record and not to the customer/vendor) are only linked from
   # Custom shipto addresses (the ones specific to the sales/purchase
   # record and not to the customer/vendor) are only linked from
-  # shipto → delivery_orders. Meaning delivery_orders.shipto_id
+  # shipto → order. Meaning order.shipto_id
   # will not be filled in that case.
   if (!$source->shipto_id && $source->id) {
     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
   # will not be filled in that case.
   if (!$source->shipto_id && $source->id) {
     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
@@ -241,6 +277,7 @@ sub new_from {
   my $order = $class->new(%args);
   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
   my $items = delete($params{items}) || $source->items_sorted;
   my $order = $class->new(%args);
   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
   my $items = delete($params{items}) || $source->items_sorted;
+
   my %item_parents;
 
   my @items = map {
   my %item_parents;
 
   my @items = map {
@@ -260,6 +297,13 @@ sub new_from {
                                                      )),
                                                  custom_variables => \@custom_variables,
     );
                                                      )),
                                                  custom_variables => \@custom_variables,
     );
+    if ( $is_abbr_any->(qw(sopo)) ) {
+      $current_oe_item->sellprice($source_item->lastcost);
+      $current_oe_item->discount(0);
+    }
+    if ( $is_abbr_any->(qw(poso)) ) {
+      $current_oe_item->lastcost($source_item->sellprice);
+    }
     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
     $current_oe_item;
   } @{ $items };
     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
     $current_oe_item;
   } @{ $items };
@@ -273,9 +317,80 @@ sub new_from {
   return $order;
 }
 
   return $order;
 }
 
+sub new_from_multi {
+  my ($class, $sources, %params) = @_;
+
+  croak("Unsupported object type in sources")                             if any { ref($_) !~ m{SL::DB::Order} }                   @$sources;
+  croak("Cannot create order for purchase records")                       if any { !$_->is_sales }                                 @$sources;
+  croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
+
+  # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
+  if (delete $params{check_same_shipto}) {
+    die "check same shipto address is not implemented yet";
+    die "Source records do not have the same shipto"        if 1;
+  }
+
+  # sort sources
+  if (defined $params{sort_sources_by}) {
+    my $sort_by = delete $params{sort_sources_by};
+    if ($sources->[0]->can($sort_by)) {
+      $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
+    } else {
+      die "Cannot sort source records by $sort_by";
+    }
+  }
+
+  # set this entries to undef that yield different information
+  my %attributes;
+  foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
+                       shipvia notes closed delivered reqdate quonumber
+                       cusordnumber proforma transaction_description
+                       order_probability expected_billing_date)) {
+    $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
+  }
+  foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
+                       delivery_customer_id delivery_vendor_id shipto_id
+                       globalproject_id)) {
+    $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) }   @$sources;
+  }
+
+  # set this entries from customer that yield different information
+  foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
+    $attributes{$attr}  = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0)     != ($_->$attr||0) }      @$sources;
+  }
+  $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'')  } @$sources;
+
+  # no periodic invoice config for new order
+  $attributes{periodic_invoices_config} = undef;
+
+  # copy global ordnumber, transdate, cusordnumber into item scope
+  #   unless already present there
+  foreach my $attr (qw(ordnumber transdate cusordnumber)) {
+    foreach my $src (@$sources) {
+      foreach my $item (@{ $src->items_sorted }) {
+        $item->$attr($src->$attr) if !$item->$attr;
+      }
+    }
+  }
+
+  # collect items
+  my @items;
+  push @items, @{$_->items_sorted} for @$sources;
+  # make order from first source and all items
+  my $order = $class->new_from($sources->[0],
+                               destination_type => 'sales_order',
+                               attributes       => \%attributes,
+                               items            => \@items,
+                               %params);
+
+  return $order;
+}
+
 sub number {
   my $self = shift;
 
 sub number {
   my $self = shift;
 
+  return if !$self->type;
+
   my %number_method = (
     sales_order       => 'ordnumber',
     sales_quotation   => 'quonumber',
   my %number_method = (
     sales_order       => 'ordnumber',
     sales_quotation   => 'quonumber',
@@ -370,7 +485,8 @@ At the moment only sales quotations and sales orders can be converted.
 =head2 C<new_from $source, %params>
 
 Creates a new C<SL::DB::Order> instance and copies as much
 =head2 C<new_from $source, %params>
 
 Creates a new C<SL::DB::Order> instance and copies as much
-information from C<$source> as possible. At the moment only sales orders from
+information from C<$source> as possible. At the moment only records with the
+same destination type as the source type and sales orders from
 sales quotations and purchase orders from requests for quotations can be
 created.
 
 sales quotations and purchase orders from requests for quotations can be
 created.
 
@@ -389,8 +505,8 @@ C<%params> can include the following options
 =item C<destination_type>
 
 (mandatory)
 =item C<destination_type>
 
 (mandatory)
-The type of the newly created object. Can be C<sales_order> or
-C<purchase_order> for now.
+The type of the newly created object. Can be C<sales_quotation>,
+C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 
 =item C<items>
 
 
 =item C<items>
 
@@ -422,15 +538,24 @@ order.
 
 =back
 
 
 =back
 
-=head2 C<create_sales_process>
+=head2 C<new_from_multi $sources, %params>
 
 
-Creates and saves a new sales process. Can only be called for sales
-orders.
+Creates a new C<SL::DB::Order> instance from multiple sources and copies as
+much information from C<$sources> as possible.
+At the moment only sales orders can be combined and they must be of the same
+customer.
 
 
-The newly created process will be linked bidirectionally to both
-C<$self> and to all sales quotations that are linked to C<$self>.
+The new order is created from the first one using C<new_from> and the positions
+of all orders are added to the new order. The orders can be sorted with the
+parameter C<sort_sources_by>.
+
+The orders attributes are kept if they contain the same information for all
+source orders an will be set to empty if they contain different information.
+
+Returns the new order instance. The object returned is not
+saved.
 
 
-Returns the newly created process instance.
+C<params> other then C<sort_sources_by> are passed to C<new_from>.
 
 =head1 BUGS
 
 
 =head1 BUGS