X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=a6b21e2e560d086537b4313b4b0f2dab60f48d25;hb=0db7873fd959b1c41613efbaaefcbeb7f029e8ba;hp=b9ef3e1d4114f4f08beaeb7292b63afdcb5e447d;hpb=c7f9da819e437745d637e714993959e57244655a;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index b9ef3e1d4..a6b21e2e5 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -38,57 +38,97 @@ package Form; use Data::Dumper; -use Cwd; -use HTML::Template; -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 Template; +use List::Util qw(first max min sum); my $standard_dbh; -sub DESTROY { +END { if ($standard_dbh) { $standard_dbh->disconnect(); undef $standard_dbh; } } +sub _store_value { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my $key = shift; + my $value = shift; + + my $curr = $self; + + while ($key =~ /\[\+?\]\.|\./) { + substr($key, 0, $+[0]) = ''; + + if ($& eq '.') { + $curr->{$`} ||= { }; + $curr = $curr->{$`}; + + } else { + $curr->{$`} ||= [ ]; + if (!scalar @{ $curr->{$`} } || $& eq '[+].') { + push @{ $curr->{$`} }, { }; + } + + $curr = $curr->{$`}->[-1]; + } + } + + $curr->{$key} = $value; + + $main::lxdebug->leave_sub(2); + + return \$curr->{$key}; +} + sub _input_to_hash { $main::lxdebug->enter_sub(2); - my $input = $_[0]; - my %in = (); + my $self = shift; + my $input = shift; + my @pairs = split(/&/, $input); foreach (@pairs) { - my ($name, $value) = split(/=/, $_, 2); - $in{$name} = unescape(undef, $value); + my ($key, $value) = split(/=/, $_, 2); + $self->_store_value($self->unescape($key), $self->unescape($value)); } $main::lxdebug->leave_sub(2); - - return %in; } sub _request_to_hash { $main::lxdebug->enter_sub(2); - my ($input) = @_; + my $self = shift; + my $input = shift; if (!$ENV{'CONTENT_TYPE'} || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { + + $self->_input_to_hash($input); + $main::lxdebug->leave_sub(2); - return _input_to_hash($input); + return; } - my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr); - my %params; + my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous); my $boundary = '--' . $1; @@ -96,9 +136,10 @@ sub _request_to_hash { last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r")); if (($line eq $boundary) || ($line eq "$boundary\r")) { - $params{$name} =~ s|\r?\n$|| if $name; + ${ $previous } =~ s|\r?\n$|| if $previous; - undef $name, $filename; + undef $previous; + undef $filename; $headers_done = 0; $content_type = "text/plain"; @@ -129,8 +170,8 @@ sub _request_to_hash { substr $line, $-[0], $+[0] - $-[0], ""; } - $params{$name} = ""; - $params{FILENAME} = $filename if ($filename); + $previous = $self->_store_value($name, ''); + $self->{FILENAME} = $filename if ($filename); next; } @@ -142,15 +183,14 @@ sub _request_to_hash { next; } - next unless $name; + next unless $previous; - $params{$name} .= "${line}\n"; + ${ $previous } .= "${line}\n"; } - $params{$name} =~ s|\r?\n$|| if $name; + ${ $previous } =~ s|\r?\n$|| if $previous; $main::lxdebug->leave_sub(2); - return %params; } sub new { @@ -175,17 +215,86 @@ sub new { $_ = $ARGV[0]; } - my %parameters = _request_to_hash($_); - map({ $self->{$_} = $parameters{$_}; } keys(%parameters)); + bless $self, $type; + + $self->_request_to_hash($_); - $self->{action} = lc $self->{action}; - $self->{action} =~ s/( |-|,|\#)/_/g; + $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(); - bless $self, $type; + 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 { @@ -200,6 +309,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); @@ -249,25 +376,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; @@ -294,11 +402,7 @@ sub error { } else { - if ($self->{error_function}) { - &{ $self->{error_function} }($msg); - } else { - die "Error: $msg\n"; - } + die "Error: $msg\n"; } $main::lxdebug->leave_sub(); @@ -335,20 +439,20 @@ sub info { $main::lxdebug->leave_sub(); } +# calculates the number of rows in a textarea based on the content and column number +# can be capped with maxrows sub numtextrows { $main::lxdebug->enter_sub(); + my ($self, $str, $cols, $maxrows, $minrows) = @_; - my ($self, $str, $cols, $maxrows) = @_; + $minrows ||= 1; - my $rows = 0; - - map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str; - - $maxrows = $rows unless defined $maxrows; + my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str; + $maxrows ||= $rows; $main::lxdebug->leave_sub(); - return ($rows > $maxrows) ? $maxrows : $rows; + return max(min($rows, $maxrows), $minrows); } sub dberror { @@ -366,12 +470,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(); @@ -385,6 +536,12 @@ sub header { my ($stylesheet, $favicon); if ($ENV{HTTP_USER_AGENT}) { + my $doctype; + + if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) { + # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise. + $doctype = qq|\n|; + } my $stylesheets = "$self->{stylesheet} $self->{stylesheets}"; @@ -420,6 +577,7 @@ sub header { if ($self->{jsscript} == 1) { $jsscript = qq| + @@ -436,15 +594,16 @@ sub header { foreach $item (@ { $self->{AJAX} }) { $ajax .= $item->show_javascript(); } - print qq|Content-Type: text/html; charset=${db_charset}; - + print $self->create_http_response('content_type' => 'text/html', + 'charset' => $db_charset,); + print qq|${doctype} + $self->{titlebar} $stylesheet $pagelayout $favicon - $jsscript $ajax @@ -458,15 +617,15 @@ sub header { - + @@ -480,6 +639,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(); @@ -532,6 +705,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; @@ -541,6 +715,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; @@ -555,88 +735,91 @@ sub parse_html_template { $file = $self->_prepare_html_template($file, $additional_params); - my $template = HTML::Template->new("filename" => $file, - "die_on_bad_params" => 0, - "strict" => 0, - "case_sensitive" => 1, - "loop_context_vars" => 1, - "global_vars" => 1); + my $template = Template->new({ 'INTERPOLATE' => 0, + 'EVAL_PERL' => 0, + 'ABSOLUTE' => 1, + 'CACHE_SIZE' => 0, + 'PLUGIN_BASE' => 'SL::Template::Plugin', + 'INCLUDE_PATH' => '.:templates/webpages', + }) || die; + + map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; + + my $in = IO::File->new($file, 'r'); - foreach my $key ($template->param()) { - my $param = $additional_params->{$key} || $self->{$key}; - $param = [] if (($template->query("name" => $key) eq "LOOP") && (ref($param) ne "ARRAY")); - $template->param($key => $param); + if (!$in) { + print STDERR "Error opening template file: $!"; + $main::lxdebug->leave_sub(); + return ''; } - my $output = $template->output(); + my $input = join('', <$in>); + $in->close(); + + if ($main::locale) { + $input = $main::locale->{iconv}->convert($input); + } - $output = $main::locale->{iconv}->convert($output) if ($main::locale); + my $output; + if (!$template->process(\$input, $additional_params, \$output)) { + print STDERR $template->error(); + } $main::lxdebug->leave_sub(); return $output; } -sub parse_html_template2 { +sub show_generic_error { $main::lxdebug->enter_sub(); - my ($self, $file, $additional_params) = @_; - - $additional_params ||= { }; - - $file = $self->_prepare_html_template($file, $additional_params); - - my $template = Template->new({ 'INTERPOLATE' => 0, - 'EVAL_PERL' => 0, - 'ABSOLUTE' => 1, - 'CACHE_SIZE' => 0, - }) || die; - - map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; - - my $output; - $template->process($file, $additional_params, \$output); - - $output = $main::locale->{iconv}->convert($output) if ($main::locale); + my ($self, $error, %params) = @_; - $main::lxdebug->leave_sub(); + my $add_params = { + 'title_error' => $params{title}, + 'label_error' => $error, + }; - return $output; -} + if ($params{action}) { + my @vars; -sub show_generic_error { - my ($self, $error, $title, $action) = @_; + map { delete($self->{$_}); } qw(action); + map { push @vars, { "name" => $_, "value" => $self->{$_} } if (!ref($self->{$_})); } keys %{ $self }; - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_error"} = $error; + $add_params->{SHOW_BUTTON} = 1; + $add_params->{BUTTON_LABEL} = $params{label} || $params{action}; + $add_params->{VARIABLES} = \@vars; - 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; + } elsif ($params{back_button}) { + $add_params->{SHOW_BACK_BUTTON} = 1; } - $add_params->{"VARIABLES"} = \@vars; + + $self->{title} = $title if ($title); $self->header(); - print($self->parse_html_template("generic/error", $add_params)); + print $self->parse_html_template("generic/error", $add_params); + + $main::lxdebug->leave_sub(); die("Error: $error\n"); } sub show_generic_information { - my ($self, $error, $title) = @_; + $main::lxdebug->enter_sub(); - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_information"} = $error; + my ($self, $text, $title) = @_; + + my $add_params = { + 'title_information' => $title, + 'label_information' => $text, + }; + + $self->{title} = $title if ($title); $self->header(); - print($self->parse_html_template("generic/information", $add_params)); + print $self->parse_html_template("generic/information", $add_params); + + $main::lxdebug->leave_sub(); die("Information: $error\n"); } @@ -728,18 +911,23 @@ sub format_amount { if ($amount eq "") { $amount = 0; } - my $neg = ($amount =~ s/-//); - + + # 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 ($places < 0) { - $amount *= 1; - $places *= -1; - - my ($actual_places) = ($amount =~ /\.(\d+)/); - $actual_places = length($actual_places); - $places = $actual_places > $places ? $actual_places : $places; + if (not $exp) { + if ($places < 0) { + $amount *= 1; + $places *= -1; + + my ($actual_places) = ($amount =~ /\.(\d+)/); + $actual_places = length($actual_places); + $places = $actual_places > $places ? $actual_places : $places; + } } - $amount = $self->round_amount($amount, $places); } @@ -761,7 +949,92 @@ 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; + + 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); + + my $self = shift; + my $input = shift; + + $input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx; + $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx; + $input =~ s/\#\#/\#/g; + + $main::lxdebug->leave_sub(2); + + return $input; +} + # + sub parse_amount { $main::lxdebug->enter_sub(2); @@ -842,12 +1115,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); $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); @@ -898,14 +1170,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}) @@ -925,9 +1198,8 @@ sub parse_template { $self->{"attachment_filename"} : $self->{"tmpfile"} }); } - $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}"; } @@ -993,50 +1265,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(); @@ -1148,6 +1454,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); @@ -1155,6 +1466,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(); @@ -1182,13 +1508,13 @@ sub update_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; - + my ($query); # some sanity check for currency if ($curr eq '') { $main::lxdebug->leave_sub(); return; } - my $query = qq|SELECT curr FROM defaults|; + $query = qq|SELECT curr FROM defaults|; my ($currency) = selectrow_query($self, $dbh, $query); my ($defaultcurrency) = split m/:/, $currency; @@ -1199,7 +1525,7 @@ sub update_exchangerate { return; } - my $query = qq|SELECT e.curr FROM exchangerate e + $query = qq|SELECT e.curr FROM exchangerate e WHERE e.curr = ? AND e.transdate = ? FOR UPDATE|; my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate); @@ -1264,13 +1590,14 @@ sub get_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $fld) = @_; + my ($query); unless ($transdate) { $main::lxdebug->leave_sub(); return 1; } - my $query = qq|SELECT curr FROM defaults|; + $query = qq|SELECT curr FROM defaults|; my ($currency) = selectrow_query($self, $dbh, $query); my ($defaultcurrency) = split m/:/, $currency; @@ -1280,7 +1607,7 @@ sub get_exchangerate { return 1; } - my $query = qq|SELECT e.$fld FROM exchangerate e + $query = qq|SELECT e.$fld FROM exchangerate e WHERE e.curr = ? AND e.transdate = ?|; my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); @@ -1314,8 +1641,6 @@ sub check_exchangerate { my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate); - $exchangerate = 1 if ($exchangerate eq ""); - $main::lxdebug->leave_sub(); return $exchangerate; @@ -1370,12 +1695,32 @@ sub set_payment_options { ($self->{netto_date}, $self->{skonto_date}) = selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto}); - my $total = ($self->{invtotal}) ? $self->{invtotal} : $self->{ordtotal}; - my $skonto_amount = $self->parse_amount($myconfig, $total) * - $self->{percent_skonto}; + my ($invtotal, $total); + my (%amounts, %formatted_amounts); + + if ($self->{type} =~ /_order$/) { + $amounts{invtotal} = $self->{ordtotal}; + $amounts{total} = $self->{ordtotal}; - $self->{skonto_amount} = - $self->format_amount($myconfig, $skonto_amount, 2); + } elsif ($self->{type} =~ /_quotation$/) { + $amounts{invtotal} = $self->{quototal}; + $amounts{total} = $self->{quototal}; + + } else { + $amounts{invtotal} = $self->{invtotal}; + $amounts{total} = $self->{total}; + } + + map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts; + + $amounts{skonto_amount} = $amounts{invtotal} * $self->{percent_skonto}; + $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto}); + $amounts{total_wo_skonto} = $amounts{total} * (1 - $self->{percent_skonto}); + + foreach (keys %amounts) { + $amounts{$_} = $self->round_amount($amounts{$_}, 2); + $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2); + } if ($self->{"language_id"}) { $query = @@ -1403,23 +1748,21 @@ sub set_payment_options { ($output_numberformat ne $myconfig->{"numberformat"})) { my $saved_numberformat = $myconfig->{"numberformat"}; $myconfig->{"numberformat"} = $output_numberformat; - $self->{skonto_amount} = - $self->format_amount($myconfig, $skonto_amount, 2); + map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts; $myconfig->{"numberformat"} = $saved_numberformat; } } $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g; $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g; - $self->{payment_terms} =~ s/<%skonto_amount%>/$self->{skonto_amount}/g; - $self->{payment_terms} =~ s/<%total%>/$self->{total}/g; - $self->{payment_terms} =~ s/<%invtotal%>/$self->{invtotal}/g; $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g; $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g; $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g; $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g; $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g; + map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts; + $main::lxdebug->leave_sub(); } @@ -1551,30 +1894,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(); @@ -1599,6 +1943,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 | . @@ -1667,10 +2017,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(); } @@ -1747,7 +2102,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(); } @@ -1823,11 +2178,12 @@ $main::lxdebug->enter_sub(); sub _get_customers { $main::lxdebug->enter_sub(); - my ($self, $dbh, $key) = @_; + my ($self, $dbh, $key, $limit) = @_; $key = "all_customers" unless ($key); + $limit_clause = "LIMIT $limit" if $limit; - my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name|; + my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|; $self->{$key} = selectall_hashref_query($self, $dbh, $query); @@ -1862,6 +2218,73 @@ sub _get_departments { $main::lxdebug->leave_sub(); } +sub _get_warehouses { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $param) = @_; + + my ($key, $bins_key); + + if ('' eq ref $param) { + $key = $param; + + } else { + $key = $param->{key}; + $bins_key = $param->{bins}; + } + + 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(); @@ -1929,11 +2352,19 @@ sub get_lists { } if($params{"customers"}) { - $self->_get_customers($dbh, $params{"customers"}); + if (ref $params{"customers"} eq 'HASH') { + $self->_get_customers($dbh, $params{"customers"}{key}, $params{"customers"}{limit}); + } else { + $self->_get_customers($dbh, $params{"customers"}); + } } if($params{"vendors"}) { - $self->_get_vendors($dbh, $params{"vendors"}); + if (ref $params{"vendors"} eq 'HASH') { + $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit}); + } else { + $self->_get_vendors($dbh, $params{"vendors"}); + } } if($params{"payments"}) { @@ -1944,6 +2375,21 @@ sub get_lists { $self->_get_departments($dbh, $params{"departments"}); } + if ($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(); } @@ -2181,7 +2627,7 @@ sub create_links { while ($ref = $sth->fetchrow_hashref(NAME_lc)) { foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /$module/) { + if ($key =~ /\Q$module\E/) { # cross reference for keys $xkeyref{ $ref->{accno} } = $key; @@ -2240,7 +2686,7 @@ sub create_links { LEFT JOIN taxkeys tk ON (tk.chart_id = c.id) WHERE c.link LIKE ? AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1) - OR c.link LIKE '%_tax%') + OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL) ORDER BY c.accno|; $sth = $dbh->prepare($query); @@ -2250,7 +2696,7 @@ sub create_links { while ($ref = $sth->fetchrow_hashref(NAME_lc)) { foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /$module/) { + if ($key =~ /\Q$module\E/) { # cross reference for keys $xkeyref{ $ref->{accno} } = $key; @@ -2358,36 +2804,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(); } @@ -2440,8 +2902,7 @@ sub redo_rows { my @ndx = (); - map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } - (1 .. $count); + map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count; my $i = 0; @@ -2482,8 +2943,8 @@ sub update_status { } $sth->finish(); - my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; - my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; my %queued = split / /, $self->{queued}; my @values; @@ -2527,7 +2988,7 @@ sub save_status { my $formnames = $self->{printed}; my $emailforms = $self->{emailed}; - my $query = qq|DELETE FROM status + $query = qq|DELETE FROM status WHERE (formname = ?) AND (trans_id = ?)|; do_query($self, $dbh, $query, $self->{formname}, $self->{id}); @@ -2538,15 +2999,15 @@ sub save_status { my %queued = split / /, $self->{queued}; foreach my $formname (keys %queued) { - $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; - $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) VALUES (?, ?, ?, ?, ?)|; do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname); - $formnames =~ s/$self->{formname}//; - $emailforms =~ s/$self->{formname}//; + $formnames =~ s/\Q$self->{formname}\E//; + $emailforms =~ s/\Q$self->{formname}\E//; } } @@ -2560,8 +3021,8 @@ sub save_status { map { $status{$_}{emailed} = 1 } split / +/, $emailforms; foreach my $formname (keys %status) { - $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0"; - $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0"; + $printed = ($formnames =~ /\Q$self->{formname}\E/) ? "1" : "0"; + $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0"; $query = qq|INSERT INTO status (trans_id, printed, emailed, formname) VALUES (?, ?, ?, ?)|; @@ -2733,6 +3194,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); @@ -2771,7 +3233,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(); } @@ -2837,4 +3299,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;