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 fd83eb261ce42456a0541fab9140122efc915718..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 List::Util qw(max min sum);
  
  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;
  
-      undef $name, $filename;
+      undef $name;
+      undef $filename;
  
        $headers_done   = 0;
        $content_type   = "text/plain";
@@ -331,20 +333,17 @@ sub info {
    $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();
-
    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();
-
-  return ($rows > $maxrows) ? $maxrows : $rows;
+  return min $rows, $maxrows;
  }
  
  sub dberror {
@@ -381,6 +380,12 @@ sub header {
    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}";
  
@@ -434,7 +439,7 @@ sub header {
      }
      print qq|Content-Type: text/html; charset=${db_charset};
  
-<html>
+${doctype}<html>
  <head>
    <title>$self->{titlebar}</title>
    $stylesheet
@@ -586,6 +591,7 @@ sub parse_html_template2 {
                                   'EVAL_PERL'   => 0,
                                   'ABSOLUTE'    => 1,
                                   'CACHE_SIZE'  => 0,
+                                 'PLUGIN_BASE' => 'SL::Template::Plugin',
                                 }) || die;
  
    map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
@@ -1205,13 +1211,13 @@ sub update_exchangerate {
    $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;
    }  
-  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;
@@ -1222,7 +1228,7 @@ sub update_exchangerate {
      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);
@@ -1287,13 +1293,14 @@ sub get_exchangerate {
    $main::lxdebug->enter_sub();
  
    my ($self, $dbh, $curr, $transdate, $fld) = @_;
+  my ($query);
  
    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;
@@ -1303,7 +1310,7 @@ sub get_exchangerate {
      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);
  
@@ -1864,11 +1871,12 @@ $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);
+  $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);
  
@@ -1984,11 +1992,19 @@ sub get_lists {
    }
    
    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"}) {
-    $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"}) {
@@ -2499,8 +2515,7 @@ sub redo_rows {
  
    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;
  
@@ -2586,7 +2601,7 @@ sub save_status {
    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});