<html>-Tag vor eigentlichem HTML-Code ausgeben.
[kivitendo-erp.git] / SL / Form.pm
index bfe8e46..acc6c6b 100644 (file)
@@ -1,4 +1,4 @@
-#=====================================================================
+#====================================================================
 # LX-Office ERP
 # Copyright (C) 2004
 # Based on SQL-Ledger Version 2.1.9
@@ -140,8 +140,8 @@ sub new {
   $self->{action} = lc $self->{action};
   $self->{action} =~ s/( |-|,|#)/_/g;
 
-  $self->{version}   = "2.1.2";
-  $self->{dbversion} = "2.1.2";
+  $self->{version}   = "2.2.0";
+  $self->{dbversion} = "2.2.0";
 
   $main::lxdebug->leave_sub();
 
@@ -195,7 +195,7 @@ sub unescape {
 sub quote {
   my ($self, $str) = @_;
 
-  if ($str && ! ref($str)) {
+  if ($str && !ref($str)) {
     $str =~ s/"/&quot;/g;
   }
 
@@ -203,11 +203,10 @@ sub quote {
 
 }
 
-
 sub unquote {
   my ($self, $str) = @_;
 
-  if ($str && ! ref($str)) {
+  if ($str && !ref($str)) {
     $str =~ s/&quot;/"/g;
   }
 
@@ -215,17 +214,24 @@ sub unquote {
 
 }
 
 sub hide_form {
   my $self = shift;
 
   if (@_) {
-    for (@_) { print qq|<input type=hidden name="$_" value="|.$self->quote($self->{$_}).qq|">\n| }
+    for (@_) {
+      print qq|<input type=hidden name="$_" value="|
+        . $self->quote($self->{$_})
+        . qq|">\n|;
+    }
   } else {
     delete $self->{header};
-    for (sort keys %$self) { print qq|<input type=hidden name="$_" value="|.$self->quote($self->{$_}).qq|">\n| }
+    for (sort keys %$self) {
+      print qq|<input type=hidden name="$_" value="|
+        . $self->quote($self->{$_})
+        . qq|">\n|;
+    }
   }
-  
+
 }
 
 sub error {
@@ -382,8 +388,8 @@ function fokus(){document.$self->{fokus}.focus();}
       $jsscript = qq|
         <style type="text/css">\@import url(js/jscalendar/calendar-win2k-1.css);</style>
         <script type="text/javascript" src="js/jscalendar/calendar.js"></script>
-        <script type="text/javascript" src="js/jscalendar/lang/calendar-de.js"></script>
-        <script type="text/javascript" src="js/jscalendar/calendar-setup.js"></script>
+        <script type="text/javascript" src="js/jscalendar/lang/calendar-de.js"></script>
+        <script type="text/javascript" src="js/jscalendar/calendar-setup.js"></script>
         $self->{javascript}
        |;
     }
@@ -395,6 +401,7 @@ function fokus(){document.$self->{fokus}.focus();}
 
     print qq|Content-Type: text/html
 
+<html>
 <head>
   <title>$self->{titlebar}</title>
   $stylesheet
@@ -412,14 +419,14 @@ function fokus(){document.$self->{fokus}.focus();}
   $main::lxdebug->leave_sub();
 }
 
-# write Trigger JavaScript-Code ($qty = 1 - only one Trigger)
+# write Trigger JavaScript-Code ($qty = quantity of Triggers)
+# changed it to accept an arbitrary number of triggers - sschoeling
 sub write_trigger {
   $main::lxdebug->enter_sub();
 
-  my ($self,         $myconfig, $qty,
-      $inputField_1, $align_1,  $button_1,
-      $inputField_2, $align_2,  $button_2)
-    = @_;
+  my $self     = shift;
+  my $myconfig = shift;
+  my $qty      = shift;
 
   # set dateform for jsscript
   # default
@@ -448,35 +455,21 @@ sub write_trigger {
     }
   }
 
-  $trigger_1 = qq|
+  while ($#_ >= 2) {
+    push @triggers, qq|
        Calendar.setup(
-       {
-         inputField  : "$inputField_1",
-         ifFormat    :"$ifFormat",
-         align    : "$align_1",     
-         button      : "$button_1"
-       }
-       );
+      {
+      inputField : "| . (shift) . qq|",
+      ifFormat :"$ifFormat",
+      align : "| .  (shift) . qq|", 
+      button : "| . (shift) . qq|"
+      }
+      );
        |;
-
-  if ($qty == 2) {
-    $trigger_2 = qq|
-       Calendar.setup(
-       {
-         inputField  : "$inputField_2",
-         ifFormat    :"$ifFormat",
-         align    : "$align_2",     
-         button      : "$button_2"
-       }
-       );
-        |;
   }
   $jsscript = qq|
        <script type="text/javascript">
-       <!--
-       $trigger_1
-       $trigger_2
-        //-->
+       <!--| . join("", @triggers) . qq|//-->
         </script>
         |;
 
@@ -520,13 +513,19 @@ sub format_amount {
 
   my ($self, $myconfig, $amount, $places, $dash) = @_;
 
+  #Workaround for $format_amount calls without $places
+  if (!defined $places) {
+    (my $dec) = ($amount =~ /\.(\d+)/);
+    $places = length $dec;
+  }
+
   if ($places =~ /\d/) {
     $amount = $self->round_amount($amount, $places);
   }
 
   # is the amount negative
   my $negative = ($amount < 0);
-  my $fillup = "";
+  my $fillup   = "";
 
   if ($amount != 0) {
     if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00'))
@@ -540,19 +539,19 @@ sub format_amount {
         $amount =~ s/\d{3,}?/$&,/g;
         $amount =~ s/,$//;
         $amount = join '', reverse split //, $amount;
-        $amount .= "\.$dec".$fillup if ($places ne '' && $places*1 != 0);
+        $amount .= "\.$dec" . $fillup if ($places ne '' && $places * 1 != 0);
       }
 
       if ($myconfig->{numberformat} eq '1.000,00') {
         $amount =~ s/\d{3,}?/$&./g;
         $amount =~ s/\.$//;
         $amount = join '', reverse split //, $amount;
-        $amount .= ",$dec".$fillup if ($places ne '' && $places*1 != 0);
+        $amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0);
       }
 
       if ($myconfig->{numberformat} eq '1000,00') {
         $amount = "$whole";
-        $amount .= ",$dec" .$fillup if ($places ne '' && $places*1 != 0);
+        $amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0);
       }
 
       if ($dash =~ /-/) {
@@ -584,17 +583,53 @@ sub parse_amount {
   $main::lxdebug->enter_sub();
 
   my ($self, $myconfig, $amount) = @_;
+  $main::lxdebug->message(LXDebug::DEBUG2, "Start amount: $amount");
 
-  if (!(substr($amount, -3, 1) eq ".")) {
-    if (   ($myconfig->{numberformat} eq '1.000,00')
-        || ($myconfig->{numberformat} eq '1000,00')) {
-      $amount =~ s/\.//g;
-      $amount =~ s/,/\./;
-    }
+  if ($myconfig->{in_numberformat} == 1) {
+
+    # Extra input number format 1000.00 or 1000,00
+    $main::lxdebug->message(LXDebug::DEBUG2,
+              "in_numberformat: " . $main::locale->text('1000,00 or 1000.00'));
+    $amount =~ s/,/\./g;
+
+    #$main::lxdebug->message(LXDebug::DEBUG2, "1.Parsed Number: $amount") if ($amount);
+    $amount = scalar reverse $amount;
+
+    #$main::lxdebug->message(LXDebug::DEBUG2, "2.Parsed Number: $amount") if ($amount);
+    $amount =~ s/\./DOT/;
+
+    #$main::lxdebug->message(LXDebug::DEBUG2, "3.Parsed Number: $amount") if ($amount);
+    $amount =~ s/\.//g;
+
+    #$main::lxdebug->message(LXDebug::DEBUG2, "4.Parsed Number: $amount") if ($amount);
+    $amount =~ s/DOT/\./;
+
+    #$main::lxdebug->message(LXDebug::DEBUG2, "5.Parsed Number:" . $amount) if ($amount);
+    $amount = scalar reverse $amount;
+    $main::lxdebug->message(LXDebug::DEBUG2,
+                            "Parsed amount:" . $amount . "\n");
 
-    $amount =~ s/,//g;
+    return ($amount * 1);
+
+  }
+  $main::lxdebug->message(LXDebug::DEBUG2,
+              "in_numberformat: " . $main::locale->text('equal Outputformat'));
+  $main::lxdebug->message(LXDebug::DEBUG2,
+                          " = numberformat: $myconfig->{numberformat}");
+  if (   ($myconfig->{numberformat} eq '1.000,00')
+      || ($myconfig->{numberformat} eq '1000,00')) {
+    $amount =~ s/\.//g;
+    $amount =~ s/,/\./;
   }
 
+  if ($myconfig->{numberformat} eq "1'000.00") {
+    $amount =~ s/'//g;
+  }
+
+  $amount =~ s/,//g;
+
+  $main::lxdebug->message(LXDebug::DEBUG2, "Parsed amount:" . $amount . "\n")
+    if ($amount);
   $main::lxdebug->leave_sub();
 
   return ($amount * 1);
@@ -608,20 +643,18 @@ sub round_amount {
 
   # Rounding like "Kaufmannsrunden"
   # Descr. http://de.wikipedia.org/wiki/Rundung
-  # Inspired by 
+  # Inspired by
   # http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html
   # Solves Bug: 189
   # Udo Spallek
-  $amount       = $amount * (10 ** ($places));
-  $round_amount = int($amount + .5 * ($amount <=> 0))/(10**($places));
+  $amount = $amount * (10**($places));
+  $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places));
 
   $main::lxdebug->leave_sub();
 
   return $round_amount;
-  
-}
-
 
+}
 
 sub parse_template {
   $main::lxdebug->enter_sub();
@@ -632,7 +665,7 @@ sub parse_template {
   # Some variables used for page breaks
   my ($chars_per_line, $lines_on_first_page, $lines_on_second_page) =
     (0, 0, 0);
-  my ($current_page, $current_line) = (1, 1);
+  my ($current_page, $current_line, $current_row) = (1, 1, 0);
   my $pagebreak = "";
   my $sum       = 0;
 
@@ -736,8 +769,12 @@ sub parse_template {
             $lpp = $lines_on_second_page;
           }
 
-          # Yes we need a manual page break
-          if (($current_line + $lines) > $lpp) {
+          # Yes we need a manual page break -- or the user has forced one
+          if (
+             (($current_line + $lines) > $lpp)
+             || ($self->{"_forced_pagebreaks"}
+               && grep(/^${current_row}$/, @{ $self->{"_forced_pagebreaks"} }))
+            ) {
             my $pb = $pagebreak;
 
             # replace the special variables <%sumcarriedforward%>
@@ -758,6 +795,7 @@ sub parse_template {
             $current_line = 1;
           }
           $current_line += $lines;
+          $current_row++;
         }
         $sum += $self->parse_amount($myconfig, $self->{"linetotal"}[$i]);
 
@@ -844,6 +882,7 @@ sub parse_template {
     }
 
     s/<%(.+?)%>/$self->{$1}/g;
+    s/<nobr><\/nobr>/&nbsp;/g;
     print OUT;
   }
 
@@ -1022,7 +1061,19 @@ sub format_string {
   my %unique_fields;
 
   %unique_fields = map({ $_ => 1 } @fields);
-  @fields = keys(%unique_fields);
+  @fields        = keys(%unique_fields);
+
+  foreach my $field (@fields) {
+    next unless ($self->{$field} =~ /\<pagebreak\>/);
+    $self->{$field} =~ s/\<pagebreak\>//g;
+    if ($field =~ /.*_(\d+)$/) {
+      if (!$self->{"_forced_pagebreaks"}) {
+        $self->{"_forced_pagebreaks"} = [];
+      }
+      push(@{ $self->{"_forced_pagebreaks"} }, "$1");
+    }
+  }
+
   my $format = $self->{format};
   if ($self->{format} =~ /(postscript|pdf)/) {
     $format = 'tex';
@@ -1086,9 +1137,6 @@ sub format_string {
                           'u' => 'underline');
 
     foreach my $field (@fields) {
-      if ($field =~ /descrip/) {
-        print(STDERR "QFT: ${field}: " . $self->{$field} . "\n");
-      }
       foreach my $key (keys(%markup_replace)) {
         my $new = $markup_replace{$key};
         $self->{$field} =~
@@ -1267,6 +1315,11 @@ sub get_exchangerate {
 
   my ($self, $dbh, $curr, $transdate, $fld) = @_;
 
+  unless ($transdate) {
+    $main::lxdebug->leave_sub();
+    return "";
+  }
+
   my $query = qq|SELECT e.$fld FROM exchangerate e
                  WHERE e.curr = '$curr'
                 AND e.transdate = '$transdate'|;
@@ -1314,8 +1367,9 @@ sub add_shipto {
   my ($self, $dbh, $id) = @_;
 ##LINET
   my $shipto;
-  foreach
-    my $item (qw(name department_1 department_2 street zipcode city country contact phone fax email)) {
+  foreach my $item (
+    qw(name department_1 department_2 street zipcode city country contact phone fax email)
+    ) {
     if ($self->{"shipto$item"}) {
       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
     }
@@ -1323,7 +1377,8 @@ sub add_shipto {
   }
 
   if ($shipto) {
-    my $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, shiptostreet,
+    my $query =
+      qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, shiptostreet,
                    shiptozipcode, shiptocity, shiptocountry, shiptocontact,
                   shiptophone, shiptofax, shiptoemail) VALUES ($id,
                   '$self->{shiptoname}', '$self->{shiptodepartment_1}', '$self->{shiptodepartment_2}', '$self->{shiptostreet}',
@@ -1582,8 +1637,7 @@ sub create_links {
   my %xkeyref = ();
 
   # now get the account numbers
-  $query =
-    qq|SELECT c.accno, SUBSTRING(c.description,1,50) as description, c.link, c.taxkey_id
+  $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id
               FROM chart c
              WHERE c.link LIKE '%$module%'
              ORDER BY c.accno|;
@@ -1656,7 +1710,7 @@ sub create_links {
                LEFT Join tax t ON (a.taxkey = t.taxkey)
                WHERE a.trans_id = $self->{id}
                AND a.fx_transaction = '0'
-               ORDER BY a.transdate|;
+               ORDER BY a.oid,a.transdate|;
     $sth = $dbh->prepare($query);
     $sth->execute || $self->dberror($query);
 
@@ -1666,12 +1720,17 @@ sub create_links {
     $self->{exchangerate} =
       $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate},
                               $fld);
+    my $index = 0;
 
     # store amounts in {acc_trans}{$key} for multiple accounts
     while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
       $ref->{exchangerate} =
         $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate},
                                 $fld);
+      if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
+        $index++;
+      }
+      $ref->{index} = $index;
 
       push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
     }
@@ -1749,10 +1808,9 @@ sub lastname_used {
     $where = "quotation = '1'";
   }
 
-  my $query = qq|SELECT id FROM $arap
-                 WHERE id IN (SELECT MAX(id) FROM $arap
+  my $query = qq|SELECT MAX(id) FROM $arap
                              WHERE $where
-                             AND ${table}_id > 0)|;
+                             AND ${table}_id > 0|;
   my $sth = $dbh->prepare($query);
   $sth->execute || $self->dberror($query);
 
@@ -2105,92 +2163,126 @@ sub get_partsgroup {
   $main::lxdebug->leave_sub();
 }
 
+sub get_pricegroup {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $myconfig, $p) = @_;
+
+  my $dbh = $self->dbconnect($myconfig);
+
+  my $query = qq|SELECT p.id, p.pricegroup
+                 FROM pricegroup p|;
+
+  $query .= qq|
+                ORDER BY pricegroup|;
+
+  if ($p->{all}) {
+    $query = qq|SELECT id, pricegroup FROM pricegroup
+                ORDER BY pricegroup|;
+  }
+
+  my $sth = $dbh->prepare($query);
+  $sth->execute || $self->dberror($query);
+
+  $self->{all_pricegroup} = ();
+  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+    push @{ $self->{all_pricegroup} }, $ref;
+  }
+  $sth->finish;
+  $dbh->disconnect;
+
+  $main::lxdebug->leave_sub();
+}
 
 sub audittrail {
   my ($self, $dbh, $myconfig, $audittrail) = @_;
-  
-# table, $reference, $formname, $action, $id, $transdate) = @_;
+
+  # table, $reference, $formname, $action, $id, $transdate) = @_;
 
   my $query;
   my $rv;
   my $disconnect;
 
-  if (! $dbh) {
-    $dbh = $self->dbconnect($myconfig);
+  if (!$dbh) {
+    $dbh        = $self->dbconnect($myconfig);
     $disconnect = 1;
   }
-    
+
   # if we have an id add audittrail, otherwise get a new timestamp
-  
+
   if ($audittrail->{id}) {
-    
+
     $query = qq|SELECT audittrail FROM defaults|;
-    
+
     if ($dbh->selectrow_array($query)) {
       my ($null, $employee_id) = $self->get_employee($dbh);
 
       if ($self->{audittrail} && !$myconfig) {
-       chop $self->{audittrail};
-       
-       my @a = split /\|/, $self->{audittrail};
-       my %newtrail = ();
-       my $key;
-       my $i;
-       my @flds = qw(tablename reference formname action transdate);
-
-       # put into hash and remove dups
-       while (@a) {
-         $key = "$a[2]$a[3]";
-         $i = 0;
-         $newtrail{$key} = { map { $_ => $a[$i++] } @flds };
-         splice @a, 0, 5;
-       }
-       
-       $query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
+        chop $self->{audittrail};
+
+        my @a = split /\|/, $self->{audittrail};
+        my %newtrail = ();
+        my $key;
+        my $i;
+        my @flds = qw(tablename reference formname action transdate);
+
+        # put into hash and remove dups
+        while (@a) {
+          $key = "$a[2]$a[3]";
+          $i   = 0;
+          $newtrail{$key} = { map { $_ => $a[$i++] } @flds };
+          splice @a, 0, 5;
+        }
+
+        $query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
                    formname, action, employee_id, transdate)
                    VALUES ($audittrail->{id}, ?, ?,
                    ?, ?, $employee_id, ?)|;
-       my $sth = $dbh->prepare($query) || $self->dberror($query);
-
-       foreach $key (sort { $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate} } keys %newtrail) {
-         $i = 1;
-         for (@flds) { $sth->bind_param($i++, $newtrail{$key}{$_}) }
-
-         $sth->execute || $self->dberror;
-         $sth->finish;
-       }
+        my $sth = $dbh->prepare($query) || $self->dberror($query);
+
+        foreach $key (
+          sort {
+            $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate}
+          } keys %newtrail
+          ) {
+          $i = 1;
+          for (@flds) { $sth->bind_param($i++, $newtrail{$key}{$_}) }
+
+          $sth->execute || $self->dberror;
+          $sth->finish;
+        }
       }
 
-     
       if ($audittrail->{transdate}) {
-       $query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
+        $query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
                    formname, action, employee_id, transdate) VALUES (
                    $audittrail->{id}, '$audittrail->{tablename}', |
-                   .$dbh->quote($audittrail->{reference}).qq|',
+          . $dbh->quote($audittrail->{reference}) . qq|,
                    '$audittrail->{formname}', '$audittrail->{action}',
                    $employee_id, '$audittrail->{transdate}')|;
       } else {
-       $query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
+        $query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
                    formname, action, employee_id) VALUES ($audittrail->{id},
                    '$audittrail->{tablename}', |
-                   .$dbh->quote($audittrail->{reference}).qq|,
+          . $dbh->quote($audittrail->{reference}) . qq|,
                    '$audittrail->{formname}', '$audittrail->{action}',
                    $employee_id)|;
       }
       $dbh->do($query);
     }
   } else {
-    
+
     $query = qq|SELECT current_timestamp FROM defaults|;
     my ($timestamp) = $dbh->selectrow_array($query);
 
-    $rv = "$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|";
+    $rv =
+      "$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|";
   }
 
   $dbh->disconnect if $disconnect;
-  
+
   $rv;
-  
+
 }
 
 package Locale;