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 {
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;
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});
# 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;
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 => 'not enough to allocate',
- msg => t8("can not allocate #1 units of #2, missing #3 units", $qty, $part->displayable_name, $rest_qty),
+ 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;
}
}
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;
for my $part_id (keys %parts_to_allocate) {
- my $part = SL::DB::Part->new(id => $part_id);
+ my $part = SL::DB::Part->load_cached($part_id);
push @allocations, allocate(%params, part => $part, qty => $parts_to_allocate{$part_id});
}
@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) = @_;
my $bin = $params{bin} or Carp::croak("need target bin");
my $chargenumber = $params{chargenumber};
my $bestbefore = $params{bestbefore};
+ my $for_object_id = $params{for_object_id};
my $comment = $params{comment} // '';
my $production_order_item = $params{production_order_item};
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,
trans_type => $trans_type_out,
shippingdate => $shippingdate,
employee => SL::DB::Manager::Employee->current,
+ oe_id => $allocation->for_object_id,
);
}
comment => $comment,
prod => $production_order_item,
employee => SL::DB::Manager::Employee->current,
+ oe_id => $for_object_id,
);
SL::DB->client->with_transaction(sub {
}
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) {
# 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
);
# 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
);
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,"
=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<chargenumber>, C<bestbefore>, C<reserve_for_id> and C<reserve_for_table> may
-be C<undef> (but must still be present at creation time). Instances are
-considered immutable.
+C<chargenumber>, C<bestbefore>, C<reserve_for_id>, C<reserve_for_table> and
+C<for_object_id> may be C<undef> (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<allocation> is "best effort" in nature. It will take the C<bin>,
+C<chargenumber> 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<allocate>. 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
projects / mfinanz.git / blobdiff