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 transfer_stock transfer_sales_delivery_order transfer_purchase_delivery_order transfer_delivery_order_item transfer_in transfer_out);
   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::DB::DeliveryOrderItemsStock;
  13 use SL::WH;
  14 use DateTime;
  15 use Data::Dumper;
  16 use Carp;
  17
  18 sub create_warehouse_and_bins {
  19   my (%params) = @_;
  20
  21   my $number_of_bins = $params{number_of_bins} || 5;
  22   my $wh = SL::DB::Warehouse->new(description => $params{warehouse_description} || "Warehouse", invalid => 0);
  23   for my $i ( 1 .. $number_of_bins ) {
  24     $wh->add_bins( SL::DB::Bin->new(description => ( $params{bin_description} || "Bin" ) . " $i" ) );
  25   }
  26   $wh->save;
  27   return ($wh, $wh->bins->[0]);
  28 }
  29
  30 sub set_stock {
  31   my (%params) = @_;
  32
  33   die "param part is missing or not an SL::DB::Part object" unless ref($params{part}) eq 'SL::DB::Part';
  34   my $part = delete $params{part};
  35   die "qty is missing" unless $params{qty} or $params{abs_qty};
  36   die "need a bin or default bin" unless $part->warehouse_id or $part->bin_id or $params{bin} or $params{bin_id};
  37
  38   my ($warehouse_id, $bin_id);
  39
  40   if ( $params{bin} ) {
  41     die "illegal param bin: " . Dumper($params{bin}) unless ref($params{bin}) eq 'SL::DB::Bin';
  42     my $bin       = delete $params{bin};
  43     $bin_id       = $bin->id;
  44     $warehouse_id = $bin->warehouse_id;
  45   } elsif ( $params{bin_id} ) {
  46     my $bin       = SL::DB::Manager::Bin->find_by(id => delete $params{bin_id});
  47     $bin_id       = $bin->id;
  48     $warehouse_id = $bin->warehouse_id;
  49   } elsif ( $part->bin_id ) {
  50     $bin_id       = $part->bin_id;
  51     $warehouse_id = $part->warehouse_id;
  52   } else {
  53     die "can't determine bin and warehouse";
  54   }
  55
  56   my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
  57   die "Can't determine employee" unless $employee_id;
  58
  59   my $qty = delete $params{qty};
  60
  61   my $transfer_type_description;
  62   my $transfer_type;
  63   if ( $params{abs_qty} ) {
  64     # determine the current qty and calculate the qty diff that needs to be applied
  65     # if abs_qty is set then any value that was in $params{qty} is ignored/overwritten
  66     my %get_stock_params;
  67     $get_stock_params{bin_id}       = $bin_id       if $bin_id;
  68     # $get_stock_params{warehouse_id} = $warehouse_id if $warehouse_id; # redundant
  69     my $current_qty = $part->get_stock(%get_stock_params);
  70     $qty = $params{abs_qty} - $current_qty;
  71   }
  72
  73   if ( $qty > 0 ) {
  74     $transfer_type_description = delete $params{transfer_type} // 'stock';
  75     $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'in' );
  76   } else {
  77     $transfer_type_description = delete $params{transfer_type} // 'shipped';
  78     $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'out' );
  79   }
  80   die "can't determine transfer_type" unless $transfer_type;
  81
  82   my $shippingdate;
  83   if ( $params{shippingdate} ) {
  84     $shippingdate = delete $params{shippingdate};
  85     $shippingdate = $::locale->parse_date_to_object($shippingdate) unless ref($shippingdate) eq 'DateTime';
  86   } else {
  87     $shippingdate = DateTime->today;
  88   }
  89
  90   my $unit;
  91   if ( $params{unit} ) {
  92     $unit = delete $params{unit};
  93     $unit = SL::DB::Manager::Unit->find_by( name => $unit ) unless ref($unit) eq 'SL::DB::Unit';
  94     $qty  = $unit->convert_to($qty, $part->unit_obj);
  95   }
  96
  97   my ($trans_id) = $part->db->dbh->selectrow_array("select nextval('id')", {});
  98
  99   SL::DB::Inventory->new(
 100     parts_id         => $part->id,
 101     bin_id           => $bin_id,
 102     warehouse_id     => $warehouse_id,
 103     employee_id      => $employee_id,
 104     trans_type_id    => $transfer_type->id,
 105     comment          => $params{comment},
 106     shippingdate     => $shippingdate,
 107     qty              => $qty,
 108     trans_id         => $trans_id,
 109   )->save;
 110 }
 111
 112 sub transfer_stock {
 113   my (%params) = @_;
 114
 115   # check params:
 116   die "missing params" unless ( $params{parts_id} or $params{part} ) and $params{from_bin} and $params{to_bin};
 117
 118   my $part;
 119   if ( $params{parts_id} ) {
 120     $part = SL::DB::Manager::Part->find_by( id => delete $params{parts_id} ) or die "illegal parts_id";
 121   } else {
 122     $part = delete $params{part};
 123   }
 124   die "illegal part" unless ref($part) eq 'SL::DB::Part';
 125
 126   my $from_bin = delete $params{from_bin};
 127   my $to_bin   = delete $params{to_bin};
 128   die "illegal bins" unless ref($from_bin) eq 'SL::DB::Bin' and ref($to_bin) eq 'SL::DB::Bin';
 129
 130   my $qty = delete($params{qty});
 131   die "qty must be > 0" unless $qty > 0;
 132
 133   # set defaults
 134   my $transfer_type = SL::DB::Manager::TransferType->find_by(description => 'transfer') or die "can't determine transfer type";
 135   my $employee_id   = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
 136
 137   my $WH_params = {
 138     'bestbefore'         => undef,
 139     'change_default_bin' => undef,
 140     'chargenumber'       => '',
 141     'comment'            => delete $params{comment} // '',
 142     'dst_bin_id'         => $to_bin->id,
 143     'dst_warehouse_id'   => $to_bin->warehouse_id,
 144     'parts_id'           => $part->id,
 145     'qty'                => $qty,
 146     'src_bin_id'         => $from_bin->id,
 147     'src_warehouse_id'   => $from_bin->warehouse_id,
 148     'transfer_type_id'   => $transfer_type->id,
 149   };
 150
 151   WH->transfer($WH_params);
 152
 153   return 1;
 154
 155   # do it manually via rose:
 156   # my $trans_id;
 157
 158   # my $db = SL::DB::Inventory->new->db;
 159   # $db->with_transaction(sub{
 160   #   ($trans_id) = $db->dbh->selectrow_array("select nextval('id')", {});
 161   #   die "no trans_id" unless $trans_id;
 162
 163   #   my %params = (
 164   #     shippingdate  => delete $params{shippingdate} // DateTime->today,
 165   #     employee_id   => $employee_id,
 166   #     trans_id      => $trans_id,
 167   #     trans_type_id => $transfer_type->id,
 168   #     parts_id      => $part->id,
 169   #     comment       => delete $params{comment} || 'Umlagerung',
 170   #   );
 171
 172   #   SL::DB::Inventory->new(
 173   #     warehouse_id => $from_bin->warehouse_id,
 174   #     bin_id       => $from_bin->id,
 175   #     qty          => $qty * -1,
 176   #     %params,
 177   #   )->save;
 178
 179   #   SL::DB::Inventory->new(
 180   #     warehouse_id => $to_bin->warehouse_id,
 181   #     bin_id       => $to_bin->id,
 182   #     qty          => $qty,
 183   #     %params,
 184   #   )->save;
 185   # }) or die $@ . "\n";
 186   # return 1;
 187 }
 188
 189 sub _transfer {
 190   my (%params) = @_;
 191
 192   my $transfer_type = delete $params{transfer_type};
 193
 194   die "param transfer_type is not a SL::DB::TransferType object: " . Dumper($transfer_type) unless ref($transfer_type) eq 'SL::DB::TransferType';
 195
 196   my $shippingdate  = delete $params{shippingdate}  // DateTime->today;
 197
 198   my $part = delete($params{part}) or croak 'part missing';
 199   my $qty  = delete($params{qty})  or croak 'qty missing';
 200
 201   # distinguish absolute qty in inventory depending on transfer type direction
 202   $qty *= -1 if $transfer_type->direction eq 'out';
 203
 204   # use defaults for unit/wh/bin is they exist and nothing else is specified
 205   my $unit = delete($params{unit}) // $part->unit      or croak 'unit missing';
 206   my $bin  = delete($params{bin})  // $part->bin       or croak 'bin missing';
 207   # if bin is given, we don't need a warehouse param
 208   my $wh   = $bin->warehouse or croak 'wh missing';
 209
 210   WH->transfer({
 211     parts_id         => $part->id,
 212     dst_bin          => $bin,
 213     dst_wh           => $wh,
 214     qty              => $qty,
 215     transfer_type    => $transfer_type,
 216     unit             => $unit,
 217     comment          => delete $params{comment},
 218     shippingdate     => $shippingdate,
 219   });
 220 }
 221
 222 sub transfer_in {
 223   my (%params) = @_;
 224
 225   my $transfer_type = delete $params{transfer_type} // 'stock';
 226
 227   my $transfer_type_obj = SL::DB::Manager::TransferType->find_by( direction => 'in', description => $transfer_type ) or die "Can't find transfer_type with direction in and descriptin " . $params{transfer_type};
 228
 229   $params{transfer_type} = $transfer_type_obj;
 230
 231   _transfer(%params);
 232 }
 233
 234 sub transfer_out {
 235   my (%params) = @_;
 236
 237   my $transfer_type = delete $params{transfer_type} // 'shipped';
 238
 239   my $transfer_type_obj = SL::DB::Manager::TransferType->find_by( direction => 'out', description => $transfer_type ) or die "Can't find transfer_type with direction in and descriptin " . $params{transfer_type};
 240
 241   $params{transfer_type} = $transfer_type_obj;
 242
 243   _transfer(%params);
 244 }
 245
 246 sub transfer_sales_delivery_order {
 247   my ($sales_delivery_order) = @_;
 248   die "first argument must be a sales delivery order Rose DB object" unless ref($sales_delivery_order) eq 'SL::DB::DeliveryOrder' and $sales_delivery_order->is_sales;
 249
 250   die "the delivery order has already been delivered" if $sales_delivery_order->delivered;
 251
 252   my ($wh, $bin, $trans_type);
 253
 254   $sales_delivery_order->db->with_transaction(sub {
 255
 256    foreach my $doi ( @{ $sales_delivery_order->items } ) {
 257      next if $doi->part->is_service or $doi->part->is_assortment;
 258      my $trans_type = SL::DB::Manager::TransferType->find_by(direction => 'out', description => 'shipped');
 259      transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
 260    };
 261    $sales_delivery_order->delivered(1);
 262    $sales_delivery_order->save(changes_only=>1);
 263    1;
 264   }) or die "error while transferring sales_delivery_order: " . $sales_delivery_order->db->error;
 265 };
 266
 267 sub transfer_purchase_delivery_order {
 268   my ($purchase_delivery_order) = @_;
 269   die "first argument must be a purchase delivery order Rose DB object" unless ref($purchase_delivery_order) eq 'SL::DB::DeliveryOrder' and not $purchase_delivery_order->is_sales;
 270
 271   my ($wh, $bin, $trans_type);
 272
 273   $purchase_delivery_order->db->with_transaction(sub {
 274
 275    foreach my $doi ( @{ $purchase_delivery_order->items } ) {
 276      my $trans_type = SL::DB::Manager::TransferType->find_by(direction => 'in', description => 'stock');
 277      transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
 278    };
 279    1;
 280   }) or die "error while transferring purchase_Delivery_order: " . $purchase_delivery_order->db->error;
 281 };
 282
 283 sub transfer_delivery_order_item {
 284   my ($doi, $wh, $bin, $trans_type) = @_;
 285
 286   unless ( defined $trans_type and ref($trans_type eq 'SL::DB::TransferType') ) {
 287     if ( $doi->record->is_sales ) {
 288       $trans_type //=  SL::DB::Manager::TransferType->find_by(direction => 'out', description => 'shipped');
 289     } else {
 290       $trans_type //= SL::DB::Manager::TransferType->find_by(direction => 'in', description => 'stock');
 291     }
 292   }
 293
 294   $bin //= $doi->part->bin;
 295   $wh  //= $doi->part->warehouse;
 296
 297   die "no bin and wh specified and part has no default bin or wh" unless $bin and $wh;
 298
 299   my $employee = SL::DB::Manager::Employee->current || die "No employee";
 300
 301   # dois are converted to base_qty, which is qty
 302   # AM->convert_unit( 'g' => 'kg') * 1000;   # 1
 303   #               $doi->unit   $doi->part->unit   $doi->qty
 304   my $dois = SL::DB::DeliveryOrderItemsStock->new(
 305     delivery_order_item => $doi,
 306     qty                 => AM->convert_unit($doi->unit => $doi->part->unit) * $doi->qty,
 307     unit                => $doi->part->unit,
 308     warehouse_id        => $wh->id,
 309     bin_id              => $bin->id,
 310   )->save;
 311
 312   my $inventory = SL::DB::Inventory->new(
 313     parts                      => $dois->delivery_order_item->part,
 314     qty                        => $dois->delivery_order_item->record->is_sales ? $dois->qty * -1 : $dois->qty,
 315     oe                         => $doi->record,
 316     warehouse_id               => $dois->warehouse_id,
 317     bin_id                     => $dois->bin_id,
 318     trans_type_id              => $trans_type->id,
 319     delivery_order_items_stock => $dois,
 320     trans_id                   => $dois->id,
 321     employee_id                => $employee->id,
 322     shippingdate               => $doi->record->transdate,
 323   )->save;
 324 };
 325
 326 1;
 327
 328 __END__
 329
 330 =head1 NAME
 331
 332 SL::Dev::Inventory - create inventory-related objects for testing, with minimal
 333 defaults
 334
 335 =head1 FUNCTIONS
 336
 337 =head2 C<create_warehouse_and_bins %PARAMS>
 338
 339 Creates a new warehouse and bins, and immediately saves them. Returns the
 340 warehouse and the first bin object.
 341   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 342
 343 Create named warehouse with 10 bins:
 344   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => 'Testlager',
 345                                                                  bin_description       => 'Testlagerplatz',
 346                                                                  number_of_bins        => 10,
 347                                                                 );
 348 To access the second bin:
 349   my $bin2 = $wh->bins->[1];
 350
 351 =head2 C<set_stock %PARAMS>
 352
 353 Change the stock level of a certain part by creating an inventory event.
 354 To access the updated onhand the part object needs to be loaded afterwards.
 355
 356 Mandatory params:
 357   part - an SL::DB::Part object or a parts_id
 358   qty | abs_qty
 359     qty     : the qty to increase of decrease the stock level by
 360     abs_qty : sets stock level for a certain part to abs_qty by creating
 361               a stock event with the current difference
 362
 363 Optional params:
 364   bin_id | bin
 365   shippingdate : may be a DateTime object or a string that needs to be parsed by parse_date_to_object.
 366   unit         : SL::DB::Unit object, or the name of an SL::DB::Unit object
 367
 368 If no bin is passed the default bin of the part is used, if that doesn't exist
 369 either there will be an error.
 370
 371 C<set_stock> creates the SL::DB::Inventory object from scratch, rather
 372 than passing params to WH->transfer_in or WH->transfer_out.
 373
 374 Examples:
 375   my $part = SL::DB::Manager::Part->find_by(partnumber => '1');
 376   SL::Dev::Inventory::set_stock(part => $part, qty =>  5);
 377   SL::Dev::Inventory::set_stock(part => $part, qty => -2);
 378   $part->load;
 379   $part->onhand; # 3
 380
 381 Set stock level of a part in a certain bin_id to 10:
 382   SL::Dev::Inventory::set_stock(part => $part, bin_id => 99, abs_qty => 10);
 383
 384 Create 10 warehouses with 5 bins each, then create 100 parts and increase the
 385 stock qty in a random bin by a random positive qty for each of the parts:
 386
 387   SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => "Testlager $_") for ( 1 .. 10 );
 388   SL::Dev::Part::create_part(description => "Testpart $_")->save for ( 1 .. 100 );
 389   my $bins = SL::DB::Manager::Bin->get_all;
 390   SL::Dev::Inventory::set_stock(part => $_,
 391                                 qty  => int(rand(99))+1,
 392                                 bin  => $bins->[ rand @{$bins} ],
 393                                ) foreach @{ SL::DB::Manager::Part->get_all() };
 394
 395 =head2 C<transfer_stock %PARAMS>
 396
 397 Transfers parts from one bin to another.
 398
 399 Mandatory params:
 400   part | parts_id    - an SL::DB::Part object or a parts_id
 401   from_bin           - an SL::DB::Bin object
 402   to_bin qty         - an SL::DB::Bin object
 403
 404 Optional params: shippingdate
 405
 406 The unit is always base_unit and there is no check for negative stock values.
 407
 408 Example: Create a warehouse and bins, a part, stock the part and then move some
 409 of the stock to a different bin inside the same warehouse:
 410
 411   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 412   my $part = SL::Dev::Part::create_part->save;
 413   SL::Dev::Inventory::set_stock(part => $part, bin_id => $wh->bins->[2]->id, qty => 5);
 414   SL::Dev::Inventory::transfer_stock(part     => $part,
 415                                      from_bin => $wh->bins->[2],
 416                                      to_bin   => $wh->bins->[4],
 417                                      qty      => 3
 418                                     );
 419   $part->get_stock(bin_id => $wh->bins->[4]->id); # 3.00000
 420   $part->get_stock(bin_id => $wh->bins->[2]->id); # 2.00000
 421
 422 =head2 C<transfer_sales_delivery_order %PARAMS>
 423
 424 Takes a SL::DB::DeliveryOrder object as its first argument and transfers out
 425 all the items via their default bin, creating the delivery_order_stock and
 426 inventory entries.
 427
 428 Assumes a fresh delivery order where nothing has been transferred out yet.
 429
 430 Should work like the functions in do.pl transfer_in/transfer_out and DO.pm
 431 transfer_in_out, except that those work on the current form where as this just
 432 works on database objects.
 433
 434 As this is just Dev it doesn't check for negative stocks etc.
 435
 436 Usage:
 437   my $sales_delivery_order = SL::DB::Manager::DeliveryOrder->find_by(donumber => 112);
 438   SL::Dev::Inventory::transfer_sales_delivery_order($sales_delivery_order1);
 439
 440 =head2 C<transfer_purchase_delivery_order %PARAMS>
 441
 442 Transfer in all the items in a purchase order.
 443
 444 Behaves like C<transfer_sales_delivery_order>.
 445
 446 =head2 C<transfer_delivery_order_item @PARAMS>
 447
 448 Transfers a delivery order item from a delivery order. The whole qty is transferred.
 449 Doesn't check for available qty.
 450
 451 Usage:
 452   SL::Dev::Inventory::transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
 453
 454 =head2 C<transfer_in %PARAMS>
 455
 456 Create stock in event for a part. Ideally the interface should mirror how data
 457 is entered via the web interface.
 458
 459 Does some param checking, sets some defaults, but otherwise uses WH->transfer.
 460
 461 Mandatory params:
 462   part               - an SL::DB::Part object
 463   qty                - a number
 464
 465 Optional params: shippingdate
 466   bin           - an SL::DB::Bin object, defaults to $part->bin
 467   wh            - an SL::DB::Bin object, defaults to $part->warehouse
 468   unit          - a string such as 't', 'Stck', defaults to $part->unit->name
 469   shippingdate  - a DateTime object, defaults to today
 470   transfer_type - a string such as 'correction', defaults to 'stock'
 471   comment
 472
 473 Example minimal usage using part default warehouse and bin:
 474   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 475   my $part       = SL::Dev::Part::create_part(unit => 'kg', warehouse => $wh, bin => $bin)->save;
 476   SL::Dev::Inventory::transfer_in(part => $part, qty => '0.9', unit => 't', comment => '900 kg in t');
 477
 478 Example with specific transfer_type and warehouse and bin and shipping_date:
 479   my $shipping_date = DateTime->today->subtract( days => 20 );
 480   SL::Dev::Inventory::transfer_in(part          => $part,
 481                                   qty           => 5,
 482                                   transfer_type => 'correction',
 483                                   bin           => $bin,
 484                                   shipping_date => $shipping_date,
 485                                  );
 486
 487 =head2 C<transfer_out %PARAMS>
 488
 489 Create stock out event for a part. See C<transfer_in>.
 490
 491 =head1 BUGS
 492
 493 Nothing here yet.
 494
 495 =head1 AUTHOR
 496
 497 G. Richardson E<lt>grichardson@kivitendo-premium.deE<gt>
 498
 499 =cut