Projekt

Allgemein

Profil

Herunterladen (34,3 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/DB/Order.pm @ e7354364

82515b2d Sven Schöling
package SL::DB::Order;

05c6840d Moritz Bunkus
use utf8;
82515b2d Sven Schöling
use strict;

42ea98b4 Moritz Bunkus
use Carp;
use DateTime;
use List::Util qw(max);
f747a789 Bernd Bleßmann
use List::MoreUtils qw(any);
82515b2d Sven Schöling
70ae535d Jan Büren
use SL::DBUtils ();
2bef4707 Tamino Steinert
use SL::DB::PurchaseBasketItem;
82515b2d Sven Schöling
use SL::DB::MetaSetup::Order;
use SL::DB::Manager::Order;
4b1666b7 Felix Eichler
use SL::DB::Helper::Attr;
a34c05f3 Moritz Bunkus
use SL::DB::Helper::AttrHTML;
f63af42d Moritz Bunkus
use SL::DB::Helper::AttrSorted;
c692dae1 Moritz Bunkus
use SL::DB::Helper::FlattenToForm;
e9fb6244 Moritz Bunkus
use SL::DB::Helper::LinkedRecords;
use SL::DB::Helper::PriceTaxCalculator;
2209370e Moritz Bunkus
use SL::DB::Helper::PriceUpdater;
d57a4596 Sven Schöling
use SL::DB::Helper::TypeDataProxy;
b9dbc9e3 Moritz Bunkus
use SL::DB::Helper::TransNumberGenerator;
5a6d7c03 Geoffrey Richardson
use SL::DB::Helper::Payment qw(forex);
320b8908 Sven Schöling
use SL::DB::Helper::RecordLink qw(RECORD_ID RECORD_TYPE_REF RECORD_ITEM_ID RECORD_ITEM_TYPE_REF);
0956f2d4 Felix Eichler
use SL::Locale::String qw(t8);
42ea98b4 Moritz Bunkus
use SL::RecordLinks;
9b0937a9 Tamino Steinert
use Rose::DB::Object::Helpers qw(as_tree strip);
82515b2d Sven Schöling
35842cc3 Tamino Steinert
use SL::DB::Order::TypeData qw(:types validate_type);
01738ec3 Tamino Steinert
use SL::DB::Reclamation::TypeData qw(:types);

82515b2d Sven Schöling
__PACKAGE__->meta->add_relationship(
orderitems => {
type => 'one to many',
class => 'SL::DB::OrderItem',
column_map => { id => 'trans_id' },
manager_args => {
0845c4b7 Moritz Bunkus
with_objects => [ 'part' ]
82515b2d Sven Schöling
}
250fa402 Moritz Bunkus
},
periodic_invoices_config => {
27bb493f Moritz Bunkus
type => 'one to one',
250fa402 Moritz Bunkus
class => 'SL::DB::PeriodicInvoicesConfig',
column_map => { id => 'oe_id' },
},
325c539c Moritz Bunkus
custom_shipto => {
type => 'one to one',
class => 'SL::DB::Shipto',
column_map => { id => 'trans_id' },
query_args => [ module => 'OE' ],
},
4b1666b7 Felix Eichler
exchangerate_obj => {
type => 'one to one',
class => 'SL::DB::Exchangerate',
column_map => { currency_id => 'currency_id', transdate => 'transdate' },
},
332b5ec7 Bernd Bleßmann
phone_notes => {
type => 'one to many',
class => 'SL::DB::Note',
column_map => { id => 'trans_id' },
query_args => [ trans_module => 'oe' ],
manager_args => {
with_objects => [ 'employee' ],
sort_by => 'notes.itime',
}
},
70ae535d Jan Büren
order_version => {
type => 'one to many',
class => 'SL::DB::OrderVersion',
column_map => { id => 'oe_id' },
},
82515b2d Sven Schöling
);

b1817cb6 Bernd Bleßmann
SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
4b1666b7 Felix Eichler
82515b2d Sven Schöling
__PACKAGE__->meta->initialize;

a34c05f3 Moritz Bunkus
__PACKAGE__->attr_html('notes');
f63af42d Moritz Bunkus
__PACKAGE__->attr_sorted('items');
a34c05f3 Moritz Bunkus
1bcb4ec6 Moritz Bunkus
__PACKAGE__->before_save('_before_save_set_ord_quo_number');
1b18f0aa Jan Büren
__PACKAGE__->before_save('_before_save_create_new_project');
7cad87f8 Bernd Bleßmann
__PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
__PACKAGE__->before_save('_before_save_set_custom_shipto_module');
320b8908 Sven Schöling
__PACKAGE__->after_save('_after_save_link_records');
9b3a6024 Bernd Bleßmann
__PACKAGE__->after_save('_after_save_close_reachable_intakes'); # uses linked records (order matters)
2bef4707 Tamino Steinert
__PACKAGE__->before_save('_before_save_delete_from_purchase_basket');
1bcb4ec6 Moritz Bunkus
# hooks

sub _before_save_set_ord_quo_number {
my ($self) = @_;

# ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
# least an empty string, even if we're saving a quotation.
$self->ordnumber('') if !$self->ordnumber;

bec63527 Tamino Steinert
$self->create_trans_number if !$self->record_number;
1bcb4ec6 Moritz Bunkus
return 1;
}
1b18f0aa Jan Büren
sub _before_save_create_new_project {
my ($self) = @_;

# force new project, if not set yet
01738ec3 Tamino Steinert
if ($::instance_conf->get_order_always_project && !$self->globalproject_id && ($self->type eq SALES_ORDER_TYPE())) {
1b18f0aa Jan Büren
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;
}
1bcb4ec6 Moritz Bunkus
7cad87f8 Bernd Bleßmann
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;
}

320b8908 Sven Schöling
sub _after_save_link_records {
my ($self) = @_;

cdf32772 Tamino Steinert
my @allowed_record_sources = qw(SL::DB::Reclamation SL::DB::Order SL::DB::EmailJournal);
320b8908 Sven Schöling
my @allowed_item_sources = qw(SL::DB::ReclamationItem SL::DB::OrderItem);

SL::DB::Helper::RecordLink::link_records(
$self,
\@allowed_record_sources,
\@allowed_item_sources,
);
66c23609 Bernd Bleßmann
return 1;
320b8908 Sven Schöling
}

9b3a6024 Bernd Bleßmann
sub _after_save_close_reachable_intakes {
my ($self) = @_;

# Close reachable sales order intakes in the from-workflow if this is a sales order
if (SALES_ORDER_TYPE() eq $self->type) {
my $lr = $self->linked_records(direction => 'from', recursive => 1);
$lr = [grep { 'SL::DB::Order' eq ref $_ && !$_->closed && $_->is_type(SALES_ORDER_INTAKE_TYPE()) } @$lr];
if (@$lr) {
SL::DB::Manager::Order->update_all(set => {closed => 1},
where => [id => [map {$_->id} @$lr]]);
}
}
66c23609 Bernd Bleßmann
return 1;
9b3a6024 Bernd Bleßmann
}
320b8908 Sven Schöling
2bef4707 Tamino Steinert
sub _before_save_delete_from_purchase_basket {
my ($self) = @_;

8e6d57a9 Tamino Steinert
my @basket_item_ids =
grep { defined($_) && $_ ne ''}
map { $_->{basket_item_id} }
$self->orderitems;
7e80cfae Tamino Steinert
return 1 unless scalar @basket_item_ids;

# check if all items are still in the basket
my $basket_item_count = SL::DB::Manager::PurchaseBasketItem->get_all_count(
where => [ id => \@basket_item_ids ]
);
if ($basket_item_count != scalar @basket_item_ids) {
die "Error while saving order: some items are not in the purchase basket anymore.";
}
2bef4707 Tamino Steinert
if (scalar @basket_item_ids) {
SL::DB::Manager::PurchaseBasketItem->delete_all(
where => [ id => \@basket_item_ids]
);
}

return 1;
}

82515b2d Sven Schöling
# methods

0845c4b7 Moritz Bunkus
sub items { goto &orderitems; }
ae906113 Moritz Bunkus
sub add_items { goto &add_orderitems; }
4f7e0fa9 Geoffrey Richardson
sub record_number { goto &number; }
4ac74078 Moritz Bunkus
82515b2d Sven Schöling
sub type {
my $self = shift;
35842cc3 Tamino Steinert
SL::DB::Order::TypeData::validate_type($self->record_type);
30710024 Tamino Steinert
return $self->record_type;
82515b2d Sven Schöling
}

sub is_type {
return shift->type eq shift;
}

bec63527 Tamino Steinert
sub quotation {
28a3e2f5 Bernd Bleßmann
my $type = $_[0]->type();
any { $type eq $_ } (
SALES_ORDER_INTAKE_TYPE(),
SALES_QUOTATION_TYPE(),
REQUEST_QUOTATION_TYPE(),
PURCHASE_QUOTATION_INTAKE_TYPE(),
);
bec63527 Tamino Steinert
}

sub intake {
28a3e2f5 Bernd Bleßmann
my $type = $_[0]->type();
any { $type eq $_ } (
SALES_ORDER_INTAKE_TYPE(),
PURCHASE_QUOTATION_INTAKE_TYPE(),
);
bec63527 Tamino Steinert
}

9f809e7f Geoffrey Richardson
sub deliverydate {
a6485c58 Bernd Bleßmann
# 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.

01738ec3 Tamino Steinert
return $_[0]->reqdate if $_[0]->type ne SALES_QUOTATION_TYPE();
9f809e7f Geoffrey Richardson
}

0b36b225 Moritz Bunkus
sub effective_tax_point {
my ($self) = @_;

a6485c58 Bernd Bleßmann
return $self->tax_point || $self->deliverydate || $self->transdate;
0b36b225 Moritz Bunkus
}

2746ccd0 Sven Schöling
sub displayable_type {
35842cc3 Tamino Steinert
my ($self) = @_;
fc264bc3 Tamino Steinert
return $self->type_data->text('type');
2746ccd0 Sven Schöling
}

a7114646 Geoffrey Richardson
sub displayable_name {
join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
};
2746ccd0 Sven Schöling
211de9e3 Sven Schöling
sub is_sales {
croak 'not an accessor' if @_ > 1;
c32c45bf Bernd Bleßmann
$_[0]->type_data->properties('is_customer');
211de9e3 Sven Schöling
}

b1817cb6 Bernd Bleßmann
sub daily_exchangerate {
4b1666b7 Felix Eichler
my ($self, $val) = @_;

return 1 if $self->currency_id == $::instance_conf->get_currency_id;

01738ec3 Tamino Steinert
my $rate = (any { $self->is_type($_) } (SALES_QUOTATION_TYPE(), SALES_ORDER_TYPE())) ? 'buy'
: (any { $self->is_type($_) } (REQUEST_QUOTATION_TYPE(), PURCHASE_ORDER_TYPE())) ? 'sell'
e810df1e Bernd Bleßmann
: undef;
return if !$rate;
4b1666b7 Felix Eichler
if (defined $val) {
0956f2d4 Felix Eichler
croak t8('exchange rate has to be positive') if $val <= 0;
4b1666b7 Felix Eichler
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 {
0956f2d4 Felix Eichler
croak t8('exchange rate already exists, no update allowed');
4b1666b7 Felix Eichler
}
}
return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
}

82515b2d Sven Schöling
sub invoices {
my $self = shift;
my %params = @_;

if ($self->quotation) {
return [];
} else {
71e6f43b Sven Schöling
require SL::DB::Invoice;
82515b2d Sven Schöling
return SL::DB::Manager::Invoice->get_all(
query => [
ordnumber => $self->ordnumber,
@{ $params{query} || [] },
]
);
}
}

2746ccd0 Sven Schöling
sub displayable_state {
my ($self) = @_;

return $self->closed ? $::locale->text('closed') : $::locale->text('open');
}

82515b2d Sven Schöling
sub abschlag_invoices {
return shift()->invoices(query => [ abschlag => 1 ]);
}

sub end_invoice {
return shift()->invoices(query => [ abschlag => 0 ]);
}

42ea98b4 Moritz Bunkus
sub convert_to_invoice {
my ($self, %params) = @_;

f4dca613 Moritz Bunkus
croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;

42ea98b4 Moritz Bunkus
my $invoice;
0fdcea4d Moritz Bunkus
if (!$self->db->with_transaction(sub {
c50f0950 Moritz Bunkus
require SL::DB::Invoice;
a4624332 Bernd Bleßmann
$invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
42ea98b4 Moritz Bunkus
$self->update_attributes(closed => 1);
0fdcea4d Moritz Bunkus
1;
42ea98b4 Moritz Bunkus
})) {
return undef;
}

return $invoice;
}

7664f50f Moritz Bunkus
sub convert_to_delivery_order {
c37da034 Moritz Bunkus
my ($self, @args) = @_;
7664f50f Moritz Bunkus
492c85c2 Moritz Bunkus
my $delivery_order;
0fdcea4d Moritz Bunkus
if (!$self->db->with_transaction(sub {
7664f50f Moritz Bunkus
require SL::DB::DeliveryOrder;
492c85c2 Moritz Bunkus
$delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
7664f50f Moritz Bunkus
$delivery_order->save;
fc890e10 Jan Büren
8f413df4 Jan Büren
$self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;
0fdcea4d Moritz Bunkus
1;
7664f50f Moritz Bunkus
})) {
492c85c2 Moritz Bunkus
return undef;
7664f50f Moritz Bunkus
}

492c85c2 Moritz Bunkus
return $delivery_order;
7664f50f Moritz Bunkus
}

eff10782 Tamino Steinert
sub convert_to_reclamation {
my ($self, %params) = @_;
01738ec3 Tamino Steinert
$params{destination_type} = $self->is_sales ? SALES_RECLAMATION_TYPE()
: PURCHASE_RECLAMATION_TYPE();
eff10782 Tamino Steinert
require SL::DB::Reclamation;
my $reclamation = SL::DB::Reclamation->new_from($self, %params);

return $reclamation;
}

b14755d0 Bernd Bleßmann
sub _clone_orderitem_cvar {
my ($cvar) = @_;

my $cloned = $_->clone_and_reset;
$cloned->sub_module('orderitems');

return $cloned;
}

2bef4707 Tamino Steinert
sub create_from_purchase_basket {
my ($class, $basket_item_ids, $vendor_item_ids, $vendor_id) = @_;

my ($vendor, $employee);
$vendor = SL::DB::Manager::Vendor->find_by(id => $vendor_id);
$employee = SL::DB::Manager::Employee->current;

my @orderitem_maps = (); # part, qty, orderer_id
if ($basket_item_ids && scalar @{ $basket_item_ids}) {
my $basket_items = SL::DB::Manager::PurchaseBasketItem->get_all(
query => [ id => $basket_item_ids ],
with_objects => ['part'],
);
push @orderitem_maps, map {{
basket_item_id => $_->id,
part => $_->part,
qty => $_->qty,
orderer_id => $_->orderer_id,
}} @{$basket_items};
}
if ($vendor_item_ids && scalar @{ $vendor_item_ids}) {
my $vendor_items = SL::DB::Manager::Part->get_all(
query => [ id => $vendor_item_ids ] );
push @orderitem_maps, map {{
basket_item_id => undef,
part => $_,
qty => $_->order_qty || 1,
orderer_id => $employee->id,
}} @{$vendor_items};
}

my $order = $class->new(
vendor_id => $vendor->id,
employee_id => $employee->id,
intnotes => $vendor->notes,
salesman_id => $employee->id,
payment_id => $vendor->payment_id,
delivery_term_id => $vendor->delivery_term_id,
taxzone_id => $vendor->taxzone_id,
currency_id => $vendor->currency_id,
b2c069f6 Werner Hahn
transdate => DateTime->today_local,
record_type => PURCHASE_ORDER_TYPE(),
2bef4707 Tamino Steinert
);

my @order_items;
my $i = 0;
foreach my $orderitem_map (@orderitem_maps) {
$i++;
my $part = $orderitem_map->{part};
my $qty = $orderitem_map->{qty};
my $orderer_id = $orderitem_map->{orderer_id};

my $order_item = SL::DB::OrderItem->new(
part => $part,
qty => $qty,
unit => $part->unit,
description => $part->description,
price_factor_id => $part->price_factor_id,
price_factor =>
$part->price_factor_id ? $part->price_factor->factor
: '',
orderer_id => $orderer_id,
position => $i,
);
$order_item->{basket_item_id} = $orderitem_map->{basket_item_id};

my $price_source = SL::PriceSource->new(
record_item => $order_item, record => $order);
$order_item->sellprice(
$price_source->best_price ? $price_source->best_price->price
: 0);
$order_item->active_price_source(
$price_source->best_price ? $price_source->best_price->source
: '');
push @order_items, $order_item;
}

$order->assign_attributes(orderitems => \@order_items);

$order->calculate_prices_and_taxes;

foreach my $item(@{ $order->orderitems }){
$item->parse_custom_variable_values;
$item->{custom_variables} = \@{ $item->cvars_by_config };
}

return $order;
}

b14755d0 Bernd Bleßmann
sub new_from {
my ($class, $source, %params) = @_;

eff10782 Tamino Steinert
unless (any {ref($source) eq $_} qw(
SL::DB::Order
SL::DB::Reclamation
)) {
croak("Unsupported source object type '" . ref($source) . "'");
}
5af5ceee Bernd Bleßmann
croak("A destination type must be given as parameter") unless $params{destination_type};
b14755d0 Bernd Bleßmann
my $destination_type = delete $params{destination_type};
f747a789 Bernd Bleßmann
my @from_tos = (
f781cda4 Bernd Bleßmann
{ from => SALES_QUOTATION_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'sqso' },
{ from => REQUEST_QUOTATION_TYPE(), to => PURCHASE_ORDER_TYPE(), abbr => 'rqpo' },
{ from => SALES_QUOTATION_TYPE(), to => SALES_QUOTATION_TYPE(), abbr => 'sqsq' },
{ from => SALES_ORDER_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'soso' },
{ from => REQUEST_QUOTATION_TYPE(), to => REQUEST_QUOTATION_TYPE(), abbr => 'rqrq' },
{ from => PURCHASE_ORDER_TYPE(), to => PURCHASE_ORDER_TYPE(), abbr => 'popo' },
{ from => SALES_ORDER_TYPE(), to => PURCHASE_ORDER_TYPE(), abbr => 'sopo' },
{ from => PURCHASE_ORDER_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'poso' },
{ from => SALES_ORDER_TYPE(), to => SALES_QUOTATION_TYPE(), abbr => 'sosq' },
{ from => PURCHASE_ORDER_TYPE(), to => REQUEST_QUOTATION_TYPE(), abbr => 'porq' },
{ from => REQUEST_QUOTATION_TYPE(), to => SALES_QUOTATION_TYPE(), abbr => 'rqsq' },
{ from => REQUEST_QUOTATION_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'rqso' },
{ from => SALES_QUOTATION_TYPE(), to => REQUEST_QUOTATION_TYPE(), abbr => 'sqrq' },
{ from => SALES_ORDER_TYPE(), to => REQUEST_QUOTATION_TYPE(), abbr => 'sorq' },
{ from => SALES_RECLAMATION_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'srso' },
{ from => PURCHASE_RECLAMATION_TYPE(), to => PURCHASE_ORDER_TYPE(), abbr => 'prpo' },
{ from => SALES_ORDER_INTAKE_TYPE(), to => SALES_ORDER_INTAKE_TYPE(), abbr => 'soisoi' },
{ from => SALES_ORDER_INTAKE_TYPE(), to => SALES_QUOTATION_TYPE(), abbr => 'soisq' },
{ from => SALES_ORDER_INTAKE_TYPE(), to => REQUEST_QUOTATION_TYPE(), abbr => 'soirq' },
{ from => SALES_ORDER_INTAKE_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'soiso' },
{ from => SALES_ORDER_INTAKE_TYPE(), to => PURCHASE_ORDER_TYPE(), abbr => 'soipo' },
{ from => SALES_QUOTATION_TYPE(), to => SALES_ORDER_INTAKE_TYPE(), abbr => 'sqsoi' },
{ from => PURCHASE_QUOTATION_INTAKE_TYPE(), to => PURCHASE_QUOTATION_INTAKE_TYPE(), abbr => 'pqipqi' },
{ from => PURCHASE_QUOTATION_INTAKE_TYPE(), to => SALES_QUOTATION_TYPE(), abbr => 'pqisq' },
{ from => PURCHASE_QUOTATION_INTAKE_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'pqiso' },
{ from => PURCHASE_QUOTATION_INTAKE_TYPE(), to => PURCHASE_ORDER_TYPE(), abbr => 'pqipo' },
{ from => REQUEST_QUOTATION_TYPE(), to => PURCHASE_QUOTATION_INTAKE_TYPE(), abbr => 'rqpqi' },
55f3c5e6 Bernd Bleßmann
{ from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => PURCHASE_ORDER_CONFIRMATION_TYPE(), abbr => 'pocpoc' },
{ from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => SALES_QUOTATION_TYPE(), abbr => 'pocsq' },
{ from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => SALES_ORDER_TYPE(), abbr => 'pocso' },
{ from => PURCHASE_ORDER_CONFIRMATION_TYPE(), to => PURCHASE_ORDER_TYPE(), abbr => 'pocpo' },
f781cda4 Bernd Bleßmann
{ from => PURCHASE_ORDER_TYPE(), to => PURCHASE_ORDER_CONFIRMATION_TYPE(), abbr => 'popoc' },
f747a789 Bernd Bleßmann
);
32cb209c Bernd Bleßmann
my $from_to = (grep { $_->{from} eq $source->record_type && $_->{to} eq $destination_type} @from_tos)[0];
croak("Cannot convert from '" . $source->record_type . "' to '" . $destination_type . "'") if !$from_to;
b14755d0 Bernd Bleßmann
69966b4c Bernd Bleßmann
my $is_abbr_any = sub {
f4632ae8 Bernd Bleßmann
my (@abbrs) = @_;

my $missing_abbr;
if (any { $missing_abbr = $_; !grep { $_->{abbr} eq $missing_abbr } @from_tos } @abbrs) {
die "no such workflow abbreviation '$missing_abbr'";
}

any { $from_to->{abbr} eq $_ } @abbrs;
69966b4c Bernd Bleßmann
};

eff10782 Tamino Steinert
my %args;
if (ref($source) eq 'SL::DB::Order') {
%args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
department_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 billing_address_id
)),
closed => 0,
delivered => 0,
transdate => DateTime->today_local,
employee => SL::DB::Manager::Employee->current,
);
# reqdate in quotation is 'offer is valid until reqdate'
# reqdate in order is 'will be delivered until reqdate'
# both dates are setable (on|off)
# and may have a additional interval in days (+ n days)
# dies if this convention will change
$args{reqdate} = $from_to->{to} =~ m/_quotation$/
? $::instance_conf->get_reqdate_on
? DateTime->today_local->next_workday(extra_days => $::instance_conf->get_reqdate_interval)->to_kivitendo
: undef
: $from_to->{to} =~ m/_order$/
? $::instance_conf->get_deliverydate_on
? DateTime->today_local->next_workday(extra_days => $::instance_conf->get_delivery_date_interval)->to_kivitendo
: undef
73192307 Jan Büren
: $from_to->{to} =~ m/^sales_order_intake$/
# ? $source->reqdate
? undef
9a47a2b9 Bernd Bleßmann
: $from_to->{to} =~ m/^purchase_quotation_intake$/
? $source->reqdate
55f3c5e6 Bernd Bleßmann
: $from_to->{to} =~ m/^purchase_order_confirmation$/
? $source->reqdate
eff10782 Tamino Steinert
: die "Wrong state for reqdate";
} elsif ( ref($source) eq 'SL::DB::Reclamation') {
%args = ( map({ ( $_ => $source->$_ ) } qw(
dc28e1c2 Tamino Steinert
amount billing_address_id currency_id customer_id delivery_term_id department_id
eff10782 Tamino Steinert
exchangerate globalproject_id intnotes language_id netamount
notes payment_id reqdate salesman_id shippingpoint shipvia taxincluded
tax_point taxzone_id transaction_description vendor_id
)),
cp_id => $source->{contact_id},
closed => 0,
delivered => 0,
transdate => DateTime->today_local,
employee => SL::DB::Manager::Employee->current,
);
}
b14755d0 Bernd Bleßmann
55f3c5e6 Bernd Bleßmann
if ( $is_abbr_any->(qw(soipo sopo poso rqso soisq sosq porq rqsq sqrq soirq sorq pqisq pqiso pocsq pocso)) ) {
69966b4c Bernd Bleßmann
$args{ordnumber} = undef;
80970e1d Jan Büren
$args{quonumber} = undef;
69966b4c Bernd Bleßmann
}
ee6fe6b9 Bernd Bleßmann
if ( $is_abbr_any->(qw(soipo sopo sqrq soirq sorq)) ) {
69966b4c Bernd Bleßmann
$args{customer_id} = undef;
$args{salesman_id} = undef;
$args{payment_id} = undef;
$args{delivery_term_id} = undef;
}
55f3c5e6 Bernd Bleßmann
if ( $is_abbr_any->(qw(poso rqsq pqisq pqiso pocsq pocso)) ) {
69966b4c Bernd Bleßmann
$args{vendor_id} = undef;
}
f1d33e8c Bernd Bleßmann
if ( $is_abbr_any->(qw(soso)) ) {
$args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
}
ee6fe6b9 Bernd Bleßmann
if ( $is_abbr_any->(qw(sqrq soirq sorq)) ) {
cc5d0de1 Bernd Bleßmann
$args{cusordnumber} = undef;
}
55f3c5e6 Bernd Bleßmann
if ( $is_abbr_any->(qw(soiso pocpoc pocpo popoc)) ) {
ee6fe6b9 Bernd Bleßmann
$args{ordnumber} = undef;
}
9a47a2b9 Bernd Bleßmann
if ( $is_abbr_any->(qw(rqpqi pqisq)) ) {
$args{quonumber} = undef;
}
69966b4c Bernd Bleßmann
b14755d0 Bernd Bleßmann
# Custom shipto addresses (the ones specific to the sales/purchase
# record and not to the customer/vendor) are only linked from
951ebae4 Bernd Bleßmann
# shipto → order. Meaning order.shipto_id
b14755d0 Bernd Bleßmann
# 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;
}

30710024 Tamino Steinert
$args{record_type} = $destination_type;

b14755d0 Bernd Bleßmann
my $order = $class->new(%args);
$order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
my $items = delete($params{items}) || $source->items_sorted;
842d6c44 Bernd Bleßmann
b14755d0 Bernd Bleßmann
my @items = map {
my $source_item = $_;
my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };

eff10782 Tamino Steinert
my $current_oe_item;
if (ref($source) eq 'SL::DB::Order') {
$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
405d828a Bernd Bleßmann
optional recurring_billing_mode position
eff10782 Tamino Steinert
)),
custom_variables => \@custom_variables,
);
} elsif (ref($source) eq 'SL::DB::Reclamation') {
$current_oe_item = SL::DB::OrderItem->new(
map({ ( $_ => $source_item->$_ ) } qw(
active_discount_source active_price_source base_qty description
discount lastcost longdescription parts_id price_factor
price_factor_id pricegroup_id project_id qty reqdate sellprice
405d828a Bernd Bleßmann
serialnumber unit position
eff10782 Tamino Steinert
)),
custom_variables => \@custom_variables,
);
}
ee6fe6b9 Bernd Bleßmann
if ( $is_abbr_any->(qw(soipo sopo)) ) {
69966b4c Bernd Bleßmann
$current_oe_item->sellprice($source_item->lastcost);
$current_oe_item->discount(0);
}
55f3c5e6 Bernd Bleßmann
if ( $is_abbr_any->(qw(poso rqsq rqso pqisq pqiso pocsq pocso)) ) {
69966b4c Bernd Bleßmann
$current_oe_item->lastcost($source_item->sellprice);
}
59d7ab3c Tamino Steinert
unless ($params{no_linked_records}) {
c94dbd0e Tamino Steinert
$current_oe_item->{ RECORD_ITEM_ID() } = $source_item->{id};
59d7ab3c Tamino Steinert
$current_oe_item->{ RECORD_ITEM_TYPE_REF() } = ref($source_item);
}
b14755d0 Bernd Bleßmann
$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);

59d7ab3c Tamino Steinert
unless ($params{no_linked_records}) {
f781cda4 Bernd Bleßmann
$order->{ RECORD_ID() } = $source->{id};
59d7ab3c Tamino Steinert
$order->{ RECORD_TYPE_REF() } = ref($source);
}
c84c3960 Sven Schöling
b14755d0 Bernd Bleßmann
return $order;
}

842d6c44 Bernd Bleßmann
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;
9c463903 Bernd Bleßmann
foreach my $attr (qw(ordnumber transdate reqdate tax_point taxincluded shippingpoint
842d6c44 Bernd Bleßmann
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;
}
5c8a0b36 Bernd Bleßmann
foreach my $attr (qw(cp_id currency_id salesman_id department_id
842d6c44 Bernd Bleßmann
delivery_customer_id delivery_vendor_id shipto_id
598383b3 Bernd Bleßmann
globalproject_id exchangerate)) {
842d6c44 Bernd Bleßmann
$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;

5c8a0b36 Bernd Bleßmann
# set emplyee to the current one
$attributes{employee} = SL::DB::Manager::Employee->current;

842d6c44 Bernd Bleßmann
# 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],
01738ec3 Tamino Steinert
destination_type => SALES_ORDER_TYPE(),
842d6c44 Bernd Bleßmann
attributes => \%attributes,
items => \@items,
%params);
c94dbd0e Tamino Steinert
$order->{RECORD_ID()} = join ' ', map { $_->id } @$sources; # link all sources
842d6c44 Bernd Bleßmann
return $order;
}

3a4ddae0 Sven Schöling
sub number {
my $self = shift;

35842cc3 Tamino Steinert
my $nr_key = $self->type_data->properties('nr_key');
return $self->$nr_key(@_);
3a4ddae0 Sven Schöling
}

9589ecd7 Sven Schöling
sub customervendor {
c32c45bf Bernd Bleßmann
$_[0]->type_data->properties('is_customer') ? $_[0]->customer : $_[0]->vendor;
9589ecd7 Sven Schöling
}

16c6be41 Moritz Bunkus
sub date {
goto &transdate;
}

23c5a950 Sven Schöling
sub digest {
my ($self) = @_;

sprintf "%s %s %s (%s)",
$self->number,
$self->customervendor->name,
$self->amount_as_number,
$self->date->to_kivitendo;
}

70ae535d Jan Büren
sub current_version_number {
my ($self) = @_;

my $query = <<EOSQL;
SELECT max(version)
FROM oe_version
WHERE (oe_id = ?)
EOSQL

my ($current_version_number) = SL::DBUtils::selectfirst_array_query($::form, $self->db->dbh, $query, ($self->id));
die "Invalid State. No version linked" unless $current_version_number;

return $current_version_number;
}

sub is_final_version {
my ($self) = @_;

4a5f2dea Bernd Bleßmann
my $order_versions_count = SL::DB::Manager::OrderVersion->get_all_count(where => [ oe_id => $self->id, final_version => 0 ]);
die "Invalid version state" unless $order_versions_count < 2;
my $final_version = $order_versions_count == 1 ? 0 : 1;
70ae535d Jan Büren
return $final_version;
}

48f45a37 Bernd Bleßmann
sub increment_version_number {
my ($self) = @_;

die t8('This sub-version is not yet finalized') if !$self->is_final_version;

my $current_version_number = $self->current_version_number;
my $new_version_number = $current_version_number + 1;

my $new_number = $self->number;
$new_number =~ s/-$current_version_number$//;
$self->number($new_number . '-' . $new_version_number);
$self->add_order_version(SL::DB::OrderVersion->new(version => $new_version_number));
}

5a6d7c03 Geoffrey Richardson
sub netamount_base_currency {
my ($self) = @_;

return $self->netamount unless $self->forex;

if ( defined $self->exchangerate ) {
return $self->netamount * $self->exchangerate;
} else {
return $self->netamount * $self->daily_exchangerate;
}
}

a669a530 Bernd Bleßmann
sub preceding_purchase_orders {
my ($self) = @_;

my @lrs = ();
if ($self->id) {
@lrs = grep { $_->record_type eq PURCHASE_ORDER_TYPE() } @{$self->linked_records(from => 'SL::DB::Order')};
} else {
if ('SL::DB::Order' eq $self->{RECORD_TYPE_REF()}) {
my $order = SL::DB::Order->load_cached($self->{RECORD_ID()});
push @lrs, $order if $order->record_type eq PURCHASE_ORDER_TYPE();
}
}

return \@lrs;
}

d57a4596 Sven Schöling
sub type_data {
SL::DB::Helper::TypeDataProxy->new(ref $_[0], $_[0]->type);
}

82515b2d Sven Schöling
1;

__END__

5af4094b Moritz Bunkus
=pod

=encoding utf8

82515b2d Sven Schöling
=head1 NAME

SL::DB::Order - Order Datenbank Objekt.

=head1 FUNCTIONS

d80ffb81 Sven Schöling
=head2 C<type>
82515b2d Sven Schöling
Returns one of the following string types:

=over 4

d80ffb81 Sven Schöling
=item sales_order
82515b2d Sven Schöling
=item purchase_order

=item sales_quotation

=item request_quotation

=back

d80ffb81 Sven Schöling
=head2 C<is_type TYPE>
82515b2d Sven Schöling
d80ffb81 Sven Schöling
Returns true if the order is of the given type.
82515b2d Sven Schöling
b1817cb6 Bernd Bleßmann
=head2 C<daily_exchangerate $val>

Gets or sets the exchangerate object's value. This is the value from the
table C<exchangerate> depending on the order's currency, the transdate and
if it is a sales or purchase order.

The order object (respectively the table C<oe>) has an own column
C<exchangerate> which can be get or set with the accessor C<exchangerate>.

The idea is to drop the legacy table C<exchangerate> in the future and to
give all relevant tables it's own C<exchangerate> 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

7664f50f Moritz Bunkus
=head2 C<convert_to_delivery_order %params>

Creates a new delivery order with C<$self> as the basis by calling
L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
1c9c1ad9 Moritz Bunkus
C<$self> is linked to the new invoice via
L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
C<true>, and C<$self> is saved.
7664f50f Moritz Bunkus
The arguments in C<%params> are passed to
L<SL::DB::DeliveryOrder::new_from>.

492c85c2 Moritz Bunkus
Returns C<undef> on failure. Otherwise the new delivery order will be
returned.
7664f50f Moritz Bunkus
d80ffb81 Sven Schöling
=head2 C<convert_to_invoice %params>
62bb3c51 Moritz Bunkus
Creates a new invoice with C<$self> as the basis by calling
L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
C<closed> attribute is set to C<true>, and C<$self> is saved.

a4624332 Bernd Bleßmann
The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
62bb3c51 Moritz Bunkus
78600d89 Moritz Bunkus
Returns the new invoice instance on success and C<undef> on
failure. The whole process is run inside a transaction. On failure
nothing is created or changed in the database.
62bb3c51 Moritz Bunkus
At the moment only sales quotations and sales orders can be converted.

b14755d0 Bernd Bleßmann
=head2 C<new_from $source, %params>

Creates a new C<SL::DB::Order> instance and copies as much
951ebae4 Bernd Bleßmann
information from C<$source> as possible. At the moment only records with the
same destination type as the source type and sales orders from
b14755d0 Bernd Bleßmann
sales quotations and purchase orders from requests for quotations can be
created.

The C<transdate> 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<destination_type> is mandatory):

=over 4

=item C<destination_type>

(mandatory)
951ebae4 Bernd Bleßmann
The type of the newly created object. Can be C<sales_quotation>,
C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
b14755d0 Bernd Bleßmann
=item C<items>

An optional array reference of RDBO instances for the items to use. If
missing then the method C<items_sorted> 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<skip_items_negative_qty>

If trueish then items with a negative quantity are skipped. Items with
a quantity of 0 are not affected by this option.

=item C<skip_items_zero_qty>

If trueish then items with a quantity of 0 are skipped.

=item C<item_filter>

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<attributes>

An optional hash reference. If it exists then it is passed to C<new>
allowing the caller to set certain attributes for the new delivery
order.

=back

842d6c44 Bernd Bleßmann
=head2 C<new_from_multi $sources, %params>

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 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.

C<params> other then C<sort_sources_by> are passed to C<new_from>.

7f3b8a99 Bernd Bleßmann
=head2 C<increment_version_number>

Checks if the current version of the order is finalized, increments
the version number and adds a new order_version to the order.
Dies if the version is not final.

82515b2d Sven Schöling
=head1 BUGS

Nothing here yet.

=head1 AUTHOR

05c6840d Moritz Bunkus
Sven Schöling <s.schoeling@linet-services.de>
82515b2d Sven Schöling
=cut