SL/DB/Order.pm

   1 package SL::DB::Order;
   2
   3 use utf8;
   4 use strict;
   5
   6 use Carp;
   7 use DateTime;
   8 use List::Util qw(max);
   9 use List::MoreUtils qw(any);
  10
  11 use SL::DB::MetaSetup::Order;
  12 use SL::DB::Manager::Order;
  13 use SL::DB::Helper::Attr;
  14 use SL::DB::Helper::AttrHTML;
  15 use SL::DB::Helper::AttrSorted;
  16 use SL::DB::Helper::FlattenToForm;
  17 use SL::DB::Helper::LinkedRecords;
  18 use SL::DB::Helper::PriceTaxCalculator;
  19 use SL::DB::Helper::PriceUpdater;
  20 use SL::DB::Helper::TransNumberGenerator;
  21 use SL::Locale::String qw(t8);
  22 use SL::RecordLinks;
  23 use Rose::DB::Object::Helpers qw(as_tree);
  24
  25 __PACKAGE__->meta->add_relationship(
  26   orderitems => {
  27     type         => 'one to many',
  28     class        => 'SL::DB::OrderItem',
  29     column_map   => { id => 'trans_id' },
  30     manager_args => {
  31       with_objects => [ 'part' ]
  32     }
  33   },
  34   periodic_invoices_config => {
  35     type                   => 'one to one',
  36     class                  => 'SL::DB::PeriodicInvoicesConfig',
  37     column_map             => { id => 'oe_id' },
  38   },
  39   custom_shipto            => {
  40     type                   => 'one to one',
  41     class                  => 'SL::DB::Shipto',
  42     column_map             => { id => 'trans_id' },
  43     query_args             => [ module => 'OE' ],
  44   },
  45   exchangerate_obj         => {
  46     type                   => 'one to one',
  47     class                  => 'SL::DB::Exchangerate',
  48     column_map             => { currency_id => 'currency_id', transdate => 'transdate' },
  49   },
  50 );
  51
  52 SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
  53
  54 __PACKAGE__->meta->initialize;
  55
  56 __PACKAGE__->attr_html('notes');
  57 __PACKAGE__->attr_sorted('items');
  58
  59 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
  60 __PACKAGE__->before_save('_before_save_create_new_project');
  61 __PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
  62 __PACKAGE__->before_save('_before_save_set_custom_shipto_module');
  63
  64 # hooks
  65
  66 sub _before_save_set_ord_quo_number {
  67   my ($self) = @_;
  68
  69   # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
  70   # least an empty string, even if we're saving a quotation.
  71   $self->ordnumber('') if !$self->ordnumber;
  72
  73   my $field = $self->quotation ? 'quonumber' : 'ordnumber';
  74   $self->create_trans_number if !$self->$field;
  75
  76   return 1;
  77 }
  78 sub _before_save_create_new_project {
  79   my ($self) = @_;
  80
  81   # force new project, if not set yet
  82   if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq 'sales_order')) {
  83
  84     die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber)
  85       if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber);
  86
  87     eval {
  88       my $new_project = SL::DB::Project->new(
  89           projectnumber     => $self->ordnumber,
  90           description       => $self->customer->name,
  91           customer_id       => $self->customer->id,
  92           active            => 1,
  93           project_type_id   => $::instance_conf->get_project_type_id,
  94           project_status_id => $::instance_conf->get_project_status_id,
  95           );
  96        $new_project->save;
  97        $self->globalproject_id($new_project->id);
  98     } or die t8('Could not create new project #1', $@);
  99   }
 100   return 1;
 101 }
 102
 103
 104 sub _before_save_remove_empty_custom_shipto {
 105   my ($self) = @_;
 106
 107   $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty;
 108
 109   return 1;
 110 }
 111
 112 sub _before_save_set_custom_shipto_module {
 113   my ($self) = @_;
 114
 115   $self->custom_shipto->module('OE') if $self->custom_shipto;
 116
 117   return 1;
 118 }
 119
 120 # methods
 121
 122 sub items { goto &orderitems; }
 123 sub add_items { goto &add_orderitems; }
 124 sub record_number { goto &number; }
 125
 126 sub type {
 127   my $self = shift;
 128
 129   return 'sales_order'       if $self->customer_id && ! $self->quotation;
 130   return 'purchase_order'    if $self->vendor_id   && ! $self->quotation;
 131   return 'sales_quotation'   if $self->customer_id &&   $self->quotation;
 132   return 'request_quotation' if $self->vendor_id   &&   $self->quotation;
 133
 134   return;
 135 }
 136
 137 sub is_type {
 138   return shift->type eq shift;
 139 }
 140
 141 sub deliverydate {
 142   # oe doesn't have deliverydate, but it does have reqdate.
 143   # But this has a different meaning for sales quotations.
 144   # deliverydate can be used to determine tax if tax_point isn't set.
 145
 146   return $_[0]->reqdate if $_[0]->type ne 'sales_quotation';
 147 }
 148
 149 sub effective_tax_point {
 150   my ($self) = @_;
 151
 152   return $self->tax_point || $self->deliverydate || $self->transdate;
 153 }
 154
 155 sub displayable_type {
 156   my $type = shift->type;
 157
 158   return $::locale->text('Sales quotation')   if $type eq 'sales_quotation';
 159   return $::locale->text('Request quotation') if $type eq 'request_quotation';
 160   return $::locale->text('Sales Order')       if $type eq 'sales_order';
 161   return $::locale->text('Purchase Order')    if $type eq 'purchase_order';
 162
 163   die 'invalid type';
 164 }
 165
 166 sub displayable_name {
 167   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 168 };
 169
 170 sub is_sales {
 171   croak 'not an accessor' if @_ > 1;
 172   return !!shift->customer_id;
 173 }
 174
 175 sub daily_exchangerate {
 176   my ($self, $val) = @_;
 177
 178   return 1 if $self->currency_id == $::instance_conf->get_currency_id;
 179
 180   my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order))      ? 'buy'
 181            : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell'
 182            : undef;
 183   return if !$rate;
 184
 185   if (defined $val) {
 186     croak t8('exchange rate has to be positive') if $val <= 0;
 187     if (!$self->exchangerate_obj) {
 188       $self->exchangerate_obj(SL::DB::Exchangerate->new(
 189         currency_id => $self->currency_id,
 190         transdate   => $self->transdate,
 191         $rate       => $val,
 192       ));
 193     } elsif (!defined $self->exchangerate_obj->$rate) {
 194       $self->exchangerate_obj->$rate($val);
 195     } else {
 196       croak t8('exchange rate already exists, no update allowed');
 197     }
 198   }
 199   return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
 200 }
 201
 202 sub invoices {
 203   my $self   = shift;
 204   my %params = @_;
 205
 206   if ($self->quotation) {
 207     return [];
 208   } else {
 209     require SL::DB::Invoice;
 210     return SL::DB::Manager::Invoice->get_all(
 211       query => [
 212         ordnumber => $self->ordnumber,
 213         @{ $params{query} || [] },
 214       ]
 215     );
 216   }
 217 }
 218
 219 sub displayable_state {
 220   my ($self) = @_;
 221
 222   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
 223 }
 224
 225 sub abschlag_invoices {
 226   return shift()->invoices(query => [ abschlag => 1 ]);
 227 }
 228
 229 sub end_invoice {
 230   return shift()->invoices(query => [ abschlag => 0 ]);
 231 }
 232
 233 sub convert_to_invoice {
 234   my ($self, %params) = @_;
 235
 236   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 237
 238   my $invoice;
 239   if (!$self->db->with_transaction(sub {
 240     require SL::DB::Invoice;
 241     $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
 242     $self->link_to_record($invoice);
 243     $self->update_attributes(closed => 1);
 244     1;
 245   })) {
 246     return undef;
 247   }
 248
 249   return $invoice;
 250 }
 251
 252 sub convert_to_delivery_order {
 253   my ($self, @args) = @_;
 254
 255   my $delivery_order;
 256   if (!$self->db->with_transaction(sub {
 257     require SL::DB::DeliveryOrder;
 258     $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
 259     $delivery_order->save;
 260     $self->link_to_record($delivery_order);
 261     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
 262     foreach my $item (@{ $delivery_order->items }) {
 263       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 264         if ($item->{"converted_from_${_}_id"}) {
 265           die unless $item->{id};
 266           RecordLinks->create_links('dbh'        => $self->db->dbh,
 267                                     'mode'       => 'ids',
 268                                     'from_table' => $_,
 269                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 270                                     'to_table'   => 'delivery_order_items',
 271                                     'to_id'      => $item->{id},
 272           ) || die;
 273           delete $item->{"converted_from_${_}_id"};
 274         }
 275       }
 276     }
 277
 278     $self->update_attributes(delivered => 1);
 279     1;
 280   })) {
 281     return undef;
 282   }
 283
 284   return $delivery_order;
 285 }
 286
 287 sub _clone_orderitem_cvar {
 288   my ($cvar) = @_;
 289
 290   my $cloned = $_->clone_and_reset;
 291   $cloned->sub_module('orderitems');
 292
 293   return $cloned;
 294 }
 295
 296 sub new_from {
 297   my ($class, $source, %params) = @_;
 298
 299   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
 300   croak("A destination type must be given as parameter")         unless $params{destination_type};
 301
 302   my $destination_type  = delete $params{destination_type};
 303
 304   my @from_tos = (
 305     { from => 'sales_quotation',   to => 'sales_order',       abbr => 'sqso' },
 306     { from => 'request_quotation', to => 'purchase_order',    abbr => 'rqpo' },
 307     { from => 'sales_quotation',   to => 'sales_quotation',   abbr => 'sqsq' },
 308     { from => 'sales_order',       to => 'sales_order',       abbr => 'soso' },
 309     { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
 310     { from => 'purchase_order',    to => 'purchase_order',    abbr => 'popo' },
 311     { from => 'sales_order',       to => 'purchase_order',    abbr => 'sopo' },
 312     { from => 'purchase_order',    to => 'sales_order',       abbr => 'poso' },
 313   );
 314   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
 315   croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
 316
 317   my $is_abbr_any = sub {
 318     # foreach my $abbr (@_) {
 319     #   croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
 320     # }
 321     any { $from_to->{abbr} eq $_ } @_;
 322   };
 323
 324   my ($item_parent_id_column, $item_parent_column);
 325
 326   if (ref($source) eq 'SL::DB::Order') {
 327     $item_parent_id_column = 'trans_id';
 328     $item_parent_column    = 'order';
 329   }
 330
 331   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
 332                                                 department_id employee_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes
 333                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded tax_point taxzone_id
 334                                                 transaction_description vendor_id
 335                                              )),
 336                quotation => !!($destination_type =~ m{quotation$}),
 337                closed    => 0,
 338                delivered => 0,
 339                transdate => DateTime->today_local,
 340             );
 341
 342   if ( $is_abbr_any->(qw(sopo poso)) ) {
 343     $args{ordnumber} = undef;
 344     $args{quonumber} = undef;
 345     $args{reqdate}   = DateTime->today_local->next_workday();
 346     $args{employee}  = SL::DB::Manager::Employee->current;
 347   }
 348   if ( $is_abbr_any->(qw(sopo)) ) {
 349     $args{customer_id}      = undef;
 350     $args{salesman_id}      = undef;
 351     $args{payment_id}       = undef;
 352     $args{delivery_term_id} = undef;
 353   }
 354   if ( $is_abbr_any->(qw(poso)) ) {
 355     $args{vendor_id} = undef;
 356   }
 357   if ( $is_abbr_any->(qw(soso)) ) {
 358     $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
 359   }
 360
 361   # Custom shipto addresses (the ones specific to the sales/purchase
 362   # record and not to the customer/vendor) are only linked from
 363   # shipto → order. Meaning order.shipto_id
 364   # will not be filled in that case.
 365   if (!$source->shipto_id && $source->id) {
 366     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 367
 368   } else {
 369     $args{shipto_id} = $source->shipto_id;
 370   }
 371
 372   my $order = $class->new(%args);
 373   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 374   my $items = delete($params{items}) || $source->items_sorted;
 375
 376   my %item_parents;
 377
 378   my @items = map {
 379     my $source_item      = $_;
 380     my $source_item_id   = $_->$item_parent_id_column;
 381     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 382
 383     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 384     my $item_parent                  = $item_parents{$source_item_id};
 385
 386     my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
 387                                                      qw(active_discount_source active_price_source base_qty cusordnumber
 388                                                         description discount lastcost longdescription
 389                                                         marge_percent marge_price_factor marge_total
 390                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
 391                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
 392                                                      )),
 393                                                  custom_variables => \@custom_variables,
 394     );
 395     if ( $is_abbr_any->(qw(sopo)) ) {
 396       $current_oe_item->sellprice($source_item->lastcost);
 397       $current_oe_item->discount(0);
 398     }
 399     if ( $is_abbr_any->(qw(poso)) ) {
 400       $current_oe_item->lastcost($source_item->sellprice);
 401     }
 402     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 403     $current_oe_item;
 404   } @{ $items };
 405
 406   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 407   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 408   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 409
 410   $order->items(\@items);
 411
 412   return $order;
 413 }
 414
 415 sub new_from_multi {
 416   my ($class, $sources, %params) = @_;
 417
 418   croak("Unsupported object type in sources")                             if any { ref($_) !~ m{SL::DB::Order} }                   @$sources;
 419   croak("Cannot create order for purchase records")                       if any { !$_->is_sales }                                 @$sources;
 420   croak("Cannot create order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;
 421
 422   # bb: todo: check shipto: is it enough to check the ids or do we have to compare the entries?
 423   if (delete $params{check_same_shipto}) {
 424     die "check same shipto address is not implemented yet";
 425     die "Source records do not have the same shipto"        if 1;
 426   }
 427
 428   # sort sources
 429   if (defined $params{sort_sources_by}) {
 430     my $sort_by = delete $params{sort_sources_by};
 431     if ($sources->[0]->can($sort_by)) {
 432       $sources = [ sort { $a->$sort_by cmp $b->$sort_by } @$sources ];
 433     } else {
 434       die "Cannot sort source records by $sort_by";
 435     }
 436   }
 437
 438   # set this entries to undef that yield different information
 439   my %attributes;
 440   foreach my $attr (qw(ordnumber transdate reqdate taxincluded shippingpoint
 441                        shipvia notes closed delivered reqdate quonumber
 442                        cusordnumber proforma transaction_description
 443                        order_probability expected_billing_date)) {
 444     $attributes{$attr} = undef if any { ($sources->[0]->$attr//'') ne ($_->$attr//'') } @$sources;
 445   }
 446   foreach my $attr (qw(cp_id currency_id employee_id salesman_id department_id
 447                        delivery_customer_id delivery_vendor_id shipto_id
 448                        globalproject_id exchangerate)) {
 449     $attributes{$attr} = undef if any { ($sources->[0]->$attr||0) != ($_->$attr||0) }   @$sources;
 450   }
 451
 452   # set this entries from customer that yield different information
 453   foreach my $attr (qw(language_id taxzone_id payment_id delivery_term_id)) {
 454     $attributes{$attr}  = $sources->[0]->customervendor->$attr if any { ($sources->[0]->$attr||0)     != ($_->$attr||0) }      @$sources;
 455   }
 456   $attributes{intnotes} = $sources->[0]->customervendor->notes if any { ($sources->[0]->intnotes//'') ne ($_->intnotes//'')  } @$sources;
 457
 458   # no periodic invoice config for new order
 459   $attributes{periodic_invoices_config} = undef;
 460
 461   # copy global ordnumber, transdate, cusordnumber into item scope
 462   #   unless already present there
 463   foreach my $attr (qw(ordnumber transdate cusordnumber)) {
 464     foreach my $src (@$sources) {
 465       foreach my $item (@{ $src->items_sorted }) {
 466         $item->$attr($src->$attr) if !$item->$attr;
 467       }
 468     }
 469   }
 470
 471   # collect items
 472   my @items;
 473   push @items, @{$_->items_sorted} for @$sources;
 474   # make order from first source and all items
 475   my $order = $class->new_from($sources->[0],
 476                                destination_type => 'sales_order',
 477                                attributes       => \%attributes,
 478                                items            => \@items,
 479                                %params);
 480
 481   return $order;
 482 }
 483
 484 sub number {
 485   my $self = shift;
 486
 487   return if !$self->type;
 488
 489   my %number_method = (
 490     sales_order       => 'ordnumber',
 491     sales_quotation   => 'quonumber',
 492     purchase_order    => 'ordnumber',
 493     request_quotation => 'quonumber',
 494   );
 495
 496   return $self->${ \ $number_method{$self->type} }(@_);
 497 }
 498
 499 sub customervendor {
 500   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
 501 }
 502
 503 sub date {
 504   goto &transdate;
 505 }
 506
 507 sub digest {
 508   my ($self) = @_;
 509
 510   sprintf "%s %s %s (%s)",
 511     $self->number,
 512     $self->customervendor->name,
 513     $self->amount_as_number,
 514     $self->date->to_kivitendo;
 515 }
 516
 517 1;
 518
 519 __END__
 520
 521 =pod
 522
 523 =encoding utf8
 524
 525 =head1 NAME
 526
 527 SL::DB::Order - Order Datenbank Objekt.
 528
 529 =head1 FUNCTIONS
 530
 531 =head2 C<type>
 532
 533 Returns one of the following string types:
 534
 535 =over 4
 536
 537 =item sales_order
 538
 539 =item purchase_order
 540
 541 =item sales_quotation
 542
 543 =item request_quotation
 544
 545 =back
 546
 547 =head2 C<is_type TYPE>
 548
 549 Returns true if the order is of the given type.
 550
 551 =head2 C<daily_exchangerate $val>
 552
 553 Gets or sets the exchangerate object's value. This is the value from the
 554 table C<exchangerate> depending on the order's currency, the transdate and
 555 if it is a sales or purchase order.
 556
 557 The order object (respectively the table C<oe>) has an own column
 558 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
 559
 560 The idea is to drop the legacy table C<exchangerate> in the future and to
 561 give all relevant tables it's own C<exchangerate> column.
 562
 563 So, this method is here if you need to access the "legacy" exchangerate via
 564 an order object.
 565
 566 =over 4
 567
 568 =item C<$val>
 569
 570 (optional) If given, the exchangerate in the "legacy" table is set to this
 571 value, depending on currency, transdate and sales or purchase.
 572
 573 =back
 574
 575 =head2 C<convert_to_delivery_order %params>
 576
 577 Creates a new delivery order with C<$self> as the basis by calling
 578 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
 579 C<$self> is linked to the new invoice via
 580 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 581 C<true>, and C<$self> is saved.
 582
 583 The arguments in C<%params> are passed to
 584 L<SL::DB::DeliveryOrder::new_from>.
 585
 586 Returns C<undef> on failure. Otherwise the new delivery order will be
 587 returned.
 588
 589 =head2 C<convert_to_invoice %params>
 590
 591 Creates a new invoice with C<$self> as the basis by calling
 592 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 593 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 594 C<closed> attribute is set to C<true>, and C<$self> is saved.
 595
 596 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
 597
 598 Returns the new invoice instance on success and C<undef> on
 599 failure. The whole process is run inside a transaction. On failure
 600 nothing is created or changed in the database.
 601
 602 At the moment only sales quotations and sales orders can be converted.
 603
 604 =head2 C<new_from $source, %params>
 605
 606 Creates a new C<SL::DB::Order> instance and copies as much
 607 information from C<$source> as possible. At the moment only records with the
 608 same destination type as the source type and sales orders from
 609 sales quotations and purchase orders from requests for quotations can be
 610 created.
 611
 612 The C<transdate> field will be set to the current date.
 613
 614 The conversion copies the order items as well.
 615
 616 Returns the new order instance. The object returned is not
 617 saved.
 618
 619 C<%params> can include the following options
 620 (C<destination_type> is mandatory):
 621
 622 =over 4
 623
 624 =item C<destination_type>
 625
 626 (mandatory)
 627 The type of the newly created object. Can be C<sales_quotation>,
 628 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 629
 630 =item C<items>
 631
 632 An optional array reference of RDBO instances for the items to use. If
 633 missing then the method C<items_sorted> will be called on
 634 C<$source>. This option can be used to override the sorting, to
 635 exclude certain positions or to add additional ones.
 636
 637 =item C<skip_items_negative_qty>
 638
 639 If trueish then items with a negative quantity are skipped. Items with
 640 a quantity of 0 are not affected by this option.
 641
 642 =item C<skip_items_zero_qty>
 643
 644 If trueish then items with a quantity of 0 are skipped.
 645
 646 =item C<item_filter>
 647
 648 An optional code reference that is called for each item with the item
 649 as its sole parameter. Items for which the code reference returns a
 650 falsish value will be skipped.
 651
 652 =item C<attributes>
 653
 654 An optional hash reference. If it exists then it is passed to C<new>
 655 allowing the caller to set certain attributes for the new delivery
 656 order.
 657
 658 =back
 659
 660 =head2 C<new_from_multi $sources, %params>
 661
 662 Creates a new C<SL::DB::Order> instance from multiple sources and copies as
 663 much information from C<$sources> as possible.
 664 At the moment only sales orders can be combined and they must be of the same
 665 customer.
 666
 667 The new order is created from the first one using C<new_from> and the positions
 668 of all orders are added to the new order. The orders can be sorted with the
 669 parameter C<sort_sources_by>.
 670
 671 The orders attributes are kept if they contain the same information for all
 672 source orders an will be set to empty if they contain different information.
 673
 674 Returns the new order instance. The object returned is not
 675 saved.
 676
 677 C<params> other then C<sort_sources_by> are passed to C<new_from>.
 678
 679 =head1 BUGS
 680
 681 Nothing here yet.
 682
 683 =head1 AUTHOR
 684
 685 Sven Schöling <s.schoeling@linet-services.de>
 686
 687 =cut