ActionBar: Verwendung undefinierter Werte in Tests vermeiden
[kivitendo-erp.git] / 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);
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::WH;
13 use DateTime;
14 use Data::Dumper;
15
16 sub create_warehouse_and_bins {
17   my (%params) = @_;
18
19   my $number_of_bins = $params{number_of_bins} || 5;
20   my $wh = SL::DB::Warehouse->new(description => $params{warehouse_description} || "Warehouse", invalid => 0);
21   for my $i ( 1 .. $number_of_bins ) {
22     $wh->add_bins( SL::DB::Bin->new(description => ( $params{bin_description} || "Bin" ) . " $i" ) );
23   }
24   $wh->save;
25   return ($wh, $wh->bins->[0]);
26 }
27
28 sub set_stock {
29   my (%params) = @_;
30
31   die "param part is missing or not an SL::DB::Part object" unless ref($params{part}) eq 'SL::DB::Part';
32   my $part = delete $params{part};
33   die "qty is missing" unless $params{qty} or $params{abs_qty};
34   die "need a bin or default bin" unless $part->warehouse_id or $part->bin_id or $params{bin} or $params{bin_id};
35
36   my ($warehouse_id, $bin_id);
37
38   if ( $params{bin} ) {
39     die "illegal param bin: " . Dumper($params{bin}) unless ref($params{bin}) eq 'SL::DB::Bin';
40     my $bin       = delete $params{bin};
41     $bin_id       = $bin->id;
42     $warehouse_id = $bin->warehouse_id;
43   } elsif ( $params{bin_id} ) {
44     my $bin       = SL::DB::Manager::Bin->find_by(id => delete $params{bin_id});
45     $bin_id       = $bin->id;
46     $warehouse_id = $bin->warehouse_id;
47   } elsif ( $part->bin_id ) {
48     $bin_id       = $part->bin_id;
49     $warehouse_id = $part->warehouse_id;
50   } else {
51     die "can't determine bin and warehouse";
52   }
53
54   my $employee_id = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
55   die "Can't determine employee" unless $employee_id;
56
57   my $qty = delete $params{qty};
58
59   my $transfer_type_description;
60   my $transfer_type;
61   if ( $params{abs_qty} ) {
62     # determine the current qty and calculate the qty diff that needs to be applied
63     # if abs_qty is set then any value that was in $params{qty} is ignored/overwritten
64     my %get_stock_params;
65     $get_stock_params{bin_id}       = $bin_id       if $bin_id;
66     # $get_stock_params{warehouse_id} = $warehouse_id if $warehouse_id; # redundant
67     my $current_qty = $part->get_stock(%get_stock_params);
68     $qty = $params{abs_qty} - $current_qty;
69   }
70
71   if ( $qty > 0 ) {
72     $transfer_type_description = delete $params{transfer_type} // 'stock';
73     $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'in' );
74   } else {
75     $transfer_type_description = delete $params{transfer_type} // 'shipped';
76     $transfer_type = SL::DB::Manager::TransferType->find_by( description => $transfer_type_description, direction => 'out' );
77   }
78   die "can't determine transfer_type" unless $transfer_type;
79
80   my $shippingdate;
81   if ( $params{shippingdate} ) {
82     $shippingdate = delete $params{shippingdate};
83     $shippingdate = $::locale->parse_date_to_object($shippingdate) unless ref($shippingdate) eq 'DateTime';
84   } else {
85     $shippingdate = DateTime->today;
86   }
87
88   my $unit;
89   if ( $params{unit} ) {
90     $unit = delete $params{unit};
91     $unit = SL::DB::Manager::Unit->find_by( name => $unit ) unless ref($unit) eq 'SL::DB::Unit';
92     $qty  = $unit->convert_to($qty, $part->unit_obj);
93   }
94
95   my ($trans_id) = $part->db->dbh->selectrow_array("select nextval('id')", {});
96
97   SL::DB::Inventory->new(
98     parts_id         => $part->id,
99     bin_id           => $bin_id,
100     warehouse_id     => $warehouse_id,
101     employee_id      => $employee_id,
102     trans_type_id    => $transfer_type->id,
103     comment          => $params{comment},
104     shippingdate     => $shippingdate,
105     qty              => $qty,
106     trans_id         => $trans_id,
107   )->save;
108 }
109
110 sub transfer_stock {
111   my (%params) = @_;
112
113   # check params:
114   die "missing params" unless ( $params{parts_id} or $params{part} ) and $params{from_bin} and $params{to_bin};
115
116   my $part;
117   if ( $params{parts_id} ) {
118     $part = SL::DB::Manager::Part->find_by( id => delete $params{parts_id} ) or die "illegal parts_id";
119   } else {
120     $part = delete $params{part};
121   }
122   die "illegal part" unless ref($part) eq 'SL::DB::Part';
123
124   my $from_bin = delete $params{from_bin};
125   my $to_bin   = delete $params{to_bin};
126   die "illegal bins" unless ref($from_bin) eq 'SL::DB::Bin' and ref($to_bin) eq 'SL::DB::Bin';
127
128   my $qty = delete($params{qty});
129   die "qty must be > 0" unless $qty > 0;
130
131   # set defaults
132   my $transfer_type = SL::DB::Manager::TransferType->find_by(description => 'transfer') or die "can't determine transfer type";
133   my $employee_id   = delete $params{employee_id} // SL::DB::Manager::Employee->current->id;
134
135   my $WH_params = {
136     'bestbefore'         => undef,
137     'change_default_bin' => undef,
138     'chargenumber'       => '',
139     'comment'            => delete $params{comment} // '',
140     'dst_bin_id'         => $to_bin->id,
141     'dst_warehouse_id'   => $to_bin->warehouse_id,
142     'parts_id'           => $part->id,
143     'qty'                => $qty,
144     'src_bin_id'         => $from_bin->id,
145     'src_warehouse_id'   => $from_bin->warehouse_id,
146     'transfer_type_id'   => $transfer_type->id,
147   };
148
149   WH->transfer($WH_params);
150
151   return 1;
152
153   # do it manually via rose:
154   # my $trans_id;
155
156   # my $db = SL::DB::Inventory->new->db;
157   # $db->with_transaction(sub{
158   #   ($trans_id) = $db->dbh->selectrow_array("select nextval('id')", {});
159   #   die "no trans_id" unless $trans_id;
160
161   #   my %params = (
162   #     shippingdate  => delete $params{shippingdate} // DateTime->today,
163   #     employee_id   => $employee_id,
164   #     trans_id      => $trans_id,
165   #     trans_type_id => $transfer_type->id,
166   #     parts_id      => $part->id,
167   #     comment       => delete $params{comment} || 'Umlagerung',
168   #   );
169
170   #   SL::DB::Inventory->new(
171   #     warehouse_id => $from_bin->warehouse_id,
172   #     bin_id       => $from_bin->id,
173   #     qty          => $qty * -1,
174   #     %params,
175   #   )->save;
176
177   #   SL::DB::Inventory->new(
178   #     warehouse_id => $to_bin->warehouse_id,
179   #     bin_id       => $to_bin->id,
180   #     qty          => $qty,
181   #     %params,
182   #   )->save;
183   # }) or die $@ . "\n";
184   # return 1;
185 }
186
187 1;
188
189 __END__
190
191 =head1 NAME
192
193 SL::Dev::Inventory - create inventory-related objects for testing, with minimal
194 defaults
195
196 =head1 FUNCTIONS
197
198 =head2 C<create_warehouse_and_bins %PARAMS>
199
200 Creates a new warehouse and bins, and immediately saves them. Returns the
201 warehouse and the first bin object.
202   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
203
204 Create named warehouse with 10 bins:
205   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => 'Testlager',
206                                                                  bin_description       => 'Testlagerplatz',
207                                                                  number_of_bins        => 10,
208                                                                 );
209 To access the second bin:
210   my $bin2 = $wh->bins->[1];
211
212 =head2 C<set_stock %PARAMS>
213
214 Change the stock level of a certain part by creating an inventory event.
215 To access the updated onhand the part object needs to be loaded afterwards.
216
217 Mandatory params:
218   part - an SL::DB::Part object or a parts_id
219   qty | abs_qty
220     qty     : the qty to increase of decrease the stock level by
221     abs_qty : sets stock level for a certain part to abs_qty by creating
222               a stock event with the current difference
223
224 Optional params:
225   bin_id | bin
226   shippingdate : may be a DateTime object or a string that needs to be parsed by parse_date_to_object.
227   unit         : SL::DB::Unit object, or the name of an SL::DB::Unit object
228
229 If no bin is passed the default bin of the part is used, if that doesn't exist
230 either there will be an error.
231
232 C<set_stock> creates the SL::DB::Inventory object from scratch, rather
233 than passing params to WH->transfer_in or WH->transfer_out.
234
235 Examples:
236   my $part = SL::DB::Manager::Part->find_by(partnumber => '1');
237   SL::Dev::Inventory::set_stock(part => $part, qty =>  5);
238   SL::Dev::Inventory::set_stock(part => $part, qty => -2);
239   $part->load;
240   $part->onhand; # 3
241
242 Set stock level of a part in a certain bin_id to 10:
243   SL::Dev::Inventory::set_stock(part => $part, bin_id => 99, abs_qty => 10);
244
245 Create 10 warehouses with 5 bins each, then create 100 parts and increase the
246 stock qty in a random bin by a random positive qty for each of the parts:
247
248   SL::Dev::Inventory::create_warehouse_and_bins(warehouse_description => "Testlager $_") for ( 1 .. 10 );
249   SL::Dev::Part::create_part(description => "Testpart $_")->save for ( 1 .. 100 );
250   my $bins = SL::DB::Manager::Bin->get_all;
251   SL::Dev::Inventory::set_stock(part => $_,
252                                 qty  => int(rand(99))+1,
253                                 bin  => $bins->[ rand @{$bins} ],
254                                ) foreach @{ SL::DB::Manager::Part->get_all() };
255
256 =head2 C<transfer_stock %PARAMS>
257
258 Transfers parts from one bin to another.
259
260 Mandatory params:
261   part | parts_id    - an SL::DB::Part object or a parts_id
262   from_bin           - an SL::DB::Bin object
263   to_bin qty         - an SL::DB::Bin object
264
265 Optional params: shippingdate
266
267 The unit is always base_unit and there is no check for negative stock values.
268
269 Example: Create a warehouse and bins, a part, stock the part and then move some
270 of the stock to a different bin inside the same warehouse:
271
272   my ($wh, $bin) = SL::Dev::Inventory::create_warehouse_and_bins();
273   my $part = SL::Dev::Part::create_part->save;
274   SL::Dev::Inventory::set_stock(part => $part, bin_id => $wh->bins->[2]->id, qty => 5);
275   SL::Dev::Inventory::transfer_stock(part     => $part,
276                                      from_bin => $wh->bins->[2],
277                                      to_bin   => $wh->bins->[4],
278                                      qty      => 3
279                                     );
280   $part->get_stock(bin_id => $wh->bins->[4]->id); # 3.00000
281   $part->get_stock(bin_id => $wh->bins->[2]->id); # 2.00000
282
283 =head1 BUGS
284
285 Nothing here yet.
286
287 =head1 AUTHOR
288
289 G. Richardson E<lt>grichardson@kivitendo-premium.deE<gt>
290
291 =cut