X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDB%2FOrder.pm;h=415896919e53ecc31d3e84481fe05a8ef99dcd6d;hb=f65440cb9d28d4862facc50858bd25fa138cb211;hp=978d128bb63bd28bbc18b44b0932f732be987670;hpb=69966b4c3df791edabe5e7265010293efbba18ed;p=kivitendo-erp.git diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm index 978d128bb..415896919 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,14 +42,24 @@ __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__, daily_exchangerate => 'numeric'); + __PACKAGE__->meta->initialize; __PACKAGE__->attr_html('notes'); __PACKAGE__->attr_sorted('items'); __PACKAGE__->before_save('_before_save_set_ord_quo_number'); +__PACKAGE__->before_save('_before_save_create_new_project'); +__PACKAGE__->before_save('_before_save_remove_empty_custom_shipto'); +__PACKAGE__->before_save('_before_save_set_custom_shipto_module'); # hooks @@ -63,6 +75,47 @@ sub _before_save_set_ord_quo_number { return 1; } +sub _before_save_create_new_project { + my ($self) = @_; + + # force new project, if not set yet + if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq 'sales_order')) { + + die t8("Error while creating project with project number of new order number, project number #1 already exists!", $self->ordnumber) + if SL::DB::Manager::Project->find_by(projectnumber => $self->ordnumber); + + eval { + my $new_project = SL::DB::Project->new( + projectnumber => $self->ordnumber, + description => $self->customer->name, + customer_id => $self->customer->id, + active => 1, + project_type_id => $::instance_conf->get_project_type_id, + project_status_id => $::instance_conf->get_project_status_id, + ); + $new_project->save; + $self->globalproject_id($new_project->id); + } or die t8('Could not create new project #1', $@); + } + return 1; +} + + +sub _before_save_remove_empty_custom_shipto { + my ($self) = @_; + + $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty; + + return 1; +} + +sub _before_save_set_custom_shipto_module { + my ($self) = @_; + + $self->custom_shipto->module('OE') if $self->custom_shipto; + + return 1; +} # methods @@ -85,6 +138,20 @@ sub is_type { return shift->type eq shift; } +sub deliverydate { + # oe doesn't have deliverydate, but it does have reqdate. + # But this has a different meaning for sales quotations. + # deliverydate can be used to determine tax if tax_point isn't set. + + return $_[0]->reqdate if $_[0]->type ne 'sales_quotation'; +} + +sub effective_tax_point { + my ($self) = @_; + + return $self->tax_point || $self->deliverydate || $self->transdate; +} + sub displayable_type { my $type = shift->type; @@ -105,6 +172,33 @@ sub is_sales { return !!shift->customer_id; } +sub daily_exchangerate { + my ($self, $val) = @_; + + return 1 if $self->currency_id == $::instance_conf->get_currency_id; + + my $rate = (any { $self->is_type($_) } qw(sales_quotation sales_order)) ? 'buy' + : (any { $self->is_type($_) } qw(request_quotation purchase_order)) ? 'sell' + : undef; + return if !$rate; + + 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 = @_; @@ -216,14 +310,12 @@ sub new_from { { from => 'purchase_order', to => 'purchase_order', abbr => 'popo' }, { from => 'sales_order', to => 'purchase_order', abbr => 'sopo' }, { from => 'purchase_order', to => 'sales_order', abbr => 'poso' }, + { from => 'sales_order', to => 'sales_quotation', abbr => 'sosq' }, ); 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 $_ } @_; }; @@ -235,8 +327,8 @@ sub new_from { } 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 + department_id employee_id exchangerate globalproject_id intnotes marge_percent marge_total language_id netamount notes + ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded tax_point taxzone_id transaction_description vendor_id )), quotation => !!($destination_type =~ m{quotation$}), @@ -247,6 +339,7 @@ sub new_from { if ( $is_abbr_any->(qw(sopo poso)) ) { $args{ordnumber} = undef; + $args{quonumber} = undef; $args{reqdate} = DateTime->today_local->next_workday(); $args{employee} = SL::DB::Manager::Employee->current; } @@ -259,6 +352,14 @@ sub new_from { 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; + } + if ( $is_abbr_any->(qw(sosq)) ) { + $args{ordnumber} = undef; + $args{quonumber} = undef; + $args{reqdate} = DateTime->today_local->next_workday(); + } # Custom shipto addresses (the ones specific to the sales/purchase # record and not to the customer/vendor) are only linked from @@ -274,6 +375,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 { @@ -313,6 +415,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 tax_point 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 exchangerate)) { + $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; @@ -380,6 +551,30 @@ Returns one of the following string types: Returns true if the order is of the given type. +=head2 C + +Gets or sets the exchangerate object's value. This is the value from the +table C depending on the order's currency, the transdate and +if it is a sales or purchase order. + +The order object (respectively the table C) has an own column +C which can be get or set with the accessor C. + +The idea is to drop the legacy table C in the future and to +give all relevant tables it's own C column. + +So, this method is here if you need to access the "legacy" exchangerate via +an order object. + +=over 4 + +=item C<$val> + +(optional) If given, the exchangerate in the "legacy" table is set to this +value, depending on currency, transdate and sales or purchase. + +=back + =head2 C Creates a new delivery order with C<$self> as the basis by calling @@ -465,15 +660,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