SL/Dev/Inventory.pm

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