]> wagnertech.de Git - mfinanz.git/blobdiff - SL/Form.pm
projects / mfinanz.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Das DBUpdate für Oesterreich lief nicht auf Postgres > 8.1. Fixed.
[mfinanz.git] / SL / Form.pm
diff --git a/SL/Form.pm b/SL/Form.pm
index b32fbd2b041a70e26575d2d6b4c05831d00dd843..a926b3cdd9c63433bc768afb1eeba4322e8210fb 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -49,6 +49,7 @@ use SL::Menu;
 use SL::User;
 use SL::Common;
 use CGI;
 use SL::User;
 use SL::Common;
 use CGI;
+use List::Util qw(max min sum);
 
 my $standard_dbh;
 
 
 my $standard_dbh;
 
@@ -98,7 +99,8 @@ sub _request_to_hash {
     if (($line eq $boundary) || ($line eq "$boundary\r")) {
       $params{$name} =~ s|\r?\n$|| if $name;
 
     if (($line eq $boundary) || ($line eq "$boundary\r")) {
       $params{$name} =~ s|\r?\n$|| if $name;
 
-      undef $name, $filename;
+      undef $name;
+      undef $filename;
 
       $headers_done   = 0;
       $content_type   = "text/plain";
 
       $headers_done   = 0;
       $content_type   = "text/plain";
@@ -331,20 +333,17 @@ sub info {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
+# calculates the number of rows in a textarea based on the content and column number
+# can be capped with maxrows
 sub numtextrows {
   $main::lxdebug->enter_sub();
 sub numtextrows {
   $main::lxdebug->enter_sub();
-
   my ($self, $str, $cols, $maxrows) = @_;
 
   my ($self, $str, $cols, $maxrows) = @_;
 
-  my $rows = 0;
-
-  map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str;
-
-  $maxrows = $rows unless defined $maxrows;
+  my $rows   = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
+  $maxrows ||= $rows;
 
   $main::lxdebug->leave_sub();
 
   $main::lxdebug->leave_sub();
-
-  return ($rows > $maxrows) ? $maxrows : $rows;
+  return min $rows, $maxrows;
 }
 
 sub dberror {
 }
 
 sub dberror {
@@ -381,6 +380,12 @@ sub header {
   my ($stylesheet, $favicon);
 
   if ($ENV{HTTP_USER_AGENT}) {
   my ($stylesheet, $favicon);
 
   if ($ENV{HTTP_USER_AGENT}) {
+    my $doctype;
+
+    if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) {
+      # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise.
+      $doctype = qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">\n|;
+    }
 
     my $stylesheets = "$self->{stylesheet} $self->{stylesheets}";
 
 
     my $stylesheets = "$self->{stylesheet} $self->{stylesheets}";
 
@@ -434,7 +439,7 @@ sub header {
     }
     print qq|Content-Type: text/html; charset=${db_charset};
 
     }
     print qq|Content-Type: text/html; charset=${db_charset};
 
-<html>
+${doctype}<html>
 <head>
   <title>$self->{titlebar}</title>
   $stylesheet
 <head>
   <title>$self->{titlebar}</title>
   $stylesheet
@@ -586,12 +591,15 @@ sub parse_html_template2 {
                                  'EVAL_PERL'   => 0,
                                  'ABSOLUTE'    => 1,
                                  'CACHE_SIZE'  => 0,
                                  'EVAL_PERL'   => 0,
                                  'ABSOLUTE'    => 1,
                                  'CACHE_SIZE'  => 0,
+                                 'PLUGIN_BASE' => 'SL::Template::Plugin',
                                }) || die;
 
   map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
 
   my $output;
                                }) || die;
 
   map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
 
   my $output;
-  $template->process($file, $additional_params, \$output);
+  if (!$template->process($file, $additional_params, \$output)) {
+    print STDERR $template->error();
+  }
 
   $output = $main::locale->{iconv}->convert($output) if ($main::locale);
 
 
   $output = $main::locale->{iconv}->convert($output) if ($main::locale);
 
@@ -724,18 +732,23 @@ sub format_amount {
   if ($amount eq "") {
     $amount = 0;
   }
   if ($amount eq "") {
     $amount = 0;
   }
-  my $neg = ($amount =~ s/-//);
-
+  
+  # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13
+  
+  my $neg = ($amount =~ s/^-//);
+  my $exp = ($amount =~ m/[e]/) ? 1 : 0;
+  
   if (defined($places) && ($places ne '')) {
   if (defined($places) && ($places ne '')) {
-    if ($places < 0) {
-      $amount *= 1;
-      $places *= -1;
-
-      my ($actual_places) = ($amount =~ /\.(\d+)/);
-      $actual_places = length($actual_places);
-      $places = $actual_places > $places ? $actual_places : $places;
+    if (not $exp) {
+      if ($places < 0) {
+        $amount *= 1;
+        $places *= -1;
+
+        my ($actual_places) = ($amount =~ /\.(\d+)/);
+        $actual_places = length($actual_places);
+        $places = $actual_places > $places ? $actual_places : $places;
+      }
     }
     }
-
     $amount = $self->round_amount($amount, $places);
   }
 
     $amount = $self->round_amount($amount, $places);
   }
 
@@ -861,6 +874,10 @@ sub parse_template {
       qw(company address signature));
   map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature));
 
       qw(company address signature));
   map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature));
 
+  map({ $self->{"${_}"} = $myconfig->{$_}; }
+      qw(co_ustid));
+              
+
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
   # OUT is used for the media, screen, printer, email
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
   # OUT is used for the media, screen, printer, email
@@ -1005,18 +1022,18 @@ sub get_formname_translation {
   $formname ||= $self->{formname};
 
   my %formname_translations = (
   $formname ||= $self->{formname};
 
   my %formname_translations = (
-     bin_list            => $main::locale->text('Bin List'),
-     credit_note         => $main::locale->text('Credit Note'),
-     invoice             => $main::locale->text('Invoice'),
-     packing_list        => $main::locale->text('Packing List'),
-     pick_list           => $main::locale->text('Pick List'),
-     proforma            => $main::locale->text('Proforma Invoice'),
-     purchase_order      => $main::locale->text('Purchase Order'),
-     request_quotation   => $main::locale->text('RFQ'),
-     sales_order         => $main::locale->text('Confirmation'),
-     sales_quotation     => $main::locale->text('Quotation'),
-     storno_invoice      => $main::locale->text('Storno Invoice'),
-     storno_packing_list => $main::locale->text('Storno Packing List'),
+    bin_list            => $main::locale->text('Bin List'),
+    credit_note         => $main::locale->text('Credit Note'),
+    invoice             => $main::locale->text('Invoice'),
+    packing_list        => $main::locale->text('Packing List'),
+    pick_list           => $main::locale->text('Pick List'),
+    proforma            => $main::locale->text('Proforma Invoice'),
+    purchase_order      => $main::locale->text('Purchase Order'),
+    request_quotation   => $main::locale->text('RFQ'),
+    sales_order         => $main::locale->text('Confirmation'),
+    sales_quotation     => $main::locale->text('Quotation'),
+    storno_invoice      => $main::locale->text('Storno Invoice'),
+    storno_packing_list => $main::locale->text('Storno Packing List'),
   );
 
   return $formname_translations{$formname}
   );
 
   return $formname_translations{$formname}
@@ -1194,13 +1211,13 @@ sub update_exchangerate {
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
-
+  my ($query);
   # some sanity check for currency
   if ($curr eq '') {
     $main::lxdebug->leave_sub();
     return;
   }  
   # some sanity check for currency
   if ($curr eq '') {
     $main::lxdebug->leave_sub();
     return;
   }  
-  my $query = qq|SELECT curr FROM defaults|;
+  $query = qq|SELECT curr FROM defaults|;
 
   my ($currency) = selectrow_query($self, $dbh, $query);
   my ($defaultcurrency) = split m/:/, $currency;
 
   my ($currency) = selectrow_query($self, $dbh, $query);
   my ($defaultcurrency) = split m/:/, $currency;
@@ -1211,7 +1228,7 @@ sub update_exchangerate {
     return;
   }
 
     return;
   }
 
-  my $query = qq|SELECT e.curr FROM exchangerate e
+  $query = qq|SELECT e.curr FROM exchangerate e
                  WHERE e.curr = ? AND e.transdate = ?
                  FOR UPDATE|;
   my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
                  WHERE e.curr = ? AND e.transdate = ?
                  FOR UPDATE|;
   my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
@@ -1276,13 +1293,14 @@ sub get_exchangerate {
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $fld) = @_;
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $fld) = @_;
+  my ($query);
 
   unless ($transdate) {
     $main::lxdebug->leave_sub();
     return 1;
   }
 
 
   unless ($transdate) {
     $main::lxdebug->leave_sub();
     return 1;
   }
 
-  my $query = qq|SELECT curr FROM defaults|;
+  $query = qq|SELECT curr FROM defaults|;
 
   my ($currency) = selectrow_query($self, $dbh, $query);
   my ($defaultcurrency) = split m/:/, $currency;
 
   my ($currency) = selectrow_query($self, $dbh, $query);
   my ($defaultcurrency) = split m/:/, $currency;
@@ -1292,7 +1310,7 @@ sub get_exchangerate {
     return 1;
   }
 
     return 1;
   }
 
-  my $query = qq|SELECT e.$fld FROM exchangerate e
+  $query = qq|SELECT e.$fld FROM exchangerate e
                  WHERE e.curr = ? AND e.transdate = ?|;
   my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
 
                  WHERE e.curr = ? AND e.transdate = ?|;
   my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
 
@@ -1853,11 +1871,12 @@ $main::lxdebug->enter_sub();
 sub _get_customers {
   $main::lxdebug->enter_sub();
 
 sub _get_customers {
   $main::lxdebug->enter_sub();
 
-  my ($self, $dbh, $key) = @_;
+  my ($self, $dbh, $key, $limit) = @_;
 
   $key = "all_customers" unless ($key);
 
   $key = "all_customers" unless ($key);
+  $limit_clause = "LIMIT $limit" if $limit;
 
 
-  my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name|;
+  my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|;
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
@@ -1973,11 +1992,19 @@ sub get_lists {
   }
   
   if($params{"customers"}) {
   }
   
   if($params{"customers"}) {
-    $self->_get_customers($dbh, $params{"customers"});
+    if (ref $params{"customers"} eq 'HASH') {
+      $self->_get_customers($dbh, $params{"customers"}{key}, $params{"customers"}{limit});
+    } else {
+      $self->_get_customers($dbh, $params{"customers"});
+    }
   }
   
   if($params{"vendors"}) {
   }
   
   if($params{"vendors"}) {
-    $self->_get_vendors($dbh, $params{"vendors"});
+    if (ref $params{"vendors"} eq 'HASH') {
+      $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
+    } else {
+      $self->_get_vendors($dbh, $params{"vendors"});
+    }
   }
   
   if($params{"payments"}) {
   }
   
   if($params{"payments"}) {
@@ -2229,7 +2256,7 @@ sub create_links {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
-        if ($key =~ /$module/) {
+        if ($key =~ /\Q$module\E/) {
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
@@ -2288,7 +2315,7 @@ sub create_links {
                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
                 WHERE c.link LIKE ?
                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
                 WHERE c.link LIKE ?
                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
-                    OR c.link LIKE '%_tax%')
+                    OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
                 ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
                 ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
@@ -2298,7 +2325,7 @@ sub create_links {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
-        if ($key =~ /$module/) {
+        if ($key =~ /\Q$module\E/) {
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
@@ -2488,8 +2515,7 @@ sub redo_rows {
 
   my @ndx = ();
 
 
   my @ndx = ();
 
-  map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } }
-    (1 .. $count);
+  map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
 
   my $i = 0;
 
 
   my $i = 0;
 
@@ -2530,8 +2556,8 @@ sub update_status {
   }
   $sth->finish();
 
   }
   $sth->finish();
 
-  my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0";
-  my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0";
+  my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
+  my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
 
   my %queued = split / /, $self->{queued};
   my @values;
 
   my %queued = split / /, $self->{queued};
   my @values;
@@ -2575,7 +2601,7 @@ sub save_status {
   my $formnames  = $self->{printed};
   my $emailforms = $self->{emailed};
 
   my $formnames  = $self->{printed};
   my $emailforms = $self->{emailed};
 
-  my $query = qq|DELETE FROM status
+  $query = qq|DELETE FROM status
                  WHERE (formname = ?) AND (trans_id = ?)|;
   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
 
                  WHERE (formname = ?) AND (trans_id = ?)|;
   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
 
@@ -2586,15 +2612,15 @@ sub save_status {
     my %queued = split / /, $self->{queued};
 
     foreach my $formname (keys %queued) {
     my %queued = split / /, $self->{queued};
 
     foreach my $formname (keys %queued) {
-      $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0";
-      $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0";
+      $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
+      $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
 
       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
                   VALUES (?, ?, ?, ?, ?)|;
       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
 
 
       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
                   VALUES (?, ?, ?, ?, ?)|;
       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
 
-      $formnames  =~ s/$self->{formname}//;
-      $emailforms =~ s/$self->{formname}//;
+      $formnames  =~ s/\Q$self->{formname}\E//;
+      $emailforms =~ s/\Q$self->{formname}\E//;
 
     }
   }
 
     }
   }
@@ -2608,8 +2634,8 @@ sub save_status {
   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
 
   foreach my $formname (keys %status) {
   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
 
   foreach my $formname (keys %status) {
-    $printed = ($formnames  =~ /$self->{formname}/) ? "1" : "0";
-    $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0";
+    $printed = ($formnames  =~ /\Q$self->{formname}\E/) ? "1" : "0";
+    $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
 
     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
                 VALUES (?, ?, ?, ?)|;
 
     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
                 VALUES (?, ?, ?, ?)|;
Unnamed repository; edit this file 'description' to name the repository.