1 #=====================================================================
 
   4 # Based on SQL-Ledger Version 2.1.9
 
   5 # Web http://www.lx-office.org
 
   7 #=====================================================================
 
   8 # SQL-Ledger, Accounting
 
   9 # Copyright (c) 1998-2003
 
  11 #  Author: Dieter Simader
 
  12 #   Email: dsimader@sql-ledger.org
 
  13 #     Web: http://www.sql-ledger.org
 
  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.
 
  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 #======================================================================
 
  31 #======================================================================
 
  34 use List::MoreUtils qw(uniq);
 
  35 use List::Util qw(max sum);
 
  36 use POSIX qw(strftime);
 
  39 use SL::DB::DeliveryOrder;
 
  43 use SL::MoreCommon qw(ary_diff);
 
  44 use SL::ReportGenerator;
 
  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";
 
  59   $main::auth->assert($main::form->{type} . '_edit');
 
  63   $main::lxdebug->enter_sub();
 
  69   my $form     = $main::form;
 
  70   my $locale   = $main::locale;
 
  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');
 
  76     $form->{vc}    = 'customer';
 
  77     $form->{title} = $action eq "edit" ? $locale->text('Edit Sales Delivery Order') : $locale->text('Add Sales Delivery Order');
 
  80   $form->{heading} = $locale->text('Delivery Order');
 
  82   $main::lxdebug->leave_sub();
 
  86   $main::lxdebug->enter_sub();
 
  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."));
 
  94   my $form     = $main::form;
 
  98   $form->{show_details} = $::myconfig{show_form_details};
 
  99   $form->{callback} = build_std_url('action=add', 'type', 'vc') unless ($form->{callback});
 
 105   $main::lxdebug->leave_sub();
 
 109   $main::lxdebug->enter_sub();
 
 113   my $form     = $main::form;
 
 115   $form->{show_details} = $::myconfig{show_form_details};
 
 117   # show history button
 
 118   $form->{javascript} = qq|<script type="text/javascript" src="js/show_history.js"></script>|;
 
 119   #/show hhistory button
 
 121   $form->{simple_save} = 0;
 
 123   set_headings("edit");
 
 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});
 
 131       undef $form->{rowcount};
 
 133       $main::lxdebug->leave_sub();
 
 136   } elsif (!$form->{id}) {
 
 138     $main::lxdebug->leave_sub();
 
 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};
 
 151   set_headings("edit");
 
 156   if ($form->{print_and_save}) {
 
 157     $form->{language_id} = $language_id;
 
 158     $form->{printer_id}  = $printer_id;
 
 163   $main::lxdebug->leave_sub();
 
 167   $main::lxdebug->enter_sub();
 
 171   my $form     = $main::form;
 
 172   my %myconfig = %main::myconfig;
 
 174   # get customer/vendor
 
 175   $form->all_vc(\%myconfig, $form->{vc}, ($form->{vc} eq 'customer') ? "AR" : "AP");
 
 177   # retrieve order/quotation
 
 178   my $editing = $form->{id};
 
 180   DO->retrieve('vc'  => $form->{vc},
 
 181                'ids' => $form->{id});
 
 183   $form->backup_vars(qw(payment_id language_id taxzone_id salesman_id taxincluded cp_id intnotes delivery_term_id currency));
 
 185   # get customer / vendor
 
 186   if ($form->{vc} eq 'vendor') {
 
 187     IR->get_vendor(\%myconfig, \%$form);
 
 188     $form->{discount} = $form->{vendor_discount};
 
 190     IS->get_customer(\%myconfig, \%$form);
 
 191     $form->{discount} = $form->{customer_discount};
 
 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;
 
 199   if ($form->{"all_$form->{vc}"}) {
 
 200     unless ($form->{"$form->{vc}_id"}) {
 
 201       $form->{"$form->{vc}_id"} = $form->{"all_$form->{vc}"}->[0]->{id};
 
 205   ($form->{ $form->{vc} })  = split /--/, $form->{ $form->{vc} };
 
 206   $form->{"old$form->{vc}"} = qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|;
 
 208   $form->{employee} = "$form->{employee}--$form->{employee_id}";
 
 210   $main::lxdebug->leave_sub();
 
 214   $main::lxdebug->enter_sub();
 
 218   my $form     = $main::form;
 
 219   my %myconfig = %main::myconfig;
 
 221   $form->{formname} = $form->{type} unless $form->{formname};
 
 224   foreach my $ref (@{ $form->{form_details} }) {
 
 225     $form->{rowcount} = ++$i;
 
 227     map { $form->{"${_}_$i"} = $ref->{$_} } keys %{$ref};
 
 229   for my $i (1 .. $form->{rowcount}) {
 
 231       $form->{"discount_$i"} = $form->format_amount(\%myconfig, $form->{"discount_$i"} * 100);
 
 233       $form->{"discount_$i"} = $form->format_amount(\%myconfig, $form->{"discount_$i"});
 
 235     my ($dec) = ($form->{"sellprice_$i"} =~ /\.(\d+)/);
 
 237     my $decimalplaces = ($dec > 2) ? $dec : 2;
 
 239     # copy reqdate from deliverydate for invoice -> order conversion
 
 240     $form->{"reqdate_$i"} = $form->{"deliverydate_$i"} unless $form->{"reqdate_$i"};
 
 242     $form->{"sellprice_$i"} = $form->format_amount(\%myconfig, $form->{"sellprice_$i"}, $decimalplaces);
 
 243     $form->{"lastcost_$i"} = $form->format_amount(\%myconfig, $form->{"lastcost_$i"}, $decimalplaces);
 
 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);
 
 250   $main::lxdebug->leave_sub();
 
 254   $main::lxdebug->enter_sub();
 
 258   my $form     = $main::form;
 
 259   my %myconfig = %main::myconfig;
 
 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};
 
 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",
 
 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) : ();
 
 275   if (($vc eq 'customers') && $::instance_conf->get_customer_projects_only_in_sales) {
 
 278         customer_id          => $::form->{customer_id},
 
 279         billable_customer_id => $::form->{customer_id},
 
 284       and => [ active => 1, @customer_cond ],
 
 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 ] ]
 
 294   $::form->{ALL_CONTACTS}          = SL::DB::Manager::Contact->get_all_sorted(query => [
 
 296       cp_cv_id => $::form->{"$::form->{vc}_id"} * 1,
 
 299         cp_id    => $::form->{cp_id} * 1
 
 304   map { $_->{value} = "$_->{description}--$_->{id}" } @{ $form->{ALL_DEPARTMENTS} };
 
 305   map { $_->{value} = "$_->{name}--$_->{id}"        } @{ $form->{ALL_VC} };
 
 307   $form->{SHOW_VC_DROP_DOWN} =  $myconfig{vclimit} > scalar @{ $form->{ALL_VC} };
 
 309   $form->{oldvcname}         =  $form->{"old$form->{vc}"};
 
 310   $form->{oldvcname}         =~ s/--.*//;
 
 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;
 
 320   $::request->{layout}->add_javascripts_inline("\$(function(){$dispatch_to_popup});");
 
 323   my $follow_up_vc                =  $form->{ $form->{vc} eq 'customer' ? 'customer' : 'vendor' };
 
 324   $follow_up_vc                   =~ s/--\d*\s*$//;
 
 326   $form->{follow_up_trans_info} = $form->{donumber} .'('. $follow_up_vc .')';
 
 328   $::request->{layout}->use_javascript(map { "${_}.js" } qw(kivi.SalesPurchase ckeditor/ckeditor ckeditor/adapters/jquery kivi.io autocomplete_customer autocomplete_part));
 
 331   push @custom_hidden, map { "shiptocvar_" . $_->name } @{ SL::DB::Manager::CustomVariableConfig->get_all(where => [ module => 'ShipTo' ]) };
 
 333   $::form->{HIDDENS} = [ map { +{ name => $_, value => $::form->{$_} } } (@custom_hidden) ];
 
 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');
 
 350   $main::lxdebug->leave_sub();
 
 354   $main::lxdebug->enter_sub();
 
 358   my $form     = $main::form;
 
 360   $form->{PRINT_OPTIONS} = print_options('inline' => 1);
 
 361   $form->{ALL_DELIVERY_TERMS} = SL::DB::Manager::DeliveryTerm->get_all_sorted();
 
 363   print $form->parse_html_template('do/form_footer',
 
 364     {transfer_default         => ($::instance_conf->get_transfer_default)});
 
 366   $main::lxdebug->leave_sub();
 
 369 sub update_delivery_order {
 
 370   $main::lxdebug->enter_sub();
 
 374   my $form     = $main::form;
 
 375   my %myconfig = %main::myconfig;
 
 377   set_headings($form->{"id"} ? "edit" : "add");
 
 379   $form->{insertdate} = SL::DB::DeliveryOrder->new(id => $form->{id})->load->itime_as_date if $form->{id};
 
 384   $payment_id = $form->{payment_id} if $form->{payment_id};
 
 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 "";
 
 402   my $i = $form->{rowcount};
 
 404   if (   ($form->{"partnumber_$i"} eq "")
 
 405       && ($form->{"description_$i"} eq "")
 
 406       && ($form->{"partsgroup_$i"}  eq "")) {
 
 413     if ($form->{type} eq 'purchase_delivery_order') {
 
 414       IR->retrieve_item(\%myconfig, $form);
 
 417       IS->retrieve_item(\%myconfig, $form);
 
 421     my $rows = scalar @{ $form->{item_list} };
 
 424       $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
 
 425       if( !$form->{"qty_$i"} ) {
 
 426         $form->{"qty_$i"} = 1;
 
 431         select_item(mode => $mode, pre_entered_qty => $form->{"qty_$i"});
 
 436         my $sellprice = $form->parse_amount(\%myconfig, $form->{"sellprice_$i"});
 
 438         map { $form->{"${_}_$i"} = $form->{item_list}[0]{$_} } keys %{ $form->{item_list}[0] };
 
 440         $form->{"marge_price_factor_$i"} = $form->{item_list}->[0]->{price_factor};
 
 443           $form->{"sellprice_$i"} = $sellprice;
 
 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;
 
 451             $::form->{"sellprice_$i"}           = $best_price->price;
 
 452             $::form->{"active_price_source_$i"} = $best_price->source;
 
 454           if ($best_discount) {
 
 455             $::form->{"discount_$i"}               = $best_discount->discount;
 
 456             $::form->{"active_discount_source_$i"} = $best_discount->source;
 
 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);
 
 470       # ok, so this is a new part
 
 471       # ask if it is a part or service item
 
 473       if (   $form->{"partsgroup_$i"}
 
 474           && ($form->{"partsnumber_$i"} eq "")
 
 475           && ($form->{"description_$i"} eq "")) {
 
 477         $form->{"discount_$i"} = "";
 
 478         $form->{"not_discountable_$i"} = "";
 
 482         $form->{"id_$i"}   = 0;
 
 488   $main::lxdebug->leave_sub();
 
 492   $main::lxdebug->enter_sub();
 
 496   my $form     = $main::form;
 
 497   my %myconfig = %main::myconfig;
 
 498   my $locale   = $main::locale;
 
 500   $form->{vc} = $form->{type} eq 'purchase_delivery_order' ? 'vendor' : 'customer';
 
 502   $form->get_lists("projects"       => { "key" => "ALL_PROJECTS",
 
 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 ]);
 
 509   $form->{SHOW_VC_DROP_DOWN} =  $myconfig{vclimit} > scalar @{ $form->{ALL_VC} };
 
 510   $form->{title}             = $locale->text('Delivery Orders');
 
 514   print $form->parse_html_template('do/search');
 
 516   $main::lxdebug->leave_sub();
 
 520   $main::lxdebug->enter_sub();
 
 524   my $form     = $main::form;
 
 525   my %myconfig = %main::myconfig;
 
 526   my $locale   = $main::locale;
 
 527   my $cgi      = $::request->{cgi};
 
 529   $form->{department_id} = (split /--/, $form->{department})[-1];
 
 530   ($form->{ $form->{vc} }, $form->{"$form->{vc}_id"}) = split(/--/, $form->{ $form->{vc} });
 
 532   report_generator_set_default_sort('transdate', 1);
 
 536   $form->{rowcount} = scalar @{ $form->{DO} };
 
 539     ids                     transdate               reqdate
 
 541     ordnumber               customernumber          cusordnumber
 
 542     name                    employee  salesman
 
 543     shipvia                 globalprojectnumber
 
 544     transaction_description department
 
 549   $form->{l_open}      = $form->{l_closed} = "Y" if ($form->{open}      && $form->{closed});
 
 550   $form->{l_delivered} = "Y"                     if ($form->{delivered} && $form->{notdelivered});
 
 552   $form->{title}       = $locale->text('Delivery Orders');
 
 554   my $attachment_basename = $form->{vc} eq 'vendor' ? $locale->text('purchase_delivery_order_list') : $locale->text('sales_delivery_order_list');
 
 556   my $report = SL::ReportGenerator->new(\%myconfig, $form);
 
 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
 
 562                                           insertdatefrom insertdateto business_id);
 
 564   my $href = build_std_url('action=orders', grep { $form->{$_} } @hidden_variables);
 
 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'), },
 
 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";
 
 592   $form->{"l_type"} = "Y";
 
 593   map { $column_defs{$_}->{visible} = $form->{"l_${_}"} ? 1 : 0 } @columns;
 
 595   $column_defs{ids}->{visible} = 'HTML';
 
 597   $report->set_columns(%column_defs);
 
 598   $report->set_column_order(@columns);
 
 600   $report->set_export_options('orders', @hidden_variables, qw(sort sortdir));
 
 602   $report->set_sort_indicator($form->{sort}, $form->{sortdir});
 
 605   if ($form->{customer}) {
 
 606     push @options, $locale->text('Customer') . " : $form->{customer}";
 
 608   if ($form->{vendor}) {
 
 609     push @options, $locale->text('Vendor') . " : $form->{vendor}";
 
 611   if ($form->{cp_name}) {
 
 612     push @options, $locale->text('Contact Person') . " : $form->{cp_name}";
 
 614   if ($form->{department}) {
 
 615     my ($department) = split /--/, $form->{department};
 
 616     push @options, $locale->text('Department') . " : $department";
 
 618   if ($form->{donumber}) {
 
 619     push @options, $locale->text('Delivery Order Number') . " : $form->{donumber}";
 
 621   if ($form->{ordnumber}) {
 
 622     push @options, $locale->text('Order Number') . " : $form->{ordnumber}";
 
 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;
 
 629   if ($form->{transaction_description}) {
 
 630     push @options, $locale->text('Transaction description') . " : $form->{transaction_description}";
 
 632   if ( $form->{transdatefrom} or $form->{transdateto} ) {
 
 633     push @options, $locale->text('Delivery Order Date');
 
 634     push @options, $locale->text('From') . " " . $locale->date(\%myconfig, $form->{transdatefrom}, 1)     if $form->{transdatefrom};
 
 635     push @options, $locale->text('Bis')  . " " . $locale->date(\%myconfig, $form->{transdateto},   1)     if $form->{transdateto};
 
 637   if ( $form->{reqdatefrom} or $form->{reqdateto} ) {
 
 638     push @options, $locale->text('Reqdate');
 
 639     push @options, $locale->text('From') . " " . $locale->date(\%myconfig, $form->{reqdatefrom}, 1)       if $form->{reqdatefrom};
 
 640     push @options, $locale->text('Bis')  . " " . $locale->date(\%myconfig, $form->{reqdateto},   1)       if $form->{reqdateto};
 
 642   if ( $form->{insertdatefrom} or $form->{insertdateto} ) {
 
 643     push @options, $locale->text('Insert Date');
 
 644     push @options, $locale->text('From') . " " . $locale->date(\%myconfig, $form->{insertdatefrom}, 1)    if $form->{insertdatefrom};
 
 645     push @options, $locale->text('Bis')  . " " . $locale->date(\%myconfig, $form->{insertdateto},   1)    if $form->{insertdateto};
 
 648     push @options, $locale->text('Open');
 
 650   if ($form->{closed}) {
 
 651     push @options, $locale->text('Closed');
 
 653   if ($form->{delivered}) {
 
 654     push @options, $locale->text('Delivered');
 
 656   if ($form->{notdelivered}) {
 
 657     push @options, $locale->text('Not delivered');
 
 660   $report->set_options('top_info_text'        => join("\n", @options),
 
 661                        'raw_top_info_text'    => $form->parse_html_template('do/orders_top'),
 
 662                        'raw_bottom_info_text' => $form->parse_html_template('do/orders_bottom'),
 
 663                        'output_format'        => 'HTML',
 
 664                        'title'                => $form->{title},
 
 665                        'attachment_basename'  => $attachment_basename . strftime('_%Y%m%d', localtime time),
 
 667   $report->set_options_from_form();
 
 668   $locale->set_numberformat_wo_thousands_separator(\%myconfig) if lc($report->{options}->{output_format}) eq 'csv';
 
 670   # add sort and escape callback, this one we use for the add sub
 
 671   $form->{callback} = $href .= "&sort=$form->{sort}";
 
 673   # escape callback for href
 
 674   my $callback = $form->escape($href);
 
 676   my $edit_url       = build_std_url('action=edit', 'type', 'vc');
 
 677   my $edit_order_url = build_std_url('script=oe.pl', 'type=' . ($form->{type} eq 'sales_delivery_order' ? 'sales_order' : 'purchase_order'), 'action=edit');
 
 681   foreach my $dord (@{ $form->{DO} }) {
 
 682     $dord->{open}      = $dord->{closed}    ? $locale->text('No')  : $locale->text('Yes');
 
 683     $dord->{delivered} = $dord->{delivered} ? $locale->text('Yes') : $locale->text('No');
 
 685     my $row = { map { $_ => { 'data' => $dord->{$_} } } @columns };
 
 688       'raw_data' =>   $cgi->hidden('-name' => "trans_id_${idx}", '-value' => $dord->{id})
 
 689                     . $cgi->checkbox('-name' => "multi_id_${idx}", '-value' => 1, '-label' => ''),
 
 690       'valign'   => 'center',
 
 694     $row->{donumber}->{link}  = $edit_url       . "&id=" . E($dord->{id})      . "&callback=${callback}";
 
 695     $row->{ordnumber}->{link} = $edit_order_url . "&id=" . E($dord->{oe_id})   . "&callback=${callback}" if $dord->{oe_id};
 
 696     $report->add_data($row);
 
 701   $report->generate_with_headers();
 
 703   $main::lxdebug->leave_sub();
 
 707   $main::lxdebug->enter_sub();
 
 713   my $form     = $main::form;
 
 714   my %myconfig = %main::myconfig;
 
 715   my $locale   = $main::locale;
 
 717   $form->mtime_ischanged('delivery_orders');
 
 719   $form->{defaultcurrency} = $form->get_default_currency(\%myconfig);
 
 721   $form->isblank("transdate", $locale->text('Delivery Order Date missing!'));
 
 723   $form->{donumber} =~ s/^\s*//g;
 
 724   $form->{donumber} =~ s/\s*$//g;
 
 726   my $msg = ucfirst $form->{vc};
 
 727   $form->isblank($form->{vc}, $locale->text($msg . " missing!"));
 
 729   # $locale->text('Customer missing!');
 
 730   # $locale->text('Vendor missing!');
 
 732   remove_emptied_rows();
 
 735   # if the name changed get new values
 
 736   if (check_name($form->{vc})) {
 
 741   $form->{id} = 0 if $form->{saveasnew};
 
 745   if(!exists $form->{addition}) {
 
 746     $form->{snumbers} = qq|donumber_| . $form->{donumber};
 
 747     $form->{addition} = "SAVED";
 
 750   # /saving the history
 
 752   $form->{simple_save} = 1;
 
 753   if (!$params{no_redirect} && !$form->{print_and_save}) {
 
 754     delete @{$form}{ary_diff([keys %{ $form }], [qw(login id script type cursor_fokus)])};
 
 758   $main::lxdebug->leave_sub();
 
 762   $main::lxdebug->enter_sub();
 
 766   my $form     = $main::form;
 
 767   my %myconfig = %main::myconfig;
 
 768   my $locale   = $main::locale;
 
 772     if(!exists $form->{addition}) {
 
 773       $form->{snumbers} = qq|donumber_| . $form->{donumber};
 
 774       $form->{addition} = "DELETED";
 
 777     # /saving the history
 
 779     $form->info($locale->text('Delivery Order deleted!'));
 
 783   $form->error($locale->text('Cannot delete delivery order!'));
 
 785   $main::lxdebug->leave_sub();
 
 789   $main::lxdebug->enter_sub();
 
 791   my $form     = $main::form;
 
 792   my %myconfig = %main::myconfig;
 
 793   my $locale   = $main::locale;
 
 796   $form->mtime_ischanged('delivery_orders');
 
 798   $main::auth->assert($form->{type} eq 'purchase_delivery_order' ? 'vendor_invoice_edit' : 'invoice_edit');
 
 800   $form->{convert_from_do_ids} = $form->{id};
 
 801   $form->{deliverydate}        = $form->{transdate};
 
 802   $form->{transdate}           = $form->{invdate} = $form->current_date(\%myconfig);
 
 803   $form->{duedate}             = $form->current_date(\%myconfig, $form->{invdate}, $form->{terms} * 1);
 
 804   $form->{defaultcurrency}     = $form->get_default_currency(\%myconfig);
 
 808   delete @{$form}{qw(id closed delivered)};
 
 810   my ($script, $buysell);
 
 811   if ($form->{type} eq 'purchase_delivery_order') {
 
 812     $form->{title}  = $locale->text('Add Vendor Invoice');
 
 813     $form->{script} = 'ir.pl';
 
 818     $form->{title}  = $locale->text('Add Sales Invoice');
 
 819     $form->{script} = 'is.pl';
 
 824   for my $i (1 .. $form->{rowcount}) {
 
 826     unless ($form->{"ordnumber"}) {
 
 827       if ($form->{discount}) { # Falls wir einen Lieferanten-/Kundenrabatt haben
 
 828         # und rabattfähig sind, dann
 
 829         unless ($form->{"not_discountable_$i"}) {
 
 830           $form->{"discount_$i"} = $form->{discount}*100; # ... nehmen wir diesen Rabatt
 
 834     map { $form->{"${_}_${i}"} = $form->parse_amount(\%myconfig, $form->{"${_}_${i}"}) if $form->{"${_}_${i}"} } qw(ship qty sellprice lastcost basefactor);
 
 835     $form->{"donumber_$i"} = $form->{donumber};
 
 836     $form->{"converted_from_delivery_order_items_id_$i"} = delete $form->{"delivery_order_items_id_$i"};
 
 839   $form->{type} = "invoice";
 
 842   $main::locale = Locale->new("$myconfig{countrycode}", "$script");
 
 843   $locale = $main::locale;
 
 845   require "bin/mozilla/$form->{script}";
 
 847   my $currency = $form->{currency};
 
 850   if ($form->{ordnumber}) {
 
 851     require SL::DB::Order;
 
 852     if (my $order = SL::DB::Manager::Order->find_by(ordnumber => $form->{ordnumber})) {
 
 854       $form->{orddate} = $order->transdate_as_date;
 
 855       $form->{$_}      = $order->$_ for qw(payment_id salesman_id taxzone_id quonumber);
 
 859   $form->{currency}     = $currency;
 
 860   $form->{exchangerate} = "";
 
 861   $form->{forex}        = $form->check_exchangerate(\%myconfig, $form->{currency}, $form->{invdate}, $buysell);
 
 862   $form->{exchangerate} = $form->{forex} if ($form->{forex});
 
 867   for my $i (1 .. $form->{rowcount}) {
 
 868     $form->{"discount_$i"} = $form->format_amount(\%myconfig, $form->{"discount_$i"});
 
 870     my ($dec) = ($form->{"sellprice_$i"} =~ /\.(\d+)/);
 
 872     my $decimalplaces = ($dec > 2) ? $dec : 2;
 
 874     # copy delivery date from reqdate for order -> invoice conversion
 
 875     $form->{"deliverydate_$i"} = $form->{"reqdate_$i"}
 
 876       unless $form->{"deliverydate_$i"};
 
 879     $form->{"sellprice_$i"} =
 
 880       $form->format_amount(\%myconfig, $form->{"sellprice_$i"},
 
 883     $form->{"lastcost_$i"} =
 
 884       $form->format_amount(\%myconfig, $form->{"lastcost_$i"},
 
 887     (my $dec_qty) = ($form->{"qty_$i"} =~ /\.(\d+)/);
 
 888     $dec_qty = length $dec_qty;
 
 890       $form->format_amount(\%myconfig, $form->{"qty_$i"}, $dec_qty);
 
 896   $main::lxdebug->leave_sub();
 
 900   $main::lxdebug->enter_sub();
 
 902   my $form     = $main::form;
 
 903   my %myconfig = %main::myconfig;
 
 904   my $locale   = $main::locale;
 
 907   $main::auth->assert($form->{type} eq 'sales_delivery_order' ? 'invoice_edit' : 'vendor_invoice_edit');
 
 909   my @do_ids = map { $form->{"trans_id_$_"} } grep { $form->{"multi_id_$_"} } (1..$form->{rowcount});
 
 911   if (!scalar @do_ids) {
 
 912     $form->show_generic_error($locale->text('You have not selected any delivery order.'), 'back_button' => 1);
 
 915   map { delete $form->{$_} } grep { m/^(?:trans|multi)_id_\d+/ } keys %{ $form };
 
 917   if (!DO->retrieve('vc' => $form->{vc}, 'ids' => \@do_ids)) {
 
 918     $form->show_generic_error($form->{vc} eq 'customer' ?
 
 919                               $locale->text('You cannot create an invoice for delivery orders for different customers.') :
 
 920                               $locale->text('You cannot create an invoice for delivery orders from different vendors.'),
 
 924   my $source_type              = $form->{type};
 
 925   $form->{convert_from_do_ids} = join ' ', @do_ids;
 
 926   # bei der auswahl von mehreren Lieferscheinen fuer eine Rechnung, die einfach in donumber_array
 
 927   # zwischenspeichern (DO.pm) und als ' '-separierte Liste wieder zurueckschreiben
 
 928   # Hinweis: delete gibt den wert zurueck und loescht danach das element (nett und einfach)
 
 929   # $shell: perldoc perlunc; /delete EXPR
 
 930   $form->{donumber}            = delete $form->{donumber_array};
 
 931   $form->{ordnumber}           = delete $form->{ordnumber_array};
 
 932   $form->{cusordnumber}        = delete $form->{cusordnumber_array};
 
 933   $form->{deliverydate}        = $form->{transdate};
 
 934   $form->{transdate}           = $form->current_date(\%myconfig);
 
 935   $form->{duedate}             = $form->current_date(\%myconfig, $form->{invdate}, $form->{terms} * 1);
 
 936   $form->{type}                = "invoice";
 
 938   $form->{defaultcurrency}     = $form->get_default_currency(\%myconfig);
 
 940   my ($script, $buysell);
 
 941   if ($source_type eq 'purchase_delivery_order') {
 
 942     $form->{title}  = $locale->text('Add Vendor Invoice');
 
 943     $form->{script} = 'ir.pl';
 
 948     $form->{title}  = $locale->text('Add Sales Invoice');
 
 949     $form->{script} = 'is.pl';
 
 954   map { delete $form->{$_} } qw(id subject message cc bcc printed emailed queued);
 
 956   # get vendor or customer discount
 
 958   my $saved_form = save_form();
 
 959   if ($form->{vc} eq 'vendor') {
 
 960     IR->get_vendor(\%myconfig, \%$form);
 
 961     $vc_discount = $form->{vendor_discount};
 
 963     IS->get_customer(\%myconfig, \%$form);
 
 964     $vc_discount = $form->{customer_discount};
 
 966   # use payment terms from customer or vendor
 
 967   restore_form($saved_form,0,qw(payment_id));
 
 969   $form->{rowcount} = 0;
 
 970   foreach my $ref (@{ $form->{form_details} }) {
 
 972     $ref->{reqdate} ||= $ref->{dord_transdate}; # copy transdates into each invoice row
 
 973     map { $form->{"${_}_$form->{rowcount}"} = $ref->{$_} } keys %{ $ref };
 
 974     map { $form->{"${_}_$form->{rowcount}"} = $form->format_amount(\%myconfig, $ref->{$_}) } qw(qty sellprice lastcost);
 
 975     $form->{"converted_from_delivery_order_items_id_$form->{rowcount}"} = delete $form->{"delivery_order_items_id_$form->{rowcount}"};
 
 977     if ($vc_discount){ # falls wir einen Lieferanten/Kundenrabatt haben
 
 978       # und keinen anderen discount wert an $i ...
 
 979       $form->{"discount_$form->{rowcount}"} ||= $vc_discount; # ... nehmen wir diesen Rabatt
 
 982     $form->{"discount_$form->{rowcount}"}   = $form->{"discount_$form->{rowcount}"}  * 100; #s.a. Bug 1151
 
 983     # Anm.: Eine Änderung des discounts in der SL/DO.pm->retrieve (select (doi.discount * 100) as discount) ergibt in psql einen
 
 984     # Wert von 10.0000001490116. Ferner ist der Rabatt in der Rechnung dann bei 1.0 (?). Deswegen lasse ich das hier. jb 10.10.09
 
 986     $form->{"discount_$form->{rowcount}"} = $form->format_amount(\%myconfig, $form->{"discount_$form->{rowcount}"});
 
 988   delete $form->{form_details};
 
 990   $locale = Locale->new("$myconfig{countrycode}", "$script");
 
 992   require "bin/mozilla/$form->{script}";
 
 999   $main::lxdebug->leave_sub();
 
1003   $main::lxdebug->enter_sub();
 
1007   my $form     = $main::form;
 
1009   $form->{saveasnew} = 1;
 
1010   $form->{closed}    = 0;
 
1011   $form->{delivered} = 0;
 
1012   map { delete $form->{$_} } qw(printed emailed queued);
 
1013   delete @{ $form }{ grep { m/^stock_(?:in|out)_\d+/ } keys %{ $form } };
 
1014   $form->{"converted_from_delivery_order_items_id_$_"} = delete $form->{"delivery_order_items_id_$_"} for 1 .. $form->{"rowcount"};
 
1015   # Let kivitendo assign a new order number if the user hasn't changed the
 
1016   # previous one. If it has been changed manually then use it as-is.
 
1017   $form->{donumber} =~ s/^\s*//g;
 
1018   $form->{donumber} =~ s/\s*$//g;
 
1019   if ($form->{saved_donumber} && ($form->{saved_donumber} eq $form->{donumber})) {
 
1020     delete($form->{donumber});
 
1025   $main::lxdebug->leave_sub();
 
1029   $main::lxdebug->enter_sub();
 
1033   $::form->mtime_ischanged('delivery_orders','mail');
 
1035   $::form->{print_and_save} = 1;
 
1037   my $saved_form = save_form();
 
1041   restore_form($saved_form, 0, qw(id ordnumber quonumber));
 
1045   $main::lxdebug->leave_sub();
 
1048 sub calculate_stock_in_out {
 
1049   $main::lxdebug->enter_sub();
 
1051   my $form     = $main::form;
 
1055   if (!$form->{"id_${i}"}) {
 
1056     $main::lxdebug->leave_sub();
 
1060   my $all_units = AM->retrieve_all_units();
 
1062   my $in_out   = $form->{type} =~ /^sales/ ? 'out' : 'in';
 
1063   my $sinfo    = DO->unpack_stock_information('packed' => $form->{"stock_${in_out}_${i}"});
 
1065   my $do_qty   = AM->sum_with_unit($::form->{"qty_$i"}, $::form->{"unit_$i"});
 
1066   my $sum      = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $sinfo });
 
1067   my $matches  = $do_qty == $sum;
 
1069   my $content  = $form->format_amount_units('amount'      => $sum * 1,
 
1070                                             'part_unit'   => $form->{"partunit_$i"},
 
1071                                             'amount_unit' => $all_units->{$form->{"partunit_$i"}}->{base_unit},
 
1072                                             'conv_units'  => 'convertible_not_smaller',
 
1074   $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="?">|;
 
1076   $main::lxdebug->leave_sub();
 
1081 sub get_basic_bin_wh_info {
 
1082   $main::lxdebug->enter_sub();
 
1084   my $stock_info = shift;
 
1086   my $form     = $main::form;
 
1088   foreach my $sinfo (@{ $stock_info }) {
 
1089     next unless ($sinfo->{bin_id});
 
1091     my $bin_info = WH->get_basic_bin_info('id' => $sinfo->{bin_id});
 
1092     map { $sinfo->{"${_}_description"} = $sinfo->{"${_}description"} = $bin_info->{"${_}_description"} } qw(bin warehouse);
 
1095   $main::lxdebug->leave_sub();
 
1098 sub stock_in_out_form {
 
1099   $main::lxdebug->enter_sub();
 
1101   my $form     = $main::form;
 
1103   if ($form->{in_out} eq 'out') {
 
1109   $main::lxdebug->leave_sub();
 
1112 sub redo_stock_info {
 
1113   $main::lxdebug->enter_sub();
 
1117   my $form     = $main::form;
 
1119   my @non_empty = grep { $_->{qty} } @{ $params{stock_info} };
 
1121   if ($params{add_empty_row}) {
 
1123       'warehouse_id' => scalar(@non_empty) ? $non_empty[-1]->{warehouse_id} : undef,
 
1124       'bin_id'       => scalar(@non_empty) ? $non_empty[-1]->{bin_id}       : undef,
 
1128   @{ $params{stock_info} } = @non_empty;
 
1130   $main::lxdebug->leave_sub();
 
1133 sub update_stock_in {
 
1134   $main::lxdebug->enter_sub();
 
1136   my $form     = $main::form;
 
1137   my %myconfig = %main::myconfig;
 
1139   my $stock_info = [];
 
1141   foreach my $i (1..$form->{rowcount}) {
 
1142     $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
 
1143     push @{ $stock_info }, { map { $_ => $form->{"${_}_${i}"} } qw(warehouse_id bin_id chargenumber
 
1144                                                                    bestbefore qty unit delivery_order_items_stock_id) };
 
1147   display_stock_in_form($stock_info);
 
1149   $main::lxdebug->leave_sub();
 
1153   $main::lxdebug->enter_sub();
 
1155   my $form     = $main::form;
 
1157   my $stock_info = DO->unpack_stock_information('packed' => $form->{stock});
 
1159   display_stock_in_form($stock_info);
 
1161   $main::lxdebug->leave_sub();
 
1164 sub display_stock_in_form {
 
1165   $main::lxdebug->enter_sub();
 
1167   my $stock_info = shift;
 
1169   my $form     = $main::form;
 
1170   my %myconfig = %main::myconfig;
 
1171   my $locale   = $main::locale;
 
1173   $form->{title} = $locale->text('Stock');
 
1175   my $part_info  = IC->get_basic_part_info('id' => $form->{parts_id});
 
1177   # Standardlagerplatz für Standard-Auslagern verwenden, falls keiner für die Ware explizit definiert wurde
 
1178   if ($::instance_conf->get_transfer_default_use_master_default_bin) {
 
1179     $part_info->{warehouse_id} ||= $::instance_conf->get_warehouse_id;
 
1180     $part_info->{bin_id}       ||= $::instance_conf->get_bin_id;
 
1183   my $units      = AM->retrieve_units(\%myconfig, $form);
 
1184   # der zweite Parameter von unit_select_data gibt den default-Namen (selected) vor
 
1185   my $units_data = AM->unit_select_data($units, $form->{do_unit}, undef, $part_info->{unit});
 
1187   $form->get_lists('warehouses' => { 'key'    => 'WAREHOUSES',
 
1188                                      'bins'   => 'BINS' });
 
1190   redo_stock_info('stock_info' => $stock_info, 'add_empty_row' => !$form->{delivered});
 
1192   get_basic_bin_wh_info($stock_info);
 
1194   $form->header(no_layout => 1);
 
1195   print $form->parse_html_template('do/stock_in_form', { 'UNITS'      => $units_data,
 
1196                                                          'STOCK_INFO' => $stock_info,
 
1197                                                          'PART_INFO'  => $part_info, });
 
1199   $main::lxdebug->leave_sub();
 
1202 sub _stock_in_out_set_qty_display {
 
1203   my $stock_info       = shift;
 
1205   my $all_units        = AM->retrieve_all_units();
 
1206   my $sum              = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $stock_info });
 
1207   $form->{qty_display} = $form->format_amount_units(amount      => $sum * 1,
 
1208                                                     part_unit   => $form->{partunit},
 
1209                                                     amount_unit => $all_units->{ $form->{partunit} }->{base_unit},
 
1210                                                     conv_units  => 'convertible_not_smaller',
 
1215   $main::lxdebug->enter_sub();
 
1217   my $form     = $main::form;
 
1218   my %myconfig = %main::myconfig;
 
1220   my $stock_info = [];
 
1222   foreach my $i (1..$form->{rowcount}) {
 
1223     $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
 
1225     next if ($form->{"qty_$i"} <= 0);
 
1227     push @{ $stock_info }, { map { $_ => $form->{"${_}_${i}"} } qw(delivery_order_items_stock_id warehouse_id bin_id chargenumber bestbefore qty unit) };
 
1230   $form->{stock} = YAML::Dump($stock_info);
 
1232   _stock_in_out_set_qty_display($stock_info);
 
1234   my $do_qty       = AM->sum_with_unit($::form->parse_amount(\%::myconfig, $::form->{do_qty}), $::form->{do_unit});
 
1235   my $transfer_qty = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $stock_info });
 
1238   print $form->parse_html_template('do/set_stock_in_out', {
 
1239     qty_matches => $do_qty == $transfer_qty,
 
1242   $main::lxdebug->leave_sub();
 
1245 sub stock_out_form {
 
1246   $main::lxdebug->enter_sub();
 
1248   my $form     = $main::form;
 
1249   my %myconfig = %main::myconfig;
 
1250   my $locale   = $main::locale;
 
1252   $form->{title} = $locale->text('Release From Stock');
 
1254   my $part_info  = IC->get_basic_part_info('id' => $form->{parts_id});
 
1256   my $units      = AM->retrieve_units(\%myconfig, $form);
 
1257   my $units_data = AM->unit_select_data($units, undef, undef, $part_info->{unit});
 
1259   my @contents   = DO->get_item_availability('parts_id' => $form->{parts_id});
 
1261   my $stock_info = DO->unpack_stock_information('packed' => $form->{stock});
 
1263   if (!$form->{delivered}) {
 
1264     foreach my $row (@contents) {
 
1265       $row->{available_qty} = $form->format_amount_units('amount'      => $row->{qty} * 1,
 
1266                                                          'part_unit'   => $part_info->{unit},
 
1267                                                          'conv_units'  => 'convertible_not_smaller',
 
1270       foreach my $sinfo (@{ $stock_info }) {
 
1271         next if (($row->{bin_id}       != $sinfo->{bin_id}) ||
 
1272                  ($row->{warehouse_id} != $sinfo->{warehouse_id}) ||
 
1273                  ($row->{chargenumber} ne $sinfo->{chargenumber}) ||
 
1274                  ($row->{bestbefore}   ne $sinfo->{bestbefore}));
 
1276         map { $row->{"stock_$_"} = $sinfo->{$_} } qw(qty unit error delivery_order_items_stock_id);
 
1281     get_basic_bin_wh_info($stock_info);
 
1283     foreach my $sinfo (@{ $stock_info }) {
 
1284       map { $sinfo->{"stock_$_"} = $sinfo->{$_} } qw(qty unit);
 
1288   $form->header(no_layout => 1);
 
1289   print $form->parse_html_template('do/stock_out_form', { 'UNITS'      => $units_data,
 
1290                                                           'WHCONTENTS' => $form->{delivered} ? $stock_info : \@contents,
 
1291                                                           'PART_INFO'  => $part_info, });
 
1293   $main::lxdebug->leave_sub();
 
1297   $main::lxdebug->enter_sub();
 
1299   my $form     = $main::form;
 
1300   my %myconfig = %main::myconfig;
 
1301   my $locale   = $main::locale;
 
1303   my $stock_info = [];
 
1305   foreach my $i (1 .. $form->{rowcount}) {
 
1306     $form->{"qty_$i"} = $form->parse_amount(\%myconfig, $form->{"qty_$i"});
 
1308     next if ($form->{"qty_$i"} <= 0);
 
1310     push @{ $stock_info }, {
 
1311       'warehouse_id' => $form->{"warehouse_id_$i"},
 
1312       'bin_id'       => $form->{"bin_id_$i"},
 
1313       'chargenumber' => $form->{"chargenumber_$i"},
 
1314       'bestbefore'   => $form->{"bestbefore_$i"},
 
1315       'qty'          => $form->{"qty_$i"},
 
1316       'unit'         => $form->{"unit_$i"},
 
1318       'delivery_order_items_stock_id'  => $form->{"delivery_order_items_stock_id_$i"},
 
1322   my @errors     = DO->check_stock_availability('requests' => $stock_info,
 
1323                                                 'parts_id' => $form->{parts_id});
 
1325   $form->{stock} = YAML::Dump($stock_info);
 
1328     $form->{ERRORS} = [];
 
1329     map { push @{ $form->{ERRORS} }, $locale->text('Error in row #1: The quantity you entered is bigger than the stocked quantity.', $_->{row}); } @errors;
 
1330     stock_in_out_form();
 
1333     _stock_in_out_set_qty_display($stock_info);
 
1335     my $do_qty       = AM->sum_with_unit($::form->parse_amount(\%::myconfig, $::form->{do_qty}), $::form->{do_unit});
 
1336     my $transfer_qty = AM->sum_with_unit(map { $_->{qty}, $_->{unit} } @{ $stock_info });
 
1339     print $form->parse_html_template('do/set_stock_in_out', {
 
1340       qty_matches => $do_qty == $transfer_qty,
 
1344   $main::lxdebug->leave_sub();
 
1348   $main::lxdebug->enter_sub();
 
1350   my $form     = $main::form;
 
1351   my %myconfig = %main::myconfig;
 
1352   my $locale   = $main::locale;
 
1354   if ($form->{id} && DO->is_marked_as_delivered(id => $form->{id})) {
 
1355     $form->show_generic_error($locale->text('The parts for this delivery order have already been transferred in.'), 'back_button' => 1);
 
1358   save(no_redirect => 1);
 
1360   my @part_ids = map { $form->{"id_${_}"} } grep { $form->{"id_${_}"} && $form->{"stock_in_${_}"} } (1 .. $form->{rowcount});
 
1364     my $units         = AM->retrieve_units(\%myconfig, $form);
 
1365     my %part_info_map = IC->get_basic_part_info('id' => \@part_ids);
 
1368     $form->{ERRORS}   = [];
 
1370     foreach my $i (1 .. $form->{rowcount}) {
 
1371       next unless ($form->{"id_$i"} && $form->{"stock_in_$i"});
 
1373       my $row_sum_base_qty = 0;
 
1374       my $base_unit_factor = $units->{ $part_info_map{$form->{"id_$i"}}->{unit} }->{factor} || 1;
 
1376       foreach my $request (@{ DO->unpack_stock_information('packed' => $form->{"stock_in_$i"}) }) {
 
1377         $request->{parts_id}  = $form->{"id_$i"};
 
1378         $row_sum_base_qty    += $request->{qty} * $units->{$request->{unit}}->{factor} / $base_unit_factor;
 
1380         $request->{project_id} = $form->{"project_id_$i"} || $form->{globalproject_id};
 
1382         push @all_requests, $request;
 
1385       next if (0 == $row_sum_base_qty);
 
1387       my $do_base_qty = $form->parse_amount(\%myconfig, $form->{"qty_$i"}) * $units->{$form->{"unit_$i"}}->{factor} / $base_unit_factor;
 
1389 #      if ($do_base_qty != $row_sum_base_qty) {
 
1390 #        push @{ $form->{ERRORS} }, $locale->text('Error in position #1: You must either assign no stock at all or the full quantity of #2 #3.',
 
1391 #                                                 $i, $form->{"qty_$i"}, $form->{"unit_$i"});
 
1395     if (@{ $form->{ERRORS} }) {
 
1396       push @{ $form->{ERRORS} }, $locale->text('The delivery order has not been marked as delivered. The warehouse contents have not changed.');
 
1398       set_headings('edit');
 
1400       $main::lxdebug->leave_sub();
 
1406   DO->transfer_in_out('direction' => 'in',
 
1407                       'requests'  => \@all_requests);
 
1409   SL::DB::DeliveryOrder->new(id => $form->{id})->load->update_attributes(delivered => 1);
 
1411   $form->{callback} = 'do.pl?action=edit&type=purchase_delivery_order&id=' . $form->escape($form->{id});
 
1414   $main::lxdebug->leave_sub();
 
1418   $main::lxdebug->enter_sub();
 
1420   my $form     = $main::form;
 
1421   my %myconfig = %main::myconfig;
 
1422   my $locale   = $main::locale;
 
1424   if ($form->{id} && DO->is_marked_as_delivered(id => $form->{id})) {
 
1425     $form->show_generic_error($locale->text('The parts for this delivery order have already been transferred out.'), 'back_button' => 1);
 
1428   save(no_redirect => 1);
 
1430   my @part_ids = map { $form->{"id_${_}"} } grep { $form->{"id_${_}"} && $form->{"stock_out_${_}"} } (1 .. $form->{rowcount});
 
1434     my $units         = AM->retrieve_units(\%myconfig, $form);
 
1435     my %part_info_map = IC->get_basic_part_info('id' => \@part_ids);
 
1438     $form->{ERRORS}   = [];
 
1440     foreach my $i (1 .. $form->{rowcount}) {
 
1441       next unless ($form->{"id_$i"} && $form->{"stock_out_$i"});
 
1443       my $row_sum_base_qty = 0;
 
1444       my $base_unit_factor = $units->{ $part_info_map{$form->{"id_$i"}}->{unit} }->{factor} || 1;
 
1446       foreach my $request (@{ DO->unpack_stock_information('packed' => $form->{"stock_out_$i"}) }) {
 
1447         $request->{parts_id} = $form->{"id_$i"};
 
1448         $request->{base_qty} = $request->{qty} * $units->{$request->{unit}}->{factor} / $base_unit_factor;
 
1449         $request->{project_id} = $form->{"project_id_$i"} ? $form->{"project_id_$i"} : $form->{globalproject_id};
 
1451         my $map_key          = join '--', ($form->{"id_$i"}, @{$request}{qw(warehouse_id bin_id chargenumber bestbefore)});
 
1453         $request_map{$map_key}                 ||= $request;
 
1454         $request_map{$map_key}->{sum_base_qty} ||= 0;
 
1455         $request_map{$map_key}->{sum_base_qty}  += $request->{base_qty};
 
1456         $row_sum_base_qty                       += $request->{base_qty};
 
1458         push @all_requests, $request;
 
1461       next if (0 == $row_sum_base_qty);
 
1463       my $do_base_qty = $form->{"qty_$i"} * $units->{$form->{"unit_$i"}}->{factor} / $base_unit_factor;
 
1465 #      if ($do_base_qty != $row_sum_base_qty) {
 
1466 #        push @{ $form->{ERRORS} }, $locale->text('Error in position #1: You must either assign no transfer at all or the full quantity of #2 #3.',
 
1467 #                                                 $i, $form->{"qty_$i"}, $form->{"unit_$i"});
 
1472       my @bin_ids      = map { $_->{bin_id} } values %request_map;
 
1473       my %bin_info_map = WH->get_basic_bin_info('id' => \@bin_ids);
 
1474       my @contents     = DO->get_item_availability('parts_id' => \@part_ids);
 
1476       foreach my $inv (@contents) {
 
1477         my $map_key = join '--', @{$inv}{qw(parts_id warehouse_id bin_id chargenumber bestbefore)};
 
1479         next unless ($request_map{$map_key});
 
1481         my $request    = $request_map{$map_key};
 
1482         $request->{ok} = $request->{sum_base_qty} <= $inv->{qty};
 
1485       foreach my $request (values %request_map) {
 
1486         next if ($request->{ok});
 
1488         my $pinfo = $part_info_map{$request->{parts_id}};
 
1489         my $binfo = $bin_info_map{$request->{bin_id}};
 
1491         if ($::instance_conf->get_show_bestbefore) {
 
1492             push @{ $form->{ERRORS} }, $locale->text("There is not enough available of '#1' at warehouse '#2', bin '#3', #4, #5, for the transfer of #6.",
 
1493                                                      $pinfo->{description},
 
1494                                                      $binfo->{warehouse_description},
 
1495                                                      $binfo->{bin_description},
 
1496                                                      $request->{chargenumber} ? $locale->text('chargenumber #1', $request->{chargenumber}) : $locale->text('no chargenumber'),
 
1497                                                      $request->{bestbefore} ? $locale->text('bestbefore #1', $request->{bestbefore}) : $locale->text('no bestbefore'),
 
1498                                                      $form->format_amount_units('amount'      => $request->{sum_base_qty},
 
1499                                                                                 'part_unit'   => $pinfo->{unit},
 
1500                                                                                 'conv_units'  => 'convertible_not_smaller'));
 
1502             push @{ $form->{ERRORS} }, $locale->text("There is not enough available of '#1' at warehouse '#2', bin '#3', #4, for the transfer of #5.",
 
1503                                                      $pinfo->{description},
 
1504                                                      $binfo->{warehouse_description},
 
1505                                                      $binfo->{bin_description},
 
1506                                                      $request->{chargenumber} ? $locale->text('chargenumber #1', $request->{chargenumber}) : $locale->text('no chargenumber'),
 
1507                                                      $form->format_amount_units('amount'      => $request->{sum_base_qty},
 
1508                                                                                 'part_unit'   => $pinfo->{unit},
 
1509                                                                                 'conv_units'  => 'convertible_not_smaller'));
 
1514     if (@{ $form->{ERRORS} }) {
 
1515       push @{ $form->{ERRORS} }, $locale->text('The delivery order has not been marked as delivered. The warehouse contents have not changed.');
 
1517       set_headings('edit');
 
1519       $main::lxdebug->leave_sub();
 
1524   DO->transfer_in_out('direction' => 'out',
 
1525                       'requests'  => \@all_requests);
 
1527   SL::DB::DeliveryOrder->new(id => $form->{id})->load->update_attributes(delivered => 1);
 
1529   $form->{callback} = 'do.pl?action=edit&type=sales_delivery_order&id=' . $form->escape($form->{id});
 
1532   $main::lxdebug->leave_sub();
 
1536   $main::lxdebug->enter_sub();
 
1538   my $form     = $main::form;
 
1540   DO->close_orders('ids' => [ $form->{id} ]);
 
1542   $form->{closed} = 1;
 
1546   $main::lxdebug->leave_sub();
 
1550   $::lxdebug->enter_sub;
 
1552   $::auth->assert('purchase_delivery_order_edit | sales_delivery_order_edit');
 
1555   retrieve_partunits();
 
1557   my $new_rowcount = $::form->{"rowcount"} * 1 + 1;
 
1558   $::form->{"project_id_${new_rowcount}"} = $::form->{"globalproject_id"};
 
1560   $::form->language_payment(\%::myconfig);
 
1562   Common::webdav_folder($::form);
 
1565   display_row(++$::form->{rowcount});
 
1568   $::lxdebug->leave_sub;
 
1572   call_sub($main::form->{yes_nextsub});
 
1576   call_sub($main::form->{no_nextsub});
 
1580   call_sub($main::form->{update_nextsub} || $main::form->{nextsub} || 'update_delivery_order');
 
1584   my $form     = $main::form;
 
1585   my $locale   = $main::locale;
 
1587   foreach my $action (qw(update ship_to print e_mail save transfer_out transfer_out_default sort
 
1588                          transfer_in transfer_in_default mark_closed save_as_new invoice delete)) {
 
1589     if ($form->{"action_${action}"}) {
 
1595   $form->error($locale->text('No action defined.'));
 
1598 sub transfer_out_default {
 
1599   $main::lxdebug->enter_sub();
 
1601   my $form     = $main::form;
 
1603   transfer_in_out_default('direction' => 'out');
 
1605   $main::lxdebug->leave_sub();
 
1608 sub transfer_in_default {
 
1609   $main::lxdebug->enter_sub();
 
1611   my $form     = $main::form;
 
1613   transfer_in_out_default('direction' => 'in');
 
1615   $main::lxdebug->leave_sub();
 
1618 # Falls das Standardlagerverfahren aktiv ist, wird
 
1619 # geprüft, ob alle Standardlagerplätze für die Auslager-
 
1620 # artikel vorhanden sind UND ob die Warenmenge ausreicht zum
 
1621 # Auslagern. Falls nicht wird entsprechend eine Fehlermeldung
 
1622 # generiert. Offen Chargennummer / bestbefore wird nicht berücksichtigt
 
1623 sub transfer_in_out_default {
 
1624   $main::lxdebug->enter_sub();
 
1626   my $form     = $main::form;
 
1627   my %myconfig = %main::myconfig;
 
1628   my $locale   = $main::locale;
 
1631   my (%missing_default_bins, %qty_parts, @all_requests, %part_info_map, $default_warehouse_id, $default_bin_id);
 
1633   Common::check_params(\%params, qw(direction));
 
1635   # entsprechende defaults holen, falls standardlagerplatz verwendet werden soll
 
1636   if ($::instance_conf->get_transfer_default_use_master_default_bin) {
 
1637     $default_warehouse_id = $::instance_conf->get_warehouse_id;
 
1638     $default_bin_id       = $::instance_conf->get_bin_id;
 
1642   my @part_ids = map { $form->{"id_${_}"} } (1 .. $form->{rowcount});
 
1644     my $units         = AM->retrieve_units(\%myconfig, $form);
 
1645     %part_info_map = IC->get_basic_part_info('id' => \@part_ids);
 
1646     foreach my $i (1 .. $form->{rowcount}) {
 
1647       next unless ($form->{"id_$i"});
 
1648       my $base_unit_factor = $units->{ $part_info_map{$form->{"id_$i"}}->{unit} }->{factor} || 1;
 
1649       my $qty =   $form->parse_amount(\%myconfig, $form->{"qty_$i"}) * $units->{$form->{"unit_$i"}}->{factor} / $base_unit_factor;
 
1651       $form->show_generic_error($locale->text("Cannot transfer negative entries." ), 'back_button' => 1) if ($qty < 0);
 
1652       # if we do not want to transfer services and this part is a service, set qty to zero
 
1653       # ... and do not create a hash entry in %qty_parts below (will skip check for bins for the transfer == out case)
 
1654       # ... 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)
 
1656       $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});
 
1657       $qty_parts{$form->{"id_$i"}} += $qty;
 
1659         delete $qty_parts{$form->{"id_$i"}} unless $qty_parts{$form->{"id_$i"}};
 
1660         undef $form->{"stock_in_$i"};
 
1663       $part_info_map{$form->{"id_$i"}}{bin_id}       ||= $default_bin_id;
 
1664       $part_info_map{$form->{"id_$i"}}{warehouse_id} ||= $default_warehouse_id;
 
1666       push @all_requests, ($qty == 0) ? { } : {
 
1667                         'chargenumber' => '',  #?? die müsste entsprechend geholt werden
 
1668                         #'bestbefore' => undef, # TODO wird nicht berücksichtigt
 
1669                         'bin_id' => $part_info_map{$form->{"id_$i"}}{bin_id},
 
1671                         'parts_id' => $form->{"id_$i"},
 
1672                         'comment' => $locale->text("Default transfer delivery order"),
 
1673                         'unit' => $part_info_map{$form->{"id_$i"}}{unit},
 
1674                         'warehouse_id' => $part_info_map{$form->{"id_$i"}}{warehouse_id},
 
1675                         'oe_id' => $form->{id},
 
1676                         'project_id' => $form->{"project_id_$i"} ? $form->{"project_id_$i"} : $form->{globalproject_id}
 
1680     # jetzt wird erst überprüft, ob die Stückzahl entsprechend stimmt.
 
1681     # check if bin (transfer in and transfer out and qty (transfer out) is correct
 
1682     foreach my $key (keys %qty_parts) {
 
1684       $missing_default_bins{$key}{missing_bin} = 1 unless ($part_info_map{$key}{bin_id});
 
1685       next unless ($part_info_map{$key}{bin_id}); # abbruch
 
1687       if ($params{direction} eq 'out') {  # wird nur für ausgehende Mengen benötigt
 
1688         my ($max_qty, $error) = WH->get_max_qty_parts_bin(parts_id => $key, bin_id => $part_info_map{$key}{bin_id});
 
1690           # wir können nicht entscheiden, welche charge oder mhd (bestbefore) ausgewählt sein soll
 
1691           # deshalb rückmeldung nach oben geben, manuell auszulagern
 
1692           # TODO Bei nur einem Treffer mit Charge oder bestbefore wäre das noch möglich
 
1693           $missing_default_bins{$key}{chargenumber} = 1;
 
1695         if ($max_qty < $qty_parts{$key}){
 
1696           $missing_default_bins{$key}{missing_qty} = $max_qty - $qty_parts{$key};
 
1702   # Abfrage für Fehlerbehandlung (nur bei direction == out)
 
1703   if (scalar (keys %missing_default_bins)) {
 
1705     foreach my $fehler (keys %missing_default_bins) {
 
1707       my $ware = WH->get_part_description(parts_id => $fehler);
 
1708       if ($missing_default_bins{$fehler}{missing_bin}){
 
1709         $fehlertext .= "Kein Standardlagerplatz definiert bei $ware <br>";
 
1711       if ($missing_default_bins{$fehler}{missing_qty}) {  # missing_qty
 
1712         $fehlertext .= "Es fehlen " . $missing_default_bins{$fehler}{missing_qty}*-1 .
 
1713                        " von $ware auf dem Standard-Lagerplatz " . $part_info_map{$fehler}{bin} .   " zum Auslagern<br>";
 
1715       if ($missing_default_bins{$fehler}{chargenumber}){
 
1716         $fehlertext .= "Die Ware hat eine Chargennummer oder eine Mindesthaltbarkeit definiert.
 
1717                         Hier kann man nicht automatisch entscheiden.
 
1718                         Bitte diesen Lieferschein manuell auslagern.
 
1721       # auslagern soll immer gehen, auch wenn nicht genügend auf lager ist.
 
1722       # der lagerplatz ist hier extra konfigurierbar, bspw. Lager-Korrektur mit
 
1723       # Lagerplatz Lagerplatz-Korrektur
 
1724       my $default_warehouse_id_ignore_onhand = $::instance_conf->get_warehouse_id_ignore_onhand;
 
1725       my $default_bin_id_ignore_onhand       = $::instance_conf->get_bin_id_ignore_onhand;
 
1726       if ($::instance_conf->get_transfer_default_ignore_onhand && $default_bin_id_ignore_onhand) {
 
1727         # entsprechende defaults holen
 
1728         # falls chargenumber, bestbefore oder anzahl nicht stimmt, auf automatischen
 
1729         # lagerplatz wegbuchen!
 
1730         foreach (@all_requests) {
 
1731           if ($_->{parts_id} eq $fehler){
 
1732           $_->{bin_id}        = $default_bin_id_ignore_onhand;
 
1733           $_->{warehouse_id}  = $default_warehouse_id_ignore_onhand;
 
1737         #$main::lxdebug->message(0, 'Fehlertext: ' . $fehlertext);
 
1738         $form->show_generic_error($locale->text("Cannot transfer. <br> Reason:<br>#1", $fehlertext ), 'back_button' => 1);
 
1744   # hier der eigentliche fallunterschied für in oder out
 
1745   my $prefix   = $params{direction} eq 'in' ? 'in' : 'out';
 
1747   # dieser array_ref ist für DO->save da:
 
1748   # einmal die all_requests in YAML verwandeln, damit delivery_order_items_stock
 
1749   # gefüllt werden kann.
 
1750   # could be dumped to the form in the first loop,
 
1751   # but maybe bin_id and warehouse_id has changed to the "korrekturlager" with
 
1752   # allowed negative qty ($::instance_conf->get_warehouse_id_ignore_onhand) ...
 
1754   foreach (@all_requests){
 
1756     next unless scalar(%{ $_ });
 
1757     $form->{"stock_${prefix}_$i"} = YAML::Dump([$_]);
 
1760   save(no_redirect => 1); # Wir können auslagern, deshalb beleg speichern
 
1761                           # und in delivery_order_items_stock speichern
 
1763   # ... and fill back the persistent dois_id for inventory fk
 
1764   undef (@all_requests);
 
1765   foreach my $i (1 .. $form->{rowcount}) {
 
1766     next unless ($form->{"id_$i"} && $form->{"stock_${prefix}_$i"});
 
1767     push @all_requests, @{ DO->unpack_stock_information('packed' => $form->{"stock_${prefix}_$i"}) };
 
1769   DO->transfer_in_out('direction' => $prefix,
 
1770                       'requests'  => \@all_requests);
 
1772   SL::DB::DeliveryOrder->new(id => $form->{id})->load->update_attributes(delivered => 1);
 
1774   $form->{callback} = 'do.pl?action=edit&type=sales_delivery_order&id=' . $form->escape($form->{id}) if $params{direction} eq 'out';
 
1775   $form->{callback} = 'do.pl?action=edit&type=purchase_delivery_order&id=' . $form->escape($form->{id}) if $params{direction} eq 'in';
 
1781   $main::lxdebug->enter_sub();
 
1785   my $form     = $main::form;
 
1788   croak ("Delivery Order needs to be saved") unless $form->{id};
 
1790   # hashify partnumbers, positions. key is delivery_order_items_id
 
1791   for my $i (1 .. ($form->{rowcount}) ) {
 
1792     $temp_hash{$form->{"delivery_order_items_id_$i"}} = { runningnumber => $form->{"runningnumber_$i"}, partnumber => $form->{"partnumber_$i"} };
 
1794   # naturally sort partnumbers and get a sorted array of doi_ids
 
1795   my @sorted_doi_ids =  sort { Sort::Naturally::ncmp($temp_hash{$a}->{"partnumber"}, $temp_hash{$b}->{"partnumber"}) }  keys %temp_hash;
 
1800   for (@sorted_doi_ids) {
 
1801     $form->{"runningnumber_$temp_hash{$_}->{runningnumber}"} = $new_number;
 
1804     $main::lxdebug->leave_sub();
 
1816 do.pl - Script for all calls to delivery order
 
1825 Sorts all position with Natural Sort. Can be activated in form_footer.html like this
 
1826 C<E<lt>input class="submit" type="submit" name="action_sort" id="sort_button" value="[% 'Sort and Save' | $T8 %]"E<gt>>
 
1832 Sort and Save can be implemented as an optional button if configuration ca be set by client config.
 
1833 Example coding for database scripts and templates in (git show af2f24b8), check also
 
1834 autogeneration for rose (scripts/rose_auto_create_model.pl --h)