Projekt

Allgemein

Profil

Herunterladen (17,8 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/DB/DeliveryOrder.pm @ 4356a33c

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

use strict;

a93f1e39 Moritz Bunkus
use Carp;

2714604a Moritz Bunkus
use Rose::DB::Object::Helpers ();

82515b2d Sven Schöling
use SL::DB::MetaSetup::DeliveryOrder;
use SL::DB::Manager::DeliveryOrder;
a34c05f3 Moritz Bunkus
use SL::DB::Helper::AttrHTML;
f63af42d Moritz Bunkus
use SL::DB::Helper::AttrSorted;
a60c6759 Moritz Bunkus
use SL::DB::Helper::FlattenToForm;
b9dbc9e3 Moritz Bunkus
use SL::DB::Helper::LinkedRecords;
use SL::DB::Helper::TransNumberGenerator;
82515b2d Sven Schöling
2632ced6 Bernd Bleßmann
use SL::DB::Part;
use SL::DB::Unit;

2cbd0263 Sven Schöling
use SL::DB::DeliveryOrder::TypeData qw(:types);
632f0308 Sven Schöling
2632ced6 Bernd Bleßmann
use SL::Helper::Number qw(_format_total _round_total);

1f2a5b4c Bernd Bleßmann
use List::Util qw(first);
af81f05f Bernd Bleßmann
use List::MoreUtils qw(any pairwise);
a72219a9 Jan Büren
use Math::Round qw(nhimult);
82515b2d Sven Schöling
__PACKAGE__->meta->add_relationship(orderitems => { type => 'one to many',
class => 'SL::DB::DeliveryOrderItem',
20f266d2 Bernd Bleßmann
column_map => { id => 'delivery_order_id' },
0845c4b7 Moritz Bunkus
manager_args => { with_objects => [ 'part' ] }
82515b2d Sven Schöling
},
325c539c Moritz Bunkus
custom_shipto => {
type => 'one to one',
class => 'SL::DB::Shipto',
column_map => { id => 'trans_id' },
query_args => [ module => 'DO' ],
},
82515b2d Sven Schöling
);

__PACKAGE__->meta->initialize;

a34c05f3 Moritz Bunkus
__PACKAGE__->attr_html('notes');
f63af42d Moritz Bunkus
__PACKAGE__->attr_sorted('items');
a34c05f3 Moritz Bunkus
08d2e0ca Moritz Bunkus
__PACKAGE__->before_save('_before_save_set_donumber');

# hooks

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

$self->create_trans_number if !$self->donumber;

return 1;
}

82515b2d Sven Schöling
# methods

4ac74078 Moritz Bunkus
sub items { goto &orderitems; }
ae906113 Moritz Bunkus
sub add_items { goto &add_orderitems; }
464f44ac Moritz Bunkus
sub payment_terms { goto &payment; }
4f7e0fa9 Geoffrey Richardson
sub record_number { goto &donumber; }
4ac74078 Moritz Bunkus
82515b2d Sven Schöling
sub sales_order {
my $self = shift;
my %params = @_;

f7e89226 Sven Schöling
require SL::DB::Order;
82515b2d Sven Schöling
my $orders = SL::DB::Manager::Order->get_all(
query => [
ordnumber => $self->ordnumber,
@{ $params{query} || [] },
],
);

return first { $_->is_type('sales_order') } @{ $orders };
}

2746ccd0 Sven Schöling
sub type {
632f0308 Sven Schöling
goto &order_type;
2746ccd0 Sven Schöling
}

1230932e Sven Schöling
sub is_type {
return shift->type eq shift;
}

b3dcf24a Geoffrey Richardson
sub displayable_type {
my $type = shift->type;

return $::locale->text('Sales Delivery Order') if $type eq 'sales_delivery_order';
return $::locale->text('Purchase Delivery Order') if $type eq 'purchase_delivery_order';

die 'invalid type';
}

a7114646 Geoffrey Richardson
sub displayable_name {
join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
};
b3dcf24a Geoffrey Richardson
2746ccd0 Sven Schöling
sub displayable_state {
my ($self) = @_;

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

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

717e8508 Sven Schöling
sub number {
goto &donumber;
}

2714604a Moritz Bunkus
sub _clone_orderitem_cvar {
my ($cvar) = @_;

da6a187a Moritz Bunkus
my $cloned = $_->clone_and_reset;
2714604a Moritz Bunkus
$cloned->sub_module('delivery_order_items');

return $cloned;
}

7664f50f Moritz Bunkus
sub new_from {
my ($class, $source, %params) = @_;

croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';

f4de41a2 Moritz Bunkus
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';
}

3572290b Bernd Bleßmann
my %args = ( map({ ( $_ => $source->$_ ) } qw(cp_id currency_id customer_id cusordnumber delivery_term_id department_id employee_id globalproject_id intnotes language_id notes
844a541e Moritz Bunkus
ordnumber payment_id reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id transaction_description vendor_id billing_address_id
7664f50f Moritz Bunkus
)),
closed => 0,
delivered => 0,
7335b28f Sven Schöling
order_type => $params{type},
7664f50f Moritz Bunkus
transdate => DateTime->today_local,
);

# Custom shipto addresses (the ones specific to the sales/purchase
# record and not to the customer/vendor) are only linked from
492c85c2 Moritz Bunkus
# shipto → delivery_orders. Meaning delivery_orders.shipto_id
# will not be filled in that case.
7664f50f Moritz Bunkus
if (!$source->shipto_id && $source->id) {
492c85c2 Moritz Bunkus
$args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
7664f50f Moritz Bunkus
} else {
$args{shipto_id} = $source->shipto_id;
}

632f0308 Sven Schöling
# infer type from legacy fields if not given
a16a5999 Sven Schöling
$args{order_type} //= $source->customer_id ? 'sales_delivery_order'
: $source->vendor_id ? 'purchase_delivery_order'
: $source->is_sales ? 'sales_delivery_order'
: croak "need some way to set delivery order type from source";
632f0308 Sven Schöling
6473dcb1 Moritz Bunkus
my $delivery_order = $class->new(%args);
$delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
53aad992 Moritz Bunkus
my $items = delete($params{items}) || $source->items_sorted;
f4de41a2 Moritz Bunkus
my %item_parents;
7664f50f Moritz Bunkus
4356a33c Sven Schöling
# do not copy items when converting to supplier delivery order
my @items = $delivery_order->is_type(SUPPLIER_DELIVERY_ORDER_TYPE) ? () : map {
2714604a Moritz Bunkus
my $source_item = $_;
f4de41a2 Moritz Bunkus
my $source_item_id = $_->$item_parent_id_column;
2714604a Moritz Bunkus
my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };

f4de41a2 Moritz Bunkus
$item_parents{$source_item_id} ||= $source_item->$item_parent_column;
my $item_parent = $item_parents{$source_item_id};

fc890e10 Jan Büren
my $current_do_item = SL::DB::DeliveryOrderItem->new(map({ ( $_ => $source_item->$_ ) }
f4de41a2 Moritz Bunkus
qw(base_qty cusordnumber description discount lastcost longdescription marge_price_factor parts_id price_factor price_factor_id
a94080db Moritz Bunkus
project_id qty reqdate sellprice serialnumber transdate unit active_discount_source active_price_source
2714604a Moritz Bunkus
)),
f4de41a2 Moritz Bunkus
custom_variables => \@custom_variables,
ordnumber => ref($item_parent) eq 'SL::DB::Order' ? $item_parent->ordnumber : $source_item->ordnumber,
);
fc890e10 Jan Büren
$current_do_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
$current_do_item;
53aad992 Moritz Bunkus
} @{ $items };
7664f50f Moritz Bunkus
bbb98e03 Moritz Bunkus
@items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
c37da034 Moritz Bunkus
@items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
f9fdf190 Moritz Bunkus
@items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
c37da034 Moritz Bunkus
7664f50f Moritz Bunkus
$delivery_order->items(\@items);

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

2632ced6 Bernd Bleßmann
sub new_from_time_recordings {
my ($class, $sources, %params) = @_;

croak("Unsupported object type in sources") if any { ref($_) ne 'SL::DB::TimeRecording' } @$sources;
croak("Cannot create delivery order from source records of different customers") if any { $_->customer_id != $sources->[0]->customer_id } @$sources;

# - one item per part (article)
# - qty is sum of duration
# - description goes to item longdescription
# - ordered and summed by date
# - each description goes to an ordered list
# - (as time recording descriptions are formatted text by now, use stripped text)
459b3c8d Bernd Bleßmann
# - merge same descriptions
2632ced6 Bernd Bleßmann
#

662df9d7 Bernd Bleßmann
my $default_part_id = $params{default_part_id} ? $params{default_part_id}
: $params{default_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{default_partnumber})->id
: undef;
my $override_part_id = $params{override_part_id} ? $params{override_part_id}
: $params{override_partnumber} ? SL::DB::Manager::Part->find_by(partnumber => $params{override_partnumber})->id
: undef;
2632ced6 Bernd Bleßmann
# check parts and collect entries
my %part_by_part_id;
my $entries;
foreach my $source (@$sources) {
68f05425 Bernd Bleßmann
next if !$source->duration;

662df9d7 Bernd Bleßmann
my $part_id = $override_part_id;
$part_id ||= $source->part_id;
$part_id ||= $default_part_id;
2632ced6 Bernd Bleßmann
die 'article not found for entry "' . $source->displayable_times . '"' if !$part_id;

if (!$part_by_part_id{$part_id}) {
$part_by_part_id{$part_id} = SL::DB::Part->new(id => $part_id)->load;
die 'article unit must be time based for entry "' . $source->displayable_times . '"' if !$part_by_part_id{$part_id}->unit_obj->is_time_based;
}

78edb322 Bernd Bleßmann
my $date = $source->date->to_kivitendo;
c968d1f7 Bernd Bleßmann
$entries->{$part_id}->{$date}->{duration} += $params{rounding}
f6a49074 Bernd Bleßmann
? nhimult(0.25, ($source->duration_in_hours))
: _round_total($source->duration_in_hours);
2851ec9a Jan Büren
# add content if not already in description
d1a7b626 Bernd Bleßmann
my $new_description = '' . $source->description_as_stripped_html;
$entries->{$part_id}->{$date}->{content} ||= '';
2851ec9a Jan Büren
$entries->{$part_id}->{$date}->{content} .= '<li>' . $new_description . '</li>'
unless $entries->{$part_id}->{$date}->{content} =~ m/\Q$new_description/;

78edb322 Bernd Bleßmann
$entries->{$part_id}->{$date}->{date_obj} = $source->start_time || $source->date; # for sorting
2632ced6 Bernd Bleßmann
}

08704bc4 Bernd Bleßmann
my @items;

2632ced6 Bernd Bleßmann
my $h_unit = SL::DB::Manager::Unit->find_h_unit;

my @keys = sort { $part_by_part_id{$a}->partnumber cmp $part_by_part_id{$b}->partnumber } keys %$entries;
foreach my $key (@keys) {
my $qty = 0;
my $longdescription = '';

my @dates = sort { $entries->{$key}->{$a}->{date_obj} <=> $entries->{$key}->{$b}->{date_obj} } keys %{$entries->{$key}};
foreach my $date (@dates) {
my $entry = $entries->{$key}->{$date};

$qty += $entry->{duration};
$longdescription .= $date . ' <strong>' . _format_total($entry->{duration}) . ' h</strong>';
$longdescription .= '<ul>';
$longdescription .= $entry->{content};
$longdescription .= '</ul>';
}

my $item = SL::DB::DeliveryOrderItem->new(
parts_id => $part_by_part_id{$key}->id,
description => $part_by_part_id{$key}->description,
qty => $qty,
42c64631 Bernd Bleßmann
base_qty => $h_unit->convert_to($qty, $part_by_part_id{$key}->unit_obj),
2632ced6 Bernd Bleßmann
unit_obj => $h_unit,
42c64631 Bernd Bleßmann
sellprice => $part_by_part_id{$key}->sellprice, # Todo: use price rules to get sellprice
2632ced6 Bernd Bleßmann
longdescription => $longdescription,
);

08704bc4 Bernd Bleßmann
push @items, $item;
}

my $delivery_order;

if ($params{related_order}) {
9c2d09b8 Bernd Bleßmann
# collect suitable items in related order
my @items_to_use;
af81f05f Bernd Bleßmann
my @new_attributes;
9c2d09b8 Bernd Bleßmann
foreach my $item (@items) {
my $item_to_use = first {$item->parts_id == $_->parts_id} @{ $params{related_order}->items_sorted };

die "no suitable item found in related order" if !$item_to_use;

my %new_attributes;
af81f05f Bernd Bleßmann
$new_attributes{$_} = $item->$_ for qw(qty base_qty unit_obj longdescription);
push @items_to_use, $item_to_use;
push @new_attributes, \%new_attributes;
9c2d09b8 Bernd Bleßmann
}
af81f05f Bernd Bleßmann
$delivery_order = $class->new_from($params{related_order}, items => \@items_to_use, %params);
pairwise { $a->assign_attributes( %$b) } @{$delivery_order->items}, @new_attributes;
08704bc4 Bernd Bleßmann
} else {
my %args = (
is_sales => 1,
632f0308 Sven Schöling
order_type => 'sales_delivery_order',
08704bc4 Bernd Bleßmann
delivered => 0,
customer_id => $sources->[0]->customer_id,
taxzone_id => $sources->[0]->customer->taxzone_id,
currency_id => $sources->[0]->customer->currency_id,
employee_id => SL::DB::Manager::Employee->current->id,
salesman_id => SL::DB::Manager::Employee->current->id,
items => \@items,
);
$delivery_order = $class->new(%args);
$delivery_order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
2632ced6 Bernd Bleßmann
}

return $delivery_order;
}

632f0308 Sven Schöling
# legacy for compatibility
# use type_data cusomtervendor and transfer direction instead
sub is_sales {
a16a5999 Sven Schöling
if ($_[0]->order_type) {
2cbd0263 Sven Schöling
return SL::DB::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer");
a16a5999 Sven Schöling
}
return $_[0]{is_sales};
632f0308 Sven Schöling
}

44310118 Jan Büren
sub customervendor {
2cbd0263 Sven Schöling
SL::DB::DeliveryOrder::TypeData::get3($_[0]->order_type, "properties", "is_customer") ? $_[0]->customer : $_[0]->vendor;
44310118 Jan Büren
}

a7ca8ba2 Jan Büren
sub convert_to_invoice {
my ($self, %params) = @_;

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

my $invoice;
if (!$self->db->with_transaction(sub {
require SL::DB::Invoice;
38666007 Jan Büren
$invoice = SL::DB::Invoice->new_from($self, %params)->post || die;
a7ca8ba2 Jan Büren
$self->link_to_record($invoice);
fc890e10 Jan Büren
# TODO extend link_to_record for items, otherwise long-term no d.r.y.
a7ca8ba2 Jan Büren
foreach my $item (@{ $invoice->items }) {
fc890e10 Jan Büren
foreach (qw(delivery_order_items)) { # expand if needed (orderitems)
a7ca8ba2 Jan Büren
if ($item->{"converted_from_${_}_id"}) {
die unless $item->{id};
RecordLinks->create_links('mode' => 'ids',
'from_table' => $_,
'from_ids' => $item->{"converted_from_${_}_id"},
'to_table' => 'invoice',
'to_id' => $item->{id},
) || die;
delete $item->{"converted_from_${_}_id"};
}
}
}
$self->update_attributes(closed => 1);
1;
})) {
return undef;
}

return $invoice;
}

0c227fb2 Moritz Bunkus
sub digest {
my ($self) = @_;

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

82515b2d Sven Schöling
1;
7664f50f Moritz Bunkus
__END__

=pod

=encoding utf8

=head1 NAME

SL::DB::DeliveryOrder - Rose model for delivery orders (table
"delivery_orders")

=head1 FUNCTIONS

=over 4

=item C<date>

46f7dbff Moritz Bunkus
An alias for C<transdate> for compatibility with other sales/purchase models.
7664f50f Moritz Bunkus
51264c43 Geoffrey Richardson
=item C<displayable_name>

Returns a human-readable and translated description of the delivery order, consisting of
record type and number, e.g. "Verkaufslieferschein 123".

7664f50f Moritz Bunkus
=item C<displayable_state>

Returns a human-readable description of the state regarding being
closed and delivered.

=item C<items>

51264c43 Geoffrey Richardson
An alias for C<delivery_order_items> for compatibility with other
7664f50f Moritz Bunkus
sales/purchase models.

c37da034 Moritz Bunkus
=item C<new_from $source, %params>
7664f50f Moritz Bunkus
Creates a new C<SL::DB::DeliveryOrder> instance and copies as much
information from C<$source> as possible. At the moment only instances
of C<SL::DB::Order> (sales quotations, sales orders, requests for
quotations and purchase orders) are supported as sources.

The conversion copies order items into delivery order items. Dates are copied
as appropriate, e.g. the C<transdate> field will be set to the current date.

492c85c2 Moritz Bunkus
Returns the new delivery order instance. The object returned is not
saved.
7664f50f Moritz Bunkus
c37da034 Moritz Bunkus
C<%params> can include the following options:

=over 2

53aad992 Moritz Bunkus
=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.

f9fdf190 Moritz Bunkus
=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.

c37da034 Moritz Bunkus
=item C<skip_items_zero_qty>

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

bbb98e03 Moritz Bunkus
=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.

c37da034 Moritz Bunkus
=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

2632ced6 Bernd Bleßmann
=item C<new_from_time_recordings $sources, %params>

f6a49074 Bernd Bleßmann
Creates a new C<SL::DB::DeliveryOrder> instance from the time recordings
2632ced6 Bernd Bleßmann
given as C<$sources>. All time recording entries must belong to the same
customer. Time recordings are sorted by article and date. For each article
a new delivery order item is created. If no article is associated with an
662df9d7 Bernd Bleßmann
entry, a default article will be used. The article given in the time
recording entry can be overriden.
2632ced6 Bernd Bleßmann
Entries of the same date (for each article) are summed together and form a
list entry in the long description of the item.

The created delivery order object will be returnd but not saved.

C<$sources> must be an array reference of C<SL::DB::TimeRecording> instances.

C<%params> can include the following options:

=over 2

=item C<attributes>

An optional hash reference. If it exists then it is used to set
attributes of the newly created delivery order object.

662df9d7 Bernd Bleßmann
=item C<default_part_id>

An optional part id which is used as default value if no part is set
in the time recording entry.

=item C<default_partnumber>

Like C<default_part_id> but given as partnumber, not as id.

=item C<override_part_id>

An optional part id which is used instead of a value set in the time
recording entry.

=item C<override_partnumber>

Like C<overrride_part_id> but given as partnumber, not as id.

459b3c8d Bernd Bleßmann
=item C<related_order>

An optional C<SL::DB::Order> object. If it exists then it is used to
generate the delivery order from that via C<new_from>.
The generated items are created from a suitable item of the related
order. If no suitable item is found, an exception is thrown.

=item C<rounding>

An optional boolean value. If truish, then the durations of the time entries
are rounded up to the full quarters of an hour.

2632ced6 Bernd Bleßmann
=back

7664f50f Moritz Bunkus
=item C<sales_order>

TODO: Describe sales_order

=item C<type>

51264c43 Geoffrey Richardson
Returns a string describing this record's type: either
7664f50f Moritz Bunkus
C<sales_delivery_order> or C<purchase_delivery_order>.

a7ca8ba2 Jan Büren
=item C<convert_to_invoice %params>

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.

38666007 Jan Büren
The arguments in C<%params> are passed to L<SL::DB::Invoice::new_from>.
a7ca8ba2 Jan Büren
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.

At the moment only sales delivery orders can be converted.

7664f50f Moritz Bunkus
=back

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

=cut