SL/Dev/Inventory.pm

   1 package SL::Dev::Inventory;
   2
   3 use strict;
   4 use base qw(Exporter);
   5 our @EXPORT = qw(create_warehouse_and_bins set_stock);
   6
   7 use SL::DB::Warehouse;
   8 use SL::DB::Bin;
   9 use SL::DB::Inventory;
  10 use SL::DB::TransferType;
  11 use SL::DB::Employee;
  12 use SL::WH;
  13 use DateTime;
  14 use Data::Dumper;
  15
  16 sub create_warehouse_and_bins {
  17   my (%params) = @_;
  18
  19   my $number_of_bins = $params{number_of_bins} || 5;
  20   my $wh = SL::DB::Warehouse->new(description => $params{warehouse_description} || "Warehouse", invalid => 0);
  21   for my $i ( 1 .. $number_of_bins ) {
  22     $wh->add_bins( SL::DB::Bin->new(description => ( $params{bin_description} || "Bin" ) . " $i" ) );
  23   }
  24   $wh->save;
  25   return ($wh, $wh->bins->[0]);
  26 }
  27
  28 sub set_stock {
  29   my (%params) = @_;
  30
  31   die "param part is missing or not an SL::DB::Part object" unless ref($params{part}) eq 'SL::DB::Part';
  32   my $part = delete $params{part};
  33   die "qty is missing" unless $params{qty} or $params{abs_qty};
  34   die "need a bin or default bin" unless $part->warehouse_id or $part->bin_id or $params{bin} or $params{bin_id};
  35
  36   my ($warehouse_id, $bin_id);
  37
  38   if ( $params{bin} ) {
  39     die "illegal param bin: " . Dumper($params{bin}) unless ref($params{bin}) eq 'SL::DB::Bin';
  40     my $bin       = delete $params{bin};
  41     $bin_id       = $bin->id;
  42     $warehouse_id = $bin->warehouse_id;
  43   } elsif ( $params{bin_id} ) {
  44     my $bin       = SL::DB::Manager::Bin->find_by(id => delete $params{bin_id});
  45     $bin_id       = $bin->id;
  46     $warehouse_id = $bin->warehouse_id;
  47   } elsif ( $part->bin_id ) {
  48     $bin_id       = $part->bin_id;
  49     $warehouse_id = $part->warehouse_id;
  50   } else {
  51     die "can't determine bin and warehouse";
  52   }
  53
  54   my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
  55   die "Can't determine employee" unless $employee_id;
  56
  57   my $qty = delete $params{qty};
  58
  59   my $transfer_type_description;
  60   my $transfer_type;
  61   if ( $params{abs_qty} ) {
  62     # determine the current qty and calculate the qty diff that needs to be applied
  63     # if abs_qty is set then any value that was in $params{qty} is ignored/overwritten
  64     my %get_stock_params;
  65     $get_stock_params{bin_id}       = $bin_id       if $bin_id;
  66     # $get_stock_params{warehouse_id} = $warehouse_id if $warehouse_id; # redundant
  67     my $current_qty = $part->get_stock(%get_stock_params);
  68     $qty = $params{abs_qty} - $current_qty;
  69   }
  70
  71   if ( $qty > 0 ) {
  72     $transfer_type_description = delete $params{transfer_type} // 'stock';
  73     $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'in' );
  74   } else {
  75     $transfer_type_description = delete $params{transfer_type} // 'shipped';
  76     $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'out' );
  77   }
  78   die "can't determine transfer_type" unless $transfer_type;
  79
  80   my $shippingdate;
  81   if ( $params{shippingdate} ) {
  82     $shippingdate = delete $params{shippingdate};
  83     $shippingdate = $::locale->parse_date_to_object($shippingdate) unless ref($shippingdate) eq 'DateTime';
  84   } else {
  85     $shippingdate = DateTime->today;
  86   }
  87
  88   my $unit;
  89   if ( $params{unit} ) {
  90     $unit = delete $params{unit};
  91     $unit = SL::DB::Manager::Unit->find_by( name => $unit ) unless ref($unit) eq 'SL::DB::Unit';
  92     $qty  = $unit->convert_to($qty, $part->unit_obj);
  93   }
  94
  95   my ($trans_id) = $part->db->dbh->selectrow_array("select nextval('id')", {});
  96
  97   SL::DB::Inventory->new(
  98     parts_id         => $part->id,
  99     bin_id           => $bin_id,
 100     warehouse_id     => $warehouse_id,
 101     employee_id      => $employee_id,
 102     trans_type_id    => $transfer_type->id,
 103     comment          => $params{comment},
 104     shippingdate     => $shippingdate,
 105     qty              => $qty,
 106     trans_id         => $trans_id,
 107   )->save;
 108 }
 109
 110 sub transfer_stock {
 111   my (%params) = @_;
 112
 113   # check params:
 114   die "missing params" unless ( $params{parts_id} or $params{part} ) and $params{from_bin} and $params{to_bin};
 115
 116   my $part;
 117   if ( $params{parts_id} ) {
 118     $part = SL::DB::Manager::Part->find_by( id => delete $params{parts_id} ) or die "illegal parts_id";
 119   } else {
 120     $part = delete $params{part};
 121   }
 122   die "illegal part" unless ref($part) eq 'SL::DB::Part';
 123
 124   my $from_bin = delete $params{from_bin};
 125   my $to_bin   = delete $params{to_bin};
 126   die "illegal bins" unless ref($from_bin) eq 'SL::DB::Bin' and ref($to_bin) eq 'SL::DB::Bin';
 127
 128   my $qty = delete($params{qty});
 129   die "qty must be > 0" unless $qty > 0;
 130
 131   # set defaults
 132   my $transfer_type = SL::DB::Manager::TransferType->find_by(description => 'transfer') or die "can't determine transfer type";
 133   my $employee_id   = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
 134
 135   my $WH_params = {
 136     'bestbefore'         => undef,
 137     'change_default_bin' => undef,
 138     'chargenumber'       => '',
 139     'comment'            => delete $params{comment} // '',
 140     'dst_bin_id'         => $to_bin->id,
 141     'dst_warehouse_id'   => $to_bin->warehouse_id,
 142     'parts_id'           => $part->id,
 143     'qty'                => $qty,
 144     'src_bin_id'         => $from_bin->id,
 145     'src_warehouse_id'   => $from_bin->warehouse_id,
 146     'transfer_type_id'   => $transfer_type->id,
 147   };
 148
 149   WH->transfer($WH_params);
 150
 151   return 1;
 152
 153   # do it manually via rose:
 154   # my $trans_id;
 155
 156   # my $db = SL::DB::Inventory->new->db;
 157   # $db->with_transaction(sub{
 158   #   ($trans_id) = $db->dbh->selectrow_array("select nextval('id')", {});
 159   #   die "no trans_id" unless $trans_id;
 160
 161   #   my %params = (
 162   #     shippingdate  => delete $params{shippingdate} // DateTime->today,
 163   #     employee_id   => $employee_id,
 164   #     trans_id      => $trans_id,
 165   #     trans_type_id => $transfer_type->id,
 166   #     parts_id      => $part->id,
 167   #     comment       => delete $params{comment} || 'Umlagerung',
 168   #   );
 169
 170   #   SL::DB::Inventory->new(
 171   #     warehouse_id => $from_bin->warehouse_id,
 172   #     bin_id       => $from_bin->id,
 173   #     qty          => $qty * -1,
 174   #     %params,
 175   #   )->save;
 176
 177   #   SL::DB::Inventory->new(
 178   #     warehouse_id => $to_bin->warehouse_id,
 179   #     bin_id       => $to_bin->id,
 180   #     qty          => $qty,
 181   #     %params,
 182   #   )->save;
 183   # }) or die $@ . "\n";
 184   # return 1;
 185 }
 186
 187 1;
 188
 189 __END__
 190
 191 =head1 NAME
 192
 193 SL::Dev::Inventory - create inventory-related objects for testing, with minimal
 194 defaults
 195
 196 =head1 FUNCTIONS
 197
 198 =head2 C<create_warehouse_and_bins %PARAMS>
 199
 200 Creates a new warehouse and bins, and immediately saves them. Returns the
 201 warehouse and the first bin object.
 202   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 203
 204 Create named warehouse with 10 bins:
 205   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => 'Testlager',
 206                                                                  bin_description       => 'Testlagerplatz',
 207                                                                  number_of_bins        => 10,
 208                                                                 );
 209 To access the second bin:
 210   my $bin2 = $wh->bins->[1];
 211
 212 =head2 C<set_stock %PARAMS>
 213
 214 Change the stock level of a certain part by creating an inventory event.
 215 To access the updated onhand the part object needs to be loaded afterwards.
 216
 217 Mandatory params:
 218   part - an SL::DB::Part object or a parts_id
 219   qty | abs_qty
 220     qty     : the qty to increase of decrease the stock level by
 221     abs_qty : sets stock level for a certain part to abs_qty by creating
 222               a stock event with the current difference
 223
 224 Optional params:
 225   bin_id | bin
 226   shippingdate : may be a DateTime object or a string that needs to be parsed by parse_date_to_object.
 227   unit         : SL::DB::Unit object, or the name of an SL::DB::Unit object
 228
 229 If no bin is passed the default bin of the part is used, if that doesn't exist
 230 either there will be an error.
 231
 232 C<set_stock> creates the SL::DB::Inventory object from scratch, rather
 233 than passing params to WH->transfer_in or WH->transfer_out.
 234
 235 Examples:
 236   my $part = SL::DB::Manager::Part->find_by(partnumber => '1');
 237   SL::Dev::Inventory::set_stock(part => $part, qty =>  5);
 238   SL::Dev::Inventory::set_stock(part => $part, qty => -2);
 239   $part->load;
 240   $part->onhand; # 3
 241
 242 Set stock level of a part in a certain bin_id to 10:
 243   SL::Dev::Inventory::set_stock(part => $part, bin_id => 99, abs_qty => 10);
 244
 245 Create 10 warehouses with 5 bins each, then create 100 parts and increase the
 246 stock qty in a random bin by a random positive qty for each of the parts:
 247
 248   SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => "Testlager $_") for ( 1 .. 10 );
 249   SL::Dev::Part::create_part(description => "Testpart $_")->save for ( 1 .. 100 );
 250   my $bins = SL::DB::Manager::Bin->get_all;
 251   SL::Dev::Inventory::set_stock(part => $_,
 252                                 qty  => int(rand(99))+1,
 253                                 bin  => $bins->[ rand @{$bins} ],
 254                                ) foreach @{ SL::DB::Manager::Part->get_all() };
 255
 256 =head2 C<transfer_stock %PARAMS>
 257
 258 Transfers parts from one bin to another.
 259
 260 Mandatory params:
 261   part | parts_id    - an SL::DB::Part object or a parts_id
 262   from_bin           - an SL::DB::Bin object
 263   to_bin qty         - an SL::DB::Bin object
 264
 265 Optional params: shippingdate
 266
 267 The unit is always base_unit and there is no check for negative stock values.
 268
 269 Example: Create a warehouse and bins, a part, stock the part and then move some
 270 of the stock to a different bin inside the same warehouse:
 271
 272   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 273   my $part = SL::Dev::Part::create_part->save;
 274   SL::Dev::Inventory::set_stock(part => $part, bin_id => $wh->bins->[2]->id, qty => 5);
 275   SL::Dev::Inventory::transfer_stock(part     => $part,
 276                                      from_bin => $wh->bins->[2],
 277                                      to_bin   => $wh->bins->[4],
 278                                      qty      => 3
 279                                     );
 280   $part->get_stock(bin_id => $wh->bins->[4]->id); # 3.00000
 281   $part->get_stock(bin_id => $wh->bins->[2]->id); # 2.00000
 282
 283 =head1 BUGS
 284
 285 Nothing here yet.
 286
 287 =head1 AUTHOR
 288
 289 G. Richardson E<lt>grichardson@kivitendo-premium.deE<gt>
 290
 291 =cut