kivitendo/SL/Dev/Inventory.pm @ 31b247ee
| ec1dc3e8 | Geoffrey Richardson | package SL::Dev::Inventory;
|
||
| 8d4130ed | Sven Schöling | use strict;
|
||
| ec1dc3e8 | Geoffrey Richardson | use base qw(Exporter);
|
||
| 8d4130ed | Sven Schöling | our @EXPORT = qw(create_warehouse_and_bins set_stock);
|
||
| ec1dc3e8 | Geoffrey Richardson | |||
use SL::DB::Warehouse;
|
||||
use SL::DB::Bin;
|
||||
use SL::DB::Inventory;
|
||||
use SL::DB::TransferType;
|
||||
use SL::DB::Employee;
|
||||
| e2db2d12 | Geoffrey Richardson | use SL::WH;
|
||
use DateTime;
|
||||
use Data::Dumper;
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
sub create_warehouse_and_bins {
|
||||
my (%params) = @_;
|
||||
my $number_of_bins = $params{number_of_bins} || 5;
|
||||
my $wh = SL::DB::Warehouse->new(description => $params{warehouse_description} || "Warehouse", invalid => 0);
|
||||
for my $i ( 1 .. $number_of_bins ) {
|
||||
$wh->add_bins( SL::DB::Bin->new(description => ( $params{bin_description} || "Bin" ) . " $i" ) );
|
||||
}
|
||||
$wh->save;
|
||||
return ($wh, $wh->bins->[0]);
|
||||
}
|
||||
sub set_stock {
|
||||
| e2db2d12 | Geoffrey Richardson | my (%params) = @_;
|
||
die "param part is missing or not an SL::DB::Part object" unless ref($params{part}) eq 'SL::DB::Part';
|
||||
my $part = delete $params{part};
|
||||
die "qty is missing" unless $params{qty} or $params{abs_qty};
|
||||
die "need a bin or default bin" unless $part->warehouse_id or $part->bin_id or $params{bin} or $params{bin_id};
|
||||
my ($warehouse_id, $bin_id);
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
| e2db2d12 | Geoffrey Richardson | if ( $params{bin} ) {
|
||
die "illegal param bin: " . Dumper($params{bin}) unless ref($params{bin}) eq 'SL::DB::Bin';
|
||||
my $bin = delete $params{bin};
|
||||
$bin_id = $bin->id;
|
||||
$warehouse_id = $bin->warehouse_id;
|
||||
} elsif ( $params{bin_id} ) {
|
||||
my $bin = SL::DB::Manager::Bin->find_by(id => delete $params{bin_id});
|
||||
$bin_id = $bin->id;
|
||||
$warehouse_id = $bin->warehouse_id;
|
||||
} elsif ( $part->bin_id ) {
|
||||
$bin_id = $part->bin_id;
|
||||
$warehouse_id = $part->warehouse_id;
|
||||
} else {
|
||||
die "can't determine bin and warehouse";
|
||||
}
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
| e2db2d12 | Geoffrey Richardson | my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
|
||
die "Can't determine employee" unless $employee_id;
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
| e2db2d12 | Geoffrey Richardson | my $qty = delete $params{qty};
|
||
| ec1dc3e8 | Geoffrey Richardson | |||
| e2db2d12 | Geoffrey Richardson | my $transfer_type_description;
|
||
my $transfer_type;
|
||||
if ( $params{abs_qty} ) {
|
||||
# determine the current qty and calculate the qty diff that needs to be applied
|
||||
# if abs_qty is set then any value that was in $params{qty} is ignored/overwritten
|
||||
my %get_stock_params;
|
||||
$get_stock_params{bin_id} = $bin_id if $bin_id;
|
||||
# $get_stock_params{warehouse_id} = $warehouse_id if $warehouse_id; # redundant
|
||||
my $current_qty = $part->get_stock(%get_stock_params);
|
||||
$qty = $params{abs_qty} - $current_qty;
|
||||
}
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
| e2db2d12 | Geoffrey Richardson | if ( $qty > 0 ) {
|
||
$transfer_type_description = delete $params{transfer_type} // 'stock';
|
||||
$transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'in' );
|
||||
} else {
|
||||
$transfer_type_description = delete $params{transfer_type} // 'shipped';
|
||||
$transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'out' );
|
||||
}
|
||||
die "can't determine transfer_type" unless $transfer_type;
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
my $shippingdate;
|
||||
if ( $params{shippingdate} ) {
|
||||
| e2db2d12 | Geoffrey Richardson | $shippingdate = delete $params{shippingdate};
|
||
$shippingdate = $::locale->parse_date_to_object($shippingdate) unless ref($shippingdate) eq 'DateTime';
|
||||
| ec1dc3e8 | Geoffrey Richardson | } else {
|
||
$shippingdate = DateTime->today;
|
||||
| e2db2d12 | Geoffrey Richardson | }
|
||
my $unit;
|
||||
if ( $params{unit} ) {
|
||||
$unit = delete $params{unit};
|
||||
$unit = SL::DB::Manager::Unit->find_by( name => $unit ) unless ref($unit) eq 'SL::DB::Unit';
|
||||
$qty = $unit->convert_to($qty, $part->unit_obj);
|
||||
}
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
my ($trans_id) = $part->db->dbh->selectrow_array("select nextval('id')", {});
|
||||
SL::DB::Inventory->new(
|
||||
parts_id => $part->id,
|
||||
| e2db2d12 | Geoffrey Richardson | bin_id => $bin_id,
|
||
warehouse_id => $warehouse_id,
|
||||
employee_id => $employee_id,
|
||||
| ec1dc3e8 | Geoffrey Richardson | trans_type_id => $transfer_type->id,
|
||
comment => $params{comment},
|
||||
shippingdate => $shippingdate,
|
||||
| e2db2d12 | Geoffrey Richardson | qty => $qty,
|
||
| ec1dc3e8 | Geoffrey Richardson | trans_id => $trans_id,
|
||
)->save;
|
||||
}
|
||||
| e2db2d12 | Geoffrey Richardson | sub transfer_stock {
|
||
my (%params) = @_;
|
||||
# check params:
|
||||
die "missing params" unless ( $params{parts_id} or $params{part} ) and $params{from_bin} and $params{to_bin};
|
||||
my $part;
|
||||
if ( $params{parts_id} ) {
|
||||
$part = SL::DB::Manager::Part->find_by( id => delete $params{parts_id} ) or die "illegal parts_id";
|
||||
} else {
|
||||
$part = delete $params{part};
|
||||
}
|
||||
die "illegal part" unless ref($part) eq 'SL::DB::Part';
|
||||
my $from_bin = delete $params{from_bin};
|
||||
my $to_bin = delete $params{to_bin};
|
||||
die "illegal bins" unless ref($from_bin) eq 'SL::DB::Bin' and ref($to_bin) eq 'SL::DB::Bin';
|
||||
my $qty = delete($params{qty});
|
||||
die "qty must be > 0" unless $qty > 0;
|
||||
# set defaults
|
||||
my $transfer_type = SL::DB::Manager::TransferType->find_by(description => 'transfer') or die "can't determine transfer type";
|
||||
my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
|
||||
my $WH_params = {
|
||||
'bestbefore' => undef,
|
||||
'change_default_bin' => undef,
|
||||
'chargenumber' => '',
|
||||
'comment' => delete $params{comment} // '',
|
||||
'dst_bin_id' => $to_bin->id,
|
||||
'dst_warehouse_id' => $to_bin->warehouse_id,
|
||||
'parts_id' => $part->id,
|
||||
'qty' => $qty,
|
||||
'src_bin_id' => $from_bin->id,
|
||||
'src_warehouse_id' => $from_bin->warehouse_id,
|
||||
'transfer_type_id' => $transfer_type->id,
|
||||
};
|
||||
WH->transfer($WH_params);
|
||||
return 1;
|
||||
# do it manually via rose:
|
||||
# my $trans_id;
|
||||
# my $db = SL::DB::Inventory->new->db;
|
||||
# $db->with_transaction(sub{
|
||||
# ($trans_id) = $db->dbh->selectrow_array("select nextval('id')", {});
|
||||
# die "no trans_id" unless $trans_id;
|
||||
# my %params = (
|
||||
# shippingdate => delete $params{shippingdate} // DateTime->today,
|
||||
# employee_id => $employee_id,
|
||||
# trans_id => $trans_id,
|
||||
# trans_type_id => $transfer_type->id,
|
||||
# parts_id => $part->id,
|
||||
# comment => delete $params{comment} || 'Umlagerung',
|
||||
# );
|
||||
# SL::DB::Inventory->new(
|
||||
# warehouse_id => $from_bin->warehouse_id,
|
||||
# bin_id => $from_bin->id,
|
||||
# qty => $qty * -1,
|
||||
# %params,
|
||||
# )->save;
|
||||
# SL::DB::Inventory->new(
|
||||
# warehouse_id => $to_bin->warehouse_id,
|
||||
# bin_id => $to_bin->id,
|
||||
# qty => $qty,
|
||||
# %params,
|
||||
# )->save;
|
||||
# }) or die $@ . "\n";
|
||||
# return 1;
|
||||
}
|
||||
| ec1dc3e8 | Geoffrey Richardson | 1;
|
||
__END__
|
||||
=head1 NAME
|
||||
SL::Dev::Inventory - create inventory-related objects for testing, with minimal
|
||||
defaults
|
||||
=head1 FUNCTIONS
|
||||
=head2 C<create_warehouse_and_bins %PARAMS>
|
||||
Creates a new warehouse and bins, and immediately saves them. Returns the
|
||||
warehouse and the first bin object.
|
||||
my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
|
||||
Create named warehouse with 10 bins:
|
||||
my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => 'Testlager',
|
||||
bin_description => 'Testlagerplatz',
|
||||
number_of_bins => 10,
|
||||
);
|
||||
To access the second bin:
|
||||
my $bin2 = $wh->bins->[1];
|
||||
| e2db2d12 | Geoffrey Richardson | =head2 C<set_stock %PARAMS>
|
||
Change the stock level of a certain part by creating an inventory event.
|
||||
To access the updated onhand the part object needs to be loaded afterwards.
|
||||
Mandatory params:
|
||||
part - an SL::DB::Part object or a parts_id
|
||||
qty | abs_qty
|
||||
qty : the qty to increase of decrease the stock level by
|
||||
abs_qty : sets stock level for a certain part to abs_qty by creating
|
||||
a stock event with the current difference
|
||||
Optional params:
|
||||
bin_id | bin
|
||||
shippingdate : may be a DateTime object or a string that needs to be parsed by parse_date_to_object.
|
||||
unit : SL::DB::Unit object, or the name of an SL::DB::Unit object
|
||||
If no bin is passed the default bin of the part is used, if that doesn't exist
|
||||
either there will be an error.
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
| e2db2d12 | Geoffrey Richardson | C<set_stock> creates the SL::DB::Inventory object from scratch, rather
|
||
than passing params to WH->transfer_in or WH->transfer_out.
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
| e2db2d12 | Geoffrey Richardson | Examples:
|
||
| ec1dc3e8 | Geoffrey Richardson | my $part = SL::DB::Manager::Part->find_by(partnumber => '1');
|
||
| e2db2d12 | Geoffrey Richardson | SL::Dev::Inventory::set_stock(part => $part, qty => 5);
|
||
SL::Dev::Inventory::set_stock(part => $part, qty => -2);
|
||||
| ec1dc3e8 | Geoffrey Richardson | $part->load;
|
||
| e2db2d12 | Geoffrey Richardson | $part->onhand; # 3
|
||
Set stock level of a part in a certain bin_id to 10:
|
||||
SL::Dev::Inventory::set_stock(part => $part, bin_id => 99, abs_qty => 10);
|
||||
Create 10 warehouses with 5 bins each, then create 100 parts and increase the
|
||||
stock qty in a random bin by a random positive qty for each of the parts:
|
||||
SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => "Testlager $_") for ( 1 .. 10 );
|
||||
SL::Dev::Part::create_part(description => "Testpart $_")->save for ( 1 .. 100 );
|
||||
my $bins = SL::DB::Manager::Bin->get_all;
|
||||
SL::Dev::Inventory::set_stock(part => $_,
|
||||
qty => int(rand(99))+1,
|
||||
bin => $bins->[ rand @{$bins} ],
|
||||
) foreach @{ SL::DB::Manager::Part->get_all() };
|
||||
=head2 C<transfer_stock %PARAMS>
|
||||
Transfers parts from one bin to another.
|
||||
Mandatory params:
|
||||
part | parts_id - an SL::DB::Part object or a parts_id
|
||||
from_bin - an SL::DB::Bin object
|
||||
to_bin qty - an SL::DB::Bin object
|
||||
Optional params: shippingdate
|
||||
The unit is always base_unit and there is no check for negative stock values.
|
||||
Example: Create a warehouse and bins, a part, stock the part and then move some
|
||||
of the stock to a different bin inside the same warehouse:
|
||||
my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
|
||||
my $part = SL::Dev::Part::create_part->save;
|
||||
SL::Dev::Inventory::set_stock(part => $part, bin_id => $wh->bins->[2]->id, qty => 5);
|
||||
SL::Dev::Inventory::transfer_stock(part => $part,
|
||||
from_bin => $wh->bins->[2],
|
||||
to_bin => $wh->bins->[4],
|
||||
qty => 3
|
||||
);
|
||||
$part->get_stock(bin_id => $wh->bins->[4]->id); # 3.00000
|
||||
$part->get_stock(bin_id => $wh->bins->[2]->id); # 2.00000
|
||||
| ec1dc3e8 | Geoffrey Richardson | |||
=head1 BUGS
|
||||
Nothing here yet.
|
||||
=head1 AUTHOR
|
||||
G. Richardson E<lt>grichardson@kivitendo-premium.deE<gt>
|
||||
=cut
|