X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDB%2FOrder.pm;h=bba7fc8efc8d55c0019043ef7963b039a3a007c3;hb=fd7e51e949f6525e98d4df24f7fee5f1a1167891;hp=5d88ad9295432474983d623a8b6d9b0493b70207;hpb=9589ecd776677cdeb2fbaf8de211963d24cf5aa1;p=kivitendo-erp.git diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm index 5d88ad929..bba7fc8ef 100644 --- a/SL/DB/Order.pm +++ b/SL/DB/Order.pm @@ -6,9 +6,12 @@ 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; +use SL::DB::Helper::AttrHTML; +use SL::DB::Helper::AttrSorted; use SL::DB::Helper::FlattenToForm; use SL::DB::Helper::LinkedRecords; use SL::DB::Helper::PriceTaxCalculator; @@ -41,6 +44,9 @@ __PACKAGE__->meta->add_relationship( __PACKAGE__->meta->initialize; +__PACKAGE__->attr_html('notes'); +__PACKAGE__->attr_sorted('items'); + __PACKAGE__->before_save('_before_save_set_ord_quo_number'); # hooks @@ -62,12 +68,7 @@ sub _before_save_set_ord_quo_number { sub items { goto &orderitems; } sub add_items { goto &add_orderitems; } - -sub items_sorted { - my ($self) = @_; - - return [ sort {$a->id <=> $b->id } @{ $self->items } ]; -} +sub record_number { goto &number; } sub type { my $self = shift; @@ -95,6 +96,9 @@ sub displayable_type { die 'invalid type'; } +sub displayable_name { + join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number); +}; sub is_sales { croak 'not an accessor' if @_ > 1; @@ -154,25 +158,239 @@ sub convert_to_invoice { sub convert_to_delivery_order { my ($self, @args) = @_; - my ($delivery_order, $custom_shipto); + my $delivery_order; if (!$self->db->with_transaction(sub { require SL::DB::DeliveryOrder; - ($delivery_order, $custom_shipto) = SL::DB::DeliveryOrder->new_from($self, @args); + $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args); $delivery_order->save; - $custom_shipto->save if $custom_shipto; $self->link_to_record($delivery_order); + # TODO extend link_to_record for items, otherwise long-term no d.r.y. + foreach my $item (@{ $delivery_order->items }) { + foreach (qw(orderitems)) { # expand if needed (delivery_order_items) + if ($item->{"converted_from_${_}_id"}) { + die unless $item->{id}; + RecordLinks->create_links('dbh' => $self->db->dbh, + 'mode' => 'ids', + 'from_table' => $_, + 'from_ids' => $item->{"converted_from_${_}_id"}, + 'to_table' => 'delivery_order_items', + 'to_id' => $item->{id}, + ) || die; + delete $item->{"converted_from_${_}_id"}; + } + } + } + $self->update_attributes(delivered => 1); 1; })) { - return wantarray ? () : undef; + return undef; + } + + return $delivery_order; +} + +sub _clone_orderitem_cvar { + my ($cvar) = @_; + + my $cloned = $_->clone_and_reset; + $cloned->sub_module('orderitems'); + + return $cloned; +} + +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 as parameter") unless $params{destination_type}; + + my $destination_type = delete $params{destination_type}; + + 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); + + if (ref($source) eq 'SL::DB::Order') { + $item_parent_id_column = 'trans_id'; + $item_parent_column = 'order'; + } + + 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 + )), + quotation => !!($destination_type =~ m{quotation$}), + closed => 0, + delivered => 0, + 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 + # 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; + + } else { + $args{shipto_id} = $source->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 { + my $source_item = $_; + my $source_item_id = $_->$item_parent_id_column; + my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables }; + + $item_parents{$source_item_id} ||= $source_item->$item_parent_column; + my $item_parent = $item_parents{$source_item_id}; + + my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) } + qw(active_discount_source active_price_source base_qty cusordnumber + description discount lastcost longdescription + 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 + )), + 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 }; + + @items = grep { $params{item_filter}->($_) } @items if $params{item_filter}; + @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty}; + @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty}; + + $order->items(\@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"; + } } - return wantarray ? ($delivery_order, $custom_shipto) : $delivery_order; + # 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; + return if !$self->type; + my %number_method = ( sales_order => 'ordnumber', sales_quotation => 'quonumber', @@ -191,10 +409,24 @@ sub date { goto &transdate; } +sub digest { + my ($self) = @_; + + sprintf "%s %s %s (%s)", + $self->number, + $self->customervendor->name, + $self->amount_as_number, + $self->date->to_kivitendo; +} + 1; __END__ +=pod + +=encoding utf8 + =head1 NAME SL::DB::Order - Order Datenbank Objekt. @@ -232,16 +464,8 @@ C, and C<$self> is saved. The arguments in C<%params> are passed to L. -Returns C on failure. Otherwise the return value depends on the -context. In list context the new delivery order and a shipto instance -will be returned. In scalar instance only the delivery order instance -is returned. - -Custom shipto addresses (the ones specific to the sales/purchase -record and not to the customer/vendor) are only linked from C -to C. Meaning C will not -be filled in that case. That's why a separate shipto object is created -and returned. +Returns C on failure. Otherwise the new delivery order will be +returned. =head2 C @@ -258,15 +482,80 @@ nothing is created or changed in the database. At the moment only sales quotations and sales orders can be converted. -=head2 C +=head2 C + +Creates a new C instance and copies as much +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. + +The C field will be set to the current date. + +The conversion copies the order items as well. + +Returns the new order instance. The object returned is not +saved. + +C<%params> can include the following options +(C is mandatory): + +=over 4 + +=item C + +(mandatory) +The type of the newly created object. Can be C, +C, C or C for now. + +=item C + +An optional array reference of RDBO instances for the items to use. If +missing then the method C will be called on +C<$source>. This option can be used to override the sorting, to +exclude certain positions or to add additional ones. + +=item C + +If trueish then items with a negative quantity are skipped. Items with +a quantity of 0 are not affected by this option. + +=item C + +If trueish then items with a quantity of 0 are skipped. + +=item C + +An optional code reference that is called for each item with the item +as its sole parameter. Items for which the code reference returns a +falsish value will be skipped. + +=item C + +An optional hash reference. If it exists then it is passed to C +allowing the caller to set certain attributes for the new delivery +order. + +=back + +=head2 C + +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 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. -Creates and saves a new sales process. Can only be called for sales -orders. +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. -The newly created process will be linked bidirectionally to both -C<$self> and to all sales quotations that are linked to C<$self>. +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