X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=456cd2e59a80c982768bc455f9b1be0d965de495;hb=560d94b29eddbd312fe0eae3726b368959f522eb;hp=db73725390fc78e5db42fb7aa667d7073986774b;hpb=5c184abc6228356bbceea79cb4e2e99a62c956f9;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index db7372539..456cd2e59 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -36,12 +36,15 @@ #====================================================================== package Form; + +#use strict; + use Data::Dumper; use CGI; use CGI::Ajax; use Cwd; -use List::Util qw(min max); +use IO::File; use SL::Auth; use SL::Auth::DB; use SL::Auth::LDAP; @@ -53,11 +56,11 @@ use SL::Menu; use SL::Template; use SL::User; use Template; -use List::Util qw(max min sum); +use List::Util qw(first max min sum); my $standard_dbh; -sub DESTROY { +END { if ($standard_dbh) { $standard_dbh->disconnect(); undef $standard_dbh; @@ -67,12 +70,10 @@ sub DESTROY { sub _store_value { $main::lxdebug->enter_sub(2); - my $self = shift; + my $curr = shift; my $key = shift; my $value = shift; - my $curr = $self; - while ($key =~ /\[\+?\]\.|\./) { substr($key, 0, $+[0]) = ''; @@ -100,14 +101,14 @@ sub _store_value { sub _input_to_hash { $main::lxdebug->enter_sub(2); - my $self = shift; - my $input = shift; + my $params = shift; + my $input = shift; - my @pairs = split(/&/, $input); + my @pairs = split(/&/, $input); foreach (@pairs) { my ($key, $value) = split(/=/, $_, 2); - $self->_store_value($self->unescape($key), $self->unescape($value)); + _store_value($params, unescape(undef, $key), unescape(undef, $value)); } $main::lxdebug->leave_sub(2); @@ -116,13 +117,13 @@ sub _input_to_hash { sub _request_to_hash { $main::lxdebug->enter_sub(2); - my $self = shift; - my $input = shift; + my $params = shift; + my $input = shift; if (!$ENV{'CONTENT_TYPE'} || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { - $self->_input_to_hash($input); + _input_to_hash($params, $input); $main::lxdebug->leave_sub(2); return; @@ -170,8 +171,8 @@ sub _request_to_hash { substr $line, $-[0], $+[0] - $-[0], ""; } - $previous = $self->_store_value($name, ''); - $self->{FILENAME} = $filename if ($filename); + $previous = _store_value($params, $name, ''); + $params->{FILENAME} = $filename if ($filename); next; } @@ -193,6 +194,31 @@ sub _request_to_hash { $main::lxdebug->leave_sub(2); } +sub _recode_recursively { + $main::lxdebug->enter_sub(); + my ($iconv, $param) = @_; + + if (ref $param eq 'HASH') { + foreach my $key (keys %{ $param }) { + if (!ref $param->{$key}) { + $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]) { + $param->[$idx] = $iconv->convert($param->[$idx]); + } else { + _recode_recursively($iconv, $param->[$idx]); + } + } + } + $main::lxdebug->leave_sub(); +} + sub new { $main::lxdebug->enter_sub(); @@ -217,12 +243,27 @@ sub new { bless $self, $type; - $self->_request_to_hash($_); + my $parameters = { }; + _request_to_hash($parameters, $_); + + my $db_charset = $main::dbcharset; + $db_charset ||= Common::DEFAULT_CHARSET; + + if ($parameters->{INPUT_ENCODING} && (lc $parameters->{INPUT_ENCODING} ne $db_charset)) { + require Text::Iconv; + my $iconv = Text::Iconv->new($parameters->{INPUT_ENCODING}, $db_charset); + + _recode_recursively($iconv, $parameters); + + delete $parameters{INPUT_ENCODING}; + } + + map { $self->{$_} = $parameters->{$_}; } keys %{ $parameters }; $self->{action} = lc $self->{action}; $self->{action} =~ s/( |-|,|\#)/_/g; - $self->{version} = "2.4.3"; + $self->{version} = "2.6.0 beta 2"; $main::lxdebug->leave_sub(); @@ -355,6 +396,7 @@ sub unescape { } sub quote { + $main::lxdebug->enter_sub(); my ($self, $str) = @_; if ($str && !ref($str)) { @@ -363,9 +405,11 @@ sub quote { $str; + $main::lxdebug->leave_sub(); } sub unquote { + $main::lxdebug->enter_sub(); my ($self, $str) = @_; if ($str && !ref($str)) { @@ -374,56 +418,11 @@ sub unquote { $str; + $main::lxdebug->leave_sub(); } -sub quote_html { - $main::lxdebug->enter_sub(2); - - my ($self, $str) = @_; - - my %replace = - ('order' => ['&', '"', '<', '>'], - '<' => '<', - '>' => '>', - '"' => '"', - '&' => '&', - ); - - map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); - - $main::lxdebug->leave_sub(2); - - return $str; -} - -sub unquote_html { - $main::lxdebug->enter_sub(2); - - my ($self, $str) = @_; - - my %replace = - ('ä' => 'ä', - 'ö' => 'ö', - 'ü' => 'ü', - 'Ä' => 'Ä', - 'Ö' => 'Ö', - 'Ü' => 'Ü', - 'ß' => 'ß', - '>' => '>', - '<' => '<', - '"' => '"', - ); - - map { $str =~ s/\Q$_\E/$replace{$_}/g; } keys %replace; - $str =~ s/\&/\&/g; - - $main::lxdebug->leave_sub(2); - - return $str; -} - - sub hide_form { + $main::lxdebug->enter_sub(); my $self = shift; if (@_) { @@ -434,7 +433,7 @@ sub hide_form { print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } } - + $main::lxdebug->leave_sub(); } sub error { @@ -518,7 +517,7 @@ sub isblank { my ($self, $name, $msg) = @_; my $curr = $self; - foreach my $part (split '.', $name) { + foreach my $part (split m/\./, $name) { if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) { $self->error($msg); } @@ -528,6 +527,48 @@ sub isblank { $main::lxdebug->leave_sub(); } +sub create_http_response { + $main::lxdebug->enter_sub(); + + my $self = shift; + my %params = @_; + + my $cgi = $main::cgi; + $cgi ||= CGI->new(''); + + my $base_path; + + if ($ENV{HTTP_X_FORWARDED_FOR}) { + $base_path = $ENV{HTTP_REFERER}; + $base_path =~ s|^.*?://.*?/|/|; + } else { + $base_path = $ENV{REQUEST_URI}; + } + $base_path =~ s|[^/]+$||; + $base_path =~ s|/$||; + + my $session_cookie; + if (defined $main::auth) { + my $session_cookie_value = $main::auth->get_session_id(); + $session_cookie_value ||= 'NO_SESSION'; + + $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), + '-value' => $session_cookie_value, + '-path' => $base_path); + } + + my %cgi_params = ('-type' => $params{content_type}); + $cgi_params{'-charset'} = $params{charset} if ($params{charset}); + + my $output = $cgi->header('-cookie' => $session_cookie, + %cgi_params); + + $main::lxdebug->leave_sub(); + + return $output; +} + + sub header { $main::lxdebug->enter_sub(); @@ -538,10 +579,7 @@ sub header { return; } - my $cgi = $main::cgi; - $cgi ||= CGI->new(''); - - my ($stylesheet, $favicon); + my ($stylesheet, $favicon, $pagelayout); if ($ENV{HTTP_USER_AGENT}) { my $doctype; @@ -585,6 +623,7 @@ sub header { if ($self->{jsscript} == 1) { $jsscript = qq| + @@ -598,47 +637,25 @@ sub header { ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; my $ajax = ""; - foreach $item (@ { $self->{AJAX} }) { + foreach my $item (@ { $self->{AJAX} }) { $ajax .= $item->show_javascript(); } - my $base_path; - - if ($ENV{HTTP_X_FORWARDED_FOR}) { - $base_path = $ENV{HTTP_REFERER}; - $base_path =~ s|^.*?://.*?/|/|; - } else { - $base_path = $ENV{REQUEST_URI}; - } - $base_path =~ s|[^/]+$||; - $base_path =~ s|/$||; - - my $session_cookie; - if (defined $main::auth) { - my $session_cookie_value = $main::auth->get_session_id(); - $session_cookie_value ||= 'NO_SESSION'; - - $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), - '-value' => $session_cookie_value, - '-path' => $base_path); - } - - print $cgi->header('-type' => 'text/html', - '-charset' => $db_charset, - '-cookie' => $session_cookie); + print $self->create_http_response('content_type' => 'text/html', + 'charset' => $db_charset,); print qq|${doctype} + $self->{titlebar} $stylesheet $pagelayout $favicon - $jsscript $ajax - + @@ -668,6 +685,20 @@ sub header { $main::lxdebug->leave_sub(); } +sub ajax_response_header { + $main::lxdebug->enter_sub(); + + 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); + + $main::lxdebug->leave_sub(); + + return $output; +} + sub _prepare_html_template { $main::lxdebug->enter_sub(); @@ -720,6 +751,7 @@ sub _prepare_html_template { $additional_params->{"myconfig_jsc_dateformat"} = $jsc_dateformat; } + $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; @@ -759,19 +791,34 @@ sub parse_html_template { map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; + my $in = IO::File->new($file, 'r'); + + if (!$in) { + print STDERR "Error opening template file: $!"; + $main::lxdebug->leave_sub(); + return ''; + } + + my $input = join('', <$in>); + $in->close(); + + if ($main::locale) { + $input = $main::locale->{iconv}->convert($input); + } + my $output; - if (!$template->process($file, $additional_params, \$output)) { + if (!$template->process(\$input, $additional_params, \$output)) { print STDERR $template->error(); } - $output = $main::locale->{iconv}->convert($output) if ($main::locale); - $main::lxdebug->leave_sub(); return $output; } sub show_generic_error { + $main::lxdebug->enter_sub(); + my ($self, $error, %params) = @_; my $add_params = { @@ -793,15 +840,19 @@ sub show_generic_error { $add_params->{SHOW_BACK_BUTTON} = 1; } - $self->{title} = $title if ($title); + $self->{title} = $params{title} if $params{title}; $self->header(); print $self->parse_html_template("generic/error", $add_params); + $main::lxdebug->leave_sub(); + die("Error: $error\n"); } sub show_generic_information { + $main::lxdebug->enter_sub(); + my ($self, $text, $title) = @_; my $add_params = { @@ -814,7 +865,9 @@ sub show_generic_information { $self->header(); print $self->parse_html_template("generic/information", $add_params); - die("Information: $error\n"); + $main::lxdebug->leave_sub(); + + die("Information: $text\n"); } # write Trigger JavaScript-Code ($qty = quantity of Triggers) @@ -837,8 +890,8 @@ sub write_trigger { "yyyy-mm-dd" => "%Y-%m-%d", ); - my $ifFormat = defined($dateformats{$myconfig{"dateformat"}}) ? - $dateformats{$myconfig{"dateformat"}} : "%d.%m.%Y"; + my $ifFormat = defined($dateformats{$myconfig->{"dateformat"}}) ? + $dateformats{$myconfig->{"dateformat"}} : "%d.%m.%Y"; my @triggers; while ($#_ >= 2) { @@ -871,7 +924,7 @@ sub redirect { if ($self->{callback}) { - ($script, $argv) = split(/\?/, $self->{callback}, 2); + my ($script, $argv) = split(/\?/, $self->{callback}, 2); $script =~ s|.*/||; $script =~ s|[^a-zA-Z0-9_\.]||g; exec("perl", "$script", $argv); @@ -904,12 +957,12 @@ sub format_amount { if ($amount eq "") { $amount = 0; } - + # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13 - + my $neg = ($amount =~ s/^-//); my $exp = ($amount =~ m/[e]/) ? 1 : 0; - + if (defined($places) && ($places ne '')) { if (not $exp) { if ($places < 0) { @@ -933,9 +986,9 @@ sub format_amount { $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); $amount = do { - ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : - ($dash =~ /DRCR/) ? ($neg ? "$amount DR" : "$amount CR" ) : - ($neg ? "-$amount" : "$amount" ) ; + ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : + ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) : + ($neg ? "-$amount" : "$amount" ) ; }; @@ -949,16 +1002,19 @@ sub format_amount_units { my $self = shift; my %params = @_; - Common::check_params(\%params, qw(amount part_unit)); - my $myconfig = \%main::myconfig; - my $amount = $params{amount}; + my $amount = $params{amount} * 1; my $places = $params{places}; my $part_unit_name = $params{part_unit}; my $amount_unit_name = $params{amount_unit}; my $conv_units = $params{conv_units}; my $max_places = $params{max_places}; + if (!$part_unit_name) { + $main::lxdebug->leave_sub(); + return ''; + } + AM->retrieve_all_units(); my $all_units = $main::all_units; @@ -978,6 +1034,7 @@ sub format_amount_units { $amount *= $conv_unit->{factor}; my @values; + my $num; foreach my $unit (@$conv_units) { my $last = $unit->{name} eq $part_unit->{name}; @@ -1079,25 +1136,37 @@ sub parse_template { $self->{"cwd"} = getcwd(); $self->{"tmpdir"} = $self->{cwd} . "/${userspath}"; + my $ext_for_format; + if ($self->{"format"} =~ /(opendocument|oasis)/i) { - $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'odt'; + } elsif ($self->{"format"} =~ /(postscript|pdf)/i) { $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"}; - $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif (($self->{"format"} =~ /html/i) || - (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { - $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif (($self->{"format"} =~ /xml/i) || - (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'pdf'; + + } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { + $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'html'; + + } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { + $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'xml'; + } elsif ( $self->{"format"} =~ /elsterwinston/i ) { $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ( $self->{"format"} =~ /elstertaxbird/i ) { $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ( defined $self->{'format'}) { $self->error("Outputformat not defined. This may be a future feature: $self->{'format'}"); + } elsif ( $self->{'format'} eq '' ) { $self->error("No Outputformat given: $self->{'format'}"); + } else { #Catch the rest $self->error("Outputformat not defined: $self->{'format'}"); } @@ -1105,13 +1174,11 @@ sub parse_template { # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be. $self->{"notes"} = $self->{ $self->{"formname"} . "notes" }; - map({ $self->{"employee_${_}"} = $myconfig->{$_}; } - qw(email tel fax name signature company address businessnumber - co_ustid taxnumber duns)); + if (!$self->{employee_id}) { + map { $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature company address businessnumber co_ustid taxnumber duns); + } - map({ $self->{"${_}"} = $myconfig->{$_}; } - qw(co_ustid)); - + map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid); $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); @@ -1184,10 +1251,10 @@ sub parse_template { } else { if (!$self->{"do_not_attach"}) { - @{ $mail->{attachments} } = - ({ "filename" => $self->{"tmpfile"}, - "name" => $self->{"attachment_filename"} ? - $self->{"attachment_filename"} : $self->{"tmpfile"} }); + my $attachment_name = $self->{attachment_filename} || $self->{tmpfile}; + $attachment_name =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format); + $mail->{attachments} = [{ "filename" => $self->{tmpfile}, + "name" => $attachment_name }]; } $mail->{message} =~ s/\r//g; @@ -1216,7 +1283,7 @@ sub parse_template { open(OUT, $self->{OUT}) or $self->error($self->cleanup . "$self->{OUT} : $!"); } else { - $self->{attachment_filename} = ($self->{attachment_filename}) + $self->{attachment_filename} = ($self->{attachment_filename}) ? $self->{attachment_filename} : $self->generate_attachment_filename(); @@ -1252,55 +1319,99 @@ Content-Length: $numbytes } sub get_formname_translation { + $main::lxdebug->enter_sub(); my ($self, $formname) = @_; $formname ||= $self->{formname}; my %formname_translations = ( - 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'), - request_quotation => $main::locale->text('RFQ'), - 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'), + 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'), + request_quotation => $main::locale->text('RFQ'), + 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'), ); + $main::lxdebug->leave_sub(); return $formname_translations{$formname} } +sub get_number_prefix_for_type { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + my $prefix = + (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv' + : ($self->{type} =~ /_quotation$/) ? 'quo' + : ($self->{type} =~ /_delivery_order$/) ? 'do' + : 'ord'; + + $main::lxdebug->leave_sub(); + return $prefix; +} + +sub get_extension_for_format { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + my $extension = $self->{format} =~ /pdf/i ? ".pdf" + : $self->{format} =~ /postscript/i ? ".ps" + : $self->{format} =~ /opendocument/i ? ".odt" + : $self->{format} =~ /html/i ? ".html" + : ""; + + $main::lxdebug->leave_sub(); + return $extension; +} + sub generate_attachment_filename { + $main::lxdebug->enter_sub(); my ($self) = @_; - my $attachment_filename = $self->unquote_html($self->get_formname_translation()); - my $prefix = - (grep { $self->{"type"} eq $_ } qw(invoice credit_note)) ? "inv" - : ($self->{"type"} =~ /_quotation$/) ? "quo" - : "ord"; - - if ($attachment_filename && $self->{"${prefix}number"}) { - $attachment_filename .= "_" . $self->{"${prefix}number"} - . ( $self->{format} =~ /pdf/i ? ".pdf" - : $self->{format} =~ /postscript/i ? ".ps" - : $self->{format} =~ /opendocument/i ? ".odt" - : $self->{format} =~ /html/i ? ".html" - : ""); - $attachment_filename =~ s/ /_/g; - my %umlaute = ( "ä" => "ae", "ö" => "oe", "ü" => "ue", - "Ä" => "Ae", "Ö" => "Oe", "Ü" => "Ue", "ß" => "ss"); - map { $attachment_filename =~ s/$_/$umlaute{$_}/g } keys %umlaute; + 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(); + + } elsif ($attachment_filename && $self->{"${prefix}number"}) { + $attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format(); + } else { $attachment_filename = ""; } + $attachment_filename = $main::locale->quote_special_chars('filenames', $attachment_filename); + $attachment_filename =~ s|[\s/\\]+|_|g; + + $main::lxdebug->leave_sub(); return $attachment_filename; } +sub generate_email_subject { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation()); + my $prefix = $self->get_number_prefix_for_type(); + + if ($subject && $self->{"${prefix}number"}) { + $subject .= " " . $self->{"${prefix}number"} + } + + $main::lxdebug->leave_sub(); + return $subject; +} + sub cleanup { $main::lxdebug->enter_sub(); @@ -1334,6 +1445,7 @@ sub datetonum { $main::lxdebug->enter_sub(); my ($self, $date, $myconfig) = @_; + my ($yy, $mm, $dd); if ($date && $date =~ /\D/) { @@ -1390,9 +1502,9 @@ sub dbconnect_noauto { $main::lxdebug->enter_sub(); my ($self, $myconfig) = @_; - + # connect to database - $dbh = + my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, { AutoCommit => 0 }) or $self->dberror; @@ -1412,6 +1524,11 @@ sub get_standard_dbh { my ($self, $myconfig) = @_; + if ($standard_dbh && !$standard_dbh->{Active}) { + $main::lxdebug->message(LXDebug::INFO, "get_standard_dbh: \$standard_dbh is defined but not Active anymore"); + undef $standard_dbh; + } + $standard_dbh ||= $self->dbconnect_noauto($myconfig); $main::lxdebug->leave_sub(2); @@ -1419,6 +1536,21 @@ sub get_standard_dbh { return $standard_dbh; } +sub date_closed { + $main::lxdebug->enter_sub(); + + my ($self, $date, $myconfig) = @_; + my $dbh = $self->dbconnect($myconfig); + + my $query = "SELECT 1 FROM defaults WHERE ? < closedto"; + my $sth = prepare_execute_query($self, $dbh, $query, $date); + my ($closed) = $sth->fetchrow_array; + + $main::lxdebug->leave_sub(); + + return $closed; +} + sub update_balance { $main::lxdebug->enter_sub(); @@ -1451,7 +1583,7 @@ sub update_exchangerate { if ($curr eq '') { $main::lxdebug->leave_sub(); return; - } + } $query = qq|SELECT curr FROM defaults|; my ($currency) = selectrow_query($self, $dbh, $query); @@ -1492,7 +1624,7 @@ sub update_exchangerate { SET $set WHERE curr = ? AND transdate = ?|; - + } else { $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate) VALUES (?, $buy, $sell, ?)|; @@ -1561,6 +1693,10 @@ sub check_exchangerate { my ($self, $myconfig, $currency, $transdate, $fld) = @_; + if ($fld !~/^buy|sell$/) { + $self->error('Fatal: check_exchangerate called with invalid buy/sell argument'); + } + unless ($transdate) { $main::lxdebug->leave_sub(); return ""; @@ -1579,8 +1715,6 @@ sub check_exchangerate { my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate); - $exchangerate = 1 if ($exchangerate eq ""); - $main::lxdebug->leave_sub(); return $exchangerate; @@ -1805,7 +1939,7 @@ sub add_shipto { shiptophone = ? AND shiptofax = ? AND shiptoemail = ? AND - module = ? AND + module = ? AND trans_id = ?|; my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id); if(!$insert_check){ @@ -1834,28 +1968,31 @@ sub get_employee { $main::lxdebug->leave_sub(); } -sub get_salesman { +sub get_employee_data { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $salesman_id) = @_; + my $self = shift; + my %params = @_; - $main::lxdebug->leave_sub() and return unless $salesman_id; + Common::check_params(\%params, qw(prefix)); + Common::check_params_x(\%params, qw(id)); - my $dbh = $self->get_standard_dbh($myconfig); + if (!$params{id}) { + $main::lxdebug->leave_sub(); + return; + } - my ($login) = - selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, - $salesman_id); + my $myconfig = \%main::myconfig; + my $dbh = $params{dbh} || $self->get_standard_dbh($myconfig); + + my ($login) = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id})); if ($login) { - my $user = new User($main::memberfile, $login); - map({ $self->{"salesman_$_"} = $user->{$_}; } - qw(address businessnumber co_ustid company duns email fax name - taxnumber tel)); - $self->{salesman_login} = $login; + my $user = User->new($login); + map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel); - $self->{salesman_name} = $login - if ($self->{salesman_name} eq ""); + $self->{$params{prefix} . '_login'} = $login; + $self->{$params{prefix} . '_name'} ||= $login; } $main::lxdebug->leave_sub(); @@ -1864,13 +2001,17 @@ sub get_salesman { sub get_duedate { $main::lxdebug->enter_sub(); - my ($self, $myconfig) = @_; + my ($self, $myconfig, $reference_date) = @_; - my $dbh = $self->get_standard_dbh($myconfig); - my $query = qq|SELECT current_date + terms_netto FROM payment_terms WHERE id = ?|; - ($self->{duedate}) = selectrow_query($self, $dbh, $query, $self->{payment_id}); + my $reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date'; + + my $dbh = $self->get_standard_dbh($myconfig); + my $query = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|; + my ($duedate) = selectrow_query($self, $dbh, $query, $self->{payment_id}); $main::lxdebug->leave_sub(); + + return $duedate; } sub _get_contacts { @@ -1880,6 +2021,12 @@ sub _get_contacts { $key = "all_contacts" unless ($key); + if (!$id) { + $self->{$key} = []; + $main::lxdebug->leave_sub(); + return; + } + my $query = qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | . qq|FROM contacts | . @@ -1948,10 +2095,15 @@ sub _get_shipto { $key = "all_shipto" unless ($key); - # get shipping addresses - my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; + if ($vc_id) { + # get shipping addresses + my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id); - $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id); + } else { + $self->{$key} = []; + } $main::lxdebug->leave_sub(); } @@ -1974,6 +2126,7 @@ sub _get_charts { $main::lxdebug->enter_sub(); my ($self, $dbh, $params) = @_; + my ($key); $key = $params->{key}; $key = "all_charts" unless ($key); @@ -1997,11 +2150,27 @@ sub _get_charts { sub _get_taxcharts { $main::lxdebug->enter_sub(); - my ($self, $dbh, $key) = @_; + my ($self, $dbh, $params) = @_; - $key = "all_taxcharts" unless ($key); + my $key = "all_taxcharts"; + my @where; - my $query = qq|SELECT * FROM tax ORDER BY taxkey|; + if (ref $params eq 'HASH') { + $key = $params->{key} if ($params->{key}); + if ($params->{module} eq 'AR') { + push @where, 'taxkey NOT IN (8, 9, 18, 19)'; + + } elsif ($params->{module} eq 'AP') { + push @where, 'taxkey NOT IN (1, 2, 3, 12, 13)'; + } + + } elsif ($params) { + $key = $params; + } + + my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@where); + + my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|; $self->{$key} = selectall_hashref_query($self, $dbh, $query); @@ -2081,7 +2250,7 @@ $main::lxdebug->enter_sub(); $key = "all_currencies" unless ($key); my $query = qq|SELECT curr AS currency FROM defaults|; - + $self->{$key} = [split(/\:/ , selectfirst_hashref_query($self, $dbh, $query)->{currency})]; $main::lxdebug->leave_sub(); @@ -2095,7 +2264,7 @@ $main::lxdebug->enter_sub(); $key = "all_payments" unless ($key); my $query = qq|SELECT * FROM payment_terms ORDER BY id|; - + $self->{$key} = selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); @@ -2107,7 +2276,7 @@ sub _get_customers { my ($self, $dbh, $key, $limit) = @_; $key = "all_customers" unless ($key); - $limit_clause = "LIMIT $limit" if $limit; + my $limit_clause = "LIMIT $limit" if $limit; my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|; @@ -2149,41 +2318,22 @@ sub _get_warehouses { my ($self, $dbh, $param) = @_; - my ($key, $bins_key, $q_access, @values); + my ($key, $bins_key); if ('' eq ref $param) { $key = $param; + } else { $key = $param->{key}; $bins_key = $param->{bins}; - - if ($param->{access}) { - $q_access = - qq| AND EXISTS ( - SELECT wa.employee_id - FROM warehouse_access wa - WHERE (wa.employee_id = (SELECT id FROM employee WHERE login = ?)) - AND (wa.warehouse_id = w.id) - AND (wa.access IN ('ro', 'rw')))|; - push @values, $param->{access}; - } - - if ($param->{no_personal}) { - $q_access .= qq| AND (w.personal_warehouse_of IS NULL)|; - - } elsif ($param->{personal}) { - $q_access .= qq| AND (w.personal_warehouse_of = ?)|; - push @values, conv_i($param->{personal}); - } } my $query = qq|SELECT w.* FROM warehouse w WHERE (NOT w.invalid) AND ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0) - $q_access ORDER BY w.sortkey|; - $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values); + $self->{$key} = selectall_hashref_query($self, $dbh, $query); if ($bins_key) { $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|; @@ -2216,19 +2366,19 @@ sub _get_simple { $main::lxdebug->leave_sub(); } -sub _get_groups { - $main::lxdebug->enter_sub(); - - my ($self, $dbh, $key) = @_; - - $key ||= "all_groups"; - - my $groups = $main::auth->read_groups(); - - $self->{$key} = selectall_hashref_query($self, $dbh, $query); - - $main::lxdebug->leave_sub(); -} +#sub _get_groups { +# $main::lxdebug->enter_sub(); +# +# my ($self, $dbh, $key) = @_; +# +# $key ||= "all_groups"; +# +# my $groups = $main::auth->read_groups(); +# +# $self->{$key} = selectall_hashref_query($self, $dbh, $query); +# +# $main::lxdebug->leave_sub(); +#} sub get_lists { $main::lxdebug->enter_sub(); @@ -2279,7 +2429,7 @@ sub get_lists { if ($params{"employees"}) { $self->_get_employees($dbh, "all_employees", $params{"employees"}); } - + if ($params{"salesmen"}) { $self->_get_employees($dbh, "all_salesmen", $params{"salesmen"}); } @@ -2291,11 +2441,11 @@ sub get_lists { if ($params{"dunning_configs"}) { $self->_get_dunning_configs($dbh, $params{"dunning_configs"}); } - + if($params{"currencies"}) { $self->_get_currencies($dbh, $params{"currencies"}); } - + if($params{"customers"}) { if (ref $params{"customers"} eq 'HASH') { $self->_get_customers($dbh, $params{"customers"}{key}, $params{"customers"}{limit}); @@ -2303,7 +2453,7 @@ sub get_lists { $self->_get_customers($dbh, $params{"customers"}); } } - + if($params{"vendors"}) { if (ref $params{"vendors"} eq 'HASH') { $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit}); @@ -2311,7 +2461,7 @@ sub get_lists { $self->_get_vendors($dbh, $params{"vendors"}); } } - + if($params{"payments"}) { $self->_get_payments($dbh, $params{"payments"}); } @@ -2328,8 +2478,12 @@ sub get_lists { $self->_get_warehouses($dbh, $params{warehouses}); } - if ($params{groups}) { - $self->_get_groups($dbh, $params{groups}); +# if ($params{groups}) { +# $self->_get_groups($dbh, $params{groups}); +# } + + if ($params{partsgroup}) { + $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} }); } $main::lxdebug->leave_sub(); @@ -2566,7 +2720,7 @@ sub create_links { do_statement($self, $sth, $query, '%' . $module . '%'); $self->{accounts} = ""; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + while ($ref = $sth->fetchrow_hashref("NAME_lc")) { foreach my $key (split(/:/, $ref->{link})) { if ($key =~ /\Q$module\E/) { @@ -2613,7 +2767,7 @@ sub create_links { WHERE a.id = ?|; $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id}); - foreach $key (keys %$ref) { + foreach my $key (keys %$ref) { $self->{$key} = $ref->{$key}; } @@ -2635,7 +2789,7 @@ sub create_links { do_statement($self, $sth, $query, "%$module%"); $self->{accounts} = ""; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + while ($ref = $sth->fetchrow_hashref("NAME_lc")) { foreach my $key (split(/:/, $ref->{link})) { if ($key =~ /\Q$module\E/) { @@ -2685,7 +2839,7 @@ sub create_links { my $index = 0; # store amounts in {acc_trans}{$key} for multiple accounts - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + while (my $ref = $sth->fetchrow_hashref("NAME_lc")) { $ref->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld); if (!($xkeyref{ $ref->{accno} } =~ /tax/)) { @@ -2746,36 +2900,52 @@ sub lastname_used { my ($self, $dbh, $myconfig, $table, $module) = @_; - my $arap = ($table eq 'customer') ? "ar" : "ap"; - $table = $table eq "customer" ? "customer" : "vendor"; - my $where = "1 = 1"; + my ($arap, $where); + + $table = $table eq "customer" ? "customer" : "vendor"; + my %column_map = ("a.curr" => "currency", + "a.${table}_id" => "${table}_id", + "a.department_id" => "department_id", + "d.description" => "department", + "ct.name" => $table, + "current_date + ct.terms" => "duedate", + ); + + if ($self->{type} =~ /delivery_order/) { + $arap = 'delivery_orders'; + delete $column_map{"a.curr"}; - if ($self->{type} =~ /_order/) { + } elsif ($self->{type} =~ /_order/) { $arap = 'oe'; $where = "quotation = '0'"; - } - if ($self->{type} =~ /_quotation/) { + + } elsif ($self->{type} =~ /_quotation/) { $arap = 'oe'; $where = "quotation = '1'"; + + } elsif ($table eq 'customer') { + $arap = 'ar'; + + } else { + $arap = 'ap'; + } - my $query = qq|SELECT MAX(id) FROM $arap - WHERE $where AND ${table}_id > 0|; - my ($trans_id) = selectrow_query($self, $dbh, $query); + $where = "($where) AND" if ($where); + my $query = qq|SELECT MAX(id) FROM $arap + WHERE $where ${table}_id > 0|; + my ($trans_id) = selectrow_query($self, $dbh, $query); + $trans_id *= 1; - $trans_id *= 1; - $query = - qq|SELECT - a.curr, a.${table}_id, a.department_id, - d.description AS department, - ct.name, current_date + ct.terms AS duedate - FROM $arap a - LEFT JOIN $table ct ON (a.${table}_id = ct.id) - LEFT JOIN department d ON (a.department_id = d.id) - WHERE a.id = ?|; - ($self->{currency}, $self->{"${table}_id"}, $self->{department_id}, - $self->{department}, $self->{$table}, $self->{duedate}) - = selectrow_query($self, $dbh, $query, $trans_id); + my $column_spec = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map); + $query = qq|SELECT $column_spec + FROM $arap a + LEFT JOIN $table ct ON (a.${table}_id = ct.id) + LEFT JOIN department d ON (a.department_id = d.id) + WHERE a.id = ?|; + my $ref = selectfirst_hashref_query($self, $dbh, $query, $trans_id); + + map { $self->{$_} = $ref->{$_} } values %column_map; $main::lxdebug->leave_sub(); } @@ -2835,7 +3005,7 @@ sub redo_rows { # fill rows foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) { $i++; - $j = $item->{ndx} - 1; + my $j = $item->{ndx} - 1; map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds}; } @@ -3015,10 +3185,9 @@ sub get_history { qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name, h.snumbers, h.trans_id AS id | . qq|FROM history_erp h | . qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | . - qq|WHERE trans_id = | . $trans_id - . $restriction . qq| | - . $order; - + qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | . + $order; + my $sth = $dbh->prepare($query) || $self->dberror($query); $sth->execute() || $self->dberror("$query"); @@ -3029,7 +3198,7 @@ sub get_history { $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g; $tempArray[$i++] = $hash_ref; } - $main::lxdebug->leave_sub() and return \@tempArray + $main::lxdebug->leave_sub() and return \@tempArray if ($i > 0 && $tempArray[0] ne ""); } $main::lxdebug->leave_sub(); @@ -3120,6 +3289,7 @@ sub get_partsgroup { $main::lxdebug->enter_sub(); my ($self, $myconfig, $p) = @_; + my $target = $p->{target} || 'all_partsgroup'; my $dbh = $self->get_standard_dbh($myconfig); @@ -3158,7 +3328,7 @@ sub get_partsgroup { @values = ($p->{language_code}); } - $self->{all_partsgroup} = selectall_hashref_query($self, $dbh, $query, @values); + $self->{$target} = selectall_hashref_query($self, $dbh, $query, @values); $main::lxdebug->leave_sub(); } @@ -3224,4 +3394,25 @@ sub all_years { $main::lxdebug->leave_sub(); } +sub backup_vars { + $main::lxdebug->enter_sub(); + my $self = shift; + my @vars = @_; + + map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars; + + $main::lxdebug->leave_sub(); +} + +sub restore_vars { + $main::lxdebug->enter_sub(); + + my $self = shift; + my @vars = @_; + + map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars; + + $main::lxdebug->leave_sub(); +} + 1;