From 1672b7f7f17ee2d9e7ec3fea74527577b4a7000c Mon Sep 17 00:00:00 2001 From: "Martin Helmling martin.helmling@octosoft.eu" Date: Wed, 2 Oct 2019 13:53:10 +0200 Subject: [PATCH] =?utf8?q?Inventory-Helper:=20neuer=20Parameter=20"constra?= =?utf8?q?ints"=20um=20die=20Verf=C3=BCgbarkeit=20von=20Lagerbest=C3=A4nde?= =?utf8?q?n=20einzuschr=C3=A4nken?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Eine extra Methode prüft gefundene Einträge auf bestimmte Einschränkungen nachdem die Sortierung stattgefunden hat zu #9457 --- SL/Helper/Inventory.pm | 84 +++++++++++++++++++++++++++++++++++++++++- locale/de/all | 3 ++ 2 files changed, 85 insertions(+), 2 deletions(-) diff --git a/SL/Helper/Inventory.pm b/SL/Helper/Inventory.pm index 804e17f9a..1225a7d52 100644 --- a/SL/Helper/Inventory.pm +++ b/SL/Helper/Inventory.pm @@ -14,7 +14,7 @@ use SL::DBUtils qw(selectall_hashref_query selectrow_query); use SL::DB::TransferType; 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 { @@ -191,7 +191,6 @@ sub allocate { || $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 } @filtered_results; - my @allocations; my $rest_qty = $qty; @@ -220,6 +219,9 @@ sub allocate { msg => t8("can not allocate #1 units of #2, missing #3 units", $qty, $part->displayable_name, $rest_qty), ); } else { + if ($params{constraints}) { + check_constraints($params{constraints},\@allocations); + } return @allocations; } } @@ -249,6 +251,45 @@ 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'), + ); + die SL::X::Inventory::Allocation->new( + error => 'allocation constraints failure', + msg => t8("Allocations didn't pass constraints for #1",$error_constraints{$_}), + ); + } + } + } +} + sub produce_assembly { my (%params) = @_; @@ -715,6 +756,45 @@ 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 C and C will throw exceptions if the request can diff --git a/locale/de/all b/locale/de/all index ead66118f..2f3856e98 100755 --- a/locale/de/all +++ b/locale/de/all @@ -270,6 +270,8 @@ $self->{texts} = { 'All transactions' => 'Alle Buchungen', 'All units have either no or exactly one base unit of which they are multiples.' => 'Einheiten haben entweder keine oder genau eine Basiseinheit, von der sie ein Vielfaches sind.', 'All users' => 'Alle BenutzerInnen', + 'Allocations didn\'t pass constraints' => 'Keine Verfügbarkeit wegen Lagereinschränkung', + 'Allocations didn\'t pass constraints for #1' => 'Keine Verfügbarkeit wegen Lagereinschränkung auf \'#1\'', 'Allow access' => 'Zugriff erlauben', 'Allow conversion from sales orders to sales invoices' => 'Umwandlung von Verkaufsaufträgen in Verkaufsrechnungen zulassen', 'Allow conversion from sales quotations to sales invoices' => 'Umwandlung von Verkaufsangeboten in Verkaufsrechnungen zulassen', @@ -598,6 +600,7 @@ $self->{texts} = { 'Charge' => 'Berechnen', 'Charge Number' => 'Chargennummer', 'Charge number' => 'Chargennummer', + 'Chargenumbers' => '', 'Charset' => 'Zeichensatz', 'Chart' => 'Buchungskonto', 'Chart Type' => 'Kontentyp', -- 2.20.1