X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=0c21ae2e672747079e01d8d30fe149a85cbd0d5f;hb=2fe6237c8b09d2f5a83145673c15be84bdfadf8a;hp=3969cbfef301a42e20fe23c066d8f86166e1982e;hpb=3d8c8e2fa8dc160248411314e135b21e92332201;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 3969cbfef..0c21ae2e6 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 @@ -49,6 +49,7 @@ use Encode; use File::Copy; use IO::File; use Math::BigInt; +use POSIX qw(strftime); use SL::Auth; use SL::Auth::DB; use SL::Auth::LDAP; @@ -78,6 +79,7 @@ use SL::Request; use SL::Template; use SL::User; use SL::Util; +use SL::Version; use SL::X; use Template; use URI; @@ -90,14 +92,7 @@ use SL::Helper::CreatePDF qw(merge_pdfs); use strict; 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 { @@ -115,8 +110,6 @@ sub new { bless $self, $type; - $self->{version} = $self->read_version; - $main::lxdebug->leave_sub(); return $self; @@ -188,7 +181,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; @@ -201,36 +194,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) = @_; @@ -376,7 +339,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)); @@ -426,7 +389,7 @@ sub create_http_response { $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), '-value' => $session_cookie_value, '-path' => $uri->path, - '-secure' => $ENV{HTTPS}); + '-secure' => $::request->is_https); } } @@ -471,11 +434,12 @@ sub header { jquery jquery-ui jquery.cookie jquery.checkall jquery.download jquery/jquery.form jquery/fixes client_js jquery/jquery.tooltipster.min + jquery.multiselect2side common part_selection ), "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}) { @@ -569,7 +533,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}; @@ -621,7 +585,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 }; @@ -633,32 +597,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(); @@ -685,6 +624,16 @@ sub show_generic_error { $self->{title} = $params{title} if $params{title}; + for my $bar ($::request->layout->get('actionbar')) { + $bar->add( + action => [ + t8('Back'), + call => [ 'kivi.history_back' ], + accesskey => 'enter', + ], + ); + } + $self->header(); print $self->parse_html_template("generic/error", $add_params); @@ -1037,16 +986,19 @@ sub parse_template { # OUT is used for the media, screen, printer, email # for postscript we store a copy in a temporary file + my $keep_temp_files = $::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files}; + 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}; @@ -1076,16 +1028,16 @@ 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}; - - if ( $ext_for_format eq 'pdf' && $::instance_conf->get_doc_storage ) { + 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 (!$self->{preview} && $::instance_conf->get_doc_storage) + if (!$self->{preview} && $self->doc_storage_enabled) { $self->{attachment_filename} ||= $self->generate_attachment_filename; $self->store_pdf($self); @@ -1100,9 +1052,10 @@ sub parse_template { Common::copy_file_to_webdav_folder($self) if $copy_to_webdav; - if ( !$self->{preview} && $ext_for_format eq 'pdf' && $::instance_conf->get_doc_storage) { + if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->doc_storage_enabled) { $self->{attachment_filename} ||= $self->generate_attachment_filename; - $self->{print_file_id} = $self->store_pdf($self); + 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"} ) { @@ -1127,10 +1080,10 @@ sub parse_template { sub get_bcc_defaults { my ($self, $myconfig, $mybcc) = @_; -# if (SL::DB::Default->get->bcc_to_login) { -# $mybcc .= ", " if $mybcc; -# $mybcc .= $myconfig->{email}; -# } + 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; @@ -1145,7 +1098,7 @@ sub send_email { my $mail = Mailer->new; map { $mail->{$_} = $self->{$_} } - qw(cc subject message version format); + qw(cc subject message format); $mail->{bcc} = $self->get_bcc_defaults($myconfig, $self->{bcc}); $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email}; @@ -1158,7 +1111,7 @@ sub send_email { my @attfiles; # if we send html or plain text inline if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) { - $mail->{contenttype} = "text/html"; + $mail->{content_type} = "text/html"; $mail->{message} =~ s/\r//g; $mail->{message} =~ s/\n/
\n/g; $full_signature =~ s/\n/
\n/g; @@ -1169,59 +1122,52 @@ sub send_email { $mail->{message} .= $_ while ; close(IN); - } else { - $main::lxdebug->message(LXDebug->DEBUG2(),"action_oldfile=" . $self->{action_oldfile}." action_nofile=".$self->{action_nofile}); - if (!$self->{"do_not_attach"} && !$self->{action_nofile}) { - my $attachment_name = $self->{attachment_filename} || $self->{tmpfile}; - $attachment_name =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format); - if ( $self->{action_oldfile} ) { - $main::lxdebug->message(LXDebug->DEBUG2(),"object_id =>". $self->{id}." object_type =>". $self->{formname}); - my ( $attfile ) = SL::File->get_all(object_id => $self->{id}, - object_type => $self->{formname}, - file_type => 'document'); - $main::lxdebug->message(LXDebug->DEBUG2(), "old file obj=".$attfile); - push @attfiles, $attfile if $attfile; - } else { - push @{ $mail->{attachments} }, { path => $self->{tmpfile}, - id => $self->{print_file_id}, - type => "application/pdf", - name => $attachment_name }; + } 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); + + if (($self->{attachment_policy} // '') eq 'old_file') { + my ( $attfile ) = SL::File->get_all(object_id => $self->{id}, + object_type => $self->{formname}, + file_type => 'document'); + + if ($attfile) { + $attfile->{override_file_name} = $attachment_name if $attachment_name; + push @attfiles, $attfile; } + + } else { + push @{ $mail->{attachments} }, { path => $self->{tmpfile}, + id => $self->{print_file_id}, + type => "application/pdf", + name => $attachment_name }; } } - if (!$self->{"do_not_attach"}) { - for my $i (1 .. $self->{attfile_count}) { - if ( $self->{"attsel_$i"} ) { - my $attfile = SL::File->get(id => $self->{"attfile_$i"}); - $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile); - push @attfiles, $attfile if $attfile; - } - } - for my $i (1 .. $self->{attfile_cv_count}) { - if ( $self->{"attsel_cv_$i"} ) { - my $attfile = SL::File->get(id => $self->{"attfile_cv_$i"}); - $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile); - push @attfiles, $attfile if $attfile; - } - } - for my $i (1 .. $self->{attfile_part_count}) { - if ( $self->{"attsel_part_$i"} ) { - my $attfile = SL::File->get(id => $self->{"attfile_part_$i"}); - $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile); - push @attfiles, $attfile if $attfile; - } - } - foreach my $attfile ( @attfiles ) { - push @{ $mail->{attachments} }, { path => SL::File->get_file_path(dbfile => $attfile), - id => $attfile->id, - type => $attfile->file_mime_type, - name => $attfile->file_name }; - } + + push @attfiles, + grep { $_ } + map { SL::File->get(id => $_) } + @{ $self->{attach_file_ids} // [] }; + + 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, + }; } + $mail->{message} =~ s/\r//g; $mail->{message} .= $full_signature; $self->{emailerr} = $mail->send(); - # $self->error($self->cleanup . "$err") if $self->{emailerr}; + + if ($self->{emailerr}) { + $self->cleanup; + $self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr})); + } + $self->{email_journal_id} = $mail->{journalentry}; $self->{snumbers} = "emailjournal" . "_" . $self->{email_journal_id}; $self->{what_done} = $::form->{type}; @@ -1305,8 +1251,13 @@ 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(); @@ -1392,6 +1343,38 @@ sub generate_email_subject { return $subject; } +sub generate_email_body { + $main::lxdebug->enter_sub(); + my ($self) = @_; + # 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}) { + 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; + + $body .= GenericTranslations->get(translation_type =>"salutation_punctuation_mark", language_id => $self->{language_id}) . "\n"; + $body .= GenericTranslations->get(translation_type =>"preset_text_$self->{formname}", language_id => $self->{language_id}); + + $body = $main::locale->unquote_special_chars('HTML', $body); + + $main::lxdebug->leave_sub(); + return $body; +} + sub cleanup { $main::lxdebug->enter_sub(); @@ -3603,29 +3586,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