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
 342   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 343
 344 Create named warehouse with 10 bins:
 345
 346   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins(
 347     warehouse_description => 'Test warehouse',
 348     bin_description       => 'Test bin',
 349     number_of_bins        => 10,
 350   );
 351
 352 To access the second bin:
 353
 354   my $bin2 = $wh->bins->[1];
 355
 356 =head2 C<set_stock %PARAMS>
 357
 358 Change the stock level of a certain part by creating an inventory event.
 359 To access the updated onhand the part object needs to be loaded afterwards.
 360
 361 Parameter:
 362
 363 =over 4
 364
 365 =item C<part>
 366
 367 Mandatory. An SL::DB::Part object or a parts_id.
 368
 369 =item C<qty>
 370
 371 The qty to increase of decrease the stock level by.
 372
 373 Exactly one of C<qty> and C<abs_qty> is mandatory.
 374
 375 =item C<abs_qty>
 376
 377 Sets stock level for a certain part to abs_qty by creating a stock event with
 378 the current difference.
 379
 380 Exactly one of C<qty> and C<abs_qty> is mandatory.
 381
 382 =item C<bin_id>
 383
 384 =item C<bin>
 385
 386 Optional. The bin for inventory entry.
 387
 388 If no bin is passed the default bin of the part is used, if that doesn't exist
 389 either there will be an error.
 390
 391 =item C<shippingdate>
 392
 393 Optional. May be a DateTime object or a string that needs to be parsed by
 394 parse_date_to_object.
 395
 396 =item C<unit>
 397
 398 Optional. SL::DB::Unit object, or the name of an SL::DB::Unit object.
 399
 400 =back
 401
 402 C<set_stock> creates the SL::DB::Inventory object from scratch, rather
 403 than passing params to WH->transfer_in or WH->transfer_out.
 404
 405 Examples:
 406
 407   my $part = SL::DB::Manager::Part->find_by(partnumber => '1');
 408   SL::Dev::Inventory::set_stock(part => $part, abs_qty => 5);
 409   SL::Dev::Inventory::set_stock(part => $part, qty => -2);
 410   $part->load;
 411   $part->onhand; # 3
 412
 413 Set stock level of a part in a certain bin_id to 10:
 414
 415   SL::Dev::Inventory::set_stock(part => $part, bin_id => 99, abs_qty => 10);
 416
 417 Create 10 warehouses with 5 bins each, then create 100 parts and increase the
 418 stock qty in a random bin by a random positive qty for each of the parts:
 419
 420   SL::Dev::Inventory::create_warehouse_and_bins(
 421     warehouse_description => "Test Warehouse $_"
 422   ) for 1 .. 10;
 423   SL::Dev::Part::create_part(
 424     description => "Test Part $_"
 425   )->save for 1 .. 100;
 426   my $bins = SL::DB::Manager::Bin->get_all;
 427   SL::Dev::Inventory::set_stock(
 428     part => $_,
 429     qty  => int(rand(99))+1,
 430     bin  => $bins->[ rand @{$bins} ],
 431   ) for @{ SL::DB::Manager::Part->get_all };
 432
 433 =head2 C<transfer_stock %PARAMS>
 434
 435 Transfers parts from one bin to another.
 436
 437 Parameters:
 438
 439 =over 4
 440
 441 =item C<part>
 442
 443 =item C<part_id>
 444
 445 Mandatory. An SL::DB::Part object or a parts_id.
 446
 447 =item C<from_bin>
 448
 449 =item C<to_bin>
 450
 451 Mandatory. SL::DB::Bin objects.
 452
 453 =item C<qty>
 454
 455 Mandatory.
 456
 457 =item C<shippingdate>
 458
 459 Optional.
 460
 461 =back
 462
 463 The unit is always base_unit and there is no check for negative stock values.
 464
 465 Example: Create a warehouse and bins, a part, stock the part and then move some
 466 of the stock to a different bin inside the same warehouse:
 467
 468   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 469   my $part = SL::Dev::Part::create_part->save;
 470   SL::Dev::Inventory::set_stock(
 471     part   => $part,
 472     bin_id => $wh->bins->[2]->id,
 473     qty    => 5,
 474   );
 475   SL::Dev::Inventory::transfer_stock(
 476     part     => $part,
 477     from_bin => $wh->bins->[2],
 478     to_bin   => $wh->bins->[4],
 479     qty      => 3,
 480   );
 481   $part->get_stock(bin_id => $wh->bins->[4]->id); # 3.00000
 482   $part->get_stock(bin_id => $wh->bins->[2]->id); # 2.00000
 483
 484 =head2 C<transfer_sales_delivery_order %PARAMS>
 485
 486 Takes a SL::DB::DeliveryOrder object as its first argument and transfers out
 487 all the items via their default bin, creating the delivery_order_stock and
 488 inventory entries.
 489
 490 Assumes a fresh delivery order where nothing has been transferred out yet.
 491
 492 Should work like the functions in do.pl transfer_in/transfer_out and DO.pm
 493 transfer_in_out, except that those work on the current form where as this just
 494 works on database objects.
 495
 496 As this is just Dev it doesn't check for negative stocks etc.
 497
 498 Usage:
 499
 500   my $sales_delivery_order = SL::DB::Manager::DeliveryOrder->find_by(donumber => 112);
 501   SL::Dev::Inventory::transfer_sales_delivery_order($sales_delivery_order1);
 502
 503 =head2 C<transfer_purchase_delivery_order %PARAMS>
 504
 505 Transfer in all the items in a purchase order.
 506
 507 Behaves like C<transfer_sales_delivery_order>.
 508
 509 =head2 C<transfer_delivery_order_item @PARAMS>
 510
 511 Transfers a delivery order item from a delivery order. The whole qty is transferred.
 512 Doesn't check for available qty.
 513
 514 Usage:
 515
 516   SL::Dev::Inventory::transfer_delivery_order_item($doi, $wh, $bin, $trans_type);
 517
 518 =head2 C<transfer_in %PARAMS>
 519
 520 Create stock in event for a part. Ideally the interface should mirror how data
 521 is entered via the web interface.
 522
 523 Does some param checking, sets some defaults, but otherwise uses WH->transfer.
 524
 525 Parameters:
 526
 527 =over 4
 528
 529 =item C<part>
 530
 531 Mandatory. An SL::DB::Part object.
 532
 533 =item C<qty>
 534
 535 Mandatory.
 536
 537 =item C<bin>
 538
 539 Optional. An SL::DB::Bin object, defaults to $part->bin.
 540
 541 =item C<wh>
 542
 543 Optional. An SL::DB::Bin object, defaults to $part->warehouse.
 544
 545 =item C<unit>
 546
 547 Optional. A string such as 't', 'Stck', defaults to $part->unit->name.
 548
 549 =item C<shippingdate>
 550
 551 Optional. A DateTime object, defaults to today.
 552
 553 =item C<transfer_type>
 554
 555 Optional. A string such as 'correction', defaults to 'stock'.
 556
 557 =item C<comment>
 558
 559 Optional.
 560
 561 =back
 562
 563 Example minimal usage using part default warehouse and bin:
 564
 565   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
 566   my $part       = SL::Dev::Part::create_part(
 567     unit      => 'kg',
 568     warehouse => $wh,
 569     bin       => $bin,
 570   )->save;
 571   SL::Dev::Inventory::transfer_in(
 572     part    => $part,
 573     qty     => 0.9,
 574     unit    => 't',
 575     comment => '900 kg in t',
 576   );
 577
 578 Example with specific transfer_type and warehouse and bin and shipping_date:
 579
 580   my $shipping_date = DateTime->today->subtract( days => 20 );
 581   SL::Dev::Inventory::transfer_in(
 582     part          => $part,
 583     qty           => 5,
 584     transfer_type => 'correction',
 585     bin           => $bin,
 586     shipping_date => $shipping_date,
 587   );
 588
 589 =head2 C<transfer_out %PARAMS>
 590
 591 Create stock out event for a part. See C<transfer_in>.
 592
 593 =head1 BUGS
 594
 595 Nothing here yet.
 596
 597 =head1 AUTHOR
 598
 599 G. Richardson E<lt>grichardson@kivitendo-premium.deE<gt>
 600
 601 =cut