X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=2dcd31f7c386b269e2c05ac53757ce8008f40f61;hb=a6bf2bd692fbf38495d46aa326d573703af3bdbd;hp=f3fe6e5d9b49de814da4b2c0251c812a50b7b66b;hpb=6f2893dcf199d5e5147cc2020c2ab6984f4274dc;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index f3fe6e5d9..2dcd31f7c 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -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; @@ -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} = ; @@ -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,120 +615,72 @@ 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, ""; + } + + 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}; - 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 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| - | 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} - - + # 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 - + $title_hack + -|; - } - $self->{header} = 1; +EOT - $main::lxdebug->leave_sub(); + $::lxdebug->leave_sub; } sub ajax_response_header { @@ -812,9 +763,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|
$info
|); + my $info = "Web page template '${file}' not found.\n"; + print qq|
$info
|; ::end_of_request(); } @@ -837,13 +787,16 @@ sub _prepare_html_template { 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; @@ -1246,7 +1199,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'; @@ -1422,7 +1375,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'), @@ -1430,7 +1382,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'), @@ -1630,7 +1581,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); @@ -3273,7 +3224,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') @@ -3566,9 +3516,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. @@ -3623,7 +3571,7 @@ supported key structures are: filter.status[] => $form->{status}->[ val1, val2, ... ] -=item update_business PARAMS +=head2 C PARAMS PARAMS (not named): \%config, - config hashref @@ -3635,7 +3583,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 $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 @@ -3649,6 +3597,45 @@ Examples: print $::form->redirect_header('oe.pl?action=edit&id=1234'); print $::form->redirect_header('http://www.lx-office.org/'); +=head2 C
+ +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