X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/1a98dbafd0a6f2c5bcb35badaeea6bcf5b0e84a4..15176cbb3b162a07a055dbe6cfc0f98f9d65d0df:/SL/Helper/Inventory.pm diff --git a/SL/Helper/Inventory.pm b/SL/Helper/Inventory.pm index 804e17f9a..a1a142803 100644 --- a/SL/Helper/Inventory.pm +++ b/SL/Helper/Inventory.pm @@ -4,17 +4,19 @@ use strict; use Carp; use DateTime; use Exporter qw(import); -use List::Util qw(min); +use List::Util qw(min sum); use List::UtilsBy qw(sort_by); use List::MoreUtils qw(any); +use POSIX qw(ceil); use SL::Locale::String qw(t8); use SL::MoreCommon qw(listify); use SL::DBUtils qw(selectall_hashref_query selectrow_query); use SL::DB::TransferType; +use SL::Helper::Number qw(_round_qty _qty); use SL::X; -our @EXPORT_OK = qw(get_stock get_onhand allocate allocate_for_assembly produce_assembly); +our @EXPORT_OK = qw(get_stock get_onhand allocate allocate_for_assembly produce_assembly check_constraints); our %EXPORT_TAGS = (ALL => \@EXPORT_OK); sub _get_stock_onhand { @@ -22,7 +24,10 @@ sub _get_stock_onhand { my $onhand_mode = !!$params{onhand}; - my @selects = ('SUM(qty) as qty'); + my @selects = ( + 'SUM(qty) AS qty', + 'MIN(EXTRACT(epoch FROM inventory.itime)) AS itime', + ); my @values; my @where; my @groups; @@ -166,9 +171,9 @@ sub allocate { return () if $qty <= 0; my $results = get_stock(part => $part, by => 'for_allocate'); - my %bin_whitelist = map { (ref $_ ? $_->id : $_) => 1 } listify($params{bin}); - my %wh_whitelist = map { (ref $_ ? $_->id : $_) => 1 } listify($params{warehouse}); - my %chargenumbers = map { (ref $_ ? $_->id : $_) => 1 } listify($params{chargenumber}); + my %bin_whitelist = map { (ref $_ ? $_->id : $_) => 1 } grep defined, listify($params{bin}); + my %wh_whitelist = map { (ref $_ ? $_->id : $_) => 1 } grep defined, listify($params{warehouse}); + my %chargenumbers = map { (ref $_ ? $_->id : $_) => 1 } grep defined, listify($params{chargenumber}); my %reserve_whitelist; if ($params{reserve_for}) { $reserve_whitelist{ $_->meta->table }{ $_->id } = 1 for listify($params{reserve_for}); @@ -187,11 +192,11 @@ sub allocate { # sort results so that reserve_for is first, then chargenumbers, then wanted bins, then wanted warehouses my @sorted_results = sort { (!!$b->{reserve_for_id}) <=> (!!$a->{reserve_for_id}) # sort by existing reserve_for_id first. - || $chargenumbers{$b->{chargenumber}} <=> $chargenumbers{$a->{chargenumber}} # then prefer wanted chargenumbers - || $bin_whitelist{$b->{bin_id}} <=> $bin_whitelist{$a->{bin_id}} # then prefer wanted bins - || $wh_whitelist{$b->{warehouse_id}} <=> $wh_whitelist{$a->{warehouse_id}} # then prefer wanted bins + || exists $chargenumbers{$b->{chargenumber}} <=> exists $chargenumbers{$a->{chargenumber}} # then prefer wanted chargenumbers + || exists $bin_whitelist{$b->{bin_id}} <=> exists $bin_whitelist{$a->{bin_id}} # then prefer wanted bins + || exists $wh_whitelist{$b->{warehouse_id}} <=> exists $wh_whitelist{$a->{warehouse_id}} # then prefer wanted bins + || $a->{itime} <=> $b->{itime} # and finally prefer earlier charges } @filtered_results; - my @allocations; my $rest_qty = $qty; @@ -208,18 +213,22 @@ sub allocate { bestbefore => $chunk->{bestbefore}, reserve_for_id => $chunk->{reserve_for_id}, reserve_for_table => $chunk->{reserve_for_table}, + for_object_id => undef, ); - $rest_qty -= $qty; + $rest_qty -= _round_qty($qty); } - + $rest_qty = _round_qty($rest_qty); last if $rest_qty == 0; } if ($rest_qty > 0) { die SL::X::Inventory::Allocation->new( - error => t8('not enough to allocate'), - msg => t8("can not allocate #1 units of #2, missing #3 units", $qty, $part->displayable_name, $rest_qty), + error => 'not enough to allocate', + msg => t8("can not allocate #1 units of #2, missing #3 units", _qty($qty), $part->displayable_name, _qty($rest_qty)), ); } else { + if ($params{constraints}) { + check_constraints($params{constraints},\@allocations); + } return @allocations; } } @@ -235,8 +244,13 @@ sub allocate_for_assembly { my %parts_to_allocate; for my $assembly ($part->assemblies) { + next if $assembly->part->dispotype eq 'no_stock'; + + my $tmpqty = $assembly->assembly_part->is_recipe ? $assembly->qty * $qty / $assembly->assembly_part->scalebasis + : $assembly->part->unit eq 'Stck' ? ceil($assembly->qty * $qty) + : $assembly->qty * $qty; $parts_to_allocate{ $assembly->part->id } //= 0; - $parts_to_allocate{ $assembly->part->id } += $assembly->qty * $qty; # TODO recipe factor + $parts_to_allocate{ $assembly->part->id } += $tmpqty; } my @allocations; @@ -249,6 +263,52 @@ sub allocate_for_assembly { @allocations; } +sub check_constraints { + my ($constraints, $allocations) = @_; + if ('CODE' eq ref $constraints) { + if (!$constraints->(@$allocations)) { + die SL::X::Inventory::Allocation->new( + error => 'allocation constraints failure', + msg => t8("Allocations didn't pass constraints"), + ); + } + } else { + croak 'constraints needs to be a hashref' unless 'HASH' eq ref $constraints; + + my %supported_constraints = ( + bin_id => 'bin_id', + warehouse_id => 'warehouse_id', + chargenumber => 'chargenumber', + ); + + for (keys %$constraints ) { + croak "unsupported constraint '$_'" unless $supported_constraints{$_}; + + my %whitelist = map { (ref $_ ? $_->id : $_) => 1 } listify($constraints->{$_}); + my $accessor = $supported_constraints{$_}; + + if (any { !$whitelist{$_->$accessor} } @$allocations) { + my %error_constraints = ( + bin_id => t8('Bins'), + warehouse_id => t8('Warehouses'), + chargenumber => t8('Chargenumbers'), + ); + my @allocs = grep { $whitelist{$_->$accessor} } @$allocations; + my $needed = sum map { $_->qty } grep { !$whitelist{$_->$accessor} } @$allocations; + my $err = t8("Cannot allocate parts."); + $err .= ' '.t8('part \'#\'1 in bin \'#2\' only with qty #3 (need additional #4) and chargenumber \'#5\'.', + SL::DB::Part->load_cached($_->parts_id)->description, + SL::DB::Bin->load_cached($_->bin_id)->full_description, + _qty($_->qty), _qty($needed), $_->chargenumber ? $_->chargenumber : '--') for @allocs; + die SL::X::Inventory::Allocation->new( + error => 'allocation constraints failure', + msg => $err, + ); + } + } + } +} + sub produce_assembly { my (%params) = @_; @@ -267,7 +327,7 @@ sub produce_assembly { my $bin = $params{bin} or Carp::croak("need target bin"); my $chargenumber = $params{chargenumber}; my $bestbefore = $params{bestbefore}; - my $oe_id = $params{oe_id}; + my $for_object_id = $params{for_object_id}; my $comment = $params{comment} // ''; my $production_order_item = $params{production_order_item}; @@ -298,6 +358,7 @@ sub produce_assembly { my @transfers; for my $allocation (@$allocations) { + my $oe_id = delete $allocation->{for_object_id}; push @transfers, SL::DB::Inventory->new( trans_id => $trans_id, %$allocation, @@ -305,7 +366,7 @@ sub produce_assembly { trans_type => $trans_type_out, shippingdate => $shippingdate, employee => SL::DB::Manager::Employee->current, - oe_id => $oe_id, + oe_id => $allocation->for_object_id, ); } @@ -326,7 +387,7 @@ sub produce_assembly { comment => $comment, prod => $production_order_item, employee => SL::DB::Manager::Employee->current, - oe_id => $oe_id, + oe_id => $for_object_id, ); SL::DB->client->with_transaction(sub { @@ -340,7 +401,7 @@ sub produce_assembly { } package SL::Helper::Inventory::Allocation { - my @attributes = qw(parts_id qty bin_id warehouse_id chargenumber bestbefore comment reserve_for_id reserve_for_table); + my @attributes = qw(parts_id qty bin_id warehouse_id chargenumber bestbefore comment reserve_for_id reserve_for_table for_object_id); my %attributes = map { $_ => 1 } @attributes; for my $name (@attributes) { @@ -372,32 +433,32 @@ SL::WH - Warehouse and Inventory API # See description for an intro to the concepts used here. - use SL::Helper::Inventory; + use SL::Helper::Inventory qw(:ALL); # stock, get "what's there" for a part with various conditions: - my $qty = SL::Helper::Inventory->get_stock(part => $part); # how much is on stock? - my $qty = SL::Helper::Inventory->get_stock(part => $part, date => $date); # how much was on stock at a specific time? - my $qty = SL::Helper::Inventory->get_stock(part => $part, bin => $bin); # how is on stock in a specific bin? - my $qty = SL::Helper::Inventory->get_stock(part => $part, warehouse => $warehouse); # how is on stock in a specific warehouse? - my $qty = SL::Helper::Inventory->get_stock(part => $part, chargenumber => $chargenumber); # how is on stock of a specific chargenumber? + my $qty = get_stock(part => $part); # how much is on stock? + my $qty = get_stock(part => $part, date => $date); # how much was on stock at a specific time? + my $qty = get_stock(part => $part, bin => $bin); # how is on stock in a specific bin? + my $qty = get_stock(part => $part, warehouse => $warehouse); # how is on stock in a specific warehouse? + my $qty = get_stock(part => $part, chargenumber => $chargenumber); # how is on stock of a specific chargenumber? # onhand, get "what's available" for a part with various conditions: - my $qty = SL::Helper::Inventory->get_onhand(part => $part); # how much is available? - my $qty = SL::Helper::Inventory->get_onhand(part => $part, date => $date); # how much was available at a specific time? - my $qty = SL::Helper::Inventory->get_onhand(part => $part, bin => $bin); # how much is available in a specific bin? - my $qty = SL::Helper::Inventory->get_onhand(part => $part, warehouse => $warehouse); # how much is available in a specific warehouse? - my $qty = SL::Helper::Inventory->get_onhand(part => $part, chargenumber => $chargenumber); # how much is availbale of a specific chargenumber? - my $qty = SL::Helper::Inventory->get_onhand(part => $part, reserve_for => $order); # how much is available if you include this reservation? + my $qty = get_onhand(part => $part); # how much is available? + my $qty = get_onhand(part => $part, date => $date); # how much was available at a specific time? + my $qty = get_onhand(part => $part, bin => $bin); # how much is available in a specific bin? + my $qty = get_onhand(part => $part, warehouse => $warehouse); # how much is available in a specific warehouse? + my $qty = get_onhand(part => $part, chargenumber => $chargenumber); # how much is availbale of a specific chargenumber? + my $qty = get_onhand(part => $part, reserve_for => $order); # how much is available if you include this reservation? # onhand batch mode: - my $data = SL::Helper::Inventory->get_onhand( + my $data = get_onhand( warehouse => $warehouse, by => [ qw(bin part chargenumber reserve_for) ], with_objects => [ qw(bin part) ], ); # allocate: - my @allocations, SL::Helper::Inventory->allocate( + my @allocations, allocate( part => $part, # part_id works too qty => $qty, # must be positive chargenumber => $chargenumber, # optional, may be arrayref. if provided these charges will be used first @@ -407,7 +468,7 @@ SL::WH - Warehouse and Inventory API ); # shortcut to allocate all that is needed for producing an assembly, will use chargenumbers as appropriate - my @allocations, SL::Helper::Inventory->allocate_for_assembly( + my @allocations, allocate_for_assembly( part => $assembly, # part_id works too qty => $qty, # must be positive ); @@ -422,10 +483,11 @@ SL::WH - Warehouse and Inventory API bestbefore => undef, reserve_for_id => undef, reserve_for_table => undef, + for_object_id => $order->id, ); # produce_assembly: - SL::Helper::Inventory->produce_assembly( + produce_assembly( part => $part, # target assembly qty => $qty, # qty allocations => \@allocations, # allocations to use. alternatively use "auto_allocate => 1," @@ -709,11 +771,58 @@ each of the following attributes to be set at creation time: =item * reserve_for_table +=item * for_object_id + +If set the allocations will be marked as allocated for the given object. +If these allocations are later used to produce an assembly, the resulting +consuming transactions will be marked as belonging to the given object. +The object may be an order, productionorder or other objects + =back -C, C, C and C may -be C (but must still be present at creation time). Instances are -considered immutable. +C, C, C, C and +C may be C (but must still be present at creation time). +Instances are considered immutable. + + +=head1 CONSTRAINTS + + # whitelist constraints + ->allocate( + ... + constraints => { + bin_id => \@allowed_bins, + chargenumber => \@allowed_chargenumbers, + } + ); + + # custom constraints + ->allocate( + constraints => sub { + # only allow chargenumbers with specific format + all { $_->chargenumber =~ /^ C \d{8} - \a{d2} $/x } @_ + + && + # and must be all reservations + all { $_->reserve_for_id } @_; + } + ) + +C is "best effort" in nature. It will take the C, +C etc hints from the parameters, but will try it's bvest to +fulfil the request anyway and only bail out if it is absolutely not possible. + +Sometimes you need to restrict allocations though. For this you can pass +additional constraints to C. A constraint serves as a whitelist. +Every allocation must fulfil every constraint by having that attribute be one +of the given values. + +In case even that is not enough, you may supply a custom check by passing a +function that will be given the allocation objects. + +Note that both whitelists and constraints do not influence the order of +allocations, which is done purely from the initial parameters. They only serve +to reject allocations made in good faith which do fulfil required assertions. =head1 ERROR HANDLING