Lieferschein-Positions-Rabatt mit Nachkommastellen
[kivitendo-erp.git] / bin / mozilla / do.pl
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) 1998-2003
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 #
16 # This program is free software; you can redistribute it and/or modify
17 # it under the terms of the GNU General Public License as published by
18 # the Free Software Foundation; either version 2 of the License, or
19 # (at your option) any later version.
20 #
21 # This program is distributed in the hope that it will be useful,
22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 # GNU General Public License for more details.
25 # You should have received a copy of the GNU General Public License
26 # along with this program; if not, write to the Free Software
27 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
28 #======================================================================
29 #
30 # Delivery orders
31 #======================================================================
32
33 use Carp;
34 use List::MoreUtils qw(uniq);
35 use List::Util qw(max sum);
36 use POSIX qw(strftime);
37 use YAML;
38
39 use SL::DB::DeliveryOrder;
40 use SL::DO;
41 use SL::IR;
42 use SL::IS;
43 use SL::MoreCommon qw(ary_diff restore_form save_form);
44 use SL::ReportGenerator;
45 use SL::WH;
46 use Sort::Naturally ();
47 require "bin/mozilla/arap.pl";
48 require "bin/mozilla/common.pl";
49 require "bin/mozilla/io.pl";
50 require "bin/mozilla/reportgenerator.pl";
51
52 use strict;
53
54 1;
55
56 # end of main
57
58 sub check_do_access {
59   $main::auth->assert($main::form->{type} . '_edit');
60 }
61
62 sub set_headings {
63   $main::lxdebug->enter_sub();
64
65   check_do_access();
66
67   my ($action) = @_;
68
69   my $form     = $main::form;
70   my $locale   = $main::locale;
71
72   if ($form->{type} eq 'purchase_delivery_order') {
73     $form->{vc}    = 'vendor';
74     $form->{title} = $action eq "edit" ? $locale->text('Edit Purchase Delivery Order') : $locale->text('Add Purchase Delivery Order');
75   } else {
76     $form->{vc}    = 'customer';
77     $form->{title} = $action eq "edit" ? $locale->text('Edit Sales Delivery Order') : $locale->text('Add Sales Delivery Order');
78   }
79
80   $form->{heading} = $locale->text('Delivery Order');
81
82   $main::lxdebug->leave_sub();
83 }
84
85 sub add {
86   $main::lxdebug->enter_sub();
87
88   check_do_access();
89
90   if (($::form->{type} =~ /purchase/) && !$::instance_conf->get_allow_new_purchase_invoice) {
91     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
92   }
93
94   my $form     = $main::form;
95
96   set_headings("add");
97
98   $form->{show_details} = $::myconfig{show_form_details};
99   $form->{callback} = build_std_url('action=add', 'type', 'vc') unless ($form->{callback});
100
101   order_links();
102   prepare_order();
103   display_form();
104
105   $main::lxdebug->leave_sub();
106 }
107
108 sub edit {
109   $main::lxdebug->enter_sub();
110
111   check_do_access();
112
113   my $form     = $main::form;
114
115   $form->{show_details} = $::myconfig{show_form_details};
116
117   # show history button
118   $form->{javascript} = qq|<script type="text/javascript" src="js/show_history.js"></script>|;
119   #/show hhistory button
120
121   $form->{simple_save} = 0;
122
123   set_headings("edit");
124
125   # editing without stuff to edit? try adding it first
126   if ($form->{rowcount} && !$form->{print_and_save}) {
127 #     map { $id++ if $form->{"multi_id_$_"} } (1 .. $form->{rowcount});
128 #     if (!$id) {
129
130       # reset rowcount
131       undef $form->{rowcount};
132       add();
133       $main::lxdebug->leave_sub();
134       return;
135 #     }
136   } elsif (!$form->{id}) {
137     add();
138     $main::lxdebug->leave_sub();
139     return;
140   }
141
142   my ($language_id, $printer_id);
143   if ($form->{print_and_save}) {
144     $form->{action}   = "dispatcher";
145     $form->{action_print} = "1";
146     $form->{resubmit} = 1;
147     $language_id      = $form->{language_id};
148     $printer_id       = $form->{printer_id};
149   }
150
151   set_headings("edit");
152
153   order_links();
154   prepare_order();
155
156   if ($form->{print_and_save}) {
157     $form->{language_id} = $language_id;
158     $form->{printer_id}  = $printer_id;
159   }
160
161   display_form();
162
163   $main::lxdebug->leave_sub();
164 }
165
166 sub order_links {
167   $main::lxdebug->enter_sub();
168
169   check_do_access();
170
171   my $form     = $main::form;
172   my %myconfig = %main::myconfig;
173
174   # get customer/vendor
175   $form->all_vc(\%myconfig, $form->{vc}, ($form->{vc} eq 'customer') ? "AR" : "AP");
176
177   # retrieve order/quotation
178   my $editing = $form->{id};
179
180   DO->retrieve('vc'  => $form->{vc},
181                'ids' => $form->{id});
182
183   $form->backup_vars(qw(payment_id language_id taxzone_id salesman_id taxincluded cp_id intnotes delivery_term_id currency));
184
185   # get customer / vendor
186   if ($form->{vc} eq 'vendor') {
187     IR->get_vendor(\%myconfig, \%$form);
188     $form->{discount} = $form->{vendor_discount};
189   } else {
190     IS->get_customer(\%myconfig, \%$form);
191     $form->{discount} = $form->{customer_discount};
192   }
193
194   $form->restore_vars(qw(payment_id language_id taxzone_id intnotes cp_id delivery_term_id));
195   $form->restore_vars(qw(currency)) if ($form->{id} || $form->{convert_from_oe_ids});
196   $form->restore_vars(qw(taxincluded)) if $form->{id};
197   $form->restore_vars(qw(salesman_id)) if $editing;
198
199   if ($form->{"all_$form->{vc}"}) {
200     unless ($form->{"$form->{vc}_id"}) {
201       $form->{"$form->{vc}_id"} = $form->{"all_$form->{vc}"}->[0]->{id};
202     }
203   }
204
205   ($form->{ $form->{vc} })  = split /--/, $form->{ $form->{vc} };
206   $form->{"old$form->{vc}"} = qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|;
207
208   $form->{employee} = "$form->{employee}--$form->{employee_id}";
209
210   $main::lxdebug->leave_sub();
211 }
212
213 sub prepare_order {
214   $main::lxdebug->enter_sub();
215
216   check_do_access();
217
218   my $form     = $main::form;
219   my %myconfig = %main::myconfig;
220
221   $form->{formname} = $form->{type} unless $form->{formname};
222
223   my $i = 0;
224   foreach my $ref (@{ $form->{form_details} }) {
225     $form->{rowcount} = ++$i;
226
227     map { $form->{"${_}_$i"} = $ref->{$_} } keys %{$ref};
228   }
229   for my $i (1 .. $form->{rowcount}) {
230     if ($form->{id}) {
231       $form->{"discount_$i"} = $form->format_amount(\%myconfig, $form->{"discount_$i"} * 100);
232     } else {
233       $form->{"discount_$i"} = $form->format_amount(\%myconfig, $form->{"discount_$i"});
234     }
235     my ($dec) = ($form->{"sellprice_$i"} =~ /\.(\d+)/);
236     $dec           = length $dec;
237     my $decimalplaces = ($dec > 2) ? $dec : 2;
238
239     # copy reqdate from deliverydate for invoice -> order conversion
240     $form->{"reqdate_$i"} = $form->{"deliverydate_$i"} unless $form->{"reqdate_$i"};
241
242     $form->{"sellprice_$i"} = $form->format_amount(\%myconfig, $form->{"sellprice_$i"}, $decimalplaces);
243     $form->{"lastcost_$i"} = $form->format_amount(\%myconfig, $form->{"lastcost_$i"}, $decimalplaces);
244
245     (my $dec_qty) = ($form->{"qty_$i"} =~ /\.(\d+)/);
246     $dec_qty = length $dec_qty;
247     $form->{"qty_$i"} = $form->format_amount(\%myconfig, $form->{"qty_$i"}, $dec_qty);
248   }
249
250   $main::lxdebug->leave_sub();
251 }
252
253 sub form_header {
254   $main::lxdebug->enter_sub();
255
256   check_do_access();
257
258   my $form     = $main::form;
259   my %myconfig = %main::myconfig;
260
261   $form->{employee_id} = $form->{old_employee_id} if $form->{old_employee_id};
262   $form->{salesman_id} = $form->{old_salesman_id} if $form->{old_salesman_id};
263
264   my $vc = $form->{vc} eq "customer" ? "customers" : "vendors";
265   $form->get_lists($vc              => "ALL_VC",
266                    "price_factors"  => "ALL_PRICE_FACTORS",
267                    "departments"    => "ALL_DEPARTMENTS",
268                    "business_types" => "ALL_BUSINESS_TYPES",
269     );
270
271   # Projects
272   my @old_project_ids = uniq grep { $_ } map { $_ * 1 } ($form->{"globalproject_id"}, map { $form->{"project_id_$_"} } 1..$form->{"rowcount"});
273   my @old_ids_cond    = @old_project_ids ? (id => \@old_project_ids) : ();
274   my @customer_cond;
275   if (($vc eq 'customers') && $::instance_conf->get_customer_projects_only_in_sales) {
276     @customer_cond = (
277       or => [
278         customer_id          => $::form->{customer_id},
279         billable_customer_id => $::form->{customer_id},
280       ]);
281   }
282   my @conditions = (
283     or => [
284       and => [ active => 1, @customer_cond ],
285       @old_ids_cond,
286     ]);
287
288   $::form->{ALL_PROJECTS}          = SL::DB::Manager::Project->get_all_sorted(query => \@conditions);
289   $::form->{ALL_EMPLOYEES}         = SL::DB::Manager::Employee->get_all_sorted(query => [ or => [ id => $::form->{employee_id},  deleted => 0 ] ]);
290   $::form->{ALL_SALESMEN}          = SL::DB::Manager::Employee->get_all_sorted(query => [ or => [ id => $::form->{salesman_id},  deleted => 0 ] ]);
291   $::form->{ALL_SHIPTO}            = SL::DB::Manager::Shipto->get_all_sorted(query => [
292     or => [ trans_id  => $::form->{"$::form->{vc}_id"} * 1, and => [ shipto_id => $::form->{shipto_id} * 1, trans_id => undef ] ]
293   ]);
294   $::form->{ALL_CONTACTS}          = SL::DB::Manager::Contact->get_all_sorted(query => [
295     or => [
296       cp_cv_id => $::form->{"$::form->{vc}_id"} * 1,
297       and      => [
298         cp_cv_id => undef,
299         cp_id    => $::form->{cp_id} * 1
300       ]
301     ]
302   ]);
303
304   map { $_->{value} = "$_->{description}--$_->{id}" } @{ $form->{ALL_DEPARTMENTS} };
305   map { $_->{value} = "$_->{name}--$_->{id}"        } @{ $form->{ALL_VC} };
306
307   $form->{SHOW_VC_DROP_DOWN} =  $myconfig{vclimit} > scalar @{ $form->{ALL_VC} };
308
309   $form->{oldvcname}         =  $form->{"old$form->{vc}"};
310   $form->{oldvcname}         =~ s/--.*//;
311
312   my $dispatch_to_popup = '';
313   if ($form->{resubmit} && ($form->{format} eq "html")) {
314     $dispatch_to_popup  = "window.open('about:blank','Beleg'); document.do.target = 'Beleg';";
315     $dispatch_to_popup .= "document.do.submit();";
316   } elsif ($form->{resubmit}) {
317     # emulate click for resubmitting actions
318     $dispatch_to_popup  = "document.do.${_}.click(); " for grep { /^action_/ } keys %$form;
319   }
320   $::request->{layout}->add_javascripts_inline("\$(function(){$dispatch_to_popup});");
321
322
323   my $follow_up_vc                =  $form->{ $form->{vc} eq 'customer' ? 'customer' : 'vendor' };
324   $follow_up_vc                   =~ s/--\d*\s*$//;
325
326   $form->{follow_up_trans_info} = $form->{donumber} .'('. $follow_up_vc .')';
327
328   $::request->{layout}->use_javascript(map { "${_}.js" } qw(kivi.SalesPurchase ckeditor/ckeditor ckeditor/adapters/jquery kivi.io autocomplete_customer autocomplete_part));
329
330   my @custom_hidden;
331   push @custom_hidden, map { "shiptocvar_" . $_->name } @{ SL::DB::Manager::CustomVariableConfig->get_all(where => [ module => 'ShipTo' ]) };
332
333   $::form->{HIDDENS} = [ map { +{ name => $_, value => $::form->{$_} } } (@custom_hidden) ];
334
335   $form->header();
336   # Fix für Bug 1082 Erwartet wird: 'abteilungsNAME--abteilungsID'
337   # und Erweiterung für Bug 1760:
338   # Das war leider nur ein Teil-Fix, da das Verhalten den 'Erneuern'-Knopf
339   # nicht überlebt. Konsequent jetzt auf L umgestellt
340   #   $ perldoc SL::Template::Plugin::L
341   # Daher entsprechend nur die Anpassung in form_header
342   # und in DO.pm gemacht. 4 Testfälle:
343   # department_id speichern                 | i.O.
344   # department_id lesen                     | i.O.
345   # department leer überlebt erneuern       | i.O.
346   # department nicht leer überlebt erneuern | i.O.
347   # $main::lxdebug->message(0, 'ABTEILUNGS ID in form?' . $form->{department_id});
348   print $form->parse_html_template('do/form_header');
349
350   $main::lxdebug->leave_sub();
351 }
352
353 sub form_footer {
354   $main::lxdebug->enter_sub();
355
356   check_do_access();
357
358   my $form     = $main::form;
359
360   $form->{PRINT_OPTIONS} = print_options('inline' => 1);
361   $form->{ALL_DELIVERY_TERMS} = SL::DB::Manager::DeliveryTerm->get_all_sorted();
362
363   print $form->parse_html_template('do/form_footer',
364     {transfer_default         => ($::instance_conf->get_transfer_default)});
365
366   $main::lxdebug->leave_sub();
367 }
368
369 sub update_delivery_order {
370   $main::lxdebug->enter_sub();
371
372   check_do_access();
373
374   my $form     = $main::form;
375   my %myconfig = %main::myconfig;
376
377   set_headings($form->{"id"} ? "edit" : "add");
378
379   $form->{insertdate} = SL::DB::DeliveryOrder->new(id => $form->{id})->load->itime_as_date if $form->{id};
380
381   $form->{update} = 1;
382
383   my $payment_id;
384   $payment_id = $form->{payment_id} if $form->{payment_id};
385
386   check_name($form->{vc});
387   $form->{discount} =  $form->{"$form->{vc}_discount"} if defined $form->{"$form->{vc}_discount"};
388   # Problem: Wenn man ohne Erneuern einen Kunden/Lieferanten
389   # wechselt, wird der entsprechende Kunden/ Lieferantenrabatt
390   # nicht übernommen. Grundproblem: In Commit 82574e78
391   # hab ich aus discount customer_discount und vendor_discount
392   # gemacht und entsprechend an den Oberflächen richtig hin-
393   # geschoben. Die damals bessere Lösung wäre gewesen:
394   # In den Templates nur die hidden für form-discount wieder ein-
395   # setzen dann wäre die Verrenkung jetzt nicht notwendig.
396   # TODO: Ggf. Bugfix 1284, 1575 und 817 wieder zusammenführen
397   # Testfälle: Kunden mit Rabatt 0 -> Rabatt 20 i.O.
398   #            Kunde mit Rabatt 20 -> Rabatt 0  i.O.
399   #            Kunde mit Rabatt 20 -> Rabatt 5,5 i.O.
400   $form->{payment_id} = $payment_id if $form->{payment_id} eq "";
401
402   my $i = $form->{rowcount};
403
404   if (   ($form->{"partnumber_$i"} eq "")
405       && ($form->{"description_$i"} eq "")
406       && ($form->{"partsgroup_$i"}  eq "")) {
407
408     check_form();
409
410   } else {
411
412     my $mode;
413     if ($form->{type} eq 'purchase_delivery_order') {
414       IR->retrieve_item(\%myconfig, $form);
415       $mode = 'IR';
416     } else {
417       IS->retrieve_item(\%myconfig, $form);
418       $mode = 'IS';
419     }
420
421     my $rows = scalar @{ $form->{item_list} };
422
423     if ($rows) {
424       $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
425       if( !$form->{"qty_$i"} ) {
426         $form->{"qty_$i"} = 1;
427       }
428
429       if ($rows > 1) {
430
431         select_item(mode => $mode, pre_entered_qty => $form->{"qty_$i"});
432         $::dispatcher->end_request;
433
434       } else {
435
436         my $sellprice = $form->parse_amount(\%myconfig, $form->{"sellprice_$i"});
437
438         map { $form->{"${_}_$i"} = $form->{item_list}[0]{$_} } keys %{ $form->{item_list}[0] };
439
440         $form->{"marge_price_factor_$i"} = $form->{item_list}->[0]->{price_factor};
441
442         if ($sellprice) {
443           $form->{"sellprice_$i"} = $sellprice;
444         } else {
445           my $record        = _make_record();
446           my $price_source  = SL::PriceSource->new(record_item => $record->items->[$i-1], record => $record);
447           my $best_price    = $price_source->best_price;
448           my $best_discount = $price_source->best_discount;
449
450           if ($best_price) {
451             $::form->{"sellprice_$i"}           = $best_price->price;
452             $::form->{"active_price_source_$i"} = $best_price->source;
453           }
454           if ($best_discount) {
455             $::form->{"discount_$i"}               = $best_discount->discount;
456             $::form->{"active_discount_source_$i"} = $best_discount->source;
457           }
458         }
459
460         $form->{"sellprice_$i"}          = $form->format_amount(\%myconfig, $form->{"sellprice_$i"});
461         $form->{"lastcost_$i"}           = $form->format_amount(\%myconfig, $form->{"lastcost_$i"});
462         $form->{"qty_$i"}                = $form->format_amount(\%myconfig, $form->{"qty_$i"});
463         $form->{"discount_$i"}           = $form->format_amount(\%myconfig, $form->{"discount_$i"} * 100.0);
464       }
465
466       display_form();
467
468     } else {
469
470       # ok, so this is a new part
471       # ask if it is a part or service item
472
473       if (   $form->{"partsgroup_$i"}
474           && ($form->{"partsnumber_$i"} eq "")
475           && ($form->{"description_$i"} eq "")) {
476         $form->{rowcount}--;
477         $form->{"discount_$i"} = "";
478         $form->{"not_discountable_$i"} = "";
479         display_form();
480
481       } else {
482         $form->{"id_$i"}   = 0;
483         new_item();
484       }
485     }
486   }
487
488   $main::lxdebug->leave_sub();
489 }
490
491 sub search {
492   $main::lxdebug->enter_sub();
493
494   check_do_access();
495
496   my $form     = $main::form;
497   my %myconfig = %main::myconfig;
498   my $locale   = $main::locale;
499
500   $form->{vc} = $form->{type} eq 'purchase_delivery_order' ? 'vendor' : 'customer';
501
502   $form->get_lists("projects"       => { "key" => "ALL_PROJECTS",
503                                          "all" => 1 },
504                    "departments"    => "ALL_DEPARTMENTS",
505                    "$form->{vc}s"   => "ALL_VC",
506                    "business_types" => "ALL_BUSINESS_TYPES");
507   $form->{ALL_EMPLOYEES} = SL::DB::Manager::Employee->get_all_sorted(query => [ deleted => 0 ]);
508
509   $form->{SHOW_VC_DROP_DOWN} =  $myconfig{vclimit} > scalar @{ $form->{ALL_VC} };
510   $form->{title}             = $locale->text('Delivery Orders');
511
512   $form->header();
513
514   print $form->parse_html_template('do/search');
515
516   $main::lxdebug->leave_sub();
517 }
518
519 sub orders {
520   $main::lxdebug->enter_sub();
521
522   check_do_access();
523
524   my $form     = $main::form;
525   my %myconfig = %main::myconfig;
526   my $locale   = $main::locale;
527   my $cgi      = $::request->{cgi};
528
529   $form->{department_id} = (split /--/, $form->{department})[-1];
530   ($form->{ $form->{vc} }, $form->{"$form->{vc}_id"}) = split(/--/, $form->{ $form->{vc} });
531
532   report_generator_set_default_sort('transdate', 1);
533
534   DO->transactions();
535
536   $form->{rowcount} = scalar @{ $form->{DO} };
537
538   my @columns = qw(
539     ids                     transdate               reqdate
540     id                      donumber
541     ordnumber               customernumber          cusordnumber
542     name                    employee  salesman
543     shipvia                 globalprojectnumber
544     transaction_description department
545     open                    delivered
546     insertdate
547   );
548
549   $form->{l_open}      = $form->{l_closed} = "Y" if ($form->{open}      && $form->{closed});
550   $form->{l_delivered} = "Y"                     if ($form->{delivered} && $form->{notdelivered});
551
552   $form->{title}       = $locale->text('Delivery Orders');
553
554   my $attachment_basename = $form->{vc} eq 'vendor' ? $locale->text('purchase_delivery_order_list') : $locale->text('sales_delivery_order_list');
555
556   my $report = SL::ReportGenerator->new(\%myconfig, $form);
557
558   my @hidden_variables = map { "l_${_}" } @columns;
559   push @hidden_variables, $form->{vc}, qw(l_closed l_notdelivered open closed delivered notdelivered donumber ordnumber serialnumber cusordnumber
560                                           transaction_description transdatefrom transdateto reqdatefrom reqdateto
561                                           type vc employee_id salesman_id project_id parts_partnumber parts_description
562                                           insertdatefrom insertdateto business_id);
563
564   my $href = build_std_url('action=orders', grep { $form->{$_} } @hidden_variables);
565
566   my %column_defs = (
567     'ids'                     => { 'text' => '', },
568     'transdate'               => { 'text' => $locale->text('Delivery Order Date'), },
569     'reqdate'                 => { 'text' => $locale->text('Reqdate'), },
570     'id'                      => { 'text' => $locale->text('ID'), },
571     'donumber'                => { 'text' => $locale->text('Delivery Order'), },
572     'ordnumber'               => { 'text' => $locale->text('Order'), },
573     'customernumber'          => { 'text' => $locale->text('Customer Number'), },
574     'cusordnumber'            => { 'text' => $locale->text('Customer Order Number'), },
575     'name'                    => { 'text' => $form->{vc} eq 'customer' ? $locale->text('Customer') : $locale->text('Vendor'), },
576     'employee'                => { 'text' => $locale->text('Employee'), },
577     'salesman'                => { 'text' => $locale->text('Salesman'), },
578     'shipvia'                 => { 'text' => $locale->text('Ship via'), },
579     'globalprojectnumber'     => { 'text' => $locale->text('Project Number'), },
580     'transaction_description' => { 'text' => $locale->text('Transaction description'), },
581     'open'                    => { 'text' => $locale->text('Open'), },
582     'delivered'               => { 'text' => $locale->text('Delivered'), },
583     'department'              => { 'text' => $locale->text('Department'), },
584     'insertdate'              => { 'text' => $locale->text('Insert Date'), },
585   );
586
587   foreach my $name (qw(id transdate reqdate donumber ordnumber name employee salesman shipvia transaction_description department insertdate)) {
588     my $sortdir                 = $form->{sort} eq $name ? 1 - $form->{sortdir} : $form->{sortdir};
589     $column_defs{$name}->{link} = $href . "&sort=$name&sortdir=$sortdir";
590   }
591
592   $form->{"l_type"} = "Y";
593   map { $column_defs{$_}->{visible} = $form->{"l_${_}"} ? 1 : 0 } @columns;
594
595   $column_defs{ids}->{visible} = 'HTML';
596
597   $report->set_columns(%column_defs);
598   $report->set_column_order(@columns);
599
600   $report->set_export_options('orders', @hidden_variables, qw(sort sortdir));
601
602   $report->set_sort_indicator($form->{sort}, $form->{sortdir});
603
604   my @options;
605   if ($form->{customer}) {
606     push @options, $locale->text('Customer') . " : $form->{customer}";
607   }
608   if ($form->{vendor}) {
609     push @options, $locale->text('Vendor') . " : $form->{vendor}";
610   }
611   if ($form->{cp_name}) {
612     push @options, $locale->text('Contact Person') . " : $form->{cp_name}";
613   }
614   if ($form->{department}) {
615     my ($department) = split /--/, $form->{department};
616     push @options, $locale->text('Department') . " : $department";
617   }
618   if ($form->{donumber}) {
619     push @options, $locale->text('Delivery Order Number') . " : $form->{donumber}";
620   }
621   if ($form->{ordnumber}) {
622     push @options, $locale->text('Order Number') . " : $form->{ordnumber}";
623   }
624   push @options, $locale->text('Serial Number') . " : $form->{serialnumber}" if $form->{serialnumber};
625   if ($form->{business_id}) {
626     my $vc_type_label = $form->{vc} eq 'customer' ? $locale->text('Customer type') : $locale->text('Vendor type');
627     push @options, $vc_type_label . " : " . SL::DB::Business->new(id => $form->{business_id})->load->description;
628   }
629   if ($form->{transaction_description}) {
630     push @options, $locale->text('Transaction description') . " : $form->{transaction_description}";
631   }
632   if ($form->{parts_description}) {
633     push @options, $locale->text('Part Description') . " : $form->{parts_description}";
634   }
635   if ($form->{parts_partnumber}) {
636     push @options, $locale->text('Part Number') . " : $form->{parts_partnumber}";
637   }
638   if ( $form->{transdatefrom} or $form->{transdateto} ) {
639     push @options, $locale->text('Delivery Order Date');
640     push @options, $locale->text('From') . " " . $locale->date(\%myconfig, $form->{transdatefrom}, 1)     if $form->{transdatefrom};
641     push @options, $locale->text('Bis')  . " " . $locale->date(\%myconfig, $form->{transdateto},   1)     if $form->{transdateto};
642   };
643   if ( $form->{reqdatefrom} or $form->{reqdateto} ) {
644     push @options, $locale->text('Reqdate');
645     push @options, $locale->text('From') . " " . $locale->date(\%myconfig, $form->{reqdatefrom}, 1)       if $form->{reqdatefrom};
646     push @options, $locale->text('Bis')  . " " . $locale->date(\%myconfig, $form->{reqdateto},   1)       if $form->{reqdateto};
647   };
648   if ( $form->{insertdatefrom} or $form->{insertdateto} ) {
649     push @options, $locale->text('Insert Date');
650     push @options, $locale->text('From') . " " . $locale->date(\%myconfig, $form->{insertdatefrom}, 1)    if $form->{insertdatefrom};
651     push @options, $locale->text('Bis')  . " " . $locale->date(\%myconfig, $form->{insertdateto},   1)    if $form->{insertdateto};
652   };
653   if ($form->{open}) {
654     push @options, $locale->text('Open');
655   }
656   if ($form->{closed}) {
657     push @options, $locale->text('Closed');
658   }
659   if ($form->{delivered}) {
660     push @options, $locale->text('Delivered');
661   }
662   if ($form->{notdelivered}) {
663     push @options, $locale->text('Not delivered');
664   }
665
666   $report->set_options('top_info_text'        => join("\n", @options),
667                        'raw_top_info_text'    => $form->parse_html_template('do/orders_top'),
668                        'raw_bottom_info_text' => $form->parse_html_template('do/orders_bottom'),
669                        'output_format'        => 'HTML',
670                        'title'                => $form->{title},
671                        'attachment_basename'  => $attachment_basename . strftime('_%Y%m%d', localtime time),
672     );
673   $report->set_options_from_form();
674   $locale->set_numberformat_wo_thousands_separator(\%myconfig) if lc($report->{options}->{output_format}) eq 'csv';
675
676   # add sort and escape callback, this one we use for the add sub
677   $form->{callback} = $href .= "&sort=$form->{sort}";
678
679   # escape callback for href
680   my $callback = $form->escape($href);
681
682   my $edit_url       = build_std_url('action=edit', 'type', 'vc');
683   my $edit_order_url = build_std_url('script=oe.pl', 'type=' . ($form->{type} eq 'sales_delivery_order' ? 'sales_order' : 'purchase_order'), 'action=edit');
684
685   my $idx            = 1;
686
687   foreach my $dord (@{ $form->{DO} }) {
688     $dord->{open}      = $dord->{closed}    ? $locale->text('No')  : $locale->text('Yes');
689     $dord->{delivered} = $dord->{delivered} ? $locale->text('Yes') : $locale->text('No');
690
691     my $row = { map { $_ => { 'data' => $dord->{$_} } } @columns };
692
693     $row->{ids}  = {
694       'raw_data' =>   $cgi->hidden('-name' => "trans_id_${idx}", '-value' => $dord->{id})
695                     . $cgi->checkbox('-name' => "multi_id_${idx}", '-value' => 1, '-label' => ''),
696       'valign'   => 'center',
697       'align'    => 'center',
698     };
699
700     $row->{donumber}->{link}  = $edit_url       . "&id=" . E($dord->{id})      . "&callback=${callback}";
701     $row->{ordnumber}->{link} = $edit_order_url . "&id=" . E($dord->{oe_id})   . "&callback=${callback}" if $dord->{oe_id};
702     $report->add_data($row);
703
704     $idx++;
705   }
706
707   $report->generate_with_headers();
708
709   $main::lxdebug->leave_sub();
710 }
711
712 sub save {
713   $main::lxdebug->enter_sub();
714
715   my (%params) = @_;
716
717   check_do_access();
718
719   my $form     = $main::form;
720   my %myconfig = %main::myconfig;
721   my $locale   = $main::locale;
722
723   $form->mtime_ischanged('delivery_orders');
724
725   $form->{defaultcurrency} = $form->get_default_currency(\%myconfig);
726
727   $form->isblank("transdate", $locale->text('Delivery Order Date missing!'));
728
729   $form->{donumber} =~ s/^\s*//g;
730   $form->{donumber} =~ s/\s*$//g;
731
732   my $msg = ucfirst $form->{vc};
733   $form->isblank($form->{vc}, $locale->text($msg . " missing!"));
734
735   # $locale->text('Customer missing!');
736   # $locale->text('Vendor missing!');
737
738   remove_emptied_rows();
739   validate_items();
740
741   # if the name changed get new values
742   if (check_name($form->{vc})) {
743     update();
744     $::dispatcher->end_request;
745   }
746
747   $form->{id} = 0 if $form->{saveasnew};
748
749   DO->save();
750   # saving the history
751   if(!exists $form->{addition}) {
752     $form->{snumbers} = qq|donumber_| . $form->{donumber};
753     $form->{addition} = "SAVED";
754     $form->save_history;
755   }
756   # /saving the history
757
758   $form->{simple_save} = 1;
759   if (!$params{no_redirect} && !$form->{print_and_save}) {
760     delete @{$form}{ary_diff([keys %{ $form }], [qw(login id script type cursor_fokus)])};
761     edit();
762     $::dispatcher->end_request;
763   }
764   $main::lxdebug->leave_sub();
765 }
766
767 sub delete {
768   $main::lxdebug->enter_sub();
769
770   check_do_access();
771
772   my $form     = $main::form;
773   my %myconfig = %main::myconfig;
774   my $locale   = $main::locale;
775
776   if (DO->delete()) {
777     # saving the history
778     if(!exists $form->{addition}) {
779       $form->{snumbers} = qq|donumber_| . $form->{donumber};
780       $form->{addition} = "DELETED";
781       $form->save_history;
782     }
783     # /saving the history
784
785     $form->info($locale->text('Delivery Order deleted!'));
786     $::dispatcher->end_request;
787   }
788
789   $form->error($locale->text('Cannot delete delivery order!'));
790
791   $main::lxdebug->leave_sub();
792 }
793
794 sub invoice {
795   $main::lxdebug->enter_sub();
796
797   my $form     = $main::form;
798   my %myconfig = %main::myconfig;
799   my $locale   = $main::locale;
800
801   check_do_access();
802   $form->mtime_ischanged('delivery_orders');
803
804   $main::auth->assert($form->{type} eq 'purchase_delivery_order' ? 'vendor_invoice_edit' : 'invoice_edit');
805
806   $form->{convert_from_do_ids} = $form->{id};
807   $form->{deliverydate}        = $form->{transdate};
808   $form->{transdate}           = $form->{invdate} = $form->current_date(\%myconfig);
809   $form->{duedate}             = $form->current_date(\%myconfig, $form->{invdate}, $form->{terms} * 1);
810   $form->{defaultcurrency}     = $form->get_default_currency(\%myconfig);
811
812   $form->{rowcount}--;
813
814   delete @{$form}{qw(id closed delivered)};
815
816   my ($script, $buysell);
817   if ($form->{type} eq 'purchase_delivery_order') {
818     $form->{title}  = $locale->text('Add Vendor Invoice');
819     $form->{script} = 'ir.pl';
820     $script         = "ir";
821     $buysell        = 'sell';
822
823   } else {
824     $form->{title}  = $locale->text('Add Sales Invoice');
825     $form->{script} = 'is.pl';
826     $script         = "is";
827     $buysell        = 'buy';
828   }
829
830   for my $i (1 .. $form->{rowcount}) {
831     # für bug 1284
832     unless ($form->{"ordnumber"}) {
833       if ($form->{discount}) { # Falls wir einen Lieferanten-/Kundenrabatt haben
834         # und rabattfähig sind, dann
835         unless ($form->{"not_discountable_$i"}) {
836           $form->{"discount_$i"} = $form->{discount}*100; # ... nehmen wir diesen Rabatt
837         }
838       }
839     }
840     map { $form->{"${_}_${i}"} = $form->parse_amount(\%myconfig, $form->{"${_}_${i}"}) if $form->{"${_}_${i}"} } qw(ship qty sellprice lastcost basefactor discount);
841     $form->{"donumber_$i"} = $form->{donumber};
842     $form->{"converted_from_delivery_order_items_id_$i"} = delete $form->{"delivery_order_items_id_$i"};
843   }
844
845   $form->{type} = "invoice";
846
847   # locale messages
848   $main::locale = Locale->new("$myconfig{countrycode}", "$script");
849   $locale = $main::locale;
850
851   require "bin/mozilla/$form->{script}";
852
853   my $currency = $form->{currency};
854   invoice_links();
855
856   if ($form->{ordnumber}) {
857     require SL::DB::Order;
858     if (my $order = SL::DB::Manager::Order->find_by(ordnumber => $form->{ordnumber})) {
859       $order->load;
860       $form->{orddate} = $order->transdate_as_date;
861       $form->{$_}      = $order->$_ for qw(payment_id salesman_id taxzone_id quonumber);
862     }
863   }
864
865   $form->{currency}     = $currency;
866   $form->{exchangerate} = "";
867   $form->{forex}        = $form->check_exchangerate(\%myconfig, $form->{currency}, $form->{invdate}, $buysell);
868   $form->{exchangerate} = $form->{forex} if ($form->{forex});
869
870   prepare_invoice();
871
872   # format amounts
873   for my $i (1 .. $form->{rowcount}) {
874     $form->{"discount_$i"} = $form->format_amount(\%myconfig, $form->{"discount_$i"});
875
876     my ($dec) = ($form->{"sellprice_$i"} =~ /\.(\d+)/);
877     $dec           = length $dec;
878     my $decimalplaces = ($dec > 2) ? $dec : 2;
879
880     # copy delivery date from reqdate for order -> invoice conversion
881     $form->{"deliverydate_$i"} = $form->{"reqdate_$i"}
882       unless $form->{"deliverydate_$i"};
883
884
885     $form->{"sellprice_$i"} =
886       $form->format_amount(\%myconfig, $form->{"sellprice_$i"},
887                            $decimalplaces);
888
889     $form->{"lastcost_$i"} =
890       $form->format_amount(\%myconfig, $form->{"lastcost_$i"},
891                            $decimalplaces);
892
893     (my $dec_qty) = ($form->{"qty_$i"} =~ /\.(\d+)/);
894     $dec_qty = length $dec_qty;
895     $form->{"qty_$i"} =
896       $form->format_amount(\%myconfig, $form->{"qty_$i"}, $dec_qty);
897
898   }
899
900   display_form();
901
902   $main::lxdebug->leave_sub();
903 }
904
905 sub invoice_multi {
906   $main::lxdebug->enter_sub();
907
908   my $form     = $main::form;
909   my %myconfig = %main::myconfig;
910   my $locale   = $main::locale;
911
912   check_do_access();
913   $main::auth->assert($form->{type} eq 'sales_delivery_order' ? 'invoice_edit' : 'vendor_invoice_edit');
914
915   my @do_ids = map { $form->{"trans_id_$_"} } grep { $form->{"multi_id_$_"} } (1..$form->{rowcount});
916
917   if (!scalar @do_ids) {
918     $form->show_generic_error($locale->text('You have not selected any delivery order.'), 'back_button' => 1);
919   }
920
921   map { delete $form->{$_} } grep { m/^(?:trans|multi)_id_\d+/ } keys %{ $form };
922
923   if (!DO->retrieve('vc' => $form->{vc}, 'ids' => \@do_ids)) {
924     $form->show_generic_error($form->{vc} eq 'customer' ?
925                               $locale->text('You cannot create an invoice for delivery orders for different customers.') :
926                               $locale->text('You cannot create an invoice for delivery orders from different vendors.'),
927                               'back_button' => 1);
928   }
929
930   my $source_type              = $form->{type};
931   $form->{convert_from_do_ids} = join ' ', @do_ids;
932   # bei der auswahl von mehreren Lieferscheinen fuer eine Rechnung, die einfach in donumber_array
933   # zwischenspeichern (DO.pm) und als ' '-separierte Liste wieder zurueckschreiben
934   # Hinweis: delete gibt den wert zurueck und loescht danach das element (nett und einfach)
935   # $shell: perldoc perlunc; /delete EXPR
936   $form->{donumber}            = delete $form->{donumber_array};
937   $form->{ordnumber}           = delete $form->{ordnumber_array};
938   $form->{cusordnumber}        = delete $form->{cusordnumber_array};
939   $form->{deliverydate}        = $form->{transdate};
940   $form->{transdate}           = $form->current_date(\%myconfig);
941   $form->{duedate}             = $form->current_date(\%myconfig, $form->{invdate}, $form->{terms} * 1);
942   $form->{type}                = "invoice";
943   $form->{closed}              = 0;
944   $form->{defaultcurrency}     = $form->get_default_currency(\%myconfig);
945
946   my ($script, $buysell);
947   if ($source_type eq 'purchase_delivery_order') {
948     $form->{title}  = $locale->text('Add Vendor Invoice');
949     $form->{script} = 'ir.pl';
950     $script         = "ir";
951     $buysell        = 'sell';
952
953   } else {
954     $form->{title}  = $locale->text('Add Sales Invoice');
955     $form->{script} = 'is.pl';
956     $script         = "is";
957     $buysell        = 'buy';
958   }
959
960   map { delete $form->{$_} } qw(id subject message cc bcc printed emailed queued);
961
962   # get vendor or customer discount
963   my $vc_discount;
964   my $saved_form = save_form();
965   if ($form->{vc} eq 'vendor') {
966     IR->get_vendor(\%myconfig, \%$form);
967     $vc_discount = $form->{vendor_discount};
968   } else {
969     IS->get_customer(\%myconfig, \%$form);
970     $vc_discount = $form->{customer_discount};
971   }
972   # use payment terms from customer or vendor
973   restore_form($saved_form,0,qw(payment_id));
974
975   $form->{rowcount} = 0;
976   foreach my $ref (@{ $form->{form_details} }) {
977     $form->{rowcount}++;
978     $ref->{reqdate} ||= $ref->{dord_transdate}; # copy transdates into each invoice row
979     map { $form->{"${_}_$form->{rowcount}"} = $ref->{$_} } keys %{ $ref };
980     map { $form->{"${_}_$form->{rowcount}"} = $form->format_amount(\%myconfig, $ref->{$_}) } qw(qty sellprice lastcost);
981     $form->{"converted_from_delivery_order_items_id_$form->{rowcount}"} = delete $form->{"delivery_order_items_id_$form->{rowcount}"};
982
983     if ($vc_discount){ # falls wir einen Lieferanten/Kundenrabatt haben
984       # und keinen anderen discount wert an $i ...
985       $form->{"discount_$form->{rowcount}"} ||= $vc_discount; # ... nehmen wir diesen Rabatt
986     }
987
988     $form->{"discount_$form->{rowcount}"}   = $form->{"discount_$form->{rowcount}"}  * 100; #s.a. Bug 1151
989     # Anm.: Eine Änderung des discounts in der SL/DO.pm->retrieve (select (doi.discount * 100) as discount) ergibt in psql einen
990     # Wert von 10.0000001490116. Ferner ist der Rabatt in der Rechnung dann bei 1.0 (?). Deswegen lasse ich das hier. jb 10.10.09
991
992     $form->{"discount_$form->{rowcount}"} = $form->format_amount(\%myconfig, $form->{"discount_$form->{rowcount}"});
993   }
994   delete $form->{form_details};
995
996   $locale = Locale->new("$myconfig{countrycode}", "$script");
997
998   require "bin/mozilla/$form->{script}";
999
1000   invoice_links();
1001   prepare_invoice();
1002
1003   display_form();
1004
1005   $main::lxdebug->leave_sub();
1006 }
1007
1008 sub save_as_new {
1009   $main::lxdebug->enter_sub();
1010
1011   check_do_access();
1012
1013   my $form     = $main::form;
1014
1015   $form->{saveasnew} = 1;
1016   $form->{closed}    = 0;
1017   $form->{delivered} = 0;
1018   map { delete $form->{$_} } qw(printed emailed queued);
1019   delete @{ $form }{ grep { m/^stock_(?:in|out)_\d+/ } keys %{ $form } };
1020   $form->{"converted_from_delivery_order_items_id_$_"} = delete $form->{"delivery_order_items_id_$_"} for 1 .. $form->{"rowcount"};
1021   # Let kivitendo assign a new order number if the user hasn't changed the
1022   # previous one. If it has been changed manually then use it as-is.
1023   $form->{donumber} =~ s/^\s*//g;
1024   $form->{donumber} =~ s/\s*$//g;
1025   if ($form->{saved_donumber} && ($form->{saved_donumber} eq $form->{donumber})) {
1026     delete($form->{donumber});
1027   }
1028
1029   save();
1030
1031   $main::lxdebug->leave_sub();
1032 }
1033
1034 sub e_mail {
1035   $main::lxdebug->enter_sub();
1036
1037   check_do_access();
1038
1039   $::form->mtime_ischanged('delivery_orders','mail');
1040
1041   $::form->{print_and_save} = 1;
1042
1043   my $saved_form = save_form();
1044
1045   save();
1046
1047   restore_form($saved_form, 0, qw(id ordnumber quonumber));
1048
1049   edit_e_mail();
1050
1051   $main::lxdebug->leave_sub();
1052 }
1053
1054 sub calculate_stock_in_out {
1055   $main::lxdebug->enter_sub();
1056
1057   my $form     = $main::form;
1058
1059   my $i = shift;
1060
1061   if (!$form->{"id_${i}"}) {
1062     $main::lxdebug->leave_sub();
1063     return '';
1064   }
1065
1066   my $all_units = AM->retrieve_all_units();
1067
1068   my $in_out   = $form->{type} =~ /^sales/ ? 'out' : 'in';
1069   my $sinfo    = DO->unpack_stock_information('packed' => $form->{"stock_${in_out}_${i}"});
1070
1071   my $do_qty   = AM->sum_with_unit($::form->{"qty_$i"}, $::form->{"unit_$i"});
1072   my $sum      = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $sinfo });
1073   my $matches  = $do_qty == $sum;
1074
1075   my $content  = $form->format_amount_units('amount'      => $sum * 1,
1076                                             'part_unit'   => $form->{"partunit_$i"},
1077                                             'amount_unit' => $all_units->{$form->{"partunit_$i"}}->{base_unit},
1078                                             'conv_units'  => 'convertible_not_smaller',
1079                                             'max_places'  => 2);
1080   $content     = qq|<span id="stock_in_out_qty_display_${i}">${content}</span><input type=hidden id='stock_in_out_qty_matches_$i' value='$matches'> <input type="button" onclick="open_stock_in_out_window('${in_out}', $i);" value="?">|;
1081
1082   $main::lxdebug->leave_sub();
1083
1084   return $content;
1085 }
1086
1087 sub get_basic_bin_wh_info {
1088   $main::lxdebug->enter_sub();
1089
1090   my $stock_info = shift;
1091
1092   my $form     = $main::form;
1093
1094   foreach my $sinfo (@{ $stock_info }) {
1095     next unless ($sinfo->{bin_id});
1096
1097     my $bin_info = WH->get_basic_bin_info('id' => $sinfo->{bin_id});
1098     map { $sinfo->{"${_}_description"} = $sinfo->{"${_}description"} = $bin_info->{"${_}_description"} } qw(bin warehouse);
1099   }
1100
1101   $main::lxdebug->leave_sub();
1102 }
1103
1104 sub stock_in_out_form {
1105   $main::lxdebug->enter_sub();
1106
1107   my $form     = $main::form;
1108
1109   if ($form->{in_out} eq 'out') {
1110     stock_out_form();
1111   } else {
1112     stock_in_form();
1113   }
1114
1115   $main::lxdebug->leave_sub();
1116 }
1117
1118 sub redo_stock_info {
1119   $main::lxdebug->enter_sub();
1120
1121   my %params    = @_;
1122
1123   my $form     = $main::form;
1124
1125   my @non_empty = grep { $_->{qty} } @{ $params{stock_info} };
1126
1127   if ($params{add_empty_row}) {
1128     push @non_empty, {
1129       'warehouse_id' => scalar(@non_empty) ? $non_empty[-1]->{warehouse_id} : undef,
1130       'bin_id'       => scalar(@non_empty) ? $non_empty[-1]->{bin_id}       : undef,
1131     };
1132   }
1133
1134   @{ $params{stock_info} } = @non_empty;
1135
1136   $main::lxdebug->leave_sub();
1137 }
1138
1139 sub update_stock_in {
1140   $main::lxdebug->enter_sub();
1141
1142   my $form     = $main::form;
1143   my %myconfig = %main::myconfig;
1144
1145   my $stock_info = [];
1146
1147   foreach my $i (1..$form->{rowcount}) {
1148     $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
1149     push @{ $stock_info }, { map { $_ => $form->{"${_}_${i}"} } qw(warehouse_id bin_id chargenumber
1150                                                                    bestbefore qty unit delivery_order_items_stock_id) };
1151   }
1152
1153   display_stock_in_form($stock_info);
1154
1155   $main::lxdebug->leave_sub();
1156 }
1157
1158 sub stock_in_form {
1159   $main::lxdebug->enter_sub();
1160
1161   my $form     = $main::form;
1162
1163   my $stock_info = DO->unpack_stock_information('packed' => $form->{stock});
1164
1165   display_stock_in_form($stock_info);
1166
1167   $main::lxdebug->leave_sub();
1168 }
1169
1170 sub display_stock_in_form {
1171   $main::lxdebug->enter_sub();
1172
1173   my $stock_info = shift;
1174
1175   my $form     = $main::form;
1176   my %myconfig = %main::myconfig;
1177   my $locale   = $main::locale;
1178
1179   $form->{title} = $locale->text('Stock');
1180
1181   my $part_info  = IC->get_basic_part_info('id' => $form->{parts_id});
1182
1183   # Standardlagerplatz für Standard-Auslagern verwenden, falls keiner für die Ware explizit definiert wurde
1184   if ($::instance_conf->get_transfer_default_use_master_default_bin) {
1185     $part_info->{warehouse_id} ||= $::instance_conf->get_warehouse_id;
1186     $part_info->{bin_id}       ||= $::instance_conf->get_bin_id;
1187   }
1188
1189   my $units      = AM->retrieve_units(\%myconfig, $form);
1190   # der zweite Parameter von unit_select_data gibt den default-Namen (selected) vor
1191   my $units_data = AM->unit_select_data($units, $form->{do_unit}, undef, $part_info->{unit});
1192
1193   $form->get_lists('warehouses' => { 'key'    => 'WAREHOUSES',
1194                                      'bins'   => 'BINS' });
1195
1196   redo_stock_info('stock_info' => $stock_info, 'add_empty_row' => !$form->{delivered});
1197
1198   get_basic_bin_wh_info($stock_info);
1199
1200   $form->header(no_layout => 1);
1201   print $form->parse_html_template('do/stock_in_form', { 'UNITS'      => $units_data,
1202                                                          'STOCK_INFO' => $stock_info,
1203                                                          'PART_INFO'  => $part_info, });
1204
1205   $main::lxdebug->leave_sub();
1206 }
1207
1208 sub _stock_in_out_set_qty_display {
1209   my $stock_info       = shift;
1210   my $form             = $::form;
1211   my $all_units        = AM->retrieve_all_units();
1212   my $sum              = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $stock_info });
1213   $form->{qty_display} = $form->format_amount_units(amount      => $sum * 1,
1214                                                     part_unit   => $form->{partunit},
1215                                                     amount_unit => $all_units->{ $form->{partunit} }->{base_unit},
1216                                                     conv_units  => 'convertible_not_smaller',
1217                                                     max_places  => 2);
1218 }
1219
1220 sub set_stock_in {
1221   $main::lxdebug->enter_sub();
1222
1223   my $form     = $main::form;
1224   my %myconfig = %main::myconfig;
1225
1226   my $stock_info = [];
1227
1228   foreach my $i (1..$form->{rowcount}) {
1229     $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
1230
1231     next if ($form->{"qty_$i"} <= 0);
1232
1233     push @{ $stock_info }, { map { $_ => $form->{"${_}_${i}"} } qw(delivery_order_items_stock_id warehouse_id bin_id chargenumber bestbefore qty unit) };
1234   }
1235
1236   $form->{stock} = YAML::Dump($stock_info);
1237
1238   _stock_in_out_set_qty_display($stock_info);
1239
1240   my $do_qty       = AM->sum_with_unit($::form->parse_amount(\%::myconfig, $::form->{do_qty}), $::form->{do_unit});
1241   my $transfer_qty = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $stock_info });
1242
1243   $form->header();
1244   print $form->parse_html_template('do/set_stock_in_out', {
1245     qty_matches => $do_qty == $transfer_qty,
1246   });
1247
1248   $main::lxdebug->leave_sub();
1249 }
1250
1251 sub stock_out_form {
1252   $main::lxdebug->enter_sub();
1253
1254   my $form     = $main::form;
1255   my %myconfig = %main::myconfig;
1256   my $locale   = $main::locale;
1257
1258   $form->{title} = $locale->text('Release From Stock');
1259
1260   my $part_info  = IC->get_basic_part_info('id' => $form->{parts_id});
1261
1262   my $units      = AM->retrieve_units(\%myconfig, $form);
1263   my $units_data = AM->unit_select_data($units, undef, undef, $part_info->{unit});
1264
1265   my @contents   = DO->get_item_availability('parts_id' => $form->{parts_id});
1266
1267   my $stock_info = DO->unpack_stock_information('packed' => $form->{stock});
1268
1269   if (!$form->{delivered}) {
1270     foreach my $row (@contents) {
1271       $row->{available_qty} = $form->format_amount_units('amount'      => $row->{qty} * 1,
1272                                                          'part_unit'   => $part_info->{unit},
1273                                                          'conv_units'  => 'convertible_not_smaller',
1274                                                          'max_places'  => 2);
1275
1276       foreach my $sinfo (@{ $stock_info }) {
1277         next if (($row->{bin_id}       != $sinfo->{bin_id}) ||
1278                  ($row->{warehouse_id} != $sinfo->{warehouse_id}) ||
1279                  ($row->{chargenumber} ne $sinfo->{chargenumber}) ||
1280                  ($row->{bestbefore}   ne $sinfo->{bestbefore}));
1281
1282         map { $row->{"stock_$_"} = $sinfo->{$_} } qw(qty unit error delivery_order_items_stock_id);
1283       }
1284     }
1285
1286   } else {
1287     get_basic_bin_wh_info($stock_info);
1288
1289     foreach my $sinfo (@{ $stock_info }) {
1290       map { $sinfo->{"stock_$_"} = $sinfo->{$_} } qw(qty unit);
1291     }
1292   }
1293
1294   $form->header(no_layout => 1);
1295   print $form->parse_html_template('do/stock_out_form', { 'UNITS'      => $units_data,
1296                                                           'WHCONTENTS' => $form->{delivered} ? $stock_info : \@contents,
1297                                                           'PART_INFO'  => $part_info, });
1298
1299   $main::lxdebug->leave_sub();
1300 }
1301
1302 sub set_stock_out {
1303   $main::lxdebug->enter_sub();
1304
1305   my $form     = $main::form;
1306   my %myconfig = %main::myconfig;
1307   my $locale   = $main::locale;
1308
1309   my $stock_info = [];
1310
1311   foreach my $i (1 .. $form->{rowcount}) {
1312     $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
1313
1314     next if ($form->{"qty_$i"} <= 0);
1315
1316     push @{ $stock_info }, {
1317       'warehouse_id' => $form->{"warehouse_id_$i"},
1318       'bin_id'       => $form->{"bin_id_$i"},
1319       'chargenumber' => $form->{"chargenumber_$i"},
1320       'bestbefore'   => $form->{"bestbefore_$i"},
1321       'qty'          => $form->{"qty_$i"},
1322       'unit'         => $form->{"unit_$i"},
1323       'row'          => $i,
1324       'delivery_order_items_stock_id'  => $form->{"delivery_order_items_stock_id_$i"},
1325     };
1326   }
1327
1328   my @errors     = DO->check_stock_availability('requests' => $stock_info,
1329                                                 'parts_id' => $form->{parts_id});
1330
1331   $form->{stock} = YAML::Dump($stock_info);
1332
1333   if (@errors) {
1334     $form->{ERRORS} = [];
1335     map { push @{ $form->{ERRORS} }, $locale->text('Error in row #1: The quantity you entered is bigger than the stocked quantity.', $_->{row}); } @errors;
1336     stock_in_out_form();
1337
1338   } else {
1339     _stock_in_out_set_qty_display($stock_info);
1340
1341     my $do_qty       = AM->sum_with_unit($::form->parse_amount(\%::myconfig, $::form->{do_qty}), $::form->{do_unit});
1342     my $transfer_qty = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $stock_info });
1343
1344     $form->header();
1345     print $form->parse_html_template('do/set_stock_in_out', {
1346       qty_matches => $do_qty == $transfer_qty,
1347     });
1348   }
1349
1350   $main::lxdebug->leave_sub();
1351 }
1352
1353 sub transfer_in {
1354   $main::lxdebug->enter_sub();
1355
1356   my $form     = $main::form;
1357   my %myconfig = %main::myconfig;
1358   my $locale   = $main::locale;
1359
1360   if ($form->{id} && DO->is_marked_as_delivered(id => $form->{id})) {
1361     $form->show_generic_error($locale->text('The parts for this delivery order have already been transferred in.'), 'back_button' => 1);
1362   }
1363
1364   save(no_redirect => 1);
1365
1366   my @part_ids = map { $form->{"id_${_}"} } grep { $form->{"id_${_}"} && $form->{"stock_in_${_}"} } (1 .. $form->{rowcount});
1367   my @all_requests;
1368
1369   if (@part_ids) {
1370     my $units         = AM->retrieve_units(\%myconfig, $form);
1371     my %part_info_map = IC->get_basic_part_info('id' => \@part_ids);
1372     my %request_map;
1373
1374     $form->{ERRORS}   = [];
1375
1376     foreach my $i (1 .. $form->{rowcount}) {
1377       next unless ($form->{"id_$i"} && $form->{"stock_in_$i"});
1378
1379       my $row_sum_base_qty = 0;
1380       my $base_unit_factor = $units->{ $part_info_map{$form->{"id_$i"}}->{unit} }->{factor} || 1;
1381
1382       foreach my $request (@{ DO->unpack_stock_information('packed' => $form->{"stock_in_$i"}) }) {
1383         $request->{parts_id}  = $form->{"id_$i"};
1384         $row_sum_base_qty    += $request->{qty} * $units->{$request->{unit}}->{factor} / $base_unit_factor;
1385
1386         $request->{project_id} = $form->{"project_id_$i"} || $form->{globalproject_id};
1387
1388         push @all_requests, $request;
1389       }
1390
1391       next if (0 == $row_sum_base_qty);
1392
1393       my $do_base_qty = $form->parse_amount(\%myconfig, $form->{"qty_$i"}) * $units->{$form->{"unit_$i"}}->{factor} / $base_unit_factor;
1394
1395 #      if ($do_base_qty != $row_sum_base_qty) {
1396 #        push @{ $form->{ERRORS} }, $locale->text('Error in position #1: You must either assign no stock at all or the full quantity of #2 #3.',
1397 #                                                 $i, $form->{"qty_$i"}, $form->{"unit_$i"});
1398 #      }
1399     }
1400
1401     if (@{ $form->{ERRORS} }) {
1402       push @{ $form->{ERRORS} }, $locale->text('The delivery order has not been marked as delivered. The warehouse contents have not changed.');
1403
1404       set_headings('edit');
1405       update();
1406       $main::lxdebug->leave_sub();
1407
1408       $::dispatcher->end_request;
1409     }
1410   }
1411
1412   DO->transfer_in_out('direction' => 'in',
1413                       'requests'  => \@all_requests);
1414
1415   SL::DB::DeliveryOrder->new(id => $form->{id})->load->update_attributes(delivered => 1);
1416
1417   $form->{callback} = 'do.pl?action=edit&type=purchase_delivery_order&id=' . $form->escape($form->{id});
1418   $form->redirect;
1419
1420   $main::lxdebug->leave_sub();
1421 }
1422
1423 sub transfer_out {
1424   $main::lxdebug->enter_sub();
1425
1426   my $form     = $main::form;
1427   my %myconfig = %main::myconfig;
1428   my $locale   = $main::locale;
1429
1430   if ($form->{id} && DO->is_marked_as_delivered(id => $form->{id})) {
1431     $form->show_generic_error($locale->text('The parts for this delivery order have already been transferred out.'), 'back_button' => 1);
1432   }
1433
1434   save(no_redirect => 1);
1435
1436   my @part_ids = map { $form->{"id_${_}"} } grep { $form->{"id_${_}"} && $form->{"stock_out_${_}"} } (1 .. $form->{rowcount});
1437   my @all_requests;
1438
1439   if (@part_ids) {
1440     my $units         = AM->retrieve_units(\%myconfig, $form);
1441     my %part_info_map = IC->get_basic_part_info('id' => \@part_ids);
1442     my %request_map;
1443
1444     $form->{ERRORS}   = [];
1445
1446     foreach my $i (1 .. $form->{rowcount}) {
1447       next unless ($form->{"id_$i"} && $form->{"stock_out_$i"});
1448
1449       my $row_sum_base_qty = 0;
1450       my $base_unit_factor = $units->{ $part_info_map{$form->{"id_$i"}}->{unit} }->{factor} || 1;
1451
1452       foreach my $request (@{ DO->unpack_stock_information('packed' => $form->{"stock_out_$i"}) }) {
1453         $request->{parts_id} = $form->{"id_$i"};
1454         $request->{base_qty} = $request->{qty} * $units->{$request->{unit}}->{factor} / $base_unit_factor;
1455         $request->{project_id} = $form->{"project_id_$i"} ? $form->{"project_id_$i"} : $form->{globalproject_id};
1456
1457         my $map_key          = join '--', ($form->{"id_$i"}, @{$request}{qw(warehouse_id bin_id chargenumber bestbefore)});
1458
1459         $request_map{$map_key}                 ||= $request;
1460         $request_map{$map_key}->{sum_base_qty} ||= 0;
1461         $request_map{$map_key}->{sum_base_qty}  += $request->{base_qty};
1462         $row_sum_base_qty                       += $request->{base_qty};
1463
1464         push @all_requests, $request;
1465       }
1466
1467       next if (0 == $row_sum_base_qty);
1468
1469       my $do_base_qty = $form->{"qty_$i"} * $units->{$form->{"unit_$i"}}->{factor} / $base_unit_factor;
1470
1471 #      if ($do_base_qty != $row_sum_base_qty) {
1472 #        push @{ $form->{ERRORS} }, $locale->text('Error in position #1: You must either assign no transfer at all or the full quantity of #2 #3.',
1473 #                                                 $i, $form->{"qty_$i"}, $form->{"unit_$i"});
1474 #      }
1475     }
1476
1477     if (%request_map) {
1478       my @bin_ids      = map { $_->{bin_id} } values %request_map;
1479       my %bin_info_map = WH->get_basic_bin_info('id' => \@bin_ids);
1480       my @contents     = DO->get_item_availability('parts_id' => \@part_ids);
1481
1482       foreach my $inv (@contents) {
1483         my $map_key = join '--', @{$inv}{qw(parts_id warehouse_id bin_id chargenumber bestbefore)};
1484
1485         next unless ($request_map{$map_key});
1486
1487         my $request    = $request_map{$map_key};
1488         $request->{ok} = $request->{sum_base_qty} <= $inv->{qty};
1489       }
1490
1491       foreach my $request (values %request_map) {
1492         next if ($request->{ok});
1493
1494         my $pinfo = $part_info_map{$request->{parts_id}};
1495         my $binfo = $bin_info_map{$request->{bin_id}};
1496
1497         if ($::instance_conf->get_show_bestbefore) {
1498             push @{ $form->{ERRORS} }, $locale->text("There is not enough available of '#1' at warehouse '#2', bin '#3', #4, #5, for the transfer of #6.",
1499                                                      $pinfo->{description},
1500                                                      $binfo->{warehouse_description},
1501                                                      $binfo->{bin_description},
1502                                                      $request->{chargenumber} ? $locale->text('chargenumber #1', $request->{chargenumber}) : $locale->text('no chargenumber'),
1503                                                      $request->{bestbefore} ? $locale->text('bestbefore #1', $request->{bestbefore}) : $locale->text('no bestbefore'),
1504                                                      $form->format_amount_units('amount'      => $request->{sum_base_qty},
1505                                                                                 'part_unit'   => $pinfo->{unit},
1506                                                                                 'conv_units'  => 'convertible_not_smaller'));
1507         } else {
1508             push @{ $form->{ERRORS} }, $locale->text("There is not enough available of '#1' at warehouse '#2', bin '#3', #4, for the transfer of #5.",
1509                                                      $pinfo->{description},
1510                                                      $binfo->{warehouse_description},
1511                                                      $binfo->{bin_description},
1512                                                      $request->{chargenumber} ? $locale->text('chargenumber #1', $request->{chargenumber}) : $locale->text('no chargenumber'),
1513                                                      $form->format_amount_units('amount'      => $request->{sum_base_qty},
1514                                                                                 'part_unit'   => $pinfo->{unit},
1515                                                                                 'conv_units'  => 'convertible_not_smaller'));
1516         }
1517       }
1518     }
1519
1520     if (@{ $form->{ERRORS} }) {
1521       push @{ $form->{ERRORS} }, $locale->text('The delivery order has not been marked as delivered. The warehouse contents have not changed.');
1522
1523       set_headings('edit');
1524       update();
1525       $main::lxdebug->leave_sub();
1526
1527       $::dispatcher->end_request;
1528     }
1529   }
1530   DO->transfer_in_out('direction' => 'out',
1531                       'requests'  => \@all_requests);
1532
1533   SL::DB::DeliveryOrder->new(id => $form->{id})->load->update_attributes(delivered => 1);
1534
1535   $form->{callback} = 'do.pl?action=edit&type=sales_delivery_order&id=' . $form->escape($form->{id});
1536   $form->redirect;
1537
1538   $main::lxdebug->leave_sub();
1539 }
1540
1541 sub mark_closed {
1542   $main::lxdebug->enter_sub();
1543
1544   my $form     = $main::form;
1545
1546   DO->close_orders('ids' => [ $form->{id} ]);
1547
1548   $form->{closed} = 1;
1549
1550   update();
1551
1552   $main::lxdebug->leave_sub();
1553 }
1554
1555 sub display_form {
1556   $::lxdebug->enter_sub;
1557
1558   $::auth->assert('purchase_delivery_order_edit | sales_delivery_order_edit');
1559
1560   relink_accounts();
1561   retrieve_partunits();
1562
1563   my $new_rowcount = $::form->{"rowcount"} * 1 + 1;
1564   $::form->{"project_id_${new_rowcount}"} = $::form->{"globalproject_id"};
1565
1566   $::form->language_payment(\%::myconfig);
1567
1568   Common::webdav_folder($::form);
1569
1570   form_header();
1571   display_row(++$::form->{rowcount});
1572   form_footer();
1573
1574   $::lxdebug->leave_sub;
1575 }
1576
1577 sub yes {
1578   call_sub($main::form->{yes_nextsub});
1579 }
1580
1581 sub no {
1582   call_sub($main::form->{no_nextsub});
1583 }
1584
1585 sub update {
1586   call_sub($main::form->{update_nextsub} || $main::form->{nextsub} || 'update_delivery_order');
1587 }
1588
1589 sub dispatcher {
1590   my $form     = $main::form;
1591   my $locale   = $main::locale;
1592
1593   foreach my $action (qw(update ship_to print e_mail save transfer_out transfer_out_default sort
1594                          transfer_in transfer_in_default mark_closed save_as_new invoice delete)) {
1595     if ($form->{"action_${action}"}) {
1596       call_sub($action);
1597       return;
1598     }
1599   }
1600
1601   $form->error($locale->text('No action defined.'));
1602 }
1603
1604 sub transfer_out_default {
1605   $main::lxdebug->enter_sub();
1606
1607   my $form     = $main::form;
1608
1609   transfer_in_out_default('direction' => 'out');
1610
1611   $main::lxdebug->leave_sub();
1612 }
1613
1614 sub transfer_in_default {
1615   $main::lxdebug->enter_sub();
1616
1617   my $form     = $main::form;
1618
1619   transfer_in_out_default('direction' => 'in');
1620
1621   $main::lxdebug->leave_sub();
1622 }
1623
1624 # Falls das Standardlagerverfahren aktiv ist, wird
1625 # geprüft, ob alle Standardlagerplätze für die Auslager-
1626 # artikel vorhanden sind UND ob die Warenmenge ausreicht zum
1627 # Auslagern. Falls nicht wird entsprechend eine Fehlermeldung
1628 # generiert. Offen Chargennummer / bestbefore wird nicht berücksichtigt
1629 sub transfer_in_out_default {
1630   $main::lxdebug->enter_sub();
1631
1632   my $form     = $main::form;
1633   my %myconfig = %main::myconfig;
1634   my $locale   = $main::locale;
1635   my %params   = @_;
1636
1637   my (%missing_default_bins, %qty_parts, @all_requests, %part_info_map, $default_warehouse_id, $default_bin_id);
1638
1639   Common::check_params(\%params, qw(direction));
1640
1641   # entsprechende defaults holen, falls standardlagerplatz verwendet werden soll
1642   if ($::instance_conf->get_transfer_default_use_master_default_bin) {
1643     $default_warehouse_id = $::instance_conf->get_warehouse_id;
1644     $default_bin_id       = $::instance_conf->get_bin_id;
1645   }
1646
1647
1648   my @part_ids = map { $form->{"id_${_}"} } (1 .. $form->{rowcount});
1649   if (@part_ids) {
1650     my $units         = AM->retrieve_units(\%myconfig, $form);
1651     %part_info_map = IC->get_basic_part_info('id' => \@part_ids);
1652     foreach my $i (1 .. $form->{rowcount}) {
1653       next unless ($form->{"id_$i"});
1654       my $base_unit_factor = $units->{ $part_info_map{$form->{"id_$i"}}->{unit} }->{factor} || 1;
1655       my $qty =   $form->parse_amount(\%myconfig, $form->{"qty_$i"}) * $units->{$form->{"unit_$i"}}->{factor} / $base_unit_factor;
1656
1657       $form->show_generic_error($locale->text("Cannot transfer negative entries." ), 'back_button' => 1) if ($qty < 0);
1658       # if we do not want to transfer services and this part is a service, set qty to zero
1659       # ... and do not create a hash entry in %qty_parts below (will skip check for bins for the transfer == out case)
1660       # ... and push only a empty (undef) element to @all_requests (will skip check for bin_id and warehouse_id and will not alter the row)
1661
1662       $qty = 0 if (!$::instance_conf->get_transfer_default_services && !defined($part_info_map{$form->{"id_$i"}}->{inventory_accno_id}) && !$part_info_map{$form->{"id_$i"}}->{assembly});
1663       $qty_parts{$form->{"id_$i"}} += $qty;
1664       if ($qty == 0) {
1665         delete $qty_parts{$form->{"id_$i"}} unless $qty_parts{$form->{"id_$i"}};
1666         undef $form->{"stock_in_$i"};
1667       }
1668
1669       $part_info_map{$form->{"id_$i"}}{bin_id}       ||= $default_bin_id;
1670       $part_info_map{$form->{"id_$i"}}{warehouse_id} ||= $default_warehouse_id;
1671
1672       push @all_requests, ($qty == 0) ? { } : {
1673                         'chargenumber' => '',  #?? die müsste entsprechend geholt werden
1674                         #'bestbefore' => undef, # TODO wird nicht berücksichtigt
1675                         'bin_id' => $part_info_map{$form->{"id_$i"}}{bin_id},
1676                         'qty' => $qty,
1677                         'parts_id' => $form->{"id_$i"},
1678                         'comment' => $locale->text("Default transfer delivery order"),
1679                         'unit' => $part_info_map{$form->{"id_$i"}}{unit},
1680                         'warehouse_id' => $part_info_map{$form->{"id_$i"}}{warehouse_id},
1681                         'oe_id' => $form->{id},
1682                         'project_id' => $form->{"project_id_$i"} ? $form->{"project_id_$i"} : $form->{globalproject_id}
1683                       };
1684     }
1685
1686     # jetzt wird erst überprüft, ob die Stückzahl entsprechend stimmt.
1687     # check if bin (transfer in and transfer out and qty (transfer out) is correct
1688     foreach my $key (keys %qty_parts) {
1689
1690       $missing_default_bins{$key}{missing_bin} = 1 unless ($part_info_map{$key}{bin_id});
1691       next unless ($part_info_map{$key}{bin_id}); # abbruch
1692
1693       if ($params{direction} eq 'out') {  # wird nur für ausgehende Mengen benötigt
1694         my ($max_qty, $error) = WH->get_max_qty_parts_bin(parts_id => $key, bin_id => $part_info_map{$key}{bin_id});
1695         if ($error == 1) {
1696           # wir können nicht entscheiden, welche charge oder mhd (bestbefore) ausgewählt sein soll
1697           # deshalb rückmeldung nach oben geben, manuell auszulagern
1698           # TODO Bei nur einem Treffer mit Charge oder bestbefore wäre das noch möglich
1699           $missing_default_bins{$key}{chargenumber} = 1;
1700         }
1701         if ($max_qty < $qty_parts{$key}){
1702           $missing_default_bins{$key}{missing_qty} = $max_qty - $qty_parts{$key};
1703         }
1704       }
1705     }
1706   } # if @parts_id
1707
1708   # Abfrage für Fehlerbehandlung (nur bei direction == out)
1709   if (scalar (keys %missing_default_bins)) {
1710     my $fehlertext;
1711     foreach my $fehler (keys %missing_default_bins) {
1712
1713       my $ware = WH->get_part_description(parts_id => $fehler);
1714       if ($missing_default_bins{$fehler}{missing_bin}){
1715         $fehlertext .= "Kein Standardlagerplatz definiert bei $ware <br>";
1716       }
1717       if ($missing_default_bins{$fehler}{missing_qty}) {  # missing_qty
1718         $fehlertext .= "Es fehlen " . $missing_default_bins{$fehler}{missing_qty}*-1 .
1719                        " von $ware auf dem Standard-Lagerplatz " . $part_info_map{$fehler}{bin} .   " zum Auslagern<br>";
1720       }
1721       if ($missing_default_bins{$fehler}{chargenumber}){
1722         $fehlertext .= "Die Ware hat eine Chargennummer oder eine Mindesthaltbarkeit definiert.
1723                         Hier kann man nicht automatisch entscheiden.
1724                         Bitte diesen Lieferschein manuell auslagern.
1725                         Bei: $ware";
1726       }
1727       # auslagern soll immer gehen, auch wenn nicht genügend auf lager ist.
1728       # der lagerplatz ist hier extra konfigurierbar, bspw. Lager-Korrektur mit
1729       # Lagerplatz Lagerplatz-Korrektur
1730       my $default_warehouse_id_ignore_onhand = $::instance_conf->get_warehouse_id_ignore_onhand;
1731       my $default_bin_id_ignore_onhand       = $::instance_conf->get_bin_id_ignore_onhand;
1732       if ($::instance_conf->get_transfer_default_ignore_onhand && $default_bin_id_ignore_onhand) {
1733         # entsprechende defaults holen
1734         # falls chargenumber, bestbefore oder anzahl nicht stimmt, auf automatischen
1735         # lagerplatz wegbuchen!
1736         foreach (@all_requests) {
1737           if ($_->{parts_id} eq $fehler){
1738           $_->{bin_id}        = $default_bin_id_ignore_onhand;
1739           $_->{warehouse_id}  = $default_warehouse_id_ignore_onhand;
1740           }
1741         }
1742       } else {
1743         #$main::lxdebug->message(0, 'Fehlertext: ' . $fehlertext);
1744         $form->show_generic_error($locale->text("Cannot transfer. <br> Reason:<br>#1", $fehlertext ), 'back_button' => 1);
1745       }
1746     }
1747   }
1748
1749
1750   # hier der eigentliche fallunterschied für in oder out
1751   my $prefix   = $params{direction} eq 'in' ? 'in' : 'out';
1752
1753   # dieser array_ref ist für DO->save da:
1754   # einmal die all_requests in YAML verwandeln, damit delivery_order_items_stock
1755   # gefüllt werden kann.
1756   # could be dumped to the form in the first loop,
1757   # but maybe bin_id and warehouse_id has changed to the "korrekturlager" with
1758   # allowed negative qty ($::instance_conf->get_warehouse_id_ignore_onhand) ...
1759   my $i = 0;
1760   foreach (@all_requests){
1761     $i++;
1762     next unless scalar(%{ $_ });
1763     $form->{"stock_${prefix}_$i"} = YAML::Dump([$_]);
1764   }
1765
1766   save(no_redirect => 1); # Wir können auslagern, deshalb beleg speichern
1767                           # und in delivery_order_items_stock speichern
1768
1769   # ... and fill back the persistent dois_id for inventory fk
1770   undef (@all_requests);
1771   foreach my $i (1 .. $form->{rowcount}) {
1772     next unless ($form->{"id_$i"} && $form->{"stock_${prefix}_$i"});
1773     push @all_requests, @{ DO->unpack_stock_information('packed' => $form->{"stock_${prefix}_$i"}) };
1774   }
1775   DO->transfer_in_out('direction' => $prefix,
1776                       'requests'  => \@all_requests);
1777
1778   SL::DB::DeliveryOrder->new(id => $form->{id})->load->update_attributes(delivered => 1);
1779
1780   $form->{callback} = 'do.pl?action=edit&type=sales_delivery_order&id=' . $form->escape($form->{id}) if $params{direction} eq 'out';
1781   $form->{callback} = 'do.pl?action=edit&type=purchase_delivery_order&id=' . $form->escape($form->{id}) if $params{direction} eq 'in';
1782   $form->redirect;
1783
1784 }
1785
1786 sub sort {
1787   $main::lxdebug->enter_sub();
1788
1789   check_do_access();
1790
1791   my $form     = $main::form;
1792   my %temp_hash;
1793
1794   save(no_redirect => 1); # has to be done, at least for newly added positions
1795
1796   # hashify partnumbers, positions. key is delivery_order_items_id
1797   for my $i (1 .. ($form->{rowcount}) ) {
1798     $temp_hash{$form->{"delivery_order_items_id_$i"}} = { runningnumber => $form->{"runningnumber_$i"}, partnumber => $form->{"partnumber_$i"} };
1799   }
1800   # naturally sort partnumbers and get a sorted array of doi_ids
1801   my @sorted_doi_ids =  sort { Sort::Naturally::ncmp($temp_hash{$a}->{"partnumber"}, $temp_hash{$b}->{"partnumber"}) }  keys %temp_hash;
1802
1803
1804   my $new_number = 1;
1805
1806   for (@sorted_doi_ids) {
1807     $form->{"runningnumber_$temp_hash{$_}->{runningnumber}"} = $new_number;
1808     $new_number++;
1809   }
1810     $main::lxdebug->leave_sub();
1811     save();
1812 }
1813
1814 __END__
1815
1816 =pod
1817
1818 =encoding utf8
1819
1820 =head1 NAME
1821
1822 do.pl - Script for all calls to delivery order
1823
1824
1825 =head1 FUNCTIONS
1826
1827 =over 2
1828
1829 =item C<sort>
1830
1831 Sorts all position with Natural Sort. Can be activated in form_footer.html like this
1832 C<E<lt>input class="submit" type="submit" name="action_sort" id="sort_button" value="[% 'Sort and Save' | $T8 %]"E<gt>>
1833
1834 =back
1835
1836 =head1 TODO
1837
1838 Sort and Save can be implemented as an optional button if configuration ca be set by client config.
1839 Example coding for database scripts and templates in (git show af2f24b8), check also
1840 autogeneration for rose (scripts/rose_auto_create_model.pl --h)