X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=bed92e21711858c0d8c82533a86db6c9ee196cca;hb=ce83fab980b72a2b3d4066ce2b49cbf3feec56a5;hp=bdb9036d2bed8acccac8e6f15dab33b2c8cd3924;hpb=79855851df86588c54007f07b2e9222e92bb816a;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index bdb9036d2..8d28f845b 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -40,24 +40,35 @@ package Form; use Data::Dumper; use CGI; -use CGI::Ajax; use Cwd; use Encode; +use File::Copy; use IO::File; use SL::Auth; use SL::Auth::DB; use SL::Auth::LDAP; use SL::AM; use SL::Common; +use SL::CVar; +use SL::DB; +use SL::DBConnect; use SL::DBUtils; +use SL::DO; +use SL::IC; +use SL::IS; +use SL::Locale; use SL::Mailer; use SL::Menu; +use SL::MoreCommon qw(uri_encode uri_decode); +use SL::OE; +use SL::Request; use SL::Template; use SL::User; +use SL::X; use Template; use URI; use List::Util qw(first max min sum); -use List::MoreUtils qw(any apply); +use List::MoreUtils qw(all any apply); use strict; @@ -73,165 +84,6 @@ sub disconnect_standard_dbh { undef $standard_dbh; } -sub _store_value { - $main::lxdebug->enter_sub(2); - - my $self = shift; - my $key = shift; - my $value = shift; - - my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key; - - my $curr; - - if (scalar @tokens) { - $curr = \ $self->{ shift @tokens }; - } - - while (@tokens) { - my $sep = shift @tokens; - my $key = shift @tokens; - - $curr = \ $$curr->[++$#$$curr], next if $sep eq '[]'; - $curr = \ $$curr->[max 0, $#$$curr] if $sep eq '[].'; - $curr = \ $$curr->[++$#$$curr] if $sep eq '[+].'; - $curr = \ $$curr->{$key} - } - - $$curr = $value; - - $main::lxdebug->leave_sub(2); - - return $curr; -} - -sub _input_to_hash { - $main::lxdebug->enter_sub(2); - - my $self = shift; - my $input = shift; - - my @pairs = split(/&/, $input); - - foreach (@pairs) { - my ($key, $value) = split(/=/, $_, 2); - $self->_store_value($self->unescape($key), $self->unescape($value)) if ($key); - } - - $main::lxdebug->leave_sub(2); -} - -sub _request_to_hash { - $main::lxdebug->enter_sub(2); - - my $self = shift; - my $input = shift; - - if (!$ENV{'CONTENT_TYPE'} - || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { - - $self->_input_to_hash($input); - - $main::lxdebug->leave_sub(2); - return; - } - - my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous); - - my $boundary = '--' . $1; - - foreach my $line (split m/\n/, $input) { - last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r")); - - if (($line eq $boundary) || ($line eq "$boundary\r")) { - ${ $previous } =~ s|\r?\n$|| if $previous; - - undef $previous; - undef $filename; - - $headers_done = 0; - $content_type = "text/plain"; - $boundary_found = 1; - $need_cr = 0; - - next; - } - - next unless $boundary_found; - - if (!$headers_done) { - $line =~ s/[\r\n]*$//; - - if (!$line) { - $headers_done = 1; - next; - } - - if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) { - if ($line =~ m|filename\s*=\s*"(.*?)"|i) { - $filename = $1; - substr $line, $-[0], $+[0] - $-[0], ""; - } - - if ($line =~ m|name\s*=\s*"(.*?)"|i) { - $name = $1; - substr $line, $-[0], $+[0] - $-[0], ""; - } - - $previous = $self->_store_value($name, '') if ($name); - $self->{FILENAME} = $filename if ($filename); - - next; - } - - if ($line =~ m|^content-type\s*:\s*(.*?)$|i) { - $content_type = $1; - } - - next; - } - - next unless $previous; - - ${ $previous } .= "${line}\n"; - } - - ${ $previous } =~ s|\r?\n$|| if $previous; - - $main::lxdebug->leave_sub(2); -} - -sub _recode_recursively { - $main::lxdebug->enter_sub(); - my ($iconv, $param) = @_; - - if (any { ref $param eq $_ } qw(Form HASH)) { - foreach my $key (keys %{ $param }) { - if (!ref $param->{$key}) { - # Workaround for a bug: converting $param->{$key} directly - # leads to 'undef'. I don't know why. Converting a copy works, - # though. - $param->{$key} = $iconv->convert("" . $param->{$key}); - } else { - _recode_recursively($iconv, $param->{$key}); - } - } - - } elsif (ref $param eq 'ARRAY') { - foreach my $idx (0 .. scalar(@{ $param }) - 1) { - if (!ref $param->[$idx]) { - # Workaround for a bug: converting $param->[$idx] directly - # leads to 'undef'. I don't know why. Converting a copy works, - # though. - $param->[$idx] = $iconv->convert("" . $param->[$idx]); - } else { - _recode_recursively($iconv, $param->[$idx]); - } - } - } - $main::lxdebug->leave_sub(); -} - sub new { $main::lxdebug->enter_sub(); @@ -239,6 +91,7 @@ sub new { my $self = {}; + no warnings 'once'; if ($LXDebug::watch_form) { require SL::Watchdog; tie %{ $self }, 'SL::Watchdog'; @@ -246,27 +99,6 @@ sub new { bless $self, $type; - $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; - $self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0]; - - if ($ENV{CONTENT_LENGTH}) { - my $content; - read STDIN, $content, $ENV{CONTENT_LENGTH}; - $self->_request_to_hash($content); - } - - my $db_charset = $main::dbcharset; - $db_charset ||= Common::DEFAULT_CHARSET; - - my $encoding = $self->{INPUT_ENCODING} || $db_charset; - 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"; # Old hardcoded but secure style open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file $self->{version} = ; close VERSION_FILE; @@ -277,6 +109,11 @@ sub new { return $self; } +sub read_cgi_input { + my ($self) = @_; + SL::Request::read_cgi_input($self); +} + sub _flatten_variables_rec { $main::lxdebug->enter_sub(2); @@ -376,31 +213,15 @@ sub dumper { } sub escape { - $main::lxdebug->enter_sub(2); - 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); - - return $str; + return uri_encode($str); } sub unescape { - $main::lxdebug->enter_sub(2); - my ($self, $str) = @_; - $str =~ tr/+/ /; - $str =~ s/\\$//; - - $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; - - $main::lxdebug->leave_sub(2); - - return $str; + return uri_decode($str); } sub quote { @@ -434,23 +255,33 @@ sub hide_form { my $self = shift; if (@_) { - map({ print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_); + map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_); } else { for (sort keys %$self) { next if (($_ eq "header") || (ref($self->{$_}) ne "")); - print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); + print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } } $main::lxdebug->leave_sub(); } +sub throw_on_error { + my ($self, $code) = @_; + local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) }; + $code->(); +} + sub error { $main::lxdebug->enter_sub(); $main::lxdebug->show_backtrace(); my ($self, $msg) = @_; - if ($ENV{HTTP_USER_AGENT}) { + + if ($self->{__ERROR_HANDLER}) { + $self->{__ERROR_HANDLER}->($msg); + + } elsif ($ENV{HTTP_USER_AGENT}) { $msg =~ s/\n/
/g; $self->show_generic_error($msg); @@ -481,7 +312,7 @@ sub info { ', - '', - '', - '', - '', - '', - ''; + push @header, map { qq|| } + qw(jquery common jscalendar/calendar jscalendar/lang/calendar-de jscalendar/calendar-setup part_selection jquery-ui jqModal switchmenuframe); push @header, $self->{javascript} if $self->{javascript}; + push @header, map { qq|| } + qw(main menu tabcontent list_accounts jquery.autocomplete jquery.multiselect2side frame_header/header ui-lightness/jquery-ui-1.8.12.custom); + push @header, map { qq|| } push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] }; push @header, "" if $self->{fokus}; push @header, sprintf "", @@ -667,10 +529,15 @@ sub header { |; } + my %doctypes = ( + strict => qq||, + transitional => qq||, + frameset => qq||, + ); + # 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 $doctypes{$params{doctype} || 'transitional'}, $/; print < @@ -679,10 +546,7 @@ sub header { EOT print " $_\n" for @header; print < - - - + - $extra_code + $params{extra_code} $title_hack @@ -706,9 +570,8 @@ sub ajax_response_header { my ($self) = @_; - my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET; - my $cgi = $main::cgi || CGI->new(''); - my $output = $cgi->header('-charset' => $db_charset); + my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; + my $output = $::request->{cgi}->header('-charset' => $db_charset); $main::lxdebug->leave_sub(); @@ -722,18 +585,17 @@ sub redirect_header { my $base_uri = $self->_get_request_uri; my $new_uri = URI->new_abs($new_url, $base_uri); - die "Headers already sent" if $::self->{header}; + die "Headers already sent" if $self->{header}; $self->{header} = 1; - my $cgi = $main::cgi || CGI->new(''); - return $cgi->redirect($new_uri); + return $::request->{cgi}->redirect($new_uri); } sub set_standard_title { $::lxdebug->enter_sub; my $self = shift; - $self->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $self->{version}"; + $self->{titlebar} = "kivitendo " . $::locale->text('Version') . " $self->{version}"; $self->{titlebar} .= "- $::myconfig{name}" if $::myconfig{name}; $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name}; @@ -747,26 +609,18 @@ sub _prepare_html_template { my $language; if (!%::myconfig || !$::myconfig{"countrycode"}) { - $language = $main::language; + $language = $::lx_office_conf{system}->{language}; } else { $language = $main::myconfig{"countrycode"}; } $language = "de" unless ($language); if (-f "templates/webpages/${file}.html") { - if ((-f ".developer") && ((stat("templates/webpages/${file}.html"))[9] > (stat("locale/${language}/all"))[9])) { - my $info = "Developer information: templates/webpages/${file}.html is newer than the translation file locale/${language}/all.\n" . - "Please re-run 'locales.pl' in 'locale/${language}'."; - print(qq|
$info
|); - ::end_of_request(); - } - $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(); } @@ -789,16 +643,20 @@ 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"} = $::lx_office_conf{system}->{dbcharset}; + $additional_params->{"conf_webdav"} = $::lx_office_conf{features}->{webdav}; + $additional_params->{"conf_latex_templates"} = $::lx_office_conf{print_templates}->{latex}; + $additional_params->{"conf_opendocument_templates"} = $::lx_office_conf{print_templates}->{opendocument}; + $additional_params->{"conf_vertreter"} = $::lx_office_conf{features}->{vertreter}; + $additional_params->{"conf_show_best_before"} = $::lx_office_conf{features}->{show_best_before}; + $additional_params->{"conf_parts_image_css"} = $::lx_office_conf{features}->{parts_image_css}; + $additional_params->{"conf_parts_listing_images"} = $::lx_office_conf{features}->{parts_listing_images}; + $additional_params->{"conf_parts_show_image"} = $::lx_office_conf{features}->{parts_show_image}; + $additional_params->{"conf_payments_changeable"} = $::lx_office_conf{features}->{payments_changeable}; + $additional_params->{"INSTANCE_CONF"} = $::instance_conf; - if (%main::debug_options) { - map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options; + if (my $debug_options = $::lx_office_conf{debug}{options}) { + map { $additional_params->{'DEBUG_' . uc($_)} = $debug_options->{$_} } keys %$debug_options; } if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) { @@ -835,7 +693,7 @@ sub parse_html_template { sub init_template { my $self = shift; - return if $self->template; + return $self->template if $self->template; return $self->template(Template->new({ 'INTERPOLATE' => 0, @@ -845,7 +703,7 @@ sub init_template { 'PLUGIN_BASE' => 'SL::Template::Plugin', 'INCLUDE_PATH' => '.:templates/webpages', 'COMPILE_EXT' => '.tcc', - 'COMPILE_DIR' => $::userspath . '/templates-cache', + 'COMPILE_DIR' => $::lx_office_conf{paths}->{userspath} . '/templates-cache', })) || die; } @@ -860,6 +718,12 @@ sub show_generic_error { my ($self, $error, %params) = @_; + if ($self->{__ERROR_HANDLER}) { + $self->{__ERROR_HANDLER}->($error); + $main::lxdebug->leave_sub(); + return; + } + my $add_params = { 'title_error' => $params{title}, 'label_error' => $error, @@ -958,23 +822,30 @@ sub write_trigger { return $jsscript; } #end sub write_trigger +sub _store_redirect_info_in_session { + my ($self) = @_; + + return unless $self->{callback} =~ m:^ ( [^\?/]+ \.pl ) \? (.+) :x; + + my ($controller, $params) = ($1, $2); + my $form = { map { map { $self->unescape($_) } split /=/, $_, 2 } split m/\&/, $params }; + $self->{callback} = "${controller}?RESTORE_FORM_FROM_SESSION_ID=" . $::auth->save_form_in_session(form => $form); +} + sub redirect { $main::lxdebug->enter_sub(); my ($self, $msg) = @_; if (!$self->{callback}) { - $self->info($msg); - ::end_of_request(); - } -# my ($script, $argv) = split(/\?/, $self->{callback}, 2); -# $script =~ s|.*/||; -# $script =~ s|[^a-zA-Z0-9_\.]||g; -# exec("perl", "$script", $argv); + } else { + $self->_store_redirect_info_in_session; + print $::form->redirect_header($self->{callback}); + } - print $::form->redirect_header($self->{callback}); + ::end_of_request(); $main::lxdebug->leave_sub(); } @@ -994,6 +865,7 @@ sub format_amount { $main::lxdebug->enter_sub(2); my ($self, $myconfig, $amount, $places, $dash) = @_; + $dash ||= ''; if ($amount eq "") { $amount = 0; @@ -1010,9 +882,10 @@ sub format_amount { $amount *= 1; $places *= -1; - my ($actual_places) = ($amount =~ /\.(\d+)/); - $actual_places = length($actual_places); - $places = $actual_places > $places ? $actual_places : $places; + if ($amount =~ /\.(\d+)/) { + my $actual_places = length $1; + $places = $actual_places if $actual_places > $places; + } } } $amount = $self->round_amount($amount, $places); @@ -1024,7 +897,7 @@ sub format_amount { $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters $amount = $p[0]; - $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); + $amount .= $d[0].($p[1]||'').(0 x ($places - length ($p[1]||''))) if ($places || $p[1] ne ''); $amount = do { ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : @@ -1056,8 +929,7 @@ sub format_amount_units { return ''; } - AM->retrieve_all_units(); - my $all_units = $main::all_units; + my $all_units = AM->retrieve_all_units; if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) { $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller'); @@ -1131,7 +1003,7 @@ sub parse_amount { if ( ($myconfig->{numberformat} eq '1.000,00') || ($myconfig->{numberformat} eq '1000,00')) { $amount =~ s/\.//g; - $amount =~ s/,/\./; + $amount =~ s/,/\./g; } if ($myconfig->{numberformat} eq "1'000.00") { @@ -1142,7 +1014,9 @@ sub parse_amount { $main::lxdebug->leave_sub(2); - return ($amount * 1); + # Make sure no code wich is not a math expression ends up in eval(). + return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x; + return scalar(eval($amount)) * 1 ; } sub round_amount { @@ -1169,11 +1043,13 @@ sub round_amount { sub parse_template { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $userspath) = @_; - my $out; + my ($self, $myconfig) = @_; + my ($out, $out_mode); local (*IN, *OUT); + my $userspath = $::lx_office_conf{paths}->{userspath}; + $self->{"cwd"} = getcwd(); $self->{"tmpdir"} = $self->{cwd} . "/${userspath}"; @@ -1228,47 +1104,61 @@ sub parse_template { } map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid); + map { $self->{"myconfig_${_}"} = $myconfig->{$_} } grep { $_ ne 'dbpasswd' } keys %{ $myconfig }; $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); # OUT is used for the media, screen, printer, email # for postscript we store a copy in a temporary file - my $fileid = time; - my $prepend_userspath; - - if (!$self->{tmpfile}) { - $self->{tmpfile} = "${fileid}.$self->{IN}"; - $prepend_userspath = 1; - } - - $prepend_userspath = 1 if substr($self->{tmpfile}, 0, length $userspath) eq $userspath; - - $self->{tmpfile} =~ s|.*/||; - $self->{tmpfile} =~ s/[^a-zA-Z0-9\._\ \-]//g; - $self->{tmpfile} = "$userspath/$self->{tmpfile}" if $prepend_userspath; + my ($temp_fh, $suffix); + $suffix = $self->{IN}; + $suffix =~ s/.*\.//; + ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile( + 'kivitendo-printXXXXXX', + SUFFIX => '.' . ($suffix || 'tex'), + DIR => $userspath, + UNLINK => 1, + ); + close $temp_fh; if ($template->uses_temp_file() || $self->{media} eq 'email') { - $out = $self->{OUT}; - $self->{OUT} = ">$self->{tmpfile}"; + $out = $self->{OUT}; + $out_mode = $self->{OUT_MODE} || '>'; + $self->{OUT} = "$self->{tmpfile}"; + $self->{OUT_MODE} = '>'; } my $result; + my $command_formatter = sub { + my ($out_mode, $out) = @_; + return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out; + }; if ($self->{OUT}) { - open OUT, "$self->{OUT}" or $self->error("$self->{OUT} : $!"); - $result = $template->parse(*OUT); - close OUT; - + $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT}); + open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!"); } else { + *OUT = ($::dispatcher->get_standard_filehandles)[1]; $self->header; - $result = $template->parse(*STDOUT); } - if (!$result) { + if (!$template->parse(*OUT)) { $self->cleanup(); $self->error("$self->{IN} : " . $template->get_error()); } + close OUT if $self->{OUT}; + + if ($self->{media} eq 'file') { + copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file; + $self->cleanup; + chdir("$self->{cwd}"); + + $::lxdebug->leave_sub(); + + return; + } + if ($template->uses_temp_file() || $self->{media} eq 'email') { if ($self->{media} eq 'email') { @@ -1277,27 +1167,23 @@ sub parse_template { map { $mail->{$_} = $self->{$_} } qw(cc bcc subject message version format); - $mail->{charset} = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET; + $mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email}; $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; - $mail->{fileid} = "$fileid."; + $mail->{fileid} = time() . '.' . $$ . '.'; $myconfig->{signature} =~ s/\r//g; # if we send html or plain text inline if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) { - $mail->{contenttype} = "text/html"; + $mail->{contenttype} = "text/html"; + $mail->{message} =~ s/\r//g; + $mail->{message} =~ s/\n/
\n/g; + $myconfig->{signature} =~ s/\n/
\n/g; + $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; - $mail->{message} =~ s/\r//g; - $mail->{message} =~ s/\n/
\n/g; - $myconfig->{signature} =~ s/\n/
\n/g; - $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; - - open(IN, $self->{tmpfile}) + open(IN, "<", $self->{tmpfile}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); - while () { - $mail->{message} .= $_; - } - + $mail->{message} .= $_ while ; close(IN); } else { @@ -1319,11 +1205,13 @@ sub parse_template { } else { - $self->{OUT} = $out; + $self->{OUT} = $out; + $self->{OUT_MODE} = $out_mode; my $numbytes = (-s $self->{tmpfile}); - open(IN, $self->{tmpfile}) + open(IN, "<", $self->{tmpfile}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); + binmode IN; $self->{copies} = 1 unless $self->{media} eq 'printer'; @@ -1332,10 +1220,12 @@ sub parse_template { #print(STDERR "OUT $self->{OUT}\n"); for my $i (1 .. $self->{copies}) { if ($self->{OUT}) { - open OUT, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); - print OUT while ; + $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT}); + + open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT $_ while ; close OUT; - seek IN, 0, 0; + seek IN, 0, 0; } else { $self->{attachment_filename} = ($self->{attachment_filename}) @@ -1370,6 +1260,9 @@ sub get_formname_translation { $formname ||= $self->{formname}; + $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language}); + local $::locale = Locale->new($self->{recipient_locale}); + my %formname_translations = ( bin_list => $main::locale->text('Bin List'), credit_note => $main::locale->text('Credit Note'), @@ -1387,7 +1280,7 @@ sub get_formname_translation { ); $main::lxdebug->leave_sub(); - return $formname_translations{$formname} + return $formname_translations{$formname}; } sub get_number_prefix_for_type { @@ -1423,11 +1316,14 @@ sub generate_attachment_filename { $main::lxdebug->enter_sub(); my ($self) = @_; + $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language}); + my $recipient_locale = Locale->new($self->{recipient_locale}); + my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation()); my $prefix = $self->get_number_prefix_for_type(); if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) { - $attachment_filename .= ' (' . $main::locale->text('Preview') . ')' . $self->get_extension_for_format(); + $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format(); } elsif ($attachment_filename && $self->{"${prefix}number"}) { $attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format(); @@ -1461,18 +1357,23 @@ sub generate_email_subject { sub cleanup { $main::lxdebug->enter_sub(); - my $self = shift; + my ($self, $application) = @_; + + my $error_code = $?; chdir("$self->{tmpdir}"); my @err = (); - if (-f "$self->{tmpfile}.err") { + if ((-1 == $error_code) || (127 == (($error_code) >> 8))) { + push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.'); + + } elsif (-f "$self->{tmpfile}.err") { open(FH, "$self->{tmpfile}.err"); @err = ; close(FH); } - if ($self->{tmpfile} && ! $::keep_temp_files) { + if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) { $self->{tmpfile} =~ s|.*/||g; # strip extension $self->{tmpfile} =~ s/\.\w+$//g; @@ -1537,7 +1438,7 @@ sub dbconnect { my ($self, $myconfig) = @_; # connect to database - my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options) + my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options) or $self->dberror; # set db options @@ -1556,7 +1457,7 @@ sub dbconnect_noauto { my ($self, $myconfig) = @_; # connect to database - my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0)) + my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0)) or $self->dberror; # set db options @@ -1594,7 +1495,24 @@ sub date_closed { my $dbh = $self->dbconnect($myconfig); my $query = "SELECT 1 FROM defaults WHERE ? < closedto"; - my $sth = prepare_execute_query($self, $dbh, $query, $date); + my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date)); + + # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke, + # es ist sicher ein conv_date vorher IMMER auszuführen. + # Testfälle ohne definiertes closedto: + # Leere Datumseingabe i.O. + # SELECT 1 FROM defaults WHERE '' < closedto + # normale Zahlungsbuchung über Rechnungsmaske i.O. + # SELECT 1 FROM defaults WHERE '10.05.2011' < closedto + # Testfälle mit definiertem closedto (30.04.2011): + # Leere Datumseingabe i.O. + # SELECT 1 FROM defaults WHERE '' < closedto + # normale Buchung im geschloßenem Zeitraum i.O. + # SELECT 1 FROM defaults WHERE '21.04.2011' < closedto + # Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden! + # normale Buchung in aktiver Buchungsperiode i.O. + # SELECT 1 FROM defaults WHERE '01.05.2011' < closedto + my ($closed) = $sth->fetchrow_array; $main::lxdebug->leave_sub(); @@ -1809,12 +1727,12 @@ sub set_payment_options { my $dbh = $self->get_standard_dbh($myconfig); my $query = - qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long | . + qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long , p.description | . qq|FROM payment_terms p | . qq|WHERE p.id = ?|; ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto}, - $self->{payment_terms}) = + $self->{payment_terms}, $self->{payment_description}) = selectrow_query($self, $dbh, $query, $self->{payment_id}); if ($transdate eq "") { @@ -1861,10 +1779,12 @@ sub set_payment_options { if ($self->{"language_id"}) { $query = - qq|SELECT t.description_long, l.output_numberformat, l.output_dateformat, l.output_longdates | . - qq|FROM translation_payment_terms t | . + qq|SELECT t.translation, l.output_numberformat, l.output_dateformat, l.output_longdates | . + qq|FROM generic_translations t | . qq|LEFT JOIN language l ON t.language_id = l.id | . - qq|WHERE (t.language_id = ?) AND (t.payment_terms_id = ?)|; + qq|WHERE (t.language_id = ?) + AND (t.translation_id = ?) + AND (t.translation_type = 'SL::DB::PaymentTerm/description_long')|; my ($description_long, $output_numberformat, $output_dateformat, $output_longdates) = selectrow_query($self, $dbh, $query, @@ -2057,7 +1977,7 @@ sub get_employee_data { my ($login) = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id})); if ($login) { - my $user = User->new($login); + my $user = User->new(login => $login); map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel); $self->{$params{prefix} . '_login'} = $login; @@ -2237,7 +2157,7 @@ sub _get_taxcharts { $key = $params; } - my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@where); + my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : ''; my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|; @@ -2338,7 +2258,7 @@ $main::lxdebug->enter_sub(); $key = "all_payments" unless ($key); - my $query = qq|SELECT * FROM payment_terms ORDER BY id|; + my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|; $self->{$key} = selectall_hashref_query($self, $dbh, $query); @@ -2352,7 +2272,7 @@ sub _get_customers { my $options = ref $key eq 'HASH' ? $key : { key => $key }; $options->{key} ||= "all_customers"; - my $limit_clause = "LIMIT $options->{limit}" if $options->{limit}; + my $limit_clause = $options->{limit} ? "LIMIT $options->{limit}" : ''; my @where; push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if $options->{business_is_salesman}; @@ -2416,7 +2336,8 @@ sub _get_warehouses { $self->{$key} = selectall_hashref_query($self, $dbh, $query); if ($bins_key) { - $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|; + $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ? + ORDER BY description|; my $sth = prepare_query($self, $dbh, $query); foreach my $warehouse (@{ $self->{$key} }) { @@ -2613,7 +2534,7 @@ sub get_name { return scalar(@{ $self->{name_list} }); } -# the selection sub is used in the AR, AP, IS, IR and OE module +# the selection sub is used in the AR, AP, IS, IR, DO and OE module # sub all_vc { $main::lxdebug->enter_sub(); @@ -2625,13 +2546,17 @@ sub all_vc { $table = $table eq "customer" ? "customer" : "vendor"; - my $query = qq|SELECT count(*) FROM $table|; + # build selection list + # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege + # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch + # nicht für veränderbare Belege (oe, do, ...) + my $obsolete = "WHERE NOT obsolete" unless $self->{id}; + my $query = qq|SELECT count(*) FROM $table $obsolete|; my ($count) = selectrow_query($self, $dbh, $query); - # build selection list - if ($count <= $myconfig->{vclimit}) { + if ($count < $myconfig->{vclimit}) { $query = qq|SELECT id, name, salesman_id - FROM $table WHERE NOT obsolete + FROM $table $obsolete ORDER BY name|; $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query); } @@ -2654,19 +2579,11 @@ sub all_vc { @{ $self->{all_employees} } = sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} }; - if ($module eq 'AR') { # prepare query for departments - $query = qq|SELECT id, description - FROM department - WHERE role = 'P' - ORDER BY description|; - - } else { $query = qq|SELECT id, description FROM department ORDER BY description|; - } $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); @@ -2737,15 +2654,9 @@ sub all_departments { my ($self, $myconfig, $table) = @_; my $dbh = $self->get_standard_dbh($myconfig); - my $where; - - if ($table eq 'customer') { - $where = "WHERE role = 'P' "; - } my $query = qq|SELECT id, description FROM department - $where ORDER BY description|; $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); @@ -2785,11 +2696,28 @@ sub create_links { } # now get the account numbers - $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id - FROM chart c, taxkeys tk - WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id = - (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1) - ORDER BY c.accno|; +# $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id +# FROM chart c, taxkeys tk +# WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id = +# (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1) +# ORDER BY c.accno|; + +# same query as above, but without expensive subquery for each row. about 80% faster + $query = qq| + SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id + FROM chart c + -- find newest entries in taxkeys + INNER JOIN ( + SELECT chart_id, MAX(startdate) AS startdate + FROM taxkeys + WHERE (startdate <= $transdate) + GROUP BY chart_id + ) tk ON (c.id = tk.chart_id) + -- and load all of those entries + INNER JOIN taxkeys tk2 + ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate) + WHERE (c.link LIKE ?) + ORDER BY c.accno|; $sth = $dbh->prepare($query); @@ -2833,6 +2761,7 @@ sub create_links { a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes, a.intnotes, a.department_id, a.amount AS oldinvtotal, a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type, + a.globalproject_id, c.name AS $table, d.description AS department, e.name AS employee @@ -2847,6 +2776,9 @@ sub create_links { $self->{$key} = $ref->{$key}; } + # remove any trailing whitespace + $self->{currency} =~ s/\s*$//; + my $transdate = "current_date"; if ($self->{transdate}) { $transdate = $dbh->quote($self->{transdate}); @@ -2889,7 +2821,7 @@ sub create_links { $query = qq|SELECT c.accno, c.description, - a.source, a.amount, a.memo, a.transdate, a.cleared, a.project_id, a.taxkey, + a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, p.projectnumber, t.rate, t.id FROM acc_trans a @@ -2954,7 +2886,7 @@ sub create_links { if ($self->{"$self->{vc}_id"}) { # only setup currency - ($self->{currency}) = split(/:/, $self->{currencies}); + ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency}; } else { @@ -2984,12 +2916,14 @@ sub lastname_used { "a.department_id" => "department_id", "d.description" => "department", "ct.name" => $table, + "ct.curr" => "cv_curr", "current_date + ct.terms" => "duedate", ); if ($self->{type} =~ /delivery_order/) { $arap = 'delivery_orders'; delete $column_map{"a.curr"}; + delete $column_map{"ct.curr"}; } elsif ($self->{type} =~ /_order/) { $arap = 'oe'; @@ -3023,6 +2957,13 @@ sub lastname_used { map { $self->{$_} = $ref->{$_} } values %column_map; + # remove any trailing whitespace + $self->{currency} =~ s/\s*$// if $self->{currency}; + $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr}; + + # if customer/vendor currency is set use this + $self->{currency} = $self->{cv_curr} if $self->{cv_curr}; + $main::lxdebug->leave_sub(); } @@ -3496,79 +3437,181 @@ sub restore_vars { $main::lxdebug->leave_sub(); } -1; +sub prepare_for_printing { + my ($self) = @_; -__END__ + $self->{templates} ||= $::myconfig{templates}; + $self->{formname} ||= $self->{type}; + $self->{media} ||= 'email'; -=head1 NAME + die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/; -SL::Form.pm - main data object. + # set shipto from billto unless set + my $has_shipto = any { $self->{"shipto$_"} } qw(name street zipcode city country contact); + if (!$has_shipto && ($self->{type} =~ m/^(?:purchase_order|request_quotation)$/)) { + $self->{shiptoname} = $::myconfig{company}; + $self->{shiptostreet} = $::myconfig{address}; + } -=head1 SYNOPSIS + my $language = $self->{language} ? '_' . $self->{language} : ''; -This is the main data object of Lx-Office. -Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points. -Points of interest for a beginner are: + my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates); + if ($self->{language_id}) { + ($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id}); + } else { + $output_dateformat = $::myconfig{dateformat}; + $output_numberformat = $::myconfig{numberformat}; + $output_longdates = 1; + } - - $form->error - renders a generic error in html. accepts an error message - - $form->get_standard_dbh - returns a database connection for the + # Retrieve accounts for tax calculation. + IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount}); -=head1 SPECIAL FUNCTIONS + if ($self->{type} =~ /_delivery_order$/) { + DO->order_details(); + } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) { + OE->order_details(\%::myconfig, $self); + } else { + IS->invoice_details(\%::myconfig, $self, $::locale); + } + + # Chose extension & set source file name + my $extension = 'html'; + if ($self->{format} eq 'postscript') { + $self->{postscript} = 1; + $extension = 'tex'; + } elsif ($self->{"format"} =~ /pdf/) { + $self->{pdf} = 1; + $extension = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex'; + } elsif ($self->{"format"} =~ /opendocument/) { + $self->{opendocument} = 1; + $extension = 'odt'; + } elsif ($self->{"format"} =~ /excel/) { + $self->{excel} = 1; + $extension = 'xls'; + } -=head2 C<_store_value()> + my $printer_code = $self->{printer_code} ? '_' . $self->{printer_code} : ''; + my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : ''; + $self->{IN} = "$self->{formname}${email_extension}${language}${printer_code}.${extension}"; -parses a complex var name, and stores it in the form. + # Format dates. + $self->format_dates($output_dateformat, $output_longdates, + qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid + transdate_oe deliverydate_oe employee_startdate employee_enddate), + grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self}))); -syntax: - $form->_store_value($key, $value); + $self->reformat_numbers($output_numberformat, 2, + qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid), + grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self}))); + + $self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self}))); + + my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_'); + + if (scalar @{ $cvar_date_fields }) { + $self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields }); + } -keys must start with a string, and can contain various tokens. -supported key structures are: + while (my ($precision, $field_list) = each %{ $cvar_number_fields }) { + $self->reformat_numbers($output_numberformat, $precision, @{ $field_list }); + } -1. simple access - simple key strings work as expected + return $self; +} - id => $form->{id} +sub format_dates { + my ($self, $dateformat, $longformat, @indices) = @_; -2. hash access. - separating two keys by a dot (.) will result in a hash lookup for the inner value - this is similar to the behaviour of java and templating mechanisms. + $dateformat ||= $::myconfig{dateformat}; - filter.description => $form->{filter}->{description} + foreach my $idx (@indices) { + if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) { + for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) { + $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat); + } + } -3. array+hashref access + next unless defined $self->{$idx}; - adding brackets ([]) before the dot will cause the next hash to be put into an array. - using [+] instead of [] will force a new array index. this is useful for recurring - data structures like part lists. put a [+] into the first varname, and use [] on the - following ones. + if (!ref($self->{$idx})) { + $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat); - repeating these names in your template: + } elsif (ref($self->{$idx}) eq "ARRAY") { + for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) { + $self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat); + } + } + } +} - invoice.items[+].id - invoice.items[].parts_id +sub reformat_numbers { + my ($self, $numberformat, $places, @indices) = @_; - will result in: + return if !$numberformat || ($numberformat eq $::myconfig{numberformat}); - $form->{invoice}->{items}->[ - { - id => ... - parts_id => ... - }, - { - id => ... - parts_id => ... + foreach my $idx (@indices) { + if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) { + for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) { + $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]); } - ... - ] + } -4. arrays + next unless defined $self->{$idx}; - using brackets at the end of a name will result in a pure array to be created. - note that you mustn't use [+], which is reserved for array+hash access and will - result in undefined behaviour in array context. + if (!ref($self->{$idx})) { + $self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx}); + + } elsif (ref($self->{$idx}) eq "ARRAY") { + for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) { + $self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]); + } + } + } - filter.status[] => $form->{status}->[ val1, val2, ... ] + my $saved_numberformat = $::myconfig{numberformat}; + $::myconfig{numberformat} = $numberformat; + + foreach my $idx (@indices) { + if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) { + for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) { + $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places); + } + } + + next unless defined $self->{$idx}; + + if (!ref($self->{$idx})) { + $self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places); + + } elsif (ref($self->{$idx}) eq "ARRAY") { + for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) { + $self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places); + } + } + } + + $::myconfig{numberformat} = $saved_numberformat; +} + +1; + +__END__ + +=head1 NAME + +SL::Form.pm - main data object. + +=head1 SYNOPSIS + +This is the main data object of Lx-Office. +Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points. +Points of interest for a beginner are: + + - $form->error - renders a generic error in html. accepts an error message + - $form->get_standard_dbh - returns a database connection for the + +=head1 SPECIAL FUNCTIONS =head2 C PARAMS @@ -3599,7 +3642,7 @@ Examples: =head2 C
Generates a general purpose http/html header and includes most of the scripts -ans stylesheets needed. +and stylesheets needed. Stylesheets can be added with L. 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 @@ -3619,9 +3662,8 @@ default to 3 seconds and the refering url. =item stylesheet -=item stylesheets - -If these are arrayrefs the contents will be inlined into the header. +Either a scalar or an array ref. Will be inlined into the header. Add +stylesheets with the L function. =item landscape