SL/Dev/Inventory.pm

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