X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=8d8f41768fb8ecd1e795d67c156d62f348683dd3;hb=2d0387d1624b5b7ed6b13b79b9d5a87ce9b6d12b;hp=fbcbe56f3b6ff9c8d605e38a083d5c4f97a2e6f5;hpb=030c208648ddd8137d8fab33bb8b2eb87f5c080f;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index fbcbe56f3..8d8f41768 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -1,4 +1,4 @@ -#========= =========================================================== +#===================================================================== # LX-Office ERP # Copyright (C) 2004 # Based on SQL-Ledger Version 2.1.9 @@ -27,7 +27,8 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +# MA 02110-1335, USA. #====================================================================== # Utilities for parsing forms # and supporting routines for linking account numbers @@ -41,13 +42,14 @@ use Carp; use Data::Dumper; use Carp; -use Config; use CGI; use Cwd; use Encode; use File::Copy; +use File::Temp (); use IO::File; use Math::BigInt; +use POSIX qw(strftime); use SL::Auth; use SL::Auth::DB; use SL::Auth::LDAP; @@ -62,6 +64,7 @@ use SL::DB::Default; use SL::DB::PaymentTerm; use SL::DB::Vendor; use SL::DO; +use SL::Helper::Flash qw(); use SL::IC; use SL::IS; use SL::Layout::Dispatcher; @@ -76,37 +79,21 @@ use SL::Request; use SL::Template; use SL::User; use SL::Util; +use SL::Version; use SL::X; use Template; use URI; use List::Util qw(first max min sum); use List::MoreUtils qw(all any apply); use SL::DB::Tax; +use SL::Helper::File qw(:all); +use SL::Helper::Number; +use SL::Helper::CreatePDF qw(merge_pdfs); use strict; -my $standard_dbh; - -END { - disconnect_standard_dbh(); -} - -sub disconnect_standard_dbh { - return unless $standard_dbh; - - $standard_dbh->rollback(); - undef $standard_dbh; -} - sub read_version { - my ($self) = @_; - - open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file - my $version = ; - $version =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code. - close VERSION_FILE; - - return $version; + SL::Version->get_version; } sub new { @@ -124,18 +111,11 @@ sub new { bless $self, $type; - $self->{version} = $self->read_version; - $main::lxdebug->leave_sub(); return $self; } -sub read_cgi_input { - my ($self) = @_; - SL::Request::read_cgi_input($self); -} - sub _flatten_variables_rec { $main::lxdebug->enter_sub(2); @@ -166,7 +146,7 @@ sub _flatten_variables_rec { $first_array_entry = 0; } } else { - @result = ({ 'key' => $prefix . $key . ($first_array_entry ? '[+]' : '[]'), 'value' => $element }); + push @result, { 'key' => $prefix . $key . '[]', 'value' => $element }; } } } @@ -197,7 +177,7 @@ 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 %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar), @_); my @variables; @@ -210,36 +190,6 @@ sub flatten_standard_variables { return @variables; } -sub debug { - $main::lxdebug->enter_sub(); - - my ($self) = @_; - - print "\n"; - - map { print "$_ = $self->{$_}\n" } (sort keys %{$self}); - - $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 { my ($self, $str) = @_; @@ -295,7 +245,7 @@ sub hide_form { sub throw_on_error { my ($self, $code) = @_; - local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) }; + local $self->{__ERROR_HANDLER} = sub { SL::X::FormError->throw(error => $_[0]) }; $code->(); } @@ -355,13 +305,12 @@ sub numtextrows { } sub dberror { - $main::lxdebug->enter_sub(); - my ($self, $msg) = @_; - $self->error("$msg\n" . $DBI::errstr); - - $main::lxdebug->leave_sub(); + SL::X::DBError->throw( + msg => $msg, + db_error => $DBI::errstr, + ); } sub isblank { @@ -386,7 +335,7 @@ sub _get_request_uri { return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR}; return URI->new if !$ENV{REQUEST_URI}; # for testing - my $scheme = $ENV{HTTPS} && (lc $ENV{HTTPS} eq 'on') ? 'https' : 'http'; + my $scheme = $::request->is_https ? 'https' : 'http'; my $port = $ENV{SERVER_PORT}; $port = undef if (($scheme eq 'http' ) && ($port == 80)) || (($scheme eq 'https') && ($port == 443)); @@ -433,10 +382,11 @@ sub create_http_response { my $session_cookie_value = $main::auth->get_session_id(); if ($session_cookie_value) { - $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), - '-value' => $session_cookie_value, - '-path' => $uri->path, - '-secure' => $ENV{HTTPS}); + $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), + '-value' => $session_cookie_value, + '-path' => $uri->path, + '-expires' => '+' . $::auth->{session_timeout} . 'm', + '-secure' => $::request->is_https); } } @@ -444,7 +394,7 @@ sub create_http_response { $cgi_params{'-charset'} = $params{charset} if ($params{charset}); $cgi_params{'-cookie'} = $session_cookie if ($session_cookie); - map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length); + map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status); my $output = $cgi->header(%cgi_params); @@ -485,7 +435,7 @@ sub header { ), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}"); $self->{favicon} ||= "favicon.ico"; - $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title} || !$self->{titlebar}; + $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->read_version if $self->{title} || !$self->{titlebar}; # build includes if ($self->{refresh_url} || $self->{refresh_time}) { @@ -500,6 +450,7 @@ sub header { push @header, " " if $self->{landscape}; push @header, "" if -f $self->{favicon}; push @header, map { qq|| } $layout->javascripts; + push @header, ''; push @header, $self->{javascript} if $self->{javascript}; push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] }; @@ -579,7 +530,7 @@ sub set_standard_title { $::lxdebug->enter_sub; my $self = shift; - $self->{titlebar} = "kivitendo " . $::locale->text('Version') . " $self->{version}"; + $self->{titlebar} = "kivitendo " . $::locale->text('Version') . " " . $self->read_version; $self->{titlebar} .= "- $::myconfig{name}" if $::myconfig{name}; $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name}; @@ -599,8 +550,10 @@ sub _prepare_html_template { } $language = "de" unless ($language); - if (-f "templates/webpages/${file}.html") { - $file = "templates/webpages/${file}.html"; + my $webpages_path = $::request->layout->webpages_path; + + if (-f "${webpages_path}/${file}.html") { + $file = "${webpages_path}/${file}.html"; } elsif (ref $file eq 'SCALAR') { # file is a scalarref, use inline mode @@ -631,7 +584,7 @@ sub parse_html_template { $additional_params ||= { }; my $real_file = $self->_prepare_html_template($file, $additional_params); - my $template = $self->template || $self->init_template; + my $template = $self->template; map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; @@ -643,32 +596,7 @@ sub parse_html_template { return $output; } -sub init_template { - my $self = shift; - - return $self->template if $self->template; - - # Force scripts/locales.pl to pick up the exception handling template. - # parse_html_template('generic/exception') - return $self->template(Template->new({ - 'INTERPOLATE' => 0, - 'EVAL_PERL' => 0, - 'ABSOLUTE' => 1, - 'CACHE_SIZE' => 0, - 'PLUGIN_BASE' => 'SL::Template::Plugin', - 'INCLUDE_PATH' => '.:templates/webpages', - 'COMPILE_EXT' => '.tcc', - 'COMPILE_DIR' => $::lx_office_conf{paths}->{userspath} . '/templates-cache', - 'ERROR' => 'templates/webpages/generic/exception.html', - 'ENCODING' => 'utf8', - })) || die; -} - -sub template { - my $self = shift; - $self->{template_object} = shift if @_; - return $self->{template_object}; -} +sub template { $::request->presenter->get_template } sub show_generic_error { $main::lxdebug->enter_sub(); @@ -693,22 +621,18 @@ sub show_generic_error { 'label_error' => $error, }; - 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; + $self->{title} = $params{title} if $params{title}; - } elsif ($params{back_button}) { - $add_params->{SHOW_BACK_BUTTON} = 1; + for my $bar ($::request->layout->get('actionbar')) { + $bar->add( + action => [ + t8('Back'), + call => [ 'kivi.history_back' ], + accesskey => 'enter', + ], + ); } - $self->{title} = $params{title} if $params{title}; - $self->header(); print $self->parse_html_template("generic/error", $add_params); @@ -758,6 +682,7 @@ sub redirect { $self->info($msg); } else { + SL::Helper::Flash::flash_later('info', $msg) if $msg; $self->_store_redirect_info_in_session; print $::form->redirect_header($self->{callback}); } @@ -778,44 +703,10 @@ sub sort_columns { return @columns; } # -sub format_amount { - $main::lxdebug->enter_sub(2); +sub format_amount { my ($self, $myconfig, $amount, $places, $dash) = @_; - $amount ||= 0; - $dash ||= ''; - my $neg = $amount < 0; - my $force_places = defined $places && $places >= 0; - - $amount = $self->round_amount($amount, abs $places) if $force_places; - $neg = 0 if $amount == 0; # don't show negative zero - $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa - - # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl - # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on - # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs. - - $amount =~ s/0*$// unless defined $places && $places == 0; # cull trailing 0s - - my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars - my @p = split(/\./, $amount); # split amount at decimal point - - $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters - $amount = $p[0]; - if ($places || $p[1]) { - $amount .= $d[0] - . ( $p[1] || '' ) - . (0 x max(abs($places || 0) - length ($p[1]||''), 0)); # pad the fraction - } - - $amount = do { - ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : - ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) : - ($neg ? "-$amount" : "$amount" ) ; - }; - - $main::lxdebug->leave_sub(2); - return $amount; + SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash); } sub format_amount_units { @@ -904,82 +795,11 @@ sub format_string { # sub parse_amount { - $main::lxdebug->enter_sub(2); - my ($self, $myconfig, $amount) = @_; - - if (!defined($amount) || ($amount eq '')) { - $main::lxdebug->leave_sub(2); - return 0; - } - - if ( ($myconfig->{numberformat} eq '1.000,00') - || ($myconfig->{numberformat} eq '1000,00')) { - $amount =~ s/\.//g; - $amount =~ s/,/\./g; - } - - if ($myconfig->{numberformat} eq "1'000.00") { - $amount =~ s/\'//g; - } - - $amount =~ s/,//g; - - $main::lxdebug->leave_sub(2); - - # Make sure no code wich is not a math expression ends up in eval(). - return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x; - - # Prevent numbers from being parsed as octals; - $amount =~ s{ (?get_precision || 0.01; - return $self->round_amount( $self->round_amount($amount / $precision, 0) * $precision, $places); - } - - # We use Perl's knowledge of string representation for - # rounding. First, convert the floating point number to a string - # with a high number of places. Then split the string on the decimal - # sign and use integer calculation for rounding the decimal places - # part. If an overflow occurs then apply that overflow to the part - # before the decimal sign as well using integer arithmetic again. - - my $int_amount = int(abs $amount); - my $str_places = max(min(10, 16 - length("$int_amount") - $places), $places); - my $amount_str = sprintf '%.*f', $places + $str_places, abs($amount); - - return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$}; - - my ($pre, $post) = ($1, $2); - my $decimals = '1' . substr($post, 0, $places); - - my $propagation_limit = $Config{i32size} == 4 ? 7 : 18; - my $add_for_rounding = substr($post, $places, 1) >= 5 ? 1 : 0; - - if ($places > $propagation_limit) { - $decimals = Math::BigInt->new($decimals)->badd($add_for_rounding); - $pre = Math::BigInt->new($decimals)->badd(1) if substr($decimals, 0, 1) eq '2'; - - } else { - $decimals += $add_for_rounding; - $pre += 1 if substr($decimals, 0, 1) eq '2'; - } - - $amount = ("${pre}." . substr($decimals, 1)) * ($amount <=> 0); - - return $amount; -} +sub round_amount { shift; goto &SL::Helper::Number::_round_number; } sub parse_template { $main::lxdebug->enter_sub(); @@ -989,11 +809,18 @@ sub parse_template { local (*IN, *OUT); - my $defaults = SL::DB::Default->get; - my $userspath = $::lx_office_conf{paths}->{userspath}; + my $defaults = SL::DB::Default->get; - $self->{"cwd"} = getcwd(); - $self->{"tmpdir"} = $self->{cwd} . "/${userspath}"; + my $keep_temp_files = $::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files}; + $self->{cwd} = getcwd(); + my $temp_dir = File::Temp->newdir( + "kivitendo-print-XXXXXX", + DIR => $self->{cwd} . "/" . $::lx_office_conf{paths}->{userspath}, + CLEANUP => !$keep_temp_files, + ); + + my $userspath = File::Spec->abs2rel($temp_dir->dirname); + $self->{tmpdir} = $temp_dir->dirname; my $ext_for_format; @@ -1010,13 +837,6 @@ sub parse_template { $template_type = 'HTML'; $ext_for_format = 'html'; - } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { - $template_type = 'XML'; - $ext_for_format = 'xml'; - - } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) { - $template_type = 'XML'; - } elsif ( $self->{"format"} =~ /excel/i ) { $template_type = 'Excel'; $ext_for_format = 'xls'; @@ -1060,16 +880,18 @@ sub parse_template { # OUT is used for the media, screen, printer, email # for postscript we store a copy in a temporary file + my ($temp_fh, $suffix); $suffix = $self->{IN}; $suffix =~ s/.*\.//; ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile( - 'kivitendo-printXXXXXX', + strftime('kivitendo-print-%Y%m%d%H%M%S-XXXXXX', localtime()), SUFFIX => '.' . ($suffix || 'tex'), DIR => $userspath, - UNLINK => ($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})? 0 : 1, + UNLINK => $keep_temp_files ? 0 : 1, ); close $temp_fh; + chmod 0644, $self->{tmpfile} if $keep_temp_files; (undef, undef, $self->{template_meta}{tmpfile}) = File::Spec->splitpath( $self->{tmpfile} ); $out = $self->{OUT}; @@ -1099,11 +921,27 @@ sub parse_template { close OUT if $self->{OUT}; # check only one flag (webdav_documents) # therefore copy to webdav, even if we do not have the webdav feature enabled (just archive) - my $copy_to_webdav = $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type}; - + my $copy_to_webdav = $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type} + && $self->{type} ne 'statement'; + if ( $ext_for_format eq 'pdf' && $self->doc_storage_enabled ) { + $self->append_general_pdf_attachments(filepath => $self->{tmpdir}."/".$self->{tmpfile}, + type => $self->{type}); + } if ($self->{media} eq 'file') { copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file; - Common::copy_file_to_webdav_folder($self) if $copy_to_webdav; + + if ($copy_to_webdav) { + if (my $error = Common::copy_file_to_webdav_folder($self)) { + chdir("$self->{cwd}"); + $self->error($error); + } + } + + if (!$self->{preview} && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) + { + $self->{attachment_filename} ||= $self->generate_attachment_filename; + $self->store_pdf($self); + } $self->cleanup; chdir("$self->{cwd}"); @@ -1112,100 +950,194 @@ sub parse_template { return; } - Common::copy_file_to_webdav_folder($self) if $copy_to_webdav; + if ($copy_to_webdav) { + if (my $error = Common::copy_file_to_webdav_folder($self)) { + chdir("$self->{cwd}"); + $self->error($error); + } + } + if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) { + $self->{attachment_filename} ||= $self->generate_attachment_filename; + my $file_obj = $self->store_pdf($self); + $self->{print_file_id} = $file_obj->id if $file_obj; + } if ($self->{media} eq 'email') { + if ( getcwd() eq $self->{"tmpdir"} ) { + # in the case of generating pdf we are in the tmpdir, but WHY ??? + $self->{tmpfile} = $userspath."/".$self->{tmpfile}; + chdir("$self->{cwd}"); + } + $self->send_email(\%::myconfig,$ext_for_format); + } + else { + $self->{OUT} = $out; + $self->{OUT_MODE} = $out_mode; + $self->output_file($template->get_mime_type,$command_formatter); + } + delete $self->{print_file_id}; - my $mail = Mailer->new; - - map { $mail->{$_} = $self->{$_} } - qw(cc bcc subject message version format); - $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email}; - $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; - $mail->{fileid} = time() . '.' . $$ . '.'; - my $full_signature = $self->create_email_signature(); - $full_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//g; - $mail->{message} =~ s/\n/
\n/g; - $full_signature =~ s/\n/
\n/g; - $mail->{message} .= $full_signature; - - open(IN, "<:encoding(UTF-8)", $self->{tmpfile}) - or $self->error($self->cleanup . "$self->{tmpfile} : $!"); - $mail->{message} .= $_ while ; - close(IN); + $self->cleanup; - } else { + chdir("$self->{cwd}"); + $main::lxdebug->leave_sub(); +} - if (!$self->{"do_not_attach"}) { - 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 }]; - } +sub get_bcc_defaults { + my ($self, $myconfig, $mybcc) = @_; + if (SL::DB::Default->get->bcc_to_login) { + $mybcc .= ", " if $mybcc; + $mybcc .= $myconfig->{email}; + } + my $otherbcc = SL::DB::Default->get->global_bcc; + if ($otherbcc) { + $mybcc .= ", " if $mybcc; + $mybcc .= $otherbcc; + } + return $mybcc; +} - $mail->{message} .= $full_signature; - } +sub send_email { + $main::lxdebug->enter_sub(); + my ($self, $myconfig, $ext_for_format) = @_; + my $mail = Mailer->new; - my $err = $mail->send(); - $self->error($self->cleanup . "$err") if ($err); + map { $mail->{$_} = $self->{$_} } + qw(cc subject message format); - } else { + if ($self->{cc_employee}) { + my ($user, $my_emp_cc); + $user = SL::DB::Manager::AuthUser->find_by(login => $self->{cc_employee}); + $my_emp_cc = $user->get_config_value('email') if ref $user eq 'SL::DB::AuthUser'; + $mail->{cc} .= ", " if $mail->{cc}; + $mail->{cc} .= $my_emp_cc if $my_emp_cc; + } - $self->{OUT} = $out; - $self->{OUT_MODE} = $out_mode; + $mail->{bcc} = $self->get_bcc_defaults($myconfig, $self->{bcc}); + $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email}; + $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + $mail->{fileid} = time() . '.' . $$ . '.'; + my $full_signature = $self->create_email_signature(); + $full_signature =~ s/\r//g; + + $mail->{attachments} = []; + my @attfiles; + # if we send html or plain text inline + if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) { + $mail->{content_type} = "text/html"; + $mail->{message} =~ s/\r//g; + $mail->{message} =~ s{\n}{
\n}g; + $full_signature =~ s{\n}{
\n}g; + $mail->{message} .= $full_signature; - my $numbytes = (-s $self->{tmpfile}); open(IN, "<", $self->{tmpfile}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); - binmode IN; + $mail->{message} .= $_ while ; + close(IN); - $self->{copies} = 1 unless $self->{media} eq 'printer'; + } elsif (($self->{attachment_policy} // '') ne 'no_file') { + my $attachment_name = $self->{attachment_filename} || $self->{tmpfile}; + $attachment_name =~ s{\.(.+?)$}{.${ext_for_format}} if ($ext_for_format); - chdir("$self->{cwd}"); - #print(STDERR "Kopien $self->{copies}\n"); - #print(STDERR "OUT $self->{OUT}\n"); - for my $i (1 .. $self->{copies}) { - if ($self->{OUT}) { - $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT}); + if (($self->{attachment_policy} // '') eq 'old_file') { + my ( $attfile ) = SL::File->get_all(object_id => $self->{id}, + object_type => $self->{formname}, + file_type => 'document'); - open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); - print OUT $_ while ; - close OUT; - seek IN, 0, 0; + if ($attfile) { + $attfile->{override_file_name} = $attachment_name if $attachment_name; + push @attfiles, $attfile; + } - } else { - my %headers = ('-type' => $template->get_mime_type, - '-connection' => 'close', - '-charset' => 'UTF-8'); - - $self->{attachment_filename} ||= $self->generate_attachment_filename; - - if ($self->{attachment_filename}) { - %headers = ( - %headers, - '-attachment' => $self->{attachment_filename}, - '-content-length' => $numbytes, - '-charset' => '', - ); - } + } else { + push @{ $mail->{attachments} }, { path => $self->{tmpfile}, + id => $self->{print_file_id}, + type => "application/pdf", + name => $attachment_name }; + } + } - print $::request->cgi->header(%headers); + push @attfiles, + grep { $_ } + map { SL::File->get(id => $_) } + @{ $self->{attach_file_ids} // [] }; - $::locale->with_raw_io(\*STDOUT, sub { print while }); - } - } + foreach my $attfile ( @attfiles ) { + push @{ $mail->{attachments} }, { + path => $attfile->get_file, + id => $attfile->id, + type => $attfile->mime_type, + name => $attfile->{override_file_name} // $attfile->file_name, + content => $attfile->get_content ? ${ $attfile->get_content } : undef, + }; + } - close(IN); + $mail->{message} =~ s/\r//g; + $mail->{message} .= $full_signature; + $self->{emailerr} = $mail->send(); + + if ($self->{emailerr}) { + $self->cleanup; + $self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr})); } - $self->cleanup; + $self->{email_journal_id} = $mail->{journalentry}; + $self->{snumbers} = "emailjournal" . "_" . $self->{email_journal_id}; + $self->{what_done} = $::form->{type}; + $self->{addition} = "MAILED"; + $self->save_history; + + #write back for message info and mail journal + $self->{cc} = $mail->{cc}; + $self->{bcc} = $mail->{bcc}; + $self->{email} = $mail->{to}; + + $main::lxdebug->leave_sub(); +} + +sub output_file { + $main::lxdebug->enter_sub(); + + my ($self,$mimeType,$command_formatter) = @_; + my $numbytes = (-s $self->{tmpfile}); + open(IN, "<", $self->{tmpfile}) + or $self->error($self->cleanup . "$self->{tmpfile} : $!"); + binmode IN; + + $self->{copies} = 1 unless $self->{media} eq 'printer'; chdir("$self->{cwd}"); + for my $i (1 .. $self->{copies}) { + if ($self->{OUT}) { + $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT}); + + open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT $_ while ; + close OUT; + seek IN, 0, 0; + + } else { + my %headers = ('-type' => $mimeType, + '-connection' => 'close', + '-charset' => 'UTF-8'); + + $self->{attachment_filename} ||= $self->generate_attachment_filename; + + if ($self->{attachment_filename}) { + %headers = ( + %headers, + '-attachment' => $self->{attachment_filename}, + '-content-length' => $numbytes, + '-charset' => '', + ); + } + + print $::request->cgi->header(%headers); + + $::locale->with_raw_io(\*STDOUT, sub { print while }); + } + } + close(IN); $main::lxdebug->leave_sub(); } @@ -1232,14 +1164,33 @@ sub get_formname_translation { sales_delivery_order => $main::locale->text('Delivery Order'), purchase_delivery_order => $main::locale->text('Delivery Order'), dunning => $main::locale->text('Dunning'), + dunning1 => $main::locale->text('Payment Reminder'), + dunning2 => $main::locale->text('Dunning'), + dunning3 => $main::locale->text('Last Dunning'), + dunning_invoice => $main::locale->text('Dunning Invoice'), letter => $main::locale->text('Letter'), ic_supply => $main::locale->text('Intra-Community supply'), + statement => $main::locale->text('Statement'), ); $main::lxdebug->leave_sub(); return $formname_translations{$formname}; } +sub get_cusordnumber_translation { + $main::lxdebug->enter_sub(); + my ($self, $formname) = @_; + + $formname ||= $self->{formname}; + + $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language}); + local $::locale = Locale->new($self->{recipient_locale}); + + + $main::lxdebug->leave_sub(); + return $main::locale->text('Your Order'); +} + sub get_number_prefix_for_type { $main::lxdebug->enter_sub(); my ($self) = @_; @@ -1315,10 +1266,49 @@ sub generate_email_subject { $subject .= " " . $self->{"${prefix}number"} } + if ($self->{cusordnumber}) { + $subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject; + } + $main::lxdebug->leave_sub(); return $subject; } +sub generate_email_body { + $main::lxdebug->enter_sub(); + my ($self, %params) = @_; + # simple german and english will work grammatically (most european languages as well) + # Dear Mr Alan Greenspan: + # Sehr geehrte Frau Meyer, + # A l’attention de Mme Villeroy, + # Gentile Signora Ferrari, + my $body = ''; + + if ($self->{cp_id} && !$params{record_email}) { + my $givenname = SL::DB::Contact->load_cached($self->{cp_id})->cp_givenname; # for qw(gender givename name); + my $name = SL::DB::Contact->load_cached($self->{cp_id})->cp_name; # for qw(gender givename name); + my $gender = SL::DB::Contact->load_cached($self->{cp_id})->cp_gender; # for qw(gender givename name); + my $mf = $gender eq 'f' ? 'female' : 'male'; + $body = GenericTranslations->get(translation_type => "salutation_$mf", language_id => $self->{language_id}); + $body .= ' ' . $givenname . ' ' . $name if $body; + } else { + $body = GenericTranslations->get(translation_type => "salutation_general", language_id => $self->{language_id}); + } + + return undef unless $body; + + my $translation_type = $params{translation_type} // "preset_text_$self->{formname}"; + my $main_body = GenericTranslations->get(translation_type => $translation_type, language_id => $self->{language_id}); + $main_body = GenericTranslations->get(translation_type => $params{fallback_translation_type}, language_id => $self->{language_id}) if !$main_body && $params{fallback_translation_type}; + $body .= GenericTranslations->get(translation_type => "salutation_punctuation_mark", language_id => $self->{language_id}) . "\n\n"; + $body .= $main_body; + + $body = $main::locale->unquote_special_chars('HTML', $body); + + $main::lxdebug->leave_sub(); + return $body; +} + sub cleanup { $main::lxdebug->enter_sub(); @@ -1388,69 +1378,29 @@ sub datetonum { } # Database routines used throughout +# DB Handling got moved to SL::DB, these are only shims for compatibility sub dbconnect { - $main::lxdebug->enter_sub(2); - - my ($self, $myconfig) = @_; - - # connect to database - my $dbh = SL::DBConnect->connect or $self->dberror; - - # set db options - if ($myconfig->{dboptions}) { - $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions}); - } - - $main::lxdebug->leave_sub(2); - - return $dbh; -} - -sub dbconnect_noauto { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig) = @_; - - # connect to database - my $dbh = SL::DBConnect->connect(SL::DBConnect->get_connect_args(AutoCommit => 0)) or $self->dberror; - - # set db options - if ($myconfig->{dboptions}) { - $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions}); - } - - $main::lxdebug->leave_sub(); - - return $dbh; + SL::DB->client->dbh; } sub get_standard_dbh { - $main::lxdebug->enter_sub(2); - - my $self = shift; - my $myconfig = shift || \%::myconfig; + my $dbh = SL::DB->client->dbh; - 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; + if ($dbh && !$dbh->{Active}) { + $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$dbh is defined but not Active anymore"); + SL::DB->client->dbh(undef); } - $standard_dbh ||= $self->dbconnect_noauto($myconfig); - - $main::lxdebug->leave_sub(2); - - return $standard_dbh; + SL::DB->client->dbh; } -sub set_standard_dbh { - my ($self, $dbh) = @_; - my $old_dbh = $standard_dbh; - $standard_dbh = $dbh; - - return $old_dbh; +sub disconnect_standard_dbh { + SL::DB->client->dbh->rollback; } +# /database + sub date_closed { $main::lxdebug->enter_sub(); @@ -1588,18 +1538,18 @@ sub save_exchangerate { my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_; - my $dbh = $self->dbconnect($myconfig); + SL::DB->client->with_transaction(sub { + my $dbh = SL::DB->client->dbh; - my ($buy, $sell); + my ($buy, $sell); - $buy = $rate if $fld eq 'buy'; - $sell = $rate if $fld eq 'sell'; + $buy = $rate if $fld eq 'buy'; + $sell = $rate if $fld eq 'sell'; - $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell); - - - $dbh->disconnect; + $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell); + 1; + }) or do { die SL::DB->client->error }; $main::lxdebug->leave_sub(); } @@ -1697,16 +1647,17 @@ sub get_default_currency { } sub set_payment_options { - my ($self, $myconfig, $transdate) = @_; + my ($self, $myconfig, $transdate, $type) = @_; my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id})->load : undef; return if !$terms; + my $is_invoice = $type =~ m{invoice}i; + $transdate ||= $self->{invdate} || $self->{transdate}; my $due_date = $self->{duedate} || $self->{reqdate}; $self->{$_} = $terms->$_ for qw(terms_netto terms_skonto percent_skonto); - $self->{payment_terms} = $terms->description_long; $self->{payment_description} = $terms->description; $self->{netto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'net')->to_kivitendo; $self->{skonto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'discount')->to_kivitendo; @@ -1739,39 +1690,26 @@ sub set_payment_options { } if ($self->{"language_id"}) { - my $dbh = $self->get_standard_dbh($myconfig); - my $query = - qq|SELECT t.translation, l.output_numberformat, l.output_dateformat, l.output_longdates | . - qq|FROM generic_translations t | . - qq|LEFT JOIN language l ON t.language_id = l.id | . - qq|WHERE (t.language_id = ?) - AND (t.translation_id = ?) - AND (t.translation_type = 'SL::DB::PaymentTerm/description_long')|; - my ($description_long, $output_numberformat, $output_dateformat, - $output_longdates) = - selectrow_query($self, $dbh, $query, - $self->{"language_id"}, $self->{"payment_id"}); - - $self->{payment_terms} = $description_long if ($description_long); - - if ($output_dateformat) { + my $language = SL::DB::Language->new(id => $self->{language_id})->load; + + $self->{payment_terms} = $type =~ m{invoice}i ? $terms->translated_attribute('description_long_invoice', $language->id) : undef; + $self->{payment_terms} ||= $terms->translated_attribute('description_long', $language->id); + + if ($language->output_dateformat) { foreach my $key (qw(netto_date skonto_date)) { - $self->{$key} = - $main::locale->reformat_date($myconfig, $self->{$key}, - $output_dateformat, - $output_longdates); + $self->{$key} = $::locale->reformat_date($myconfig, $self->{$key}, $language->output_dateformat, $language->output_longdates); } } - if ($output_numberformat && - ($output_numberformat ne $myconfig->{"numberformat"})) { - my $saved_numberformat = $myconfig->{"numberformat"}; - $myconfig->{"numberformat"} = $output_numberformat; - map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts; - $myconfig->{"numberformat"} = $saved_numberformat; + if ($language->output_numberformat && ($language->output_numberformat ne $myconfig->{numberformat})) { + local $myconfig->{numberformat}; + $myconfig->{"numberformat"} = $language->output_numberformat; + $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) for keys %amounts; } } + $self->{payment_terms} = $self->{payment_terms} || ($is_invoice ? $terms->description_long_invoice : undef) || $terms->description_long; + $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g; $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g; $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g; @@ -1857,7 +1795,7 @@ sub add_shipto { my @values; foreach my $item (qw(name department_1 department_2 street zipcode city country gln - contact cp_gender phone fax email)) { + contact phone fax email)) { if ($self->{"shipto$item"}) { $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"}); } @@ -1866,6 +1804,12 @@ sub add_shipto { return if !$shipto; + # shiptocp_gender only makes sense, if any other shipto attribute is set. + # Because shiptocp_gender is set to 'm' by default in forms + # it must not be considered above to decide if shiptos has to be added or + # updated, but must be inserted or updated as well in case. + push(@values, $self->{shiptocp_gender}); + my $shipto_id = $self->{shipto_id}; if ($self->{shipto_id}) { @@ -1879,10 +1823,10 @@ sub add_shipto { shiptocountry = ?, shiptogln = ?, shiptocontact = ?, - shiptocp_gender = ?, shiptophone = ?, shiptofax = ?, shiptoemail = ? + shiptocp_gender = ?, WHERE shipto_id = ?|; do_query($self, $dbh, $query, @values, $self->{shipto_id}); } else { @@ -1896,10 +1840,10 @@ sub add_shipto { shiptocountry = ? AND shiptogln = ? AND shiptocontact = ? AND - shiptocp_gender = ? AND shiptophone = ? AND shiptofax = ? AND shiptoemail = ? AND + shiptocp_gender = ? AND module = ? AND trans_id = ?|; my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id); @@ -1907,7 +1851,7 @@ sub add_shipto { my $insert_query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln, - shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module) + shiptocontact, shiptophone, shiptofax, shiptoemail, shiptocp_gender, module) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; do_query($self, $dbh, $insert_query, $id, @values, $module); @@ -2055,26 +1999,6 @@ sub _get_projects { $main::lxdebug->leave_sub(); } -sub _get_shipto { - $main::lxdebug->enter_sub(); - - my ($self, $dbh, $vc_id, $key) = @_; - - $key = "all_shipto" unless ($key); - - 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); - - } else { - $self->{$key} = []; - } - - $main::lxdebug->leave_sub(); -} - sub _get_printers { $main::lxdebug->enter_sub(); @@ -2114,36 +2038,6 @@ sub _get_charts { $main::lxdebug->leave_sub(); } -sub _get_taxcharts { - $main::lxdebug->enter_sub(); - - my ($self, $dbh, $params) = @_; - - my $key = "all_taxcharts"; - my @where; - - if (ref $params eq 'HASH') { - $key = $params->{key} if ($params->{key}); - if ($params->{module} eq 'AR') { - push @where, 'chart_categories ~ \'[ACILQ]\''; - - } elsif ($params->{module} eq 'AP') { - push @where, 'chart_categories ~ \'[ACELQ]\''; - } - - } elsif ($params) { - $key = $params; - } - - my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : ''; - - my $query = qq|SELECT * FROM tax $where ORDER BY taxkey, rate|; - - $self->{$key} = selectall_hashref_query($self, $dbh, $query); - - $main::lxdebug->leave_sub(); -} - sub _get_taxzones { $main::lxdebug->enter_sub(); @@ -2357,31 +2251,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_lists { $main::lxdebug->enter_sub(); my $self = shift; my %params = @_; + croak "get_lists: shipto is no longer supported" if $params{shipto}; + my $dbh = $self->get_standard_dbh(\%main::myconfig); my ($sth, $query, $ref); my ($vc, $vc_id); - if ($params{contacts} || $params{shipto}) { + if ($params{contacts}) { $vc = 'customer' if $self->{"vc"} eq "customer"; $vc = 'vendor' if $self->{"vc"} eq "vendor"; die "invalid use of get_lists, need 'vc'" unless $vc; @@ -2392,10 +2274,6 @@ sub get_lists { $self->_get_contacts($dbh, $vc_id, $params{"contacts"}); } - if ($params{"shipto"}) { - $self->_get_shipto($dbh, $vc_id, $params{"shipto"}); - } - if ($params{"projects"} || $params{"all_projects"}) { $self->_get_projects($dbh, $params{"all_projects"} ? $params{"all_projects"} : $params{"projects"}, @@ -2414,10 +2292,6 @@ sub get_lists { $self->_get_charts($dbh, $params{"charts"}); } - if ($params{"taxcharts"}) { - $self->_get_taxcharts($dbh, $params{"taxcharts"}); - } - if ($params{"taxzones"}) { $self->_get_taxzones($dbh, $params{"taxzones"}); } @@ -2470,10 +2344,6 @@ sub get_lists { $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} }); } @@ -2529,90 +2399,19 @@ sub get_name { return scalar(@{ $self->{name_list} }); } -# the selection sub is used in the AR, AP, IS, IR, DO and OE module -# -sub all_vc { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $table, $module) = @_; - - my $ref; - my $dbh = $self->get_standard_dbh; - - $table = $table eq "customer" ? "customer" : "vendor"; - - # build selection list - # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege - # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch - # nicht für veränderbare Belege (oe, do, ...) - my $obsolete = $self->{id} ? '' : "WHERE NOT obsolete"; - my $query = qq|SELECT count(*) FROM $table $obsolete|; - my ($count) = selectrow_query($self, $dbh, $query); - - if ($count <= $myconfig->{vclimit}) { - $query = qq|SELECT id, name, salesman_id - FROM $table $obsolete - ORDER BY name|; - $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query); - } - - # get self - $self->get_employee($dbh); - - # setup sales contacts - $query = qq|SELECT e.id, e.name - FROM employee e - WHERE (e.sales = '1') AND (NOT e.id = ?) - ORDER BY name|; - $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id}); - - # this is for self - push(@{ $self->{all_employees} }, - { id => $self->{employee_id}, - name => $self->{employee} }); - - # prepare query for departments - $query = qq|SELECT id, description - FROM department - ORDER BY description|; - - $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); - - # get languages - $query = qq|SELECT id, description - FROM language - ORDER BY id|; - - $self->{languages} = selectall_hashref_query($self, $dbh, $query); - - # get printer - $query = qq|SELECT printer_description, id - FROM printers - ORDER BY printer_description|; - - $self->{printers} = selectall_hashref_query($self, $dbh, $query); - - # get payment terms - $query = qq|SELECT id, description - FROM payment_terms - ORDER BY sortkey|; - - $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); - - $main::lxdebug->leave_sub(); -} - sub new_lastmtime { - my ($self, $table, $option) = @_; + my ($self, $table, $provided_dbh) = @_; + + my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh; return unless $self->{id}; croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/; my $query = "SELECT mtime, itime FROM " . $table . " WHERE id = ?"; - my $ref = selectfirst_hashref_query($self, $self->get_standard_dbh, $query, $self->{id}); + my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id}); $ref->{mtime} ||= $ref->{itime}; $self->{lastmtime} = $ref->{mtime}; - $main::lxdebug->message(LXDebug->DEBUG2(),"new lastmtime=".$self->{lastmtime}); + } sub mtime_ischanged { @@ -2634,6 +2433,9 @@ sub mtime_ischanged { } } +# language_payment duplicates some of the functionality of all_vc (language, +# printer, payment_terms), and at least in the case of sales invoices both +# all_vc and language_payment are called when adding new invoices sub language_payment { $main::lxdebug->enter_sub(); @@ -2657,9 +2459,9 @@ sub language_payment { # get payment terms $query = qq|SELECT id, description FROM payment_terms - ORDER BY sortkey|; - - $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); + WHERE ( obsolete IS FALSE OR id = ? ) + ORDER BY sortkey |; + $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef); # get buchungsgruppen $query = qq|SELECT id, description @@ -2703,8 +2505,6 @@ sub create_links { $arap = "ap"; } - $self->all_vc($myconfig, $table, $module); - # get last customers or vendors my ($query, $sth, $ref); @@ -2719,15 +2519,8 @@ sub create_links { } # now get the account numbers -# $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id -# FROM chart c, taxkeys tk -# WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id = -# (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1) -# ORDER BY c.accno|; - -# same query as above, but without expensive subquery for each row. about 80% faster $query = qq| - SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id + SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk2.tax_id FROM chart c -- find newest entries in taxkeys INNER JOIN ( @@ -2757,6 +2550,7 @@ sub create_links { push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, + chart_id => $ref->{chart_id}, description => $ref->{description}, taxkey => $ref->{taxkey_id}, tax_id => $ref->{tax_id} }; @@ -2783,8 +2577,8 @@ sub create_links { if ($self->{id}) { $query = qq|SELECT - a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, - a.duedate, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes, + a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.deliverydate, + a.duedate, a.tax_point, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes, a.mtime, a.itime, a.intnotes, a.department_id, a.amount AS oldinvtotal, a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type, @@ -2810,7 +2604,7 @@ sub create_links { } # now get the account numbers - $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id + $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk.tax_id FROM chart c LEFT JOIN taxkeys tk ON (tk.chart_id = c.id) WHERE c.link LIKE ? @@ -2832,6 +2626,7 @@ sub create_links { push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, + chart_id => $ref->{chart_id}, description => $ref->{description}, taxkey => $ref->{taxkey_id}, tax_id => $ref->{tax_id} }; @@ -2846,7 +2641,7 @@ sub create_links { $query = qq|SELECT c.accno, c.description, - a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, + a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id, p.projectnumber, t.rate, t.id FROM acc_trans a @@ -2983,6 +2778,22 @@ sub lastname_used { $main::lxdebug->leave_sub(); } +sub get_variable_content_types { + my %html_variables = ( + longdescription => 'html', + partnotes => 'html', + notes => 'html', + orignotes => 'html', + notes1 => 'html', + notes2 => 'html', + notes3 => 'html', + notes4 => 'html', + header_text => 'html', + footer_text => 'html', + ); + return \%html_variables; +} + sub current_date { $main::lxdebug->enter_sub(); @@ -3043,52 +2854,52 @@ sub update_status { my ($i, $id); - my $dbh = $self->dbconnect_noauto($myconfig); + SL::DB->client->with_transaction(sub { + my $dbh = SL::DB->client->dbh; - my $query = qq|DELETE FROM status - WHERE (formname = ?) AND (trans_id = ?)|; - my $sth = prepare_query($self, $dbh, $query); + my $query = qq|DELETE FROM status + WHERE (formname = ?) AND (trans_id = ?)|; + my $sth = prepare_query($self, $dbh, $query); - if ($self->{formname} =~ /(check|receipt)/) { - for $i (1 .. $self->{rowcount}) { - do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1); + if ($self->{formname} =~ /(check|receipt)/) { + for $i (1 .. $self->{rowcount}) { + do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1); + } + } else { + do_statement($self, $sth, $query, $self->{formname}, $self->{id}); } - } else { - do_statement($self, $sth, $query, $self->{formname}, $self->{id}); - } - $sth->finish(); + $sth->finish(); - my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; - my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "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; + my %queued = split / /, $self->{queued}; + my @values; - if ($self->{formname} =~ /(check|receipt)/) { + if ($self->{formname} =~ /(check|receipt)/) { - # this is a check or receipt, add one entry for each lineitem - my ($accno) = split /--/, $self->{account}; - $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id) - VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|; - @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno); - $sth = prepare_query($self, $dbh, $query); + # this is a check or receipt, add one entry for each lineitem + my ($accno) = split /--/, $self->{account}; + $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id) + VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|; + @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno); + $sth = prepare_query($self, $dbh, $query); - for $i (1 .. $self->{rowcount}) { - if ($self->{"checked_$i"}) { - do_statement($self, $sth, $query, $self->{"id_$i"}, @values); + for $i (1 .. $self->{rowcount}) { + if ($self->{"checked_$i"}) { + do_statement($self, $sth, $query, $self->{"id_$i"}, @values); + } } - } - $sth->finish(); - - } else { - $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) - VALUES (?, ?, ?, ?, ?)|; - do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, - $queued{$self->{formname}}, $self->{formname}); - } + $sth->finish(); - $dbh->commit; - $dbh->disconnect; + } else { + $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) + VALUES (?, ?, ?, ?, ?)|; + do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, + $queued{$self->{formname}}, $self->{formname}); + } + 1; + }) or do { die SL::DB->client->error }; $main::lxdebug->leave_sub(); } @@ -3149,6 +2960,7 @@ sub save_status { #--- 4 locale ---# # $main::locale->text('SAVED') +# $main::locale->text('SCREENED') # $main::locale->text('DELETED') # $main::locale->text('ADDED') # $main::locale->text('PAYMENT POSTED') @@ -3157,10 +2969,14 @@ sub save_status { # $main::locale->text('ELSE') # $main::locale->text('SAVED FOR DUNNING') # $main::locale->text('DUNNING STARTED') +# $main::locale->text('PREVIEWED') # $main::locale->text('PRINTED') # $main::locale->text('MAILED') # $main::locale->text('SCREENED') # $main::locale->text('CANCELED') +# $main::locale->text('IMPORT') +# $main::locale->text('UNDO TRANSFER') +# $main::locale->text('UNIMPORT') # $main::locale->text('invoice') # $main::locale->text('proforma') # $main::locale->text('sales_order') @@ -3174,20 +2990,21 @@ sub save_history { $main::lxdebug->enter_sub(); my $self = shift; - my $dbh = shift || $self->get_standard_dbh; - - if(!exists $self->{employee_id}) { - &get_employee($self, $dbh); - } + my $dbh = shift || SL::DB->client->dbh; + SL::DB->client->with_transaction(sub { - my $query = - qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | . - qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|; - my @values = (conv_i($self->{id}), $self->{login}, - $self->{addition}, $self->{what_done}, "$self->{snumbers}"); - do_query($self, $dbh, $query, @values); + if(!exists $self->{employee_id}) { + &get_employee($self, $dbh); + } - $dbh->commit; + my $query = + qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | . + qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|; + my @values = (conv_i($self->{id}), $self->{login}, + $self->{addition}, $self->{what_done}, "$self->{snumbers}"); + do_query($self, $dbh, $query, @values); + 1; + }) or do { die SL::DB->client->error }; $main::lxdebug->leave_sub(); } @@ -3215,7 +3032,10 @@ sub get_history { while(my $hash_ref = $sth->fetchrow_hashref()) { $hash_ref->{addition} = $main::locale->text($hash_ref->{addition}); $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done}); - $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g; + my ( $what, $number ) = split /_/, $hash_ref->{snumbers}; + $hash_ref->{snumbers} = $number; + $hash_ref->{haslink} = 'controller.pl?action=EmailJournal/show&id='.$number if $what eq 'emailjournal'; + $hash_ref->{snumbers} = $main::locale->text("E-Mail").' '.$number if $what eq 'emailjournal'; $tempArray[$i++] = $hash_ref; } $main::lxdebug->leave_sub() and return \@tempArray @@ -3239,16 +3059,13 @@ sub get_partsgroup { my @values; if ($p->{searchitems} eq 'part') { - $query .= qq|WHERE p.inventory_accno_id > 0|; + $query .= qq|WHERE p.part_type = 'part'|; } if ($p->{searchitems} eq 'service') { - $query .= qq|WHERE p.inventory_accno_id IS NULL|; + $query .= qq|WHERE p.part_type = 'service'|; } if ($p->{searchitems} eq 'assembly') { - $query .= qq|WHERE p.assembly = '1'|; - } - if ($p->{searchitems} eq 'labor') { - $query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|; + $query .= qq|WHERE p.part_type = 'assembly'|; } $query .= qq|ORDER BY partsgroup|; @@ -3378,19 +3195,6 @@ sub prepare_for_printing { $self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber); } - # Load shipping address from database. If shipto_id is set then it's - # one from the customer's/vendor's master data. Otherwise look an a - # customized address linking back to the current record. - my $shipto_module = $self->{type} =~ /_delivery_order$/ ? 'DO' - : $self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/ ? 'OE' - : 'AR'; - my $shipto = $self->{shipto_id} ? SL::DB::Shipto->new(shipto_id => $self->{shipto_id})->load - : SL::DB::Manager::Shipto->get_first(where => [ module => $shipto_module, trans_id => $self->{id} ]); - if ($shipto) { - $self->{$_} = $shipto->$_ for grep { m{^shipto} } map { $_->name } @{ $shipto->meta->columns }; - $self->{"shiptocvar_" . $_->config->name} = $_->value_as_text for @{ $shipto->cvars_by_config }; - } - my $language = $self->{language} ? '_' . $self->{language} : ''; my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates); @@ -3439,7 +3243,7 @@ sub prepare_for_printing { # Format dates. $self->format_dates($output_dateformat, $output_longdates, - qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid + qw(invdate orddate quodate pldate duedate reqdate transdate tax_point shippingdate deliverydate validitydate paymentdate datepaid transdate_oe deliverydate_oe employee_startdate employee_enddate), grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self}))); @@ -3459,6 +3263,14 @@ sub prepare_for_printing { $self->reformat_numbers($output_numberformat, $precision, @{ $field_list }); } + # Translate units + if (($self->{language} // '') ne '') { + my $template_arrays = $self->{TEMPLATE_ARRAYS} || $self; + for my $idx (0..scalar(@{ $template_arrays->{unit} }) - 1) { + $template_arrays->{unit}->[$idx] = AM->translate_units($self, $self->{language}, $template_arrays->{unit}->[$idx], $template_arrays->{qty}->[$idx]) + } + } + $self->{template_meta} = { formname => $self->{formname}, language => SL::DB::Manager::Language->find_by_or_create(id => $self->{language_id} || undef), @@ -3637,29 +3449,6 @@ sub create_email_signature { }; -sub layout { - my ($self) = @_; - $::lxdebug->enter_sub; - - my %style_to_script_map = ( - v3 => 'v3', - neu => 'new', - ); - - my $menu_script = $style_to_script_map{$::myconfig{menustyle}} || ''; - - package main; - require "bin/mozilla/menu$menu_script.pl"; - package Form; - require SL::Controller::FrameHeader; - - - my $layout = SL::Controller::FrameHeader->new->action_header . ::render(); - - $::lxdebug->leave_sub; - return $layout; -} - sub calculate_tax { # this function calculates the net amount and tax for the lines in ar, ap and # gl and is used for update as well as post. When used with update the return