Kontoauszug verbuchen -> Dialogbuchungsentwürfe verbessert

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

diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm
index ec1212568a331fe550e091356d6f0dd955ed877a..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 };


@@ -276,6 +316,8 @@ sub new_from {
 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 +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.
 


@@ -389,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>