5e2551b2d3694ff26151cd3b0298bd95f804b77d
[kivitendo-erp.git] / SL / OE.pm
1 #====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (C) 1999-2003
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 #  Contributors:
16 #
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
21 #
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
25 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
29 #======================================================================
30 #
31 # Order entry module
32 # Quotation
33 #======================================================================
34
35 package OE;
36
37 use List::Util qw(max first);
38 use YAML;
39
40 use SL::AM;
41 use SL::Common;
42 use SL::CVar;
43 use SL::DB::Order;
44 use SL::DB::PeriodicInvoicesConfig;
45 use SL::DB::Status;
46 use SL::DB::Tax;
47 use SL::DBUtils;
48 use SL::HTML::Restrict;
49 use SL::IC;
50 use SL::TransNumber;
51
52 use strict;
53
54 sub transactions {
55   $main::lxdebug->enter_sub();
56
57   my ($self, $myconfig, $form) = @_;
58
59   # connect to database
60   my $dbh = $form->get_standard_dbh;
61
62   my $query;
63   my $ordnumber = 'ordnumber';
64   my $quotation = '0';
65
66   my @values;
67   my $where;
68
69   my ($periodic_invoices_columns, $periodic_invoices_joins);
70
71   my $rate = ($form->{vc} eq 'customer') ? 'buy' : 'sell';
72
73   if ($form->{type} =~ /_quotation$/) {
74     $quotation = '1';
75     $ordnumber = 'quonumber';
76
77   } elsif ($form->{type} eq 'sales_order') {
78     $periodic_invoices_columns = qq| , COALESCE(pcfg.active, 'f') AS periodic_invoices |;
79     $periodic_invoices_joins   = qq| LEFT JOIN periodic_invoices_configs pcfg ON (o.id = pcfg.oe_id) |;
80   }
81
82   my $vc = $form->{vc} eq "customer" ? "customer" : "vendor";
83
84   my %billed_amount;
85   my %billed_netamount;
86   if ($form->{l_remaining_amount} || $form->{l_remaining_netamount}) {
87     $query = <<'';
88       SELECT from_id, ar.amount, ar.netamount FROM (
89         SELECT from_id, to_id
90         FROM record_links
91         WHERE from_table = 'oe' AND to_table = 'ar'
92         UNION
93         SELECT rl1.from_id, rl2.to_id
94         FROM record_links rl1
95         LEFT JOIN record_links rl2 ON (rl1.to_table = rl2.from_table AND rl1.to_id = rl2.from_id)
96         WHERE rl1.from_table = 'oe' AND rl2.to_table = 'ar'
97       ) rl
98       LEFT JOIN ar ON ar.id = rl.to_id
99
100     for my $ref (@{ selectall_hashref_query($form, $dbh, $query) }) {
101       $billed_amount{   $ref->{from_id}} += $ref->{amount};
102       $billed_netamount{$ref->{from_id}} += $ref->{netamount};
103     }
104   }
105
106   $query =
107     qq|SELECT o.id, o.ordnumber, o.transdate, o.reqdate, | .
108     qq|  o.amount, ct.${vc}number, ct.name, o.netamount, o.${vc}_id, o.globalproject_id, | .
109     qq|  o.closed, o.delivered, o.quonumber, o.cusordnumber, o.shippingpoint, o.shipvia, | .
110     qq|  o.transaction_description, | .
111     qq|  o.marge_total, o.marge_percent, | .
112     qq|  ex.$rate AS exchangerate, | .
113     qq|  pr.projectnumber AS globalprojectnumber, | .
114     qq|  e.name AS employee, s.name AS salesman, | .
115     qq|  ct.${vc}number AS vcnumber, ct.country, ct.ustid, ct.business_id,  | .
116     qq|  tz.description AS taxzone | .
117     $periodic_invoices_columns .
118     qq|  , o.order_probability, o.expected_billing_date, (o.netamount * o.order_probability / 100) AS expected_netamount | .
119     qq|FROM oe o | .
120     qq|JOIN $vc ct ON (o.${vc}_id = ct.id) | .
121     qq|LEFT JOIN contacts cp ON (o.cp_id = cp.cp_id) | .
122     qq|LEFT JOIN employee e ON (o.employee_id = e.id) | .
123     qq|LEFT JOIN employee s ON (o.salesman_id = s.id) | .
124     qq|LEFT JOIN exchangerate ex ON (ex.currency_id = o.currency_id | .
125     qq|  AND ex.transdate = o.transdate) | .
126     qq|LEFT JOIN project pr ON (o.globalproject_id = pr.id) | .
127     qq|LEFT JOIN tax_zones tz ON (o.taxzone_id = tz.id) | .
128     qq|$periodic_invoices_joins | .
129     qq|WHERE (o.quotation = ?) |;
130   push(@values, $quotation);
131
132   my ($null, $split_department_id) = split /--/, $form->{department};
133   my $department_id = $form->{department_id} || $split_department_id;
134   if ($department_id) {
135     $query .= qq| AND o.department_id = ?|;
136     push(@values, $department_id);
137   }
138
139   if ($form->{"project_id"}) {
140     $query .=
141       qq|AND ((globalproject_id = ?) OR EXISTS | .
142       qq|  (SELECT * FROM orderitems oi | .
143       qq|   WHERE oi.project_id = ? AND oi.trans_id = o.id))|;
144     push(@values, conv_i($form->{"project_id"}), conv_i($form->{"project_id"}));
145   }
146
147   if ($form->{"projectnumber"}) {
148     $query .= <<SQL;
149       AND ((pr.projectnumber ILIKE ?) OR EXISTS (
150         SELECT * FROM orderitems oi
151         LEFT JOIN project proi ON proi.id = oi.project_id
152         WHERE proi.projectnumber ILIKE ? AND oi.trans_id = o.id
153       ))
154 SQL
155     push @values, "%" . $form->{"projectnumber"} . "%", "%" . $form->{"projectnumber"} . "%" ;
156   }
157
158   if ($form->{"business_id"}) {
159     $query .= " AND ct.business_id = ?";
160     push(@values, $form->{"business_id"});
161   }
162
163   if ($form->{"${vc}_id"}) {
164     $query .= " AND o.${vc}_id = ?";
165     push(@values, $form->{"${vc}_id"});
166
167   } elsif ($form->{$vc}) {
168     $query .= " AND ct.name ILIKE ?";
169     push(@values, '%' . $form->{$vc} . '%');
170   }
171
172   if ($form->{"cp_name"}) {
173     $query .= " AND (cp.cp_name ILIKE ? OR cp.cp_givenname ILIKE ?)";
174     push(@values, ('%' . $form->{"cp_name"} . '%')x2);
175   }
176
177   if (!$main::auth->assert('sales_all_edit', 1)) {
178     $query .= " AND o.employee_id = (select id from employee where login= ?)";
179     push @values, $form->{login};
180   }
181   if ($form->{employee_id}) {
182     $query .= " AND o.employee_id = ?";
183     push @values, conv_i($form->{employee_id});
184   }
185
186   if ($form->{salesman_id}) {
187     $query .= " AND o.salesman_id = ?";
188     push @values, conv_i($form->{salesman_id});
189   }
190
191   if (!$form->{open} && !$form->{closed}) {
192     $query .= " AND o.id = 0";
193   } elsif (!($form->{open} && $form->{closed})) {
194     $query .= ($form->{open}) ? " AND o.closed = '0'" : " AND o.closed = '1'";
195   }
196
197   if (($form->{"notdelivered"} || $form->{"delivered"}) &&
198       ($form->{"notdelivered"} ne $form->{"delivered"})) {
199     $query .= $form->{"delivered"} ?
200       " AND o.delivered " : " AND NOT o.delivered";
201   }
202
203   if ($form->{$ordnumber}) {
204     $query .= qq| AND o.$ordnumber ILIKE ?|;
205     push(@values, '%' . $form->{$ordnumber} . '%');
206   }
207
208   if ($form->{cusordnumber}) {
209     $query .= qq| AND o.cusordnumber ILIKE ?|;
210     push(@values, '%' . $form->{cusordnumber} . '%');
211   }
212
213   if($form->{transdatefrom}) {
214     $query .= qq| AND o.transdate >= ?|;
215     push(@values, conv_date($form->{transdatefrom}));
216   }
217
218   if($form->{transdateto}) {
219     $query .= qq| AND o.transdate <= ?|;
220     push(@values, conv_date($form->{transdateto}));
221   }
222
223   if($form->{reqdatefrom}) {
224     $query .= qq| AND o.reqdate >= ?|;
225     push(@values, conv_date($form->{reqdatefrom}));
226   }
227
228   if($form->{reqdateto}) {
229     $query .= qq| AND o.reqdate <= ?|;
230     push(@values, conv_date($form->{reqdateto}));
231   }
232
233   if ($form->{shippingpoint}) {
234     $query .= qq| AND o.shippingpoint ILIKE ?|;
235     push(@values, '%' . $form->{shippingpoint} . '%');
236   }
237
238   if ($form->{taxzone_id} ne '') { # taxzone_id could be 0
239     $query .= qq| AND tz.id = ?|;
240     push(@values, $form->{taxzone_id});
241   }
242
243   if ($form->{transaction_description}) {
244     $query .= qq| AND o.transaction_description ILIKE ?|;
245     push(@values, '%' . $form->{transaction_description} . '%');
246   }
247
248   if ($form->{periodic_invoices_active} ne $form->{periodic_invoices_inactive}) {
249     my $not  = $form->{periodic_invoices_inactive} ? 'NOT' : '';
250     $query  .= qq| AND ${not} COALESCE(pcfg.active, 'f')|;
251   }
252
253   if ($form->{reqdate_unset_or_old}) {
254     $query .= qq| AND ((o.reqdate IS NULL) OR (o.reqdate < date_trunc('month', current_date)))|;
255   }
256
257   if (($form->{order_probability_value} || '') ne '') {
258     my $op  = $form->{order_probability_value} eq 'le' ? '<=' : '>=';
259     $query .= qq| AND (o.order_probability ${op} ?)|;
260     push @values, $form->{order_probability_value};
261   }
262
263   if ($form->{expected_billing_date_from}) {
264     $query .= qq| AND (o.expected_billing_date >= ?)|;
265     push @values, conv_date($form->{expected_billing_date_from});
266   }
267
268   if ($form->{expected_billing_date_to}) {
269     $query .= qq| AND (o.expected_billing_date <= ?)|;
270     push @values, conv_date($form->{expected_billing_date_to});
271   }
272
273   my $sortdir   = !defined $form->{sortdir} ? 'ASC' : $form->{sortdir} ? 'ASC' : 'DESC';
274   my $sortorder = join(', ', map { "${_} ${sortdir} " } ("o.id", $form->sort_columns("transdate", $ordnumber, "name")));
275   my %allowed_sort_columns = (
276     "transdate"               => "o.transdate",
277     "reqdate"                 => "o.reqdate",
278     "id"                      => "o.id",
279     "ordnumber"               => "o.ordnumber",
280     "cusordnumber"            => "o.cusordnumber",
281     "quonumber"               => "o.quonumber",
282     "name"                    => "ct.name",
283     "employee"                => "e.name",
284     "salesman"                => "s.name",
285     "shipvia"                 => "o.shipvia",
286     "transaction_description" => "o.transaction_description",
287     "shippingpoint"           => "o.shippingpoint",
288     "taxzone"                 => "tz.description",
289   );
290   if ($form->{sort} && grep($form->{sort}, keys(%allowed_sort_columns))) {
291     $sortorder = $allowed_sort_columns{$form->{sort}} . " ${sortdir}";
292   }
293   $query .= qq| ORDER by | . $sortorder;
294
295   my $sth = $dbh->prepare($query);
296   $sth->execute(@values) ||
297     $form->dberror($query . " (" . join(", ", @values) . ")");
298
299   my %id = ();
300   $form->{OE} = [];
301   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
302     $ref->{billed_amount}    = $billed_amount{$ref->{id}};
303     $ref->{billed_netamount} = $billed_netamount{$ref->{id}};
304     $ref->{remaining_amount} = $ref->{amount} - $ref->{billed_amount};
305     $ref->{remaining_netamount} = $ref->{netamount} - $ref->{billed_netamount};
306     $ref->{exchangerate} = 1 unless $ref->{exchangerate};
307     push @{ $form->{OE} }, $ref if $ref->{id} != $id{ $ref->{id} };
308     $id{ $ref->{id} } = $ref->{id};
309   }
310
311   $sth->finish;
312
313   $main::lxdebug->leave_sub();
314 }
315
316 sub transactions_for_todo_list {
317   $main::lxdebug->enter_sub();
318
319   my $self     = shift;
320   my %params   = @_;
321
322   my $myconfig = \%main::myconfig;
323   my $form     = $main::form;
324
325   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
326
327   my $query    = qq|SELECT id FROM employee WHERE login = ?|;
328   my ($e_id)   = selectrow_query($form, $dbh, $query, $form->{login});
329
330   $query       =
331     qq|SELECT oe.id, oe.transdate, oe.reqdate, oe.quonumber, oe.transaction_description, oe.amount,
332          CASE WHEN (COALESCE(oe.customer_id, 0) = 0) THEN 'vendor' ELSE 'customer' END AS vc,
333          c.name AS customer,
334          v.name AS vendor,
335          e.name AS employee
336        FROM oe
337        LEFT JOIN customer c ON (oe.customer_id = c.id)
338        LEFT JOIN vendor v   ON (oe.vendor_id   = v.id)
339        LEFT JOIN employee e ON (oe.employee_id = e.id)
340        WHERE (COALESCE(quotation, FALSE) = TRUE)
341          AND (COALESCE(closed,    FALSE) = FALSE)
342          AND ((oe.employee_id = ?) OR (oe.salesman_id = ?))
343          AND NOT (oe.reqdate ISNULL)
344          AND (oe.reqdate < current_date)
345        ORDER BY transdate|;
346
347   my $quotations = selectall_hashref_query($form, $dbh, $query, $e_id, $e_id);
348
349   $main::lxdebug->leave_sub();
350
351   return $quotations;
352 }
353
354 sub save {
355   $main::lxdebug->enter_sub();
356
357   my ($self, $myconfig, $form) = @_;
358
359   # connect to database, turn off autocommit
360   my $dbh = $form->get_standard_dbh;
361   my $restricter = SL::HTML::Restrict->create;
362
363   my ($query, @values, $sth, $null);
364   my $exchangerate = 0;
365
366   my $all_units = AM->retrieve_units($myconfig, $form);
367   $form->{all_units} = $all_units;
368
369   my $ic_cvar_configs = CVar->get_configs(module => 'IC',
370                                           dbh    => $dbh);
371
372   $form->{employee_id} = (split /--/, $form->{employee})[1] if !$form->{employee_id};
373   unless ($form->{employee_id}) {
374     $form->get_employee($dbh);
375   }
376
377   my $ml = ($form->{type} eq 'sales_order') ? 1 : -1;
378
379   my $number_field         = $form->{type} =~ m{order} ? 'ordnumber' : 'quonumber';
380   my $trans_number         = SL::TransNumber->new(type => $form->{type}, dbh => $dbh, number => $form->{$number_field}, id => $form->{id});
381   $form->{$number_field} ||= $trans_number->create_unique;
382
383   if ($form->{id}) {
384     $query = qq|DELETE FROM shipto | .
385              qq|WHERE trans_id = ? AND module = 'OE'|;
386     do_query($form, $dbh, $query, $form->{id});
387
388   } else {
389
390     $query = qq|SELECT nextval('id')|;
391     ($form->{id}) = selectrow_query($form, $dbh, $query);
392
393     $query = qq|INSERT INTO oe (id, ordnumber, employee_id, currency_id, taxzone_id) VALUES (?, '', ?, (SELECT currency_id FROM defaults), ?)|;
394     do_query($form, $dbh, $query, $form->{id}, $form->{employee_id}, $form->{taxzone_id});
395   }
396
397   my $amount    = 0;
398   my $linetotal = 0;
399   my $discount  = 0;
400   my $project_id;
401   my $reqdate;
402   my $taxrate;
403   my $taxbase;
404   my $taxdiff;
405   my $taxamount = 0;
406   my $fxsellprice;
407   my %taxbase;
408   my @taxaccounts;
409   my %taxaccounts;
410   my $netamount = 0;
411   my @processed_orderitems;
412
413   $form->get_lists('price_factors' => 'ALL_PRICE_FACTORS');
414   my %price_factors = map { $_->{id} => $_->{factor} } @{ $form->{ALL_PRICE_FACTORS} };
415   my $price_factor;
416
417   for my $i (1 .. $form->{rowcount}) {
418
419     map({ $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"}) } qw(qty ship));
420
421     if ($form->{"id_$i"}) {
422
423       # get item baseunit
424       $query = qq|SELECT unit FROM parts WHERE id = ?|;
425       my ($item_unit) = selectrow_query($form, $dbh, $query, $form->{"id_$i"});
426
427       my $basefactor = 1;
428       if (defined($all_units->{$item_unit}->{factor}) &&
429           (($all_units->{$item_unit}->{factor} * 1) != 0)) {
430         $basefactor = $all_units->{$form->{"unit_$i"}}->{factor} / $all_units->{$item_unit}->{factor};
431       }
432       my $baseqty = $form->{"qty_$i"} * $basefactor;
433
434       $form->{"marge_percent_$i"} = $form->parse_amount($myconfig, $form->{"marge_percent_$i"}) * 1;
435       $form->{"marge_absolut_$i"} = $form->parse_amount($myconfig, $form->{"marge_absolut_$i"}) * 1;
436
437       $form->{"lastcost_$i"} = $form->parse_amount($myconfig, $form->{"lastcost_$i"});
438
439       # keep entered selling price
440       my $fxsellprice =
441         $form->parse_amount($myconfig, $form->{"sellprice_$i"});
442
443       my ($dec) = ($fxsellprice =~ /\.(\d+)/);
444       $dec = length $dec;
445       my $decimalplaces = ($dec > 2) ? $dec : 2;
446
447       # undo discount formatting
448       $form->{"discount_$i"} = $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100;
449
450       # deduct discount
451       $form->{"sellprice_$i"} = $fxsellprice * (1 - $form->{"discount_$i"});
452
453       # round linetotal at least to 2 decimal places
454       $price_factor = $price_factors{ $form->{"price_factor_id_$i"} } || 1;
455       $linetotal    = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"} / $price_factor, 2);
456
457       $form->{"inventory_accno_$i"} *= 1;
458       $form->{"expense_accno_$i"}   *= 1;
459
460       @taxaccounts = split(/ /, $form->{"taxaccounts_$i"});
461       $taxrate     = 0;
462       $taxdiff     = 0;
463
464       map { $taxrate += $form->{"${_}_rate"} } @taxaccounts;
465
466       if ($form->{taxincluded}) {
467         $taxamount = $linetotal * $taxrate / (1 + $taxrate);
468         $taxbase   = $linetotal - $taxamount;
469
470         # we are not keeping a natural price, do not round
471         $form->{"sellprice_$i"} =
472           $form->{"sellprice_$i"} * (1 / (1 + $taxrate));
473       } else {
474         $taxamount = $linetotal * $taxrate;
475         $taxbase   = $linetotal;
476       }
477
478       if ($form->round_amount($taxrate, 7) == 0) {
479         if ($form->{taxincluded}) {
480           foreach my $item (@taxaccounts) {
481             $taxamount = $form->round_amount($linetotal * $form->{"${item}_rate"} / (1 + abs($form->{"${item}_rate"})), 2);
482             $taxaccounts{$item} += $taxamount;
483             $taxdiff            += $taxamount;
484             $taxbase{$item}     += $taxbase;
485           }
486           $taxaccounts{ $taxaccounts[0] } += $taxdiff;
487         } else {
488           foreach my $item (@taxaccounts) {
489             $taxaccounts{$item} += $linetotal * $form->{"${item}_rate"};
490             $taxbase{$item}     += $taxbase;
491           }
492         }
493       } else {
494         foreach my $item (@taxaccounts) {
495           $taxaccounts{$item} += $taxamount * $form->{"${item}_rate"} / $taxrate;
496           $taxbase{$item} += $taxbase;
497         }
498       }
499
500       $netamount += $form->{"sellprice_$i"} * $form->{"qty_$i"} / $price_factor;
501
502       $reqdate = ($form->{"reqdate_$i"}) ? $form->{"reqdate_$i"} : undef;
503
504       # Get pricegroup_id and save it. Unfortunately the interface
505       # also uses ID "0" for signalling that none is selected, but "0"
506       # must not be stored in the database. Therefore we cannot simply
507       # use conv_i().
508       ($null, my $pricegroup_id) = split(/--/, $form->{"sellprice_pg_$i"});
509       $pricegroup_id *= 1;
510       $pricegroup_id  = undef if !$pricegroup_id;
511
512       my $position = $i;
513
514       # save detail record in orderitems table
515       my $cvars;
516       if (! $form->{"orderitems_id_$i"}) {
517         $query = qq|SELECT nextval('orderitemsid')|;
518         ($form->{"orderitems_id_$i"}) = selectrow_query($form, $dbh, $query);
519
520         $query = qq|INSERT INTO orderitems (id, position) VALUES (?, ?)|;
521         do_query($form, $dbh, $query, $form->{"orderitems_id_$i"}, conv_i($position));
522
523         # get values for CVars from master data for new items
524         $cvars = CVar->get_custom_variables(dbh      => $dbh,
525                                             module   => 'IC',
526                                             trans_id => $form->{"id_$i"},
527                                            );
528       } else {
529         # get values for CVars from custom_variables for existing items
530         $cvars = CVar->get_custom_variables(dbh        => $dbh,
531                                             module     => 'IC',
532                                             sub_module => 'orderitems',
533                                             trans_id   => $form->{"orderitems_id_$i"},
534                                            );
535       }
536       # map only non-editable CVars to form (editable ones are already there)
537       map { $form->{"ic_cvar_$_->{name}_$i"} = $_->{value} unless $_->{flag_editable} } @{ $cvars };
538
539       my $orderitems_id = $form->{"orderitems_id_$i"};
540       push @processed_orderitems, $orderitems_id;
541
542        $query = <<SQL;
543          UPDATE orderitems SET
544           trans_id = ?, position = ?, parts_id = ?, description = ?, longdescription = ?, qty = ?, base_qty = ?,
545           sellprice = ?, discount = ?, unit = ?, reqdate = ?, project_id = ?, serialnumber = ?, ship = ?,
546           pricegroup_id = ?, ordnumber = ?, transdate = ?, cusordnumber = ?, subtotal = ?,
547           marge_percent = ?, marge_total = ?, lastcost = ?, price_factor_id = ?,
548           active_price_source = ?, active_discount_source = ?,
549           price_factor = (SELECT factor FROM price_factors WHERE id = ?), marge_price_factor = ?
550         WHERE id = ?
551 SQL
552       @values = (
553            conv_i($form->{id}), conv_i($position), conv_i($form->{"id_$i"}),
554            $form->{"description_$i"}, $restricter->process($form->{"longdescription_$i"}),
555            $form->{"qty_$i"}, $baseqty,
556            $fxsellprice, $form->{"discount_$i"},
557            $form->{"unit_$i"}, conv_date($reqdate), conv_i($form->{"project_id_$i"}),
558            $form->{"serialnumber_$i"}, $form->{"ship_$i"}, $pricegroup_id,
559            $form->{"ordnumber_$i"}, conv_date($form->{"transdate_$i"}),
560            $form->{"cusordnumber_$i"}, $form->{"subtotal_$i"} ? 't' : 'f',
561            $form->{"marge_percent_$i"}, $form->{"marge_absolut_$i"},
562            $form->{"lastcost_$i"}, conv_i($form->{"price_factor_id_$i"}),
563            $form->{"active_price_source_$i"}, $form->{"active_discount_source_$i"},
564            conv_i($form->{"price_factor_id_$i"}), conv_i($form->{"marge_price_factor_$i"}),
565            conv_i($orderitems_id),
566       );
567
568       do_query($form, $dbh, $query, @values);
569
570       $form->{"sellprice_$i"} = $fxsellprice;
571       $form->{"discount_$i"} *= 100;
572
573       CVar->save_custom_variables(module       => 'IC',
574                                   sub_module   => 'orderitems',
575                                   trans_id     => $orderitems_id,
576                                   configs      => $ic_cvar_configs,
577                                   variables    => $form,
578                                   name_prefix  => 'ic_',
579                                   name_postfix => "_$i",
580                                   dbh          => $dbh);
581       # link previous items with orderitems
582       foreach (qw(orderitems invoice)) {
583         if ($form->{"converted_from_${_}_id_$i"}) {
584           RecordLinks->create_links('dbh'        => $dbh,
585                                     'mode'       => 'ids',
586                                     'from_table' => $_,
587                                     'from_ids'   => $form->{"converted_from_${_}_id_$i"},
588                                     'to_table'   => 'orderitems',
589                                     'to_id'      => $orderitems_id,
590           );
591           delete $form->{"converted_from_${_}_id_$i"};
592         }
593       }
594     }
595   }
596   # search for orphaned ids
597   $query  = sprintf 'SELECT id FROM orderitems WHERE trans_id = ? AND NOT id IN (%s)', join ', ', ("?") x scalar @processed_orderitems;
598   @values = (conv_i($form->{id}), map { conv_i($_) } @processed_orderitems);
599   my @orphaned_ids = map { $_->{id} } selectall_hashref_query($form, $dbh, $query, @values);
600
601   if (scalar @orphaned_ids) {
602     # clean up orderitems
603     $query  = sprintf 'DELETE FROM orderitems WHERE id IN (%s)', join ', ', ("?") x scalar @orphaned_ids;
604     do_query($form, $dbh, $query, @orphaned_ids);
605   }
606
607   $reqdate = ($form->{reqdate}) ? $form->{reqdate} : undef;
608
609   # add up the tax
610   my $tax = 0;
611   map { $tax += $form->round_amount($taxaccounts{$_}, 2) } keys %taxaccounts;
612
613   $amount = $form->round_amount($netamount + $tax, 2);
614   $netamount = $form->round_amount($netamount, 2);
615
616   if ($form->{currency} eq $form->{defaultcurrency}) {
617     $form->{exchangerate} = 1;
618   } else {
619     $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, ($form->{vc} eq 'customer') ? 'buy' : 'sell');
620   }
621
622   $form->{exchangerate} = $exchangerate || $form->parse_amount($myconfig, $form->{exchangerate});
623
624   my $quotation = $form->{type} =~ /_order$/ ? 'f' : 't';
625
626   ($null, $form->{department_id}) = split(/--/, $form->{department}) if $form->{department};
627
628   # save OE record
629   $query =
630     qq|UPDATE oe SET
631          ordnumber = ?, quonumber = ?, cusordnumber = ?, transdate = ?, vendor_id = ?,
632          customer_id = ?, amount = ?, netamount = ?, reqdate = ?, taxincluded = ?,
633          shippingpoint = ?, shipvia = ?, notes = ?, intnotes = ?, currency_id = (SELECT id FROM currencies WHERE name=?), closed = ?,
634          delivered = ?, proforma = ?, quotation = ?, department_id = ?, language_id = ?,
635          taxzone_id = ?, shipto_id = ?, payment_id = ?, delivery_vendor_id = ?, delivery_customer_id = ?,delivery_term_id = ?,
636          globalproject_id = ?, employee_id = ?, salesman_id = ?, cp_id = ?, transaction_description = ?, marge_total = ?, marge_percent = ?
637          , order_probability = ?, expected_billing_date = ?
638        WHERE id = ?|;
639
640   @values = ($form->{ordnumber} || '', $form->{quonumber},
641              $form->{cusordnumber}, conv_date($form->{transdate}),
642              conv_i($form->{vendor_id}), conv_i($form->{customer_id}),
643              $amount, $netamount, conv_date($reqdate),
644              $form->{taxincluded} ? 't' : 'f', $form->{shippingpoint},
645              $form->{shipvia}, $form->{notes}, $form->{intnotes},
646              $form->{currency}, $form->{closed} ? 't' : 'f',
647              $form->{delivered} ? "t" : "f", $form->{proforma} ? 't' : 'f',
648              $quotation, conv_i($form->{department_id}),
649              conv_i($form->{language_id}), conv_i($form->{taxzone_id}),
650              conv_i($form->{shipto_id}), conv_i($form->{payment_id}),
651              conv_i($form->{delivery_vendor_id}),
652              conv_i($form->{delivery_customer_id}),
653              conv_i($form->{delivery_term_id}),
654              conv_i($form->{globalproject_id}), conv_i($form->{employee_id}),
655              conv_i($form->{salesman_id}), conv_i($form->{cp_id}),
656              $form->{transaction_description},
657              $form->{marge_total} * 1, $form->{marge_percent} * 1,
658              $form->{order_probability} * 1, conv_date($form->{expected_billing_date}),
659              conv_i($form->{id}));
660   do_query($form, $dbh, $query, @values);
661
662   $form->{ordtotal} = $amount;
663
664   $form->{name} = $form->{ $form->{vc} };
665   $form->{name} =~ s/--\Q$form->{"$form->{vc}_id"}\E//;
666
667   # add shipto
668   if (!$form->{shipto_id}) {
669     $form->add_shipto($dbh, $form->{id}, "OE");
670   }
671
672   # save printed, emailed, queued
673   $form->save_status($dbh);
674
675   # Link this record to the records it was created from.
676   $form->{convert_from_oe_ids} =~ s/^\s+//;
677   $form->{convert_from_oe_ids} =~ s/\s+$//;
678   my @convert_from_oe_ids      =  split m/\s+/, $form->{convert_from_oe_ids};
679   delete $form->{convert_from_oe_ids};
680
681   if (scalar @convert_from_oe_ids) {
682     RecordLinks->create_links('dbh'        => $dbh,
683                               'mode'       => 'ids',
684                               'from_table' => 'oe',
685                               'from_ids'   => \@convert_from_oe_ids,
686                               'to_table'   => 'oe',
687                               'to_id'      => $form->{id},
688       );
689
690     $self->_close_quotations_rfqs('dbh'     => $dbh,
691                                   'from_id' => \@convert_from_oe_ids,
692                                   'to_id'   => $form->{id});
693   }
694
695   if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) {
696     if ($form->{vc} eq 'customer') {
697       $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, $form->{exchangerate}, 0);
698     }
699     if ($form->{vc} eq 'vendor') {
700       $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, 0, $form->{exchangerate});
701     }
702   }
703
704   $form->{saved_xyznumber} = $form->{$form->{type} =~ /_quotation$/ ?
705                                        "quonumber" : "ordnumber"};
706
707   Common::webdav_folder($form);
708
709   my $rc = $dbh->commit;
710
711   $self->save_periodic_invoices_config(dbh         => $dbh,
712                                        oe_id       => $form->{id},
713                                        config_yaml => $form->{periodic_invoices_config})
714     if ($form->{type} eq 'sales_order');
715
716   $main::lxdebug->leave_sub();
717
718   return $rc;
719 }
720
721 sub save_periodic_invoices_config {
722   my ($self, %params) = @_;
723
724   return if !$params{oe_id};
725
726   my $config = $params{config_yaml} ? YAML::Load($params{config_yaml}) : undef;
727   return if 'HASH' ne ref $config;
728
729   my $obj  = SL::DB::Manager::PeriodicInvoicesConfig->find_by(oe_id => $params{oe_id})
730           || SL::DB::PeriodicInvoicesConfig->new(oe_id => $params{oe_id});
731   $obj->update_attributes(%{ $config });
732 }
733
734 sub load_periodic_invoice_config {
735   my $self = shift;
736   my $form = shift;
737
738   delete $form->{periodic_invoices_config};
739
740   if ($form->{id}) {
741     my $config_obj = SL::DB::Manager::PeriodicInvoicesConfig->find_by(oe_id => $form->{id});
742
743     if ($config_obj) {
744       my $config = { map { $_ => $config_obj->$_ } qw(active terminated periodicity start_date_as_date end_date_as_date first_billing_date_as_date extend_automatically_by ar_chart_id
745                                                       print printer_id copies) };
746       $form->{periodic_invoices_config} = YAML::Dump($config);
747     }
748   }
749 }
750
751 sub _close_quotations_rfqs {
752   $main::lxdebug->enter_sub();
753
754   my $self     = shift;
755   my %params   = @_;
756
757   Common::check_params(\%params, qw(from_id to_id));
758
759   my $myconfig = \%main::myconfig;
760   my $form     = $main::form;
761
762   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
763
764   my $query    = qq|SELECT quotation FROM oe WHERE id = ?|;
765   my $sth      = prepare_query($form, $dbh, $query);
766
767   do_statement($form, $sth, $query, conv_i($params{to_id}));
768
769   my ($quotation) = $sth->fetchrow_array();
770
771   if ($quotation) {
772     $main::lxdebug->leave_sub();
773     return;
774   }
775
776   my @close_ids;
777
778   foreach my $from_id (@{ $params{from_id} }) {
779     $from_id = conv_i($from_id);
780     do_statement($form, $sth, $query, $from_id);
781     ($quotation) = $sth->fetchrow_array();
782     push @close_ids, $from_id if ($quotation);
783   }
784
785   $sth->finish();
786
787   if (scalar @close_ids) {
788     $query = qq|UPDATE oe SET closed = TRUE WHERE id IN (| . join(', ', ('?') x scalar @close_ids) . qq|)|;
789     do_query($form, $dbh, $query, @close_ids);
790
791     $dbh->commit() unless ($params{dbh});
792   }
793
794   $main::lxdebug->leave_sub();
795 }
796
797 sub delete {
798   $main::lxdebug->enter_sub();
799
800   my ($self, $myconfig, $form) = @_;
801
802   my $rc = SL::DB::Order->new->db->with_transaction(sub {
803     my @spoolfiles = grep { $_ } map { $_->spoolfile } @{ SL::DB::Manager::Status->get_all(where => [ trans_id => $form->{id} ]) };
804
805     SL::DB::Order->new(id => $form->{id})->delete;
806
807     my $spool = $::lx_office_conf{paths}->{spool};
808     unlink map { "$spool/$_" } @spoolfiles if $spool;
809
810     1;
811   });
812
813   $main::lxdebug->leave_sub();
814
815   return $rc;
816 }
817
818 sub retrieve {
819   $main::lxdebug->enter_sub();
820
821   my ($self, $myconfig, $form) = @_;
822
823   # connect to database
824   my $dbh = $form->get_standard_dbh;
825
826   my ($query, $query_add, @values, @ids, $sth);
827
828   # translate the ids (given by id_# and trans_id_#) into one array of ids, so we can join them later
829   map {
830     push @ids, $form->{"trans_id_$_"}
831       if ($form->{"multi_id_$_"} and $form->{"trans_id_$_"})
832   } (1 .. $form->{"rowcount"});
833
834   if ($form->{rowcount} && scalar @ids) {
835     $form->{convert_from_oe_ids} = join ' ', @ids;
836   }
837
838   # if called in multi id mode, and still only got one id, switch back to single id
839   if ($form->{"rowcount"} and $#ids == 0) {
840     $form->{"id"} = $ids[0];
841     undef @ids;
842   }
843
844   # and remember for the rest of the function
845   my $is_collective_order = scalar @ids;
846
847   if (!$form->{id}) {
848     my $wday         = (localtime(time))[6];
849     my $next_workday = $wday == 5 ? 3 : $wday == 6 ? 2 : 1;
850
851     # if we have a client configured interval for sales quotation, we add this
852     $next_workday   += $::instance_conf->get_reqdate_interval if ($::instance_conf->get_reqdate_interval &&
853                                                                     $form->{type} eq 'sales_quotation' );
854
855     $query_add       = qq|, current_date AS transdate, date(current_date + interval '${next_workday} days') AS reqdate|;
856   }
857
858   # get default accounts
859   $query = qq|SELECT (SELECT c.accno FROM chart c WHERE d.inventory_accno_id = c.id) AS inventory_accno,
860                      (SELECT c.accno FROM chart c WHERE d.income_accno_id    = c.id) AS income_accno,
861                      (SELECT c.accno FROM chart c WHERE d.expense_accno_id   = c.id) AS expense_accno,
862                      (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id    = c.id) AS fxgain_accno,
863                      (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id    = c.id) AS fxloss_accno
864               $query_add
865               FROM defaults d|;
866   my $ref = selectfirst_hashref_query($form, $dbh, $query);
867   map { $form->{$_} = $ref->{$_} } keys %$ref;
868
869   $form->{currency} = $form->get_default_currency($myconfig);
870
871   # set reqdate if this is an invoice->order conversion. If someone knows a better check to ensure
872   # we come from invoices, feel free.
873   $form->{reqdate} = $form->{deliverydate}
874     if (    $form->{deliverydate}
875         and $form->{callback} =~ /action=ar_transactions/);
876
877   my $vc = $form->{vc} eq "customer" ? "customer" : "vendor";
878
879   if ($form->{id} or @ids) {
880
881     # retrieve order for single id
882     # NOTE: this query is intended to fetch all information only ONCE.
883     # so if any of these infos is important (or even different) for any item,
884     # it will be killed out and then has to be fetched from the item scope query further down
885     $query =
886       qq|SELECT o.cp_id, o.ordnumber, o.transdate, o.reqdate,
887            o.taxincluded, o.shippingpoint, o.shipvia, o.notes, o.intnotes,
888            (SELECT cu.name FROM currencies cu WHERE cu.id=o.currency_id) AS currency, e.name AS employee, o.employee_id, o.salesman_id,
889            o.${vc}_id, cv.name AS ${vc}, o.amount AS invtotal,
890            o.closed, o.reqdate, o.quonumber, o.department_id, o.cusordnumber,
891            d.description AS department, o.payment_id, o.language_id, o.taxzone_id,
892            o.delivery_customer_id, o.delivery_vendor_id, o.proforma, o.shipto_id,
893            o.globalproject_id, o.delivered, o.transaction_description, o.delivery_term_id
894            , o.order_probability, o.expected_billing_date
895          FROM oe o
896          JOIN ${vc} cv ON (o.${vc}_id = cv.id)
897          LEFT JOIN employee e ON (o.employee_id = e.id)
898          LEFT JOIN department d ON (o.department_id = d.id) | .
899         ($form->{id}
900          ? "WHERE o.id = ?"
901          : "WHERE o.id IN (" . join(', ', map("? ", @ids)) . ")"
902         );
903     @values = $form->{id} ? ($form->{id}) : @ids;
904     $sth = prepare_execute_query($form, $dbh, $query, @values);
905
906     $ref = $sth->fetchrow_hashref("NAME_lc");
907
908     if ($ref) {
909       map { $form->{$_} = $ref->{$_} } keys %$ref;
910
911       $form->{saved_xyznumber} = $form->{$form->{type} =~ /_quotation$/ ? "quonumber" : "ordnumber"};
912
913       # set all entries for multiple ids blank that yield different information
914       while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
915         map { $form->{$_} = '' if ($ref->{$_} ne $form->{$_}) } keys %$ref;
916       }
917     }
918
919     # if not given, fill transdate with current_date
920     $form->{transdate} = $form->current_date($myconfig)
921       unless $form->{transdate};
922
923     $sth->finish;
924
925     if ($form->{delivery_customer_id}) {
926       $query = qq|SELECT name FROM customer WHERE id = ?|;
927       ($form->{delivery_customer_string}) = selectrow_query($form, $dbh, $query, $form->{delivery_customer_id});
928     }
929
930     if ($form->{delivery_vendor_id}) {
931       $query = qq|SELECT name FROM customer WHERE id = ?|;
932       ($form->{delivery_vendor_string}) = selectrow_query($form, $dbh, $query, $form->{delivery_vendor_id});
933     }
934
935     # shipto and pinted/mailed/queued status makes only sense for single id retrieve
936     if (!@ids) {
937       $query = qq|SELECT s.* FROM shipto s WHERE s.trans_id = ? AND s.module = 'OE'|;
938       $sth = prepare_execute_query($form, $dbh, $query, $form->{id});
939
940       $ref = $sth->fetchrow_hashref("NAME_lc");
941       delete($ref->{id});
942       map { $form->{$_} = $ref->{$_} } keys %$ref;
943       $sth->finish;
944
945       # get printed, emailed and queued
946       $query = qq|SELECT s.printed, s.emailed, s.spoolfile, s.formname FROM status s WHERE s.trans_id = ?|;
947       $sth = prepare_execute_query($form, $dbh, $query, $form->{id});
948
949       while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
950         $form->{printed} .= "$ref->{formname} " if $ref->{printed};
951         $form->{emailed} .= "$ref->{formname} " if $ref->{emailed};
952         $form->{queued}  .= "$ref->{formname} $ref->{spoolfile} " if $ref->{spoolfile};
953       }
954       $sth->finish;
955       map { $form->{$_} =~ s/ +$//g } qw(printed emailed queued);
956     }    # if !@ids
957
958     my $transdate = $form->{transdate} ? $dbh->quote($form->{transdate}) : "current_date";
959
960     $form->{taxzone_id} = 0 unless ($form->{taxzone_id});
961
962     # retrieve individual items
963     # this query looks up all information about the items
964     # stuff different from the whole will not be overwritten, but saved with a suffix.
965     $query =
966       qq|SELECT o.id AS orderitems_id,
967            c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from as inventory_valid,
968            c2.accno AS income_accno,    c2.new_chart_id AS income_new_chart,    date($transdate) - c2.valid_from as income_valid,
969            c3.accno AS expense_accno,   c3.new_chart_id AS expense_new_chart,   date($transdate) - c3.valid_from as expense_valid,
970            oe.ordnumber AS ordnumber_oe, oe.transdate AS transdate_oe, oe.cusordnumber AS cusordnumber_oe,
971            p.partnumber, p.assembly, p.listprice, o.description, o.qty,
972            o.sellprice, o.parts_id AS id, o.unit, o.discount, p.notes AS partnotes, p.inventory_accno_id AS part_inventory_accno_id,
973            o.reqdate, o.project_id, o.serialnumber, o.ship, o.lastcost,
974            o.ordnumber, o.transdate, o.cusordnumber, o.subtotal, o.longdescription,
975            o.price_factor_id, o.price_factor, o.marge_price_factor, o.active_price_source, o.active_discount_source,
976            pr.projectnumber, p.formel,
977            pg.partsgroup, o.pricegroup_id, (SELECT pricegroup FROM pricegroup WHERE id=o.pricegroup_id) as pricegroup
978          FROM orderitems o
979          JOIN parts p ON (o.parts_id = p.id)
980          JOIN oe ON (o.trans_id = oe.id)
981          LEFT JOIN chart c1 ON ((SELECT inventory_accno_id                   FROM buchungsgruppen WHERE id=p.buchungsgruppen_id) = c1.id)
982          LEFT JOIN chart c2 ON ((SELECT tc.income_accno_id FROM taxzone_charts tc WHERE tc.taxzone_id = '$form->{taxzone_id}' and tc.buchungsgruppen_id = p.buchungsgruppen_id) = c2.id)
983          LEFT JOIN chart c3 ON ((SELECT tc.expense_accno_id FROM taxzone_charts tc WHERE tc.taxzone_id = '$form->{taxzone_id}' and tc.buchungsgruppen_id = p.buchungsgruppen_id) = c3.id)
984          LEFT JOIN project pr ON (o.project_id = pr.id)
985          LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) | .
986       ($form->{id}
987        ? qq|WHERE o.trans_id = ?|
988        : qq|WHERE o.trans_id IN (| . join(", ", map("?", @ids)) . qq|)|) .
989       qq|ORDER BY o.trans_id, o.position|;
990
991     @ids = $form->{id} ? ($form->{id}) : @ids;
992     $sth = prepare_execute_query($form, $dbh, $query, @values);
993
994     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
995       # Retrieve custom variables.
996       my $cvars = CVar->get_custom_variables(dbh        => $dbh,
997                                              module     => 'IC',
998                                              sub_module => 'orderitems',
999                                              trans_id   => $ref->{orderitems_id},
1000                                             );
1001       map { $ref->{"ic_cvar_$_->{name}"} = $_->{value} } @{ $cvars };
1002
1003       # Handle accounts.
1004       if (!$ref->{"part_inventory_accno_id"}) {
1005         map({ delete($ref->{$_}); } qw(inventory_accno inventory_new_chart inventory_valid));
1006       }
1007       delete($ref->{"part_inventory_accno_id"});
1008
1009       # in collective order, copy global ordnumber, transdate, cusordnumber into item scope
1010       #   unless already present there
1011       # remove _oe entries afterwards
1012       map { $ref->{$_} = $ref->{"${_}_oe"} if ($ref->{$_} eq '') }
1013         qw|ordnumber transdate cusordnumber|
1014         if (@ids);
1015       map { delete $ref->{$_} } qw|ordnumber_oe transdate_oe cusordnumber_oe|;
1016
1017
1018
1019       while ($ref->{inventory_new_chart} && ($ref->{inventory_valid} >= 0)) {
1020         my $query =
1021           qq|SELECT accno AS inventory_accno, | .
1022           qq|  new_chart_id AS inventory_new_chart, | .
1023           qq|  date($transdate) - valid_from AS inventory_valid | .
1024           qq|FROM chart WHERE id = $ref->{inventory_new_chart}|;
1025         ($ref->{inventory_accno}, $ref->{inventory_new_chart},
1026          $ref->{inventory_valid}) = selectrow_query($form, $dbh, $query);
1027       }
1028
1029       while ($ref->{income_new_chart} && ($ref->{income_valid} >= 0)) {
1030         my $query =
1031           qq|SELECT accno AS income_accno, | .
1032           qq|  new_chart_id AS income_new_chart, | .
1033           qq|  date($transdate) - valid_from AS income_valid | .
1034           qq|FROM chart WHERE id = $ref->{income_new_chart}|;
1035         ($ref->{income_accno}, $ref->{income_new_chart},
1036          $ref->{income_valid}) = selectrow_query($form, $dbh, $query);
1037       }
1038
1039       while ($ref->{expense_new_chart} && ($ref->{expense_valid} >= 0)) {
1040         my $query =
1041           qq|SELECT accno AS expense_accno, | .
1042           qq|  new_chart_id AS expense_new_chart, | .
1043           qq|  date($transdate) - valid_from AS expense_valid | .
1044           qq|FROM chart WHERE id = $ref->{expense_new_chart}|;
1045         ($ref->{expense_accno}, $ref->{expense_new_chart},
1046          $ref->{expense_valid}) = selectrow_query($form, $dbh, $query);
1047       }
1048
1049       # delete orderitems_id in collective orders, so that they get cloned no matter what
1050       delete $ref->{orderitems_id} if $is_collective_order;
1051
1052       # get tax rates and description
1053       my $accno_id = ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno};
1054       $query =
1055         qq|SELECT c.accno, t.taxdescription, t.rate, t.taxnumber | .
1056         qq|FROM tax t LEFT JOIN chart c on (c.id = t.chart_id) | .
1057         qq|WHERE t.id IN (SELECT tk.tax_id FROM taxkeys tk | .
1058         qq|               WHERE tk.chart_id = (SELECT id FROM chart WHERE accno = ?) | .
1059         qq|                 AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1) | .
1060         qq|ORDER BY c.accno|;
1061       my $stw = prepare_execute_query($form, $dbh, $query, $accno_id);
1062       $ref->{taxaccounts} = "";
1063       my $i = 0;
1064       while (my $ptr = $stw->fetchrow_hashref("NAME_lc")) {
1065         if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) {
1066           $i++;
1067           $ptr->{accno} = $i;
1068         }
1069         $ref->{taxaccounts} .= "$ptr->{accno} ";
1070         if (!($form->{taxaccounts} =~ /\Q$ptr->{accno}\E/)) {
1071           $form->{"$ptr->{accno}_rate"}        = $ptr->{rate};
1072           $form->{"$ptr->{accno}_description"} = $ptr->{taxdescription};
1073           $form->{"$ptr->{accno}_taxnumber"}   = $ptr->{taxnumber};
1074           $form->{taxaccounts} .= "$ptr->{accno} ";
1075         }
1076
1077       }
1078
1079       chop $ref->{taxaccounts};
1080
1081       push @{ $form->{form_details} }, $ref;
1082       $stw->finish;
1083     }
1084     $sth->finish;
1085
1086   } else {
1087
1088     # get last name used
1089     $form->lastname_used($dbh, $myconfig, $form->{vc})
1090       unless $form->{"$form->{vc}_id"};
1091
1092   }
1093
1094   $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{transdate}, ($form->{vc} eq 'customer') ? "buy" : "sell");
1095
1096   Common::webdav_folder($form);
1097
1098   $self->load_periodic_invoice_config($form);
1099
1100   my $rc = $dbh->commit;
1101
1102   $main::lxdebug->leave_sub();
1103
1104   return $rc;
1105 }
1106
1107 sub retrieve_simple {
1108   $main::lxdebug->enter_sub();
1109
1110   my $self     = shift;
1111   my %params   = @_;
1112
1113   Common::check_params(\%params, qw(id));
1114
1115   my $myconfig    = \%main::myconfig;
1116   my $form        = $main::form;
1117
1118   my $dbh         = $params{dbh} || $form->get_standard_dbh($myconfig);
1119
1120   my $oe_query    = qq|SELECT * FROM oe         WHERE id = ?|;
1121   my $oi_query    = qq|SELECT * FROM orderitems WHERE trans_id = ? ORDER BY position|;
1122
1123   my $order            = selectfirst_hashref_query($form, $dbh, $oe_query, conv_i($params{id}));
1124   $order->{orderitems} = selectall_hashref_query(  $form, $dbh, $oi_query, conv_i($params{id}));
1125
1126   $main::lxdebug->leave_sub();
1127
1128   return $order;
1129 }
1130
1131 sub order_details {
1132   $main::lxdebug->enter_sub();
1133
1134   my ($self, $myconfig, $form) = @_;
1135
1136   # connect to database
1137   my $dbh = $form->get_standard_dbh;
1138   my $query;
1139   my @values = ();
1140   my $sth;
1141   my $nodiscount;
1142   my $yesdiscount;
1143   my $nodiscount_subtotal = 0;
1144   my $discount_subtotal = 0;
1145   my $item;
1146   my $i;
1147   my @partsgroup = ();
1148   my $partsgroup;
1149   my $position = 0;
1150   my $subtotal_header = 0;
1151   my $subposition = 0;
1152   my %taxaccounts;
1153   my %taxbase;
1154   my $tax_rate;
1155   my $taxamount;
1156
1157   my (@project_ids);
1158
1159   push(@project_ids, $form->{"globalproject_id"}) if ($form->{"globalproject_id"});
1160
1161   $form->get_lists('price_factors' => 'ALL_PRICE_FACTORS',
1162                    'departments'   => 'ALL_DEPARTMENTS');
1163   my %price_factors;
1164
1165   foreach my $pfac (@{ $form->{ALL_PRICE_FACTORS} }) {
1166     $price_factors{$pfac->{id}}  = $pfac;
1167     $pfac->{factor}             *= 1;
1168     $pfac->{formatted_factor}    = $form->format_amount($myconfig, $pfac->{factor});
1169   }
1170
1171   # lookup department
1172   foreach my $dept (@{ $form->{ALL_DEPARTMENTS} }) {
1173     next unless $dept->{id} eq $form->{department_id};
1174     $form->{department} = $dept->{description};
1175     last;
1176   }
1177
1178   # sort items by partsgroup
1179   for $i (1 .. $form->{rowcount}) {
1180     $partsgroup = "";
1181     if ($form->{"partsgroup_$i"} && $form->{groupitems}) {
1182       $partsgroup = $form->{"partsgroup_$i"};
1183     }
1184     push @partsgroup, [$i, $partsgroup];
1185     push(@project_ids, $form->{"project_id_$i"}) if ($form->{"project_id_$i"});
1186   }
1187
1188   my $projects = [];
1189   my %projects_by_id;
1190   if (@project_ids) {
1191     $projects = SL::DB::Manager::Project->get_all(query => [ id => \@project_ids ]);
1192     %projects_by_id = map { $_->id => $_ } @$projects;
1193   }
1194
1195   if ($projects_by_id{$form->{"globalproject_id"}}) {
1196     $form->{globalprojectnumber} = $projects_by_id{$form->{"globalproject_id"}}->projectnumber;
1197     $form->{globalprojectdescription} = $projects_by_id{$form->{"globalproject_id"}}->description;
1198
1199     for (@{ $projects_by_id{$form->{"globalproject_id"}}->cvars_by_config }) {
1200       $form->{"project_cvar_" . $_->config->name} = $_->value_as_text;
1201     }
1202   }
1203
1204   $form->{discount} = [];
1205
1206   $form->{TEMPLATE_ARRAYS} = { };
1207   IC->prepare_parts_for_printing(myconfig => $myconfig, form => $form);
1208
1209   my $ic_cvar_configs = CVar->get_configs(module => 'IC');
1210   my $project_cvar_configs = CVar->get_configs(module => 'Projects');
1211
1212   my @arrays =
1213     qw(runningnumber number description longdescription qty ship unit bin
1214        partnotes serialnumber reqdate sellprice listprice netprice
1215        discount p_discount discount_sub nodiscount_sub
1216        linetotal  nodiscount_linetotal tax_rate projectnumber projectdescription
1217        price_factor price_factor_name partsgroup weight lineweight);
1218
1219   push @arrays, map { "ic_cvar_$_->{name}" } @{ $ic_cvar_configs };
1220   push @arrays, map { "project_cvar_$_->{name}" } @{ $project_cvar_configs };
1221
1222   my @tax_arrays = qw(taxbase tax taxdescription taxrate taxnumber);
1223
1224   map { $form->{TEMPLATE_ARRAYS}->{$_} = [] } (@arrays, @tax_arrays);
1225
1226   my $totalweight = 0;
1227   my $sameitem = "";
1228   foreach $item (sort { $a->[1] cmp $b->[1] } @partsgroup) {
1229     $i = $item->[0];
1230
1231     if ($item->[1] ne $sameitem) {
1232       push(@{ $form->{TEMPLATE_ARRAYS}->{description} }, qq|$item->[1]|);
1233       $sameitem = $item->[1];
1234
1235       map({ push(@{ $form->{TEMPLATE_ARRAYS}->{$_} }, "") } grep({ $_ ne "description" } @arrays));
1236     }
1237
1238     $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});
1239
1240     if ($form->{"id_$i"} != 0) {
1241
1242       # add number, description and qty to $form->{number}, ....
1243
1244       if ($form->{"subtotal_$i"} && !$subtotal_header) {
1245         $subtotal_header = $i;
1246         $position = int($position);
1247         $subposition = 0;
1248         $position++;
1249       } elsif ($subtotal_header) {
1250         $subposition += 1;
1251         $position = int($position);
1252         $position = $position.".".$subposition;
1253       } else {
1254         $position = int($position);
1255         $position++;
1256       }
1257
1258       my $price_factor = $price_factors{$form->{"price_factor_id_$i"}} || { 'factor' => 1 };
1259
1260       push @{ $form->{TEMPLATE_ARRAYS}->{runningnumber} },     $position;
1261       push @{ $form->{TEMPLATE_ARRAYS}->{number} },            $form->{"partnumber_$i"};
1262       push @{ $form->{TEMPLATE_ARRAYS}->{description} },       $form->{"description_$i"};
1263       push @{ $form->{TEMPLATE_ARRAYS}->{longdescription} },   $form->{"longdescription_$i"};
1264       push @{ $form->{TEMPLATE_ARRAYS}->{qty} },               $form->format_amount($myconfig, $form->{"qty_$i"});
1265       push @{ $form->{TEMPLATE_ARRAYS}->{qty_nofmt} },         $form->{"qty_$i"};
1266       push @{ $form->{TEMPLATE_ARRAYS}->{ship} },              $form->format_amount($myconfig, $form->{"ship_$i"});
1267       push @{ $form->{TEMPLATE_ARRAYS}->{ship_nofmt} },        $form->{"ship_$i"};
1268       push @{ $form->{TEMPLATE_ARRAYS}->{unit} },              $form->{"unit_$i"};
1269       push @{ $form->{TEMPLATE_ARRAYS}->{bin} },               $form->{"bin_$i"};
1270       push @{ $form->{TEMPLATE_ARRAYS}->{partnotes} },         $form->{"partnotes_$i"};
1271       push @{ $form->{TEMPLATE_ARRAYS}->{serialnumber} },      $form->{"serialnumber_$i"};
1272       push @{ $form->{TEMPLATE_ARRAYS}->{reqdate} },           $form->{"reqdate_$i"};
1273       push @{ $form->{TEMPLATE_ARRAYS}->{sellprice} },         $form->{"sellprice_$i"};
1274       push @{ $form->{TEMPLATE_ARRAYS}->{sellprice_nofmt} },   $form->parse_amount($myconfig, $form->{"sellprice_$i"});
1275       push @{ $form->{TEMPLATE_ARRAYS}->{listprice} },         $form->{"listprice_$i"};
1276       push @{ $form->{TEMPLATE_ARRAYS}->{price_factor} },      $price_factor->{formatted_factor};
1277       push @{ $form->{TEMPLATE_ARRAYS}->{price_factor_name} }, $price_factor->{description};
1278       push @{ $form->{TEMPLATE_ARRAYS}->{partsgroup} },        $form->{"partsgroup_$i"};
1279
1280       my $sellprice     = $form->parse_amount($myconfig, $form->{"sellprice_$i"});
1281       my ($dec)         = ($sellprice =~ /\.(\d+)/);
1282       my $decimalplaces = max 2, length($dec);
1283
1284       my $parsed_discount            = $form->parse_amount($myconfig, $form->{"discount_$i"});
1285
1286       my $linetotal_exact            = $form->{"qty_$i"} * $sellprice * (100 - $parsed_discount) / 100 / $price_factor->{factor};
1287       my $linetotal                  = $form->round_amount($linetotal_exact, 2);
1288
1289       my $nodiscount_exact_linetotal = $form->{"qty_$i"} * $sellprice                                  / $price_factor->{factor};
1290       my $nodiscount_linetotal       = $form->round_amount($nodiscount_exact_linetotal,2);
1291
1292       my $discount                   = $nodiscount_linetotal - $linetotal; # is always rounded because $nodiscount_linetotal and $linetotal are rounded
1293
1294       my $discount_round_error       = $discount + ($linetotal_exact - $nodiscount_exact_linetotal); # not used
1295
1296       $form->{"netprice_$i"}   = $form->round_amount($form->{"qty_$i"} ? ($linetotal / $form->{"qty_$i"}) : 0, $decimalplaces);
1297
1298       push @{ $form->{TEMPLATE_ARRAYS}->{netprice} },       ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : '';
1299       push @{ $form->{TEMPLATE_ARRAYS}->{netprice_nofmt} }, ($form->{"netprice_$i"} != 0) ? $form->{"netprice_$i"} : '';
1300
1301       $linetotal = ($linetotal != 0) ? $linetotal : '';
1302
1303       push @{ $form->{TEMPLATE_ARRAYS}->{discount} },       ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, 2) : '';
1304       push @{ $form->{TEMPLATE_ARRAYS}->{discount_nofmt} }, ($discount != 0) ? $discount * -1 : '';
1305       push @{ $form->{TEMPLATE_ARRAYS}->{p_discount} },     $form->{"discount_$i"};
1306
1307       $form->{ordtotal}         += $linetotal;
1308       $form->{nodiscount_total} += $nodiscount_linetotal;
1309       $form->{discount_total}   += $discount;
1310
1311       if ($subtotal_header) {
1312         $discount_subtotal   += $linetotal;
1313         $nodiscount_subtotal += $nodiscount_linetotal;
1314       }
1315
1316       if ($form->{"subtotal_$i"} && $subtotal_header && ($subtotal_header != $i)) {
1317         push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub} },         $form->format_amount($myconfig, $discount_subtotal,   2);
1318         push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub_nofmt} },   $discount_subtotal;
1319         push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub} },       $form->format_amount($myconfig, $nodiscount_subtotal, 2);
1320         push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub_nofmt} }, $nodiscount_subtotal;
1321
1322         $discount_subtotal   = 0;
1323         $nodiscount_subtotal = 0;
1324         $subtotal_header     = 0;
1325
1326       } else {
1327         push @{ $form->{TEMPLATE_ARRAYS}->{$_} }, "" for qw(discount_sub nodiscount_sub discount_sub_nofmt nodiscount_sub_nofmt);
1328       }
1329
1330       if (!$form->{"discount_$i"}) {
1331         $nodiscount += $linetotal;
1332       }
1333
1334       my $project = $projects_by_id{$form->{"project_id_$i"}} || SL::DB::Project->new;
1335
1336       push @{ $form->{TEMPLATE_ARRAYS}->{linetotal} },                  $form->format_amount($myconfig, $linetotal, 2);
1337       push @{ $form->{TEMPLATE_ARRAYS}->{linetotal_nofmt} },            $linetotal_exact;
1338       push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal} },       $form->format_amount($myconfig, $nodiscount_linetotal, 2);
1339       push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal_nofmt} }, $nodiscount_linetotal;
1340       push @{ $form->{TEMPLATE_ARRAYS}->{projectnumber} },              $project->projectnumber;
1341       push @{ $form->{TEMPLATE_ARRAYS}->{projectdescription} },         $project->description;
1342
1343       my $lineweight = $form->{"qty_$i"} * $form->{"weight_$i"};
1344       $totalweight += $lineweight;
1345       push @{ $form->{TEMPLATE_ARRAYS}->{weight} },            $form->format_amount($myconfig, $form->{"weight_$i"}, 3);
1346       push @{ $form->{TEMPLATE_ARRAYS}->{weight_nofmt} },      $form->{"weight_$i"};
1347       push @{ $form->{TEMPLATE_ARRAYS}->{lineweight} },        $form->format_amount($myconfig, $lineweight, 3);
1348       push @{ $form->{TEMPLATE_ARRAYS}->{lineweight_nofmt} },  $lineweight;
1349
1350       my ($taxamount, $taxbase);
1351       my $taxrate = 0;
1352
1353       map { $taxrate += $form->{"${_}_rate"} } split(/ /, $form->{"taxaccounts_$i"});
1354
1355       if ($form->{taxincluded}) {
1356
1357         # calculate tax
1358         $taxamount = $linetotal * $taxrate / (1 + $taxrate);
1359         $taxbase = $linetotal / (1 + $taxrate);
1360       } else {
1361         $taxamount = $linetotal * $taxrate;
1362         $taxbase   = $linetotal;
1363       }
1364
1365       if ($taxamount != 0) {
1366         foreach my $accno (split / /, $form->{"taxaccounts_$i"}) {
1367           $taxaccounts{$accno} += $taxamount * $form->{"${accno}_rate"} / $taxrate;
1368           $taxbase{$accno}     += $taxbase;
1369         }
1370       }
1371
1372       $tax_rate = $taxrate * 100;
1373       push(@{ $form->{TEMPLATE_ARRAYS}->{tax_rate} }, qq|$tax_rate|);
1374
1375       if ($form->{"assembly_$i"}) {
1376         $sameitem = "";
1377
1378         # get parts and push them onto the stack
1379         my $sortorder = "";
1380         if ($form->{groupitems}) {
1381           $sortorder = qq|ORDER BY pg.partsgroup, a.oid|;
1382         } else {
1383           $sortorder = qq|ORDER BY a.oid|;
1384         }
1385
1386         $query = qq|SELECT p.partnumber, p.description, p.unit, a.qty, | .
1387                  qq|pg.partsgroup | .
1388                  qq|FROM assembly a | .
1389                  qq|  JOIN parts p ON (a.parts_id = p.id) | .
1390                  qq|    LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) | .
1391                  qq|    WHERE a.bom = '1' | .
1392                  qq|    AND a.id = ? | . $sortorder;
1393         @values = ($form->{"id_$i"});
1394         $sth = $dbh->prepare($query);
1395         $sth->execute(@values) || $form->dberror($query);
1396
1397         while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1398           if ($form->{groupitems} && $ref->{partsgroup} ne $sameitem) {
1399             map({ push(@{ $form->{TEMPLATE_ARRAYS}->{$_} }, "") } grep({ $_ ne "description" } @arrays));
1400             $sameitem = ($ref->{partsgroup}) ? $ref->{partsgroup} : "--";
1401             push(@{ $form->{TEMPLATE_ARRAYS}->{description} }, $sameitem);
1402           }
1403
1404           push(@{ $form->{TEMPLATE_ARRAYS}->{description} }, $form->format_amount($myconfig, $ref->{qty} * $form->{"qty_$i"}) . qq|, $ref->{partnumber}, $ref->{description}|);
1405           map({ push(@{ $form->{TEMPLATE_ARRAYS}->{$_} }, "") } grep({ $_ ne "description" } @arrays));
1406         }
1407         $sth->finish;
1408       }
1409
1410       my $cvars;
1411       if (! $form->{"orderitems_id_$i"}) {
1412         # get values for CVars from master data for new items
1413         $cvars = CVar->get_custom_variables(dbh      => $dbh,
1414                                             module   => 'IC',
1415                                             trans_id => $form->{"id_$i"},
1416                                            );
1417       } else {
1418         # get values for CVars from custom_variables for existing items
1419         $cvars = CVar->get_custom_variables(dbh        => $dbh,
1420                                             module     => 'IC',
1421                                             sub_module => 'orderitems',
1422                                             trans_id   => $form->{"orderitems_id_$i"},
1423                                            );
1424       }
1425       # map only non-editable CVars to form (editable ones are already there)
1426       map { $form->{"ic_cvar_$_->{name}_$i"} = $_->{value} unless $_->{flag_editable} } @{ $cvars };
1427
1428       push @{ $form->{TEMPLATE_ARRAYS}->{"ic_cvar_$_->{name}"} },
1429         CVar->format_to_template(CVar->parse($form->{"ic_cvar_$_->{name}_$i"}, $_), $_)
1430           for @{ $ic_cvar_configs };
1431
1432       push @{ $form->{TEMPLATE_ARRAYS}->{"project_cvar_" . $_->config->name} }, $_->value_as_text for @{ $project->cvars_by_config };
1433     }
1434   }
1435
1436   $form->{totalweight}       = $form->format_amount($myconfig, $totalweight, 3);
1437   $form->{totalweight_nofmt} = $totalweight;
1438   my $defaults = AM->get_defaults();
1439   $form->{weightunit}        = $defaults->{weightunit};
1440
1441   my $tax = 0;
1442   foreach $item (sort keys %taxaccounts) {
1443     $tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2);
1444
1445     push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase} },        $form->format_amount($myconfig, $taxbase{$item}, 2));
1446     push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase_nofmt} },  $taxbase{$item});
1447     push(@{ $form->{TEMPLATE_ARRAYS}->{tax} },            $form->format_amount($myconfig, $taxamount,      2));
1448     push(@{ $form->{TEMPLATE_ARRAYS}->{tax_nofmt} },      $taxamount);
1449     push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate} },        $form->format_amount($myconfig, $form->{"${item}_rate"} * 100));
1450     push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate_nofmt} },  $form->{"${item}_rate"} * 100);
1451     push(@{ $form->{TEMPLATE_ARRAYS}->{taxnumber} },      $form->{"${item}_taxnumber"});
1452
1453     my $tax_obj     = SL::DB::Manager::Tax->find_by(taxnumber => $form->{"${item}_taxnumber"});
1454     my $description = $tax_obj ? $tax_obj->translated_attribute('taxdescription',  $form->{language_id}, 0) : '';
1455     push(@{ $form->{TEMPLATE_ARRAYS}->{taxdescription} }, $description . q{ } . 100 * $form->{"${item}_rate"} . q{%});
1456   }
1457
1458   $form->{nodiscount_subtotal} = $form->format_amount($myconfig, $form->{nodiscount_total}, 2);
1459   $form->{discount_total}      = $form->format_amount($myconfig, $form->{discount_total}, 2);
1460   $form->{nodiscount}          = $form->format_amount($myconfig, $nodiscount, 2);
1461   $form->{yesdiscount}         = $form->format_amount($myconfig, $form->{nodiscount_total} - $nodiscount, 2);
1462
1463   if($form->{taxincluded}) {
1464     $form->{subtotal}       = $form->format_amount($myconfig, $form->{ordtotal} - $tax, 2);
1465     $form->{subtotal_nofmt} = $form->{ordtotal} - $tax;
1466   } else {
1467     $form->{subtotal}       = $form->format_amount($myconfig, $form->{ordtotal}, 2);
1468     $form->{subtotal_nofmt} = $form->{ordtotal};
1469   }
1470
1471   $form->{ordtotal} = ($form->{taxincluded}) ? $form->{ordtotal} : $form->{ordtotal} + $tax;
1472
1473   # format amounts
1474   $form->{quototal} = $form->{ordtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2);
1475
1476   if ($form->{type} =~ /_quotation/) {
1477     $form->set_payment_options($myconfig, $form->{quodate});
1478   } else {
1479     $form->set_payment_options($myconfig, $form->{orddate});
1480   }
1481
1482   $form->{username} = $myconfig->{name};
1483
1484   $dbh->disconnect;
1485
1486   $form->{delivery_term} = SL::DB::Manager::DeliveryTerm->find_by(id => $form->{delivery_term_id} || undef);
1487   $form->{delivery_term}->description_long($form->{delivery_term}->translated_attribute('description_long', $form->{language_id})) if $form->{delivery_term} && $form->{language_id};
1488
1489   $::form->{order} = SL::DB::Manager::Order->find_by(id => $::form->{id});
1490
1491   $main::lxdebug->leave_sub();
1492 }
1493
1494 sub project_description {
1495   $main::lxdebug->enter_sub();
1496
1497   my ($self, $dbh, $id) = @_;
1498
1499   my $query = qq|SELECT description FROM project WHERE id = ?|;
1500   my ($value) = selectrow_query($main::form, $dbh, $query, $id);
1501
1502   $main::lxdebug->leave_sub();
1503
1504   return $value;
1505 }
1506
1507 1;
1508
1509 __END__
1510
1511 =head1 NAME
1512
1513 OE.pm - Order entry module
1514
1515 =head1 DESCRIPTION
1516
1517 OE.pm is part of the OE module. OE is responsible for sales and purchase orders, as well as sales quotations and purchase requests. This file abstracts the database tables C<oe> and C<orderitems>.
1518
1519 =head1 FUNCTIONS
1520
1521 =over 4
1522
1523 =item retrieve_simple PARAMS
1524
1525 simple OE retrieval by id. does not look up customer, vendor, units or any other stuff. only oe and orderitems.
1526
1527   my $order = retrieve_simple(id => 2);
1528
1529   $order => {
1530     %_OE_CONTENT,
1531     orderitems => [
1532       %_ORDERITEM_ROW_1,
1533       %_ORDERITEM_ROW_2,
1534       ...
1535     ]
1536   }
1537
1538 =back
1539
1540 =cut