X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDB%2FOrder.pm;h=bba7fc8efc8d55c0019043ef7963b039a3a007c3;hb=4c8c615a3268dc328f748cc8efe20fc2dc6cb8c5;hp=6baa0e20dc7905f0fa70e493dbb86115a23758ee;hpb=161082b04bdd3320fe94ff448e80a0b4d19bc29b;p=kivitendo-erp.git diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm index 6baa0e20d..bba7fc8ef 100644 --- 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 List::MoreUtils qw(any); use SL::DB::MetaSetup::Order; use SL::DB::Manager::Order; @@ -202,16 +203,29 @@ sub new_from { 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 $src_dst_allowed = ('sales_quotation' eq $source->type && 'sales_order' eq $destination_type) - || ('request_quotation' eq $source->type && 'purchase_order' eq $destination_type) - || ('sales_quotation' eq $source->type && 'sales_quotation' eq $destination_type) - || ('sales_order' eq $source->type && 'sales_order' eq $destination_type) - || ('request_quotation' eq $source->type && 'request_quotation' eq $destination_type) - || ('purchase_order' 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); @@ -231,6 +245,24 @@ sub new_from { 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; + } + if ( $is_abbr_any->(qw(soso)) ) { + $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config; + } + # Custom shipto addresses (the ones specific to the sales/purchase # record and not to the customer/vendor) are only linked from # shipto → order. Meaning order.shipto_id @@ -245,6 +277,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 { @@ -264,6 +297,13 @@ sub new_from { )), 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 }; @@ -277,6 +317,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; @@ -429,15 +538,24 @@ order. =back -=head2 C +=head2 C -Creates and saves a new sales process. Can only be called for sales -orders. +Creates a new C 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 and the positions +of all orders are added to the new order. The orders can be sorted with the +parameter C. + +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 other then C are passed to C. =head1 BUGS