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