Kontoauszug verbuchen -> Dialogbuchungsentwürfe verbessert

[mfinanz.git] / SL / DB / Order.pm

diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm
index 31f6ad4a34a03e60d75902f8c05e640c45a68866..978d128bb63bd28bbc18b44b0932f732be987670 100644 (file)
--- a/SL/DB/Order.pm
+++ b/SL/DB/Order.pm
@@ -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,30 @@ 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;
+  }
+

   # 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;


@@ -260,6 +293,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 };


@@ -372,7 +412,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.
 


@@ -391,8 +432,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>