X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/6cf3f7762efd40bee49a2b8f11bb4ab6915d9071..50365526:/SL/Form.pm diff --git a/SL/Form.pm b/SL/Form.pm index 2647cec37..4360c0740 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -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; @@ -268,7 +269,7 @@ sub new { #$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} = ; - close 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(); @@ -379,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); @@ -475,7 +477,7 @@ sub info { print qq|

$msg

- + - + |; @@ -614,121 +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|\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|\n|; - } - - $self->{favicon} = "favicon.ico" unless $self->{favicon}; - - if ($self->{favicon} && (-f "$self->{favicon}")) { - $favicon = - qq| - |; - } - - my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET; - - if ($self->{landscape}) { - $pagelayout = qq||; - } - - my $fokus = qq| - - | 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| - - |; - } - - #Set Calendar - my $jsscript = ""; - if ($self->{jsscript} == 1) { - - $jsscript = qq| - - - - - - - $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} - - + 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, ""; + } + + push @header, "" + for grep { -f "css/$_" } apply { s|.*/|| } $self->{stylesheet}, $self->{stylesheets}; + + push @header, "" if $self->{landscape}; + push @header, "" if -f $self->{favicon}; + push @header, '', + '', + '', + '', + '', + '', + ''; + push @header, $self->{javascript} if $self->{javascript}; + push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] }; + push @header, "" if $self->{fokus}; + push @header, sprintf "", + 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 "\n" + if $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/; # Other browsers may choke on menu scripts with DOCTYPE. + print < + + $self->{titlebar} - $stylesheet - $pagelayout - $favicon - $jsscript - $ajax - $fokus - $title_hack - +EOT + print " $_\n" for @header; + print < - - - $extra_code - + -|; - } - $self->{header} = 1; +EOT - $main::lxdebug->leave_sub(); + $::lxdebug->leave_sub; } sub ajax_response_header { @@ -829,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; @@ -2019,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"}); } @@ -2037,6 +1974,7 @@ sub add_shipto { shiptocity = ?, shiptocountry = ?, shiptocontact = ?, + shiptocp_gender = ?, shiptophone = ?, shiptofax = ?, shiptoemail = ? @@ -2052,6 +1990,7 @@ sub add_shipto { shiptocity = ? AND shiptocountry = ? AND shiptocontact = ? AND + shiptocp_gender = ? AND shiptophone = ? AND shiptofax = ? AND shiptoemail = ? AND @@ -2062,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); } }