Volltext-Suche: changelog

[kivitendo-erp.git] / SL / DB / Order.pm

diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm
index 31f6ad4..fdaa1e8 100644 (file)
--- a/SL/DB/Order.pm
+++ b/SL/DB/Order.pm
@@ -6,9 +6,11 @@ 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;

+use SL::DB::Helper::Attr;

 use SL::DB::Helper::AttrHTML;
 use SL::DB::Helper::AttrSorted;
 use SL::DB::Helper::FlattenToForm;
 use SL::DB::Helper::AttrHTML;
 use SL::DB::Helper::AttrSorted;
 use SL::DB::Helper::FlattenToForm;


@@ -16,6 +18,7 @@ use SL::DB::Helper::LinkedRecords;
 use SL::DB::Helper::PriceTaxCalculator;
 use SL::DB::Helper::PriceUpdater;
 use SL::DB::Helper::TransNumberGenerator;
 use SL::DB::Helper::PriceTaxCalculator;
 use SL::DB::Helper::PriceUpdater;
 use SL::DB::Helper::TransNumberGenerator;

+use SL::Locale::String qw(t8);

 use SL::RecordLinks;
 use Rose::DB::Object::Helpers qw(as_tree);
 
 use SL::RecordLinks;
 use Rose::DB::Object::Helpers qw(as_tree);
 


@@ -39,14 +42,34 @@ __PACKAGE__->meta->add_relationship(
     column_map             => { id => 'trans_id' },
     query_args             => [ module => 'OE' ],
   },
     column_map             => { id => 'trans_id' },
     query_args             => [ module => 'OE' ],
   },

+  exchangerate_obj         => {
+    type                   => 'one to one',
+    class                  => 'SL::DB::Exchangerate',
+    column_map             => { currency_id => 'currency_id', transdate => 'transdate' },
+  },
+  phone_notes => {
+    type         => 'one to many',
+    class        => 'SL::DB::Note',
+    column_map   => { id => 'trans_id' },
+    query_args   => [ trans_module => 'oe' ],
+    manager_args => {
+      with_objects => [ 'employee' ],
+      sort_by      => 'notes.itime',
+    }
+  },

 );
 
 );
 

+SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
+

 __PACKAGE__->meta->initialize;
 
 __PACKAGE__->attr_html('notes');
 __PACKAGE__->attr_sorted('items');
 
 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
 __PACKAGE__->meta->initialize;
 
 __PACKAGE__->attr_html('notes');
 __PACKAGE__->attr_sorted('items');
 
 __PACKAGE__->before_save('_before_save_set_ord_quo_number');

+__PACKAGE__->before_save('_before_save_create_new_project');
+__PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
+__PACKAGE__->before_save('_before_save_set_custom_shipto_module');

 
 # hooks
 
 
 # hooks
 


@@ -62,6 +85,47 @@ sub _before_save_set_ord_quo_number {
 
   return 1;
 }
 
   return 1;
 }

+sub _before_save_create_new_project {
+  my ($self) = @_;
+
+  # force new project, if not set yet
+  if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq 'sales_order')) {
+
+    die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber)
+      if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber);
+
+    eval {
+      my $new_project = SL::DB::Project->new(
+          projectnumber     => $self->ordnumber,
+          description       => $self->customer->name,
+          customer_id       => $self->customer->id,
+          active            => 1,
+          project_type_id   => $::instance_conf->get_project_type_id,
+          project_status_id => $::instance_conf->get_project_status_id,
+          );
+       $new_project->save;
+       $self->globalproject_id($new_project->id);
+    } or die t8('Could not create new project #1', $@);
+  }
+  return 1;
+}
+
+
+sub _before_save_remove_empty_custom_shipto {
+  my ($self) = @_;
+
+  $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty;
+
+  return 1;
+}
+
+sub _before_save_set_custom_shipto_module {
+  my ($self) = @_;
+
+  $self->custom_shipto->module('OE') if $self->custom_shipto;
+
+  return 1;
+}

 
 # methods
 
 
 # methods
 


@@ -84,6 +148,20 @@ sub is_type {
   return shift->type eq shift;
 }
 
   return shift->type eq shift;
 }
 

+sub deliverydate {
+  # oe doesn't have deliverydate, but it does have reqdate.
+  # But this has a different meaning for sales quotations.
+  # deliverydate can be used to determine tax if tax_point isn't set.
+
+  return $_[0]->reqdate if $_[0]->type ne 'sales_quotation';
+}
+
+sub effective_tax_point {
+  my ($self) = @_;
+
+  return $self->tax_point || $self->deliverydate || $self->transdate;
+}
+

 sub displayable_type {
   my $type = shift->type;
 
 sub displayable_type {
   my $type = shift->type;
 


@@ -104,6 +182,33 @@ sub is_sales {
   return !!shift->customer_id;
 }
 
   return !!shift->customer_id;
 }
 

+sub daily_exchangerate {
+  my ($self, $val) = @_;
+
+  return 1 if $self->currency_id == $::instance_conf->get_currency_id;
+
+  my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order))      ? 'buy'
+           : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
+           : undef;
+  return if !$rate;
+
+  if (defined $val) {
+    croak t8('exchange rate has to be positive') if $val <= 0;
+    if (!$self->exchangerate_obj) {
+      $self->exchangerate_obj(SL::DB::Exchangerate->new(
+        currency_id => $self->currency_id,
+        transdate   => $self->transdate,
+        $rate       => $val,
+      ));
+    } elsif (!defined $self->exchangerate_obj->$rate) {
+      $self->exchangerate_obj->$rate($val);
+    } else {
+      croak t8('exchange rate already exists, no update allowed');
+    }
+  }
+  return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
+}
+

 sub invoices {
   my $self   = shift;
   my %params = @_;
 sub invoices {
   my $self   = shift;
   my %params = @_;


@@ -143,8 +248,23 @@ sub convert_to_invoice {
   my $invoice;
   if (!$self->db->with_transaction(sub {
     require SL::DB::Invoice;
   my $invoice;
   if (!$self->db->with_transaction(sub {
     require SL::DB::Invoice;

-    $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
+    $invoice = SL::DB::Invoice->new_from($self, %params)->post || die;

     $self->link_to_record($invoice);
     $self->link_to_record($invoice);

+    # TODO extend link_to_record for items, otherwise long-term no d.r.y.
+    foreach my $item (@{ $invoice->items }) {
+      foreach (qw(orderitems)) {
+        if ($item->{"converted_from_${_}_id"}) {
+          die unless $item->{id};
+          RecordLinks->create_links('mode'       => 'ids',
+                                    'from_table' => $_,
+                                    'from_ids'   => $item->{"converted_from_${_}_id"},
+                                    'to_table'   => 'invoice',
+                                    'to_id'      => $item->{id},
+          ) || die;
+          delete $item->{"converted_from_${_}_id"};
+        }
+      }
+    }

     $self->update_attributes(closed => 1);
     1;
   })) {
     $self->update_attributes(closed => 1);
     1;
   })) {


@@ -180,7 +300,7 @@ sub convert_to_delivery_order {
       }
     }
 
       }
     }
 

-    $self->update_attributes(delivered => 1);
+    $self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;

     1;
   })) {
     return undef;
     1;
   })) {
     return undef;


@@ -202,12 +322,28 @@ 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' },
+    { from => 'sales_order',       to => 'sales_quotation',   abbr => 'sosq' },
+    { from => 'purchase_order',    to => 'request_quotation', abbr => 'porq' },
+  );
+  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 {
+    any { $from_to->{abbr} eq $_ } @_;
+  };

 
   my ($item_parent_id_column, $item_parent_column);
 
 
   my ($item_parent_id_column, $item_parent_column);
 


@@ -217,19 +353,43 @@ sub new_from {
   }
 
   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
   }
 
   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id

-                                                department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
-                                                ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
-                                                transaction_description vendor_id
+                                                department_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
+                                                ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded tax_point taxzone_id
+                                                transaction_description vendor_id billing_address_id

                                              )),
                                              )),

-               quotation => 0,
+               quotation => !!($destination_type =~ m{quotation$}),

                closed    => 0,
                delivered => 0,
                transdate => DateTime->today_local,
                closed    => 0,
                delivered => 0,
                transdate => DateTime->today_local,

+               employee  => SL::DB::Manager::Employee->current,

             );
 
             );
 

+  if ( $is_abbr_any->(qw(sopo poso)) ) {
+    $args{ordnumber} = undef;
+    $args{quonumber} = undef;
+    $args{reqdate}   = DateTime->today_local->next_workday();
+  }
+  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;
+  }
+  if ( $is_abbr_any->(qw(sosq porq)) ) {
+    $args{ordnumber} = undef;
+    $args{quonumber} = undef;
+    $args{reqdate}   = DateTime->today_local->next_workday();
+  }
+

   # 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 +401,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 {


@@ -257,9 +418,17 @@ sub new_from {
                                                         marge_percent marge_price_factor marge_total
                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
                                                         marge_percent marge_price_factor marge_total
                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit

+                                                        optional

                                                      )),
                                                  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,6 +442,78 @@ 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 tax_point 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 salesman_id department_id
+                       delivery_customer_id delivery_vendor_id shipto_id
+                       globalproject_id exchangerate)) {
+    $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;
+
+  # set emplyee to the current one
+  $attributes{employee} = SL::DB::Manager::Employee->current;
+
+  # 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;
 


@@ -340,6 +581,30 @@ Returns one of the following string types:
 
 Returns true if the order is of the given type.
 
 
 Returns true if the order is of the given type.
 

+=head2 C<daily_exchangerate $val>
+
+Gets or sets the exchangerate object's value. This is the value from the
+table C<exchangerate> depending on the order's currency, the transdate and
+if it is a sales or purchase order.
+
+The order object (respectively the table C<oe>) has an own column
+C<exchangerate> which can be get or set with the accessor C<exchangerate>.
+
+The idea is to drop the legacy table C<exchangerate> in the future and to
+give all relevant tables it's own C<exchangerate> column.
+
+So, this method is here if you need to access the "legacy" exchangerate via
+an order object.
+
+=over 4
+
+=item C<$val>
+
+(optional) If given, the exchangerate in the "legacy" table is set to this
+value, depending on currency, transdate and sales or purchase.
+
+=back
+

 =head2 C<convert_to_delivery_order %params>
 
 Creates a new delivery order with C<$self> as the basis by calling
 =head2 C<convert_to_delivery_order %params>
 
 Creates a new delivery order with C<$self> as the basis by calling


@@ -361,7 +626,7 @@ L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 C<closed> attribute is set to C<true>, and C<$self> is saved.
 
 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 C<closed> attribute is set to C<true>, and C<$self> is saved.
 

-The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
+The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.

 
 Returns the new invoice instance on success and C<undef> on
 failure. The whole process is run inside a transaction. On failure
 
 Returns the new invoice instance on success and C<undef> on
 failure. The whole process is run inside a transaction. On failure


@@ -372,7 +637,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 +657,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>
 


@@ -424,15 +690,24 @@ order.
 
 =back
 
 
 =back
 

-=head2 C<create_sales_process>
+=head2 C<new_from_multi $sources, %params>
+
+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.

 
 

-Creates and saves a new sales process. Can only be called for sales
-orders.
+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 newly created process will be linked bidirectionally to both
-C<$self> and to all sales quotations that are linked to C<$self>.
+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