]> wagnertech.de Git - mfinanz.git/blobdiff - SL/Form.pm
Form::header
[mfinanz.git] / SL / Form.pm
index cab29d426e999fc530e7d6e0ea524bffafb8d657..4360c07402a7bf8efaab0ffbd610e76ce0ae0119 100644 (file)
@@ -42,6 +42,7 @@ use Data::Dumper;
 use CGI;
 use CGI::Ajax;
 use Cwd;
+use Encode;
 use IO::File;
 use SL::Auth;
 use SL::Auth::DB;
@@ -56,7 +57,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;
 
@@ -265,7 +266,11 @@ sub new {
   $self->{action}  =  lc $self->{action};
   $self->{action}  =~ s/( |-|,|\#)/_/g;
 
-  $self->{version} =  "2.6.1";
+  #$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>;
+  close VERSION_FILE;
+  $self->{version}  =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code.
 
   $main::lxdebug->leave_sub();
 
@@ -375,6 +380,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);
@@ -466,13 +472,22 @@ sub info {
 
     if (!$self->{header}) {
       $self->header;
-      print qq|
-      <body>|;
+      print qq|<body>|;
     }
 
     print qq|
+    <p class="message_ok"><b>$msg</b></p>
 
-    <p><b>$msg</b>
+    <script type="text/javascript">
+    <!--
+    // If JavaScript is enabled, the whole thing will be reloaded.
+    // The reason is: When one changes his menu setup (HTML / XUL / CSS ...)
+    // it now loads the correct code into the browser instead of do nothing.
+    setTimeout("top.frames.location.href='login.pl'",500);
+    //-->
+    </script>
+
+</body>
     |;
 
   } else {
@@ -601,107 +616,59 @@ 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) = @_;
-
-  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|
-    <script type="text/javascript">
-    <!--
-      function fokus() {
-        document.$self->{fokus}.focus();
-      }
-    //-->
-    </script>
-    | if $self->{"fokus"};
-
-    #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();
-    }
-
-    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}">
+  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};
+
+  # 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
-
+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">
 
@@ -712,15 +679,12 @@ sub header {
    ***********************************************/
 
   </script>
-
   $extra_code
-</head>
+ </head>
 
-|;
-  }
-  $self->{header} = 1;
+EOT
 
-  $main::lxdebug->leave_sub();
+  $::lxdebug->leave_sub;
 }
 
 sub ajax_response_header {
@@ -802,13 +766,13 @@ 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;
@@ -1992,7 +1956,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"});
     }
@@ -2010,6 +1974,7 @@ sub add_shipto {
                        shiptocity = ?,
                        shiptocountry = ?,
                        shiptocontact = ?,
+                       shiptocp_gender = ?,
                        shiptophone = ?,
                        shiptofax = ?,
                        shiptoemail = ?
@@ -2025,6 +1990,7 @@ sub add_shipto {
                        shiptocity = ? AND
                        shiptocountry = ? AND
                        shiptocontact = ? AND
+                       shiptocp_gender = ? AND
                        shiptophone = ? AND
                        shiptofax = ? AND
                        shiptoemail = ? AND
@@ -2035,8 +2001,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);
       }
     }