X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/7bd555b62a7501d750d7989b75b46a40c5e7c1a3..85ffde7a577589762b70de99ca08b6f25e9e9d1b:/SL/Form.pm diff --git a/SL/Form.pm b/SL/Form.pm index cfffd78e2..f3fe6e5d9 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -56,7 +56,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; @@ -243,38 +243,33 @@ sub new { tie %{ $self }, 'SL::Watchdog'; } - read(STDIN, $_, $ENV{CONTENT_LENGTH}); + bless $self, $type; - if ($ENV{QUERY_STRING}) { - $_ = $ENV{QUERY_STRING}; - } + $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; + $self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0]; - if ($ARGV[0]) { - $_ = $ARGV[0]; + if ($ENV{CONTENT_LENGTH}) { + my $content; + read STDIN, $content, $ENV{CONTENT_LENGTH}; + $self->_request_to_hash($content); } - bless $self, $type; - - $self->_request_to_hash($_); - my $db_charset = $main::dbcharset; $db_charset ||= Common::DEFAULT_CHARSET; - if ($self->{INPUT_ENCODING}) { - if (lc $self->{INPUT_ENCODING} ne lc $db_charset) { - require Text::Iconv; - my $iconv = Text::Iconv->new($self->{INPUT_ENCODING}, $db_charset); + my $encoding = $self->{INPUT_ENCODING} || $db_charset; + delete $self->{INPUT_ENCODING}; - _recode_recursively($iconv, $self); - } - - delete $self->{INPUT_ENCODING}; - } + _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self); $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} = ; + 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(); @@ -475,13 +470,22 @@ sub info { if (!$self->{header}) { $self->header; - print qq| - |; + print qq||; } print qq| +

$msg

$msg + + + |; } else { @@ -558,6 +562,20 @@ sub _get_request_uri { return $uri; } +sub _add_to_request_uri { + my $self = shift; + + my $relative_new_path = shift; + my $request_uri = shift || $self->_get_request_uri; + my $relative_new_uri = URI->new($relative_new_path); + my @request_segments = $request_uri->path_segments; + + my $new_uri = $request_uri->clone; + $new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments); + + return $new_uri; +} + sub create_http_response { $main::lxdebug->enter_sub(); @@ -654,6 +672,20 @@ sub header { | 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) { @@ -689,13 +721,12 @@ sub header { $favicon $jsscript $ajax - $fokus + $title_hack -