use Carp;
use DateTime;
use List::Util qw(max);
+use List::MoreUtils qw(any);
use SL::DB::MetaSetup::Order;
use SL::DB::Manager::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 $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);
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
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 {
)),
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 };
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;
=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
projects / kivitendo-erp.git / blobdiff