X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=637bbe286b056776f45d1b14819e4e4ce8eb5eae;hb=49c7621e7bd48352be257e6ceea0e6fbb1718516;hp=d9d79a511ff530946f287cf160a1cdc83116ab28;hpb=e5478aea0bc6d86ed99f41abed16dff8b3cb6094;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index d9d79a511..637bbe286 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -36,23 +36,31 @@ #====================================================================== package Form; + +#use strict; + use Data::Dumper; -use Cwd; -use Template; -use SL::Template; +use CGI; use CGI::Ajax; +use Cwd; +use IO::File; +use SL::Auth; +use SL::Auth::DB; +use SL::Auth::LDAP; +use SL::AM; +use SL::Common; use SL::DBUtils; use SL::Mailer; use SL::Menu; +use SL::Template; use SL::User; -use SL::Common; -use CGI; -use List::Util qw(max min sum); +use Template; +use List::Util qw(first max min sum); my $standard_dbh; -sub DESTROY { +END { if ($standard_dbh) { $standard_dbh->disconnect(); undef $standard_dbh; @@ -62,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]) = ''; @@ -95,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); @@ -111,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; @@ -165,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; } @@ -188,6 +194,29 @@ sub _request_to_hash { $main::lxdebug->leave_sub(2); } +sub _recode_recursively { + 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]); + } + } + } +} + sub new { $main::lxdebug->enter_sub(); @@ -212,18 +241,101 @@ 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 1"; $main::lxdebug->leave_sub(); return $self; } +sub _flatten_variables_rec { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my $curr = shift; + my $prefix = shift; + my $key = shift; + + my @result; + + if ('' eq ref $curr->{$key}) { + @result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} }); + + } elsif ('HASH' eq ref $curr->{$key}) { + foreach my $hash_key (sort keys %{ $curr->{$key} }) { + push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key); + } + + } else { + foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) { + my $first_array_entry = 1; + + foreach my $hash_key (sort keys %{ $curr->{$key}->[$idx] }) { + push @result, $self->_flatten_variables_rec($curr->{$key}->[$idx], $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key); + $first_array_entry = 0; + } + } + } + + $main::lxdebug->leave_sub(2); + + return @result; +} + +sub flatten_variables { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my @keys = @_; + + my @variables; + + foreach (@keys) { + push @variables, $self->_flatten_variables_rec($self, '', $_); + } + + $main::lxdebug->leave_sub(2); + + return @variables; +} + +sub flatten_standard_variables { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar version), @_); + + my @variables; + + foreach (grep { ! $skip_keys{$_} } keys %{ $self }) { + push @variables, $self->_flatten_variables_rec($self, '', $_); + } + + $main::lxdebug->leave_sub(2); + + return @variables; +} + sub debug { $main::lxdebug->enter_sub(); @@ -236,6 +348,24 @@ sub debug { $main::lxdebug->leave_sub(); } +sub dumper { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my $password = $self->{password}; + + $self->{password} = 'X' x 8; + + local $Data::Dumper::Sortkeys = 1; + my $output = Dumper($self); + + $self->{password} = $password; + + $main::lxdebug->leave_sub(2); + + return $output; +} + sub escape { $main::lxdebug->enter_sub(2); @@ -285,25 +415,6 @@ sub unquote { } -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 hide_form { my $self = shift; @@ -371,13 +482,16 @@ sub info { # can be capped with maxrows sub numtextrows { $main::lxdebug->enter_sub(); - my ($self, $str, $cols, $maxrows) = @_; + my ($self, $str, $cols, $maxrows, $minrows) = @_; + + $minrows ||= 1; my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str; $maxrows ||= $rows; $main::lxdebug->leave_sub(); - return min $rows, $maxrows; + + return max(min($rows, $maxrows), $minrows); } sub dberror { @@ -395,12 +509,59 @@ sub isblank { my ($self, $name, $msg) = @_; - if ($self->{$name} =~ /^\s*$/) { - $self->error($msg); + my $curr = $self; + foreach my $part (split m/\./, $name) { + if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) { + $self->error($msg); + } + $curr = $curr->{$part}; + } + + $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(); @@ -411,7 +572,7 @@ sub header { return; } - my ($stylesheet, $favicon); + my ($stylesheet, $favicon, $pagelayout); if ($ENV{HTTP_USER_AGENT}) { my $doctype; @@ -455,6 +616,7 @@ sub header { if ($self->{jsscript} == 1) { $jsscript = qq| + @@ -468,24 +630,25 @@ sub header { ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; my $ajax = ""; - foreach $item (@ { $self->{AJAX} }) { + foreach my $item (@ { $self->{AJAX} }) { $ajax .= $item->show_javascript(); } - print qq|Content-Type: text/html; charset=${db_charset}; -${doctype} + print $self->create_http_response('content_type' => 'text/html', + 'charset' => $db_charset,); + print qq|${doctype} + $self->{titlebar} $stylesheet $pagelayout $favicon - $jsscript $ajax - + @@ -515,6 +678,20 @@ ${doctype} $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(); @@ -567,6 +744,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; @@ -576,6 +754,12 @@ sub _prepare_html_template { map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options; } + if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) { + while (my ($key, $value) = each %{ $main::auth->{RIGHTS}->{$self->{login}} }) { + $additional_params->{"AUTH_RIGHTS_" . uc($key)} = $value; + } + } + $main::lxdebug->leave_sub(); return $file; @@ -600,46 +784,68 @@ 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 { - my ($self, $error, $title, $action) = @_; + $main::lxdebug->enter_sub(); + + my ($self, $error, %params) = @_; my $add_params = { - 'title_error' => $title, + 'title_error' => $params{title}, 'label_error' => $error, }; - my @vars; - if ($action) { - map({ delete($self->{$_}); } qw(action)); - map({ push(@vars, { "name" => $_, "value" => $self->{$_} }) - if (!ref($self->{$_})); } - keys(%{$self})); - $add_params->{"SHOW_BUTTON"} = 1; - $add_params->{"BUTTON_LABEL"} = $action; + if ($params{action}) { + my @vars; + + map { delete($self->{$_}); } qw(action); + map { push @vars, { "name" => $_, "value" => $self->{$_} } if (!ref($self->{$_})); } keys %{ $self }; + + $add_params->{SHOW_BUTTON} = 1; + $add_params->{BUTTON_LABEL} = $params{label} || $params{action}; + $add_params->{VARIABLES} = \@vars; + + } elsif ($params{back_button}) { + $add_params->{SHOW_BACK_BUTTON} = 1; } - $add_params->{"VARIABLES"} = \@vars; - $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 = { @@ -652,7 +858,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) @@ -675,8 +883,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) { @@ -709,7 +917,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); @@ -742,12 +950,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) { @@ -780,7 +988,75 @@ sub format_amount { $main::lxdebug->leave_sub(2); return $amount; } -# + +sub format_amount_units { + $main::lxdebug->enter_sub(); + + my $self = shift; + my %params = @_; + + my $myconfig = \%main::myconfig; + 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; + + if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) { + $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller'); + } + + if (!scalar @{ $conv_units }) { + my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name; + $main::lxdebug->leave_sub(); + return $result; + } + + my $part_unit = $all_units->{$part_unit_name}; + my $conv_unit = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit; + + $amount *= $conv_unit->{factor}; + + my @values; + my $num; + + foreach my $unit (@$conv_units) { + my $last = $unit->{name} eq $part_unit->{name}; + if (!$last) { + $num = int($amount / $unit->{factor}); + $amount -= $num * $unit->{factor}; + } + + if ($last ? $amount : $num) { + push @values, { "unit" => $unit->{name}, + "amount" => $last ? $amount / $unit->{factor} : $num, + "places" => $last ? $places : 0 }; + } + + last if $last; + } + + if (!@values) { + push @values, { "unit" => $part_unit_name, + "amount" => 0, + "places" => 0 }; + } + + my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values; + + $main::lxdebug->leave_sub(); + + return $result; +} sub format_string { $main::lxdebug->enter_sub(2); @@ -797,6 +1073,8 @@ sub format_string { return $input; } +# + sub parse_amount { $main::lxdebug->enter_sub(2); @@ -851,25 +1129,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'}"); } @@ -877,16 +1167,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)); - map({ $self->{"employee_${_}"} =~ s/\\n/\n/g; } - qw(company address signature)); - map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature)); + 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); @@ -937,14 +1222,15 @@ sub parse_template { $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email}; $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; $mail->{fileid} = "$fileid."; - $myconfig->{signature} =~ s/\\r\\n/\\n/g; + $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->{message} =~ s/\r\n/
\n/g; - $myconfig->{signature} =~ s/\\n/
\n/g; + $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}) @@ -958,15 +1244,14 @@ 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\n/\n/g; - $myconfig->{signature} =~ s/\\n/\n/g; - $mail->{message} .= "\n-- \n$myconfig->{signature}"; + $mail->{message} =~ s/\r//g; + $mail->{message} .= "\n-- \n$myconfig->{signature}"; } @@ -991,7 +1276,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(); @@ -1032,50 +1317,84 @@ sub get_formname_translation { $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'), ); return $formname_translations{$formname} } +sub get_number_prefix_for_type { + my ($self) = @_; + + my $prefix = + (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv' + : ($self->{type} =~ /_quotation$/) ? 'quo' + : ($self->{type} =~ /_delivery_order$/) ? 'do' + : 'ord'; + + return $prefix; +} + +sub get_extension_for_format { + my ($self) = @_; + + my $extension = $self->{format} =~ /pdf/i ? ".pdf" + : $self->{format} =~ /postscript/i ? ".ps" + : $self->{format} =~ /opendocument/i ? ".odt" + : $self->{format} =~ /html/i ? ".html" + : ""; + + return $extension; +} + sub generate_attachment_filename { my ($self) = @_; - my $attachment_filename = $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; + return $attachment_filename; } +sub generate_email_subject { + 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"} + } + + return $subject; +} + sub cleanup { $main::lxdebug->enter_sub(); @@ -1109,6 +1428,7 @@ sub datetonum { $main::lxdebug->enter_sub(); my ($self, $date, $myconfig) = @_; + my ($yy, $mm, $dd); if ($date && $date =~ /\D/) { @@ -1165,9 +1485,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; @@ -1187,6 +1507,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); @@ -1194,6 +1519,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(); @@ -1226,7 +1566,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); @@ -1267,7 +1607,7 @@ sub update_exchangerate { SET $set WHERE curr = ? AND transdate = ?|; - + } else { $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate) VALUES (?, $buy, $sell, ?)|; @@ -1336,6 +1676,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 ""; @@ -1354,8 +1698,6 @@ sub check_exchangerate { my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate); - $exchangerate = 1 if ($exchangerate eq ""); - $main::lxdebug->leave_sub(); return $exchangerate; @@ -1580,7 +1922,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){ @@ -1609,30 +1951,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); - 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 ($login) = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id})); - $self->{salesman_name} = $login - if ($self->{salesman_name} eq ""); + if ($login) { + my $user = User->new($login); + map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel); - map({ $self->{"salesman_$_"} =~ s/\\n/\n/g; } qw(address company)); + $self->{$params{prefix} . '_login'} = $login; + $self->{$params{prefix} . '_name'} ||= $login; } $main::lxdebug->leave_sub(); @@ -1657,6 +2000,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 | . @@ -1725,10 +2074,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(); } @@ -1751,6 +2105,7 @@ sub _get_charts { $main::lxdebug->enter_sub(); my ($self, $dbh, $params) = @_; + my ($key); $key = $params->{key}; $key = "all_charts" unless ($key); @@ -1774,11 +2129,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); @@ -1805,7 +2176,7 @@ sub _get_employees { my ($self, $dbh, $default_key, $key) = @_; $key = $default_key unless ($key); - $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY name|); + $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|); $main::lxdebug->leave_sub(); } @@ -1858,7 +2229,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(); @@ -1872,7 +2243,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(); @@ -1884,7 +2255,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|; @@ -1921,20 +2292,73 @@ sub _get_departments { $main::lxdebug->leave_sub(); } -sub _get_price_factors { +sub _get_warehouses { $main::lxdebug->enter_sub(); - my ($self, $dbh, $key) = @_; + my ($self, $dbh, $param) = @_; + + my ($key, $bins_key); + + if ('' eq ref $param) { + $key = $param; - $key ||= "all_price_factors"; + } else { + $key = $param->{key}; + $bins_key = $param->{bins}; + } - my $query = qq|SELECT * FROM price_factors ORDER BY sortkey|; + 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) + ORDER BY w.sortkey|; $self->{$key} = selectall_hashref_query($self, $dbh, $query); + if ($bins_key) { + $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|; + my $sth = prepare_query($self, $dbh, $query); + + foreach my $warehouse (@{ $self->{$key} }) { + do_statement($self, $sth, $query, $warehouse->{id}); + $warehouse->{$bins_key} = []; + + while (my $ref = $sth->fetchrow_hashref()) { + push @{ $warehouse->{$bins_key} }, $ref; + } + } + $sth->finish(); + } + $main::lxdebug->leave_sub(); } +sub _get_simple { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $table, $key, $sortkey) = @_; + + my $query = qq|SELECT * FROM $table|; + $query .= qq| ORDER BY $sortkey| if ($sortkey); + + $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(); @@ -1984,7 +2408,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"}); } @@ -1996,11 +2420,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}); @@ -2008,7 +2432,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}); @@ -2016,7 +2440,7 @@ sub get_lists { $self->_get_vendors($dbh, $params{"vendors"}); } } - + if($params{"payments"}) { $self->_get_payments($dbh, $params{"payments"}); } @@ -2026,7 +2450,19 @@ sub get_lists { } if ($params{price_factors}) { - $self->_get_price_factors($dbh, $params{price_factors}); + $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey'); + } + + if ($params{warehouses}) { + $self->_get_warehouses($dbh, $params{warehouses}); + } + +# 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(); @@ -2263,7 +2699,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/) { @@ -2310,7 +2746,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}; } @@ -2332,7 +2768,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/) { @@ -2382,7 +2818,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/)) { @@ -2443,36 +2879,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} =~ /_order/) { + if ($self->{type} =~ /delivery_order/) { + $arap = 'delivery_orders'; + delete $column_map{"a.curr"}; + + } 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(); } @@ -2532,7 +2984,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}; } @@ -2715,7 +3167,7 @@ sub get_history { qq|WHERE trans_id = | . $trans_id . $restriction . qq| | . $order; - + my $sth = $dbh->prepare($query) || $self->dberror($query); $sth->execute() || $self->dberror("$query"); @@ -2726,7 +3178,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(); @@ -2817,6 +3269,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); @@ -2855,7 +3308,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(); } @@ -2921,4 +3374,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 $self->{$_} } @vars; + + $main::lxdebug->leave_sub(); +} + +sub restore_vars { + $main::lxdebug->enter_sub(); + + my $self = shift; + my @vars = @_; + + map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if $self->{_VAR_BACKUP}->{$_} } @vars; + + $main::lxdebug->leave_sub(); +} + 1;