+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{$_};
+ next unless defined $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,
+ _format_number($_->qty), _format_number($needed), $_->chargenumber ? $_->chargenumber : '--') for @allocs;
+ die SL::X::Inventory::Allocation->new(
+ error => 'allocation constraints failure',
+ msg => $err,
+ );
+ }
+ }
+ }
+}
+