X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=d0a4157b4a66bb7d4ee10f2fc5833bbcd631688b;hb=8003c3b1db2dd73402977fcfe29653108794099c;hp=4c90304354488766a9a284497ad7d71e5922eb08;hpb=5fd2cf413e611047a3b8d667378a258a7955941e;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 4c9030435..d0a4157b4 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -40,7 +40,6 @@ package Form; use Data::Dumper; use CGI; -use CGI::Ajax; use Cwd; use Encode; use File::Copy; @@ -59,7 +58,9 @@ use SL::IC; use SL::IS; 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; @@ -82,168 +83,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; - my $uploads = {}; - - 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 $uploads; - } - - 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 = _store_value($uploads, $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); - - return $uploads; -} - -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(); @@ -251,6 +90,7 @@ sub new { my $self = {}; + no warnings 'once'; if ($LXDebug::watch_form) { require SL::Watchdog; tie %{ $self }, 'SL::Watchdog'; @@ -258,27 +98,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]; - - my $uploads; - if ($ENV{CONTENT_LENGTH}) { - my $content; - read STDIN, $content, $ENV{CONTENT_LENGTH}; - $uploads = $self->_request_to_hash($content); - } - - my $db_charset = $::lx_office_conf{system}->{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); - - map { $self->{$_} = $uploads->{$_} } keys %{ $uploads } if $uploads; - - #$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; @@ -289,6 +108,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); @@ -388,32 +212,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; - $str = Encode::decode('utf-8-strict', $str) if $::locale->is_utf8; - - $main::lxdebug->leave_sub(2); - - return $str; + return uri_decode($str); } sub quote { @@ -447,11 +254,11 @@ 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(); @@ -504,7 +311,7 @@ sub info { ', '', - '', + '', '', '', '', - ''; + '', + '', + '', + ''; push @header, $self->{javascript} if $self->{javascript}; push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] }; push @header, "" if $self->{fokus}; @@ -693,10 +513,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 < @@ -705,9 +530,9 @@ sub header { EOT print " $_\n" for @header; print < - - + + + - $extra_code + $params{extra_code} $title_hack @@ -732,8 +557,7 @@ sub ajax_response_header { my ($self) = @_; my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; - my $cgi = $main::cgi || CGI->new(''); - my $output = $cgi->header('-charset' => $db_charset); + my $output = $::request->{cgi}->header('-charset' => $db_charset); $main::lxdebug->leave_sub(); @@ -750,8 +574,7 @@ sub redirect_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 { @@ -779,13 +602,6 @@ sub _prepare_html_template { $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 { @@ -815,7 +631,6 @@ sub _prepare_html_template { $additional_params->{"conf_dbcharset"} = $::lx_office_conf{system}->{dbcharset}; $additional_params->{"conf_webdav"} = $::lx_office_conf{features}->{webdav}; - $additional_params->{"conf_lizenzen"} = $::lx_office_conf{features}->{lizenzen}; $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}; @@ -823,9 +638,11 @@ sub _prepare_html_template { $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}}) { @@ -862,7 +679,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, @@ -991,6 +808,16 @@ 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(); @@ -1000,6 +827,7 @@ sub redirect { $self->info($msg); } else { + $self->_store_redirect_info_in_session; print $::form->redirect_header($self->{callback}); } @@ -1085,8 +913,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'); @@ -1160,7 +987,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") { @@ -1171,7 +998,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 { @@ -1199,7 +1028,7 @@ sub parse_template { $main::lxdebug->enter_sub(); my ($self, $myconfig) = @_; - my $out; + my ($out, $out_mode); local (*IN, *OUT); @@ -1265,42 +1094,40 @@ sub parse_template { # 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( + 'lx-office-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_mode = $self->{OUT_MODE} || '>'; + $self->{OUT} = "$self->{tmpfile}"; + $self->{OUT_MODE} = '>'; } my $result; if ($self->{OUT}) { - open OUT, "$self->{OUT}" or $self->error("$self->{OUT} : $!"); - $result = $template->parse(*OUT); - close 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; @@ -1322,7 +1149,7 @@ sub parse_template { $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 @@ -1334,7 +1161,7 @@ sub parse_template { $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} .= $_; @@ -1361,10 +1188,11 @@ 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; @@ -1375,8 +1203,8 @@ 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 ; + open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT $_ while ; close OUT; seek IN, 0, 0; @@ -1504,12 +1332,17 @@ 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); @@ -1637,7 +1470,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(); @@ -1852,12 +1702,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 "") { @@ -2282,7 +2132,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|; @@ -2397,7 +2247,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}; @@ -2700,19 +2550,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); @@ -2783,15 +2625,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); @@ -2831,11 +2667,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); @@ -2879,6 +2732,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 @@ -2893,6 +2747,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}); @@ -2935,7 +2792,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 @@ -3000,7 +2857,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 { @@ -3030,12 +2887,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'; @@ -3069,6 +2928,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(); } @@ -3596,8 +3462,8 @@ sub prepare_for_printing { $extension = 'xls'; } - my $printer_code = '_' . $self->{printer_code} if $self->{printer_code}; - my $email_extension = '_email' if -f "$self->{templates}/$self->{formname}_email${language}${printer_code}.${extension}"; + 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}"; # Format dates. @@ -3718,61 +3584,6 @@ Points of interest for a beginner are: =head1 SPECIAL FUNCTIONS -=head2 C<_store_value()> - -parses a complex var name, and stores it in the form. - -syntax: - $form->_store_value($key, $value); - -keys must start with a string, and can contain various tokens. -supported key structures are: - -1. simple access - simple key strings work as expected - - id => $form->{id} - -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. - - filter.description => $form->{filter}->{description} - -3. array+hashref access - - 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. - - repeating these names in your template: - - invoice.items[+].id - invoice.items[].parts_id - - will result in: - - $form->{invoice}->{items}->[ - { - id => ... - parts_id => ... - }, - { - id => ... - parts_id => ... - } - ... - ] - -4. arrays - - 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. - - filter.status[] => $form->{status}->[ val1, val2, ... ] - =head2 C PARAMS PARAMS (not named): @@ -3802,7 +3613,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 @@ -3822,9 +3633,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