Merge branch 'master' into rb-wiederkehrende-rechnungen
[kivitendo-erp.git] / SL / Form.pm
index fad6e8e..e1646e6 100644 (file)
@@ -42,11 +42,13 @@ use Data::Dumper;
 use CGI;
 use CGI::Ajax;
 use Cwd;
+use Encode;
 use IO::File;
 use SL::Auth;
 use SL::Auth::DB;
 use SL::Auth::LDAP;
 use SL::AM;
+use SL::DB;
 use SL::Common;
 use SL::DBUtils;
 use SL::Mailer;
@@ -56,7 +58,7 @@ use SL::User;
 use Template;
 use URI;
 use List::Util qw(first max min sum);
-use List::MoreUtils qw(any);
+use List::MoreUtils qw(any apply);
 
 use strict;
 
@@ -262,9 +264,6 @@ sub new {
 
   _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
 
-  $self->{action}  =  lc $self->{action};
-  $self->{action}  =~ s/( |-|,|\#)/_/g;
-
   #$self->{version} =  "2.6.1";                 # Old hardcoded but secure style
   open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
   $self->{version} =  <VERSION_FILE>;
@@ -379,6 +378,7 @@ sub escape {
 
   my ($self, $str) = @_;
 
+  $str =  Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
   $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
 
   $main::lxdebug->leave_sub(2);
@@ -592,20 +592,21 @@ sub create_http_response {
     pop @segments;
     $uri->path_segments(@segments);
 
-    my $session_cookie_value   = $main::auth->get_session_id();
-    $session_cookie_value    ||= 'NO_SESSION';
+    my $session_cookie_value = $main::auth->get_session_id();
 
-    $session_cookie = $cgi->cookie('-name'   => $main::auth->get_session_cookie_name(),
-                                   '-value'  => $session_cookie_value,
-                                   '-path'   => $uri->path,
-                                   '-secure' => $ENV{HTTPS});
+    if ($session_cookie_value) {
+      $session_cookie = $cgi->cookie('-name'   => $main::auth->get_session_cookie_name(),
+                                     '-value'  => $session_cookie_value,
+                                     '-path'   => $uri->path,
+                                     '-secure' => $ENV{HTTPS});
+    }
   }
 
   my %cgi_params = ('-type' => $params{content_type});
   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
+  $cgi_params{'-cookie'}  = $session_cookie  if ($session_cookie);
 
-  my $output = $cgi->header('-cookie' => $session_cookie,
-                            %cgi_params);
+  my $output = $cgi->header(%cgi_params);
 
   $main::lxdebug->leave_sub();
 
@@ -614,121 +615,71 @@ sub create_http_response {
 
 
 sub header {
-  $main::lxdebug->enter_sub();
+  $::lxdebug->enter_sub;
 
-  # extra code ist currently only used by menuv3 and menuv4 to set their css.
+  # extra code is currently only used by menuv3 and menuv4 to set their css.
   # it is strongly deprecated, and will be changed in a future version.
   my ($self, $extra_code) = @_;
+  my $db_charset = $::dbcharset || Common::DEFAULT_CHARSET;
+  my @header;
+
+  $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
+
+  $self->{favicon} ||= "favicon.ico";
+  $self->{titlebar}  = "$self->{title} - $self->{titlebar}" if $self->{title};
+
+  # build includes
+  if ($self->{refresh_url} || $self->{refresh_time}) {
+    my $refresh_time = $self->{refresh_time} || 3;
+    my $refresh_url  = $self->{refresh_url}  || $ENV{REFERER};
+    push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
+  }
+
+  push @header, "<link rel='stylesheet' href='css/$_' type='text/css' title='Lx-Office stylesheet'>"
+    for grep { -f "css/$_" } apply { s|.*/|| } $self->{stylesheet}, $self->{stylesheets};
+
+  push @header, "<style type='text/css'>\@page { size:landscape; }</style>" if $self->{landscape};
+  push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>" if -f $self->{favicon};
+  push @header, '<script type="text/javascript" src="js/jquery.js"></script>',
+                '<script type="text/javascript" src="js/common.js"></script>',
+                '<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/part_selection.js"></script>';
+  push @header, $self->{javascript} if $self->{javascript};
+  push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
+  push @header, "<script type='text/javascript'>function fokus(){ document.$self->{fokus}.focus(); }</script>" if $self->{fokus};
+  push @header, sprintf "<script type='text/javascript'>top.document.title='%s';</script>",
+    join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title};
 
-  if ($self->{header}) {
-    $main::lxdebug->leave_sub();
-    return;
-  }
-
-  my ($stylesheet, $favicon, $pagelayout);
-
-  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}";
-
-    $stylesheets =~ s|^\s*||;
-    $stylesheets =~ s|\s*$||;
-    foreach my $file (split m/\s+/, $stylesheets) {
-      $file =~ s|.*/||;
-      next if (! -f "css/$file");
-
-      $stylesheet .= qq|<link rel="stylesheet" href="css/$file" TYPE="text/css" TITLE="Lx-Office stylesheet">\n|;
-    }
-
-    $self->{favicon}    = "favicon.ico" unless $self->{favicon};
-
-    if ($self->{favicon} && (-f "$self->{favicon}")) {
-      $favicon =
-        qq|<LINK REL="shortcut icon" HREF="$self->{favicon}" TYPE="image/x-icon">
-  |;
-    }
-
-    my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
-
-    if ($self->{landscape}) {
-      $pagelayout = qq|<style type="text/css">
-                        \@page { size:landscape; }
-                        </style>|;
-    }
-
-    my $fokus = qq|
+  # if there is a title, we put some JavaScript in to the page, wich writes a
+  # meaningful title-tag for our frameset.
+  my $title_hack = '';
+  if ($self->{title}) {
+    $title_hack = qq|
     <script type="text/javascript">
     <!--
-      function fokus() {
-        document.$self->{fokus}.focus();
-      }
+      // Write a meaningful title-tag for our frameset.
+      top.document.title="| . $self->{"title"} . qq| - | . $self->{"login"} . qq| - | . $::myconfig{dbname} . qq| - V| . $self->{"version"} . qq|";
     //-->
-    </script>
-    | if $self->{"fokus"};
-
-  # if there is a title, we put some JavaScript in to the page, wich writes a
-  # meaningful title-tag for our frameset.
-    my $title_hack;
-    if ($self->{"title"}){
-               $title_hack = qq|
-               <script type="text/javascript">
-               <!--
-                 // Write a meaningful title-tag for our frameset.
-                 top.document.title="| . $self->{"title"} . qq| - | . $self->{"login"} . qq| - | . $::myconfig{dbname} . qq| - V| . $self->{"version"} . qq|";
-               //-->
-               </script>
-               |;
-       }
-
-    #Set Calendar
-    my $jsscript = "";
-    if ($self->{jsscript} == 1) {
-
-      $jsscript = qq|
-        <script type="text/javascript" src="js/jquery.js"></script>
-        <script type="text/javascript" src="js/common.js"></script>
-        <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>
-        $self->{javascript}
-       |;
-    }
-
-    $self->{titlebar} =
-      ($self->{title})
-      ? "$self->{title} - $self->{titlebar}"
-      : $self->{titlebar};
-    my $ajax = "";
-    for my $item (@ { $self->{AJAX} || [] }) {
-      $ajax .= $item->show_javascript();
-    }
+    </script>|;
+  }
 
-    print $self->create_http_response('content_type' => 'text/html',
-                                      'charset'      => $db_charset,);
-    print qq|${doctype}<html>
-<head>
-  <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=${db_charset}">
+  # output
+  print $self->create_http_response(content_type => 'text/html', charset => $db_charset);
+  print "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.01//EN' 'http://www.w3.org/TR/html4/strict.dtd'>\n"
+    if  $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/; # Other browsers may choke on menu scripts with DOCTYPE.
+  print <<EOT;
+<html>
+ <head>
+  <meta http-equiv="Content-Type" content="text/html; charset=$db_charset">
   <title>$self->{titlebar}</title>
-  $stylesheet
-  $pagelayout
-  $favicon
-  $jsscript
-  $ajax
-  $fokus
-  $title_hack
-
+EOT
+  print "  $_\n" for @header;
+  print <<EOT;
   <link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
-
   <meta name="robots" content="noindex,nofollow" />
-  <script type="text/javascript" src="js/highlight_input.js"></script>
-
   <link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
   <script type="text/javascript" src="js/tabcontent.js">
 
@@ -739,15 +690,13 @@ sub header {
    ***********************************************/
 
   </script>
-
   $extra_code
-</head>
+  $title_hack
+ </head>
 
-|;
-  }
-  $self->{header} = 1;
+EOT
 
-  $main::lxdebug->leave_sub();
+  $::lxdebug->leave_sub;
 }
 
 sub ajax_response_header {
@@ -813,9 +762,8 @@ sub _prepare_html_template {
     $file = "templates/webpages/${file}.html";
 
   } else {
-    my $info = "Web page template '${file}' not found.\n" .
-      "Please re-run 'locales.pl' in 'locale/${language}'.";
-    print(qq|<pre>$info</pre>|);
+    my $info = "Web page template '${file}' not found.\n";
+    print qq|<pre>$info</pre>|;
     ::end_of_request();
   }
 
@@ -829,22 +777,25 @@ sub _prepare_html_template {
   }
 
   if (%main::myconfig) {
-    map({ $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys(%main::myconfig));
-    my $jsc_dateformat = $main::myconfig{"dateformat"};
-    $jsc_dateformat =~ s/d+/\%d/gi;
-    $jsc_dateformat =~ s/m+/\%m/gi;
-    $jsc_dateformat =~ s/y+/\%Y/gi;
-    $additional_params->{"myconfig_jsc_dateformat"} = $jsc_dateformat;
+    $::myconfig{jsc_dateformat} = apply {
+      s/d+/\%d/gi;
+      s/m+/\%m/gi;
+      s/y+/\%Y/gi;
+    } $::myconfig{"dateformat"};
     $additional_params->{"myconfig"} ||= \%::myconfig;
+    map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
   }
 
-  $additional_params->{"conf_dbcharset"}              = $main::dbcharset;
-  $additional_params->{"conf_webdav"}                 = $main::webdav;
-  $additional_params->{"conf_lizenzen"}               = $main::lizenzen;
-  $additional_params->{"conf_latex_templates"}        = $main::latex;
-  $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates;
-  $additional_params->{"conf_vertreter"}              = $main::vertreter;
-  $additional_params->{"conf_show_best_before"}       = $main::show_best_before;
+  $additional_params->{"conf_dbcharset"}              = $::dbcharset;
+  $additional_params->{"conf_webdav"}                 = $::webdav;
+  $additional_params->{"conf_lizenzen"}               = $::lizenzen;
+  $additional_params->{"conf_latex_templates"}        = $::latex;
+  $additional_params->{"conf_opendocument_templates"} = $::opendocument_templates;
+  $additional_params->{"conf_vertreter"}              = $::vertreter;
+  $additional_params->{"conf_show_best_before"}       = $::show_best_before;
+  $additional_params->{"conf_parts_image_css"}        = $::parts_image_css;
+  $additional_params->{"conf_parts_listing_images"}   = $::parts_listing_images;
+  $additional_params->{"conf_parts_show_image"}       = $::parts_show_image;
 
   if (%main::debug_options) {
     map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
@@ -1247,7 +1198,7 @@ sub parse_template {
     $ext_for_format = 'xml';
 
   } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
-    $template_type = 'xml';
+    $template_type = 'XML';
 
   } elsif ( $self->{"format"} =~ /excel/i ) {
     $template_type  = 'Excel';
@@ -1423,7 +1374,6 @@ sub get_formname_translation {
     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'),
@@ -1431,7 +1381,6 @@ sub get_formname_translation {
     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'),
     sales_delivery_order    => $main::locale->text('Delivery Order'),
     purchase_delivery_order => $main::locale->text('Delivery Order'),
     dunning                 => $main::locale->text('Dunning'),
@@ -1631,7 +1580,7 @@ sub get_standard_dbh {
     undef $standard_dbh;
   }
 
-  $standard_dbh ||= $self->dbconnect_noauto($myconfig);
+  $standard_dbh ||= SL::DB::create->dbh;
 
   $main::lxdebug->leave_sub(2);
 
@@ -2019,7 +1968,7 @@ sub add_shipto {
   my @values;
 
   foreach my $item (qw(name department_1 department_2 street zipcode city country
-                       contact phone fax email)) {
+                       contact cp_gender phone fax email)) {
     if ($self->{"shipto$item"}) {
       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
     }
@@ -2037,6 +1986,7 @@ sub add_shipto {
                        shiptocity = ?,
                        shiptocountry = ?,
                        shiptocontact = ?,
+                       shiptocp_gender = ?,
                        shiptophone = ?,
                        shiptofax = ?,
                        shiptoemail = ?
@@ -2052,6 +2002,7 @@ sub add_shipto {
                        shiptocity = ? AND
                        shiptocountry = ? AND
                        shiptocontact = ? AND
+                       shiptocp_gender = ? AND
                        shiptophone = ? AND
                        shiptofax = ? AND
                        shiptoemail = ? AND
@@ -2062,8 +2013,8 @@ sub add_shipto {
         $query =
           qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
                                  shiptostreet, shiptozipcode, shiptocity, shiptocountry,
-                                 shiptocontact, shiptophone, shiptofax, shiptoemail, module)
-             VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
+                                 shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module)
+             VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
         do_query($self, $dbh, $query, $id, @values, $module);
       }
     }
@@ -3272,7 +3223,6 @@ sub save_status {
 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('sales_order')
-# $main::locale->text('packing_list')
 # $main::locale->text('pick_list')
 # $main::locale->text('purchase_order')
 # $main::locale->text('bin_list')
@@ -3565,9 +3515,7 @@ Points of interest for a beginner are:
 
 =head1 SPECIAL FUNCTIONS
 
-=over 4
-
-=item _store_value()
+=head2 C<_store_value()>
 
 parses a complex var name, and stores it in the form.
 
@@ -3622,7 +3570,7 @@ supported key structures are:
 
   filter.status[]  => $form->{status}->[ val1, val2, ... ]
 
-=item update_business PARAMS
+=head2 C<update_business> PARAMS
 
 PARAMS (not named):
  \%config,     - config hashref
@@ -3634,7 +3582,7 @@ handles business (thats customer/vendor types) sequences.
 special behaviour for empty strings in customerinitnumber field:
 will in this case not increase the value, and return undef.
 
-=item redirect_header $url
+=head2 C<redirect_header> $url
 
 Generates a HTTP redirection header for the new C<$url>. Constructs an
 absolute URL including scheme, host name and port. If C<$url> is a
@@ -3648,6 +3596,45 @@ Examples:
   print $::form->redirect_header('oe.pl?action=edit&id=1234');
   print $::form->redirect_header('http://www.lx-office.org/');
 
+=head2 C<header>
+
+Generates a general purpose http/html header and includes most of the scripts
+ans stylesheets needed.
+
+Only one header will be generated. If the method was already called in this
+request it will not output anything and return undef. Also if no
+HTTP_USER_AGENT is found, no header is generated.
+
+Although header does not accept parameters itself, it will honor special
+hashkeys of its Form instance:
+
+=over 4
+
+=item refresh_time
+
+=item refresh_url
+
+If one of these is set, a http-equiv refresh is generated. Missing parameters
+default to 3 seconds and the refering url.
+
+=item stylesheet
+
+=item stylesheets
+
+If these are arrayrefs the contents will be inlined into the header.
+
+=item landscape
+
+If true, a css snippet will be generated that sets the page in landscape mode.
+
+=item favicon
+
+Used to override the default favicon.
+
+=item title
+
+A html page title will be generated from this
+
 =back
 
 =cut