X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/f1d33e8c42f2da428be80a6909335cf88689c1b3..0956f2d427fe43c70fca245bc55ce85423b76ce8:/SL/DB/Order.pm

diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm
index 3b50272ee..dac89d30e 100644
--- a/SL/DB/Order.pm
+++ b/SL/DB/Order.pm
@@ -10,6 +10,7 @@ use List::MoreUtils qw(any);
 
 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;
@@ -17,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::Locale::String qw(t8);
 use SL::RecordLinks;
 use Rose::DB::Object::Helpers qw(as_tree);
 
@@ -40,8 +42,15 @@ __PACKAGE__->meta->add_relationship(
     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' },
+  },
 );
 
+SL::DB::Helper::Attr::make(__PACKAGE__, exchangerate => 'numeric');
+
 __PACKAGE__->meta->initialize;
 
 __PACKAGE__->attr_html('notes');
@@ -85,6 +94,12 @@ sub is_type {
   return shift->type eq shift;
 }
 
+sub deliverydate {
+  # oe doesn't have deliverydate, but PTC checks for deliverydate or transdate to determine tax
+  # oe can't deal with deviating tax rates, but at least make sure PTC doesn't barf
+  return shift->transdate;
+}
+
 sub displayable_type {
   my $type = shift->type;
 
@@ -105,6 +120,33 @@ sub is_sales {
   return !!shift->customer_id;
 }
 
+sub exchangerate {
+  my ($self, $val) = @_;
+
+  return 1 if $self->currency_id == $::instance_conf->get_currency_id;
+
+  # unable to determine if sales or purchase
+  return undef if !$self->has_customervendor;
+
+  my $rate = $self->is_sales ? 'buy' : 'sell';
+
+  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 = @_;
@@ -277,6 +319,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 %item_parents;
 
   my @items = map {
@@ -316,6 +359,75 @@ sub new_from {
   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;
 
@@ -468,15 +580,24 @@ order.
 
 =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