X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=644b9dbead7a36222070f265990105ef14216533;hb=9c19433144efc5b50d90a969aa9ac6ea65b2dbbf;hp=4c8f3d702c583dabccd89cd33391dcefad3dbb3f;hpb=77807bf531a9c3f945b2de1fc970439be5e95e70;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 4c8f3d702..644b9dbea 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -63,6 +63,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; @@ -83,6 +84,8 @@ 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::CreatePDF qw(merge_pdfs); use strict; @@ -343,13 +346,12 @@ sub numtextrows { } sub dberror { - $main::lxdebug->enter_sub(); - my ($self, $msg) = @_; - $self->error("$msg\n" . $DBI::errstr); - - $main::lxdebug->leave_sub(); + die SL::X::DBError->new( + msg => $msg, + error => $DBI::errstr, + ); } sub isblank { @@ -681,20 +683,6 @@ 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; - - } elsif ($params{back_button}) { - $add_params->{SHOW_BACK_BUTTON} = 1; - } - $self->{title} = $params{title} if $params{title}; $self->header(); @@ -746,6 +734,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}); } @@ -1089,9 +1078,18 @@ sub parse_template { # 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 ) { + $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) + { + $self->{attachment_filename} ||= $self->generate_attachment_filename; + $self->store_pdf($self); + } $self->cleanup; chdir("$self->{cwd}"); @@ -1102,98 +1100,185 @@ 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) { + $self->{attachment_filename} ||= $self->generate_attachment_filename; + $self->{print_file_id} = $self->store_pdf($self); + } 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 version format); - } else { + $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; - $self->{OUT} = $out; - $self->{OUT_MODE} = $out_mode; + $mail->{attachments} = []; + my @attfiles; + # 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; - 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'; + } 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 }; + } + } + } + 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 }; + } + } + $mail->{message} =~ s/\r//g; + $mail->{message} .= $full_signature; + $self->{emailerr} = $mail->send(); + # $self->error($self->cleanup . "$err") if $self->{emailerr}; + $self->{email_journal_id} = $mail->{journalentry}; + $self->{snumbers} = "emailjournal" . "_" . $self->{email_journal_id}; + $self->{what_done} = $::form->{type}; + $self->{addition} = "MAILED"; + $self->save_history; - 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}); + #write back for message info and mail journal + $self->{cc} = $mail->{cc}; + $self->{bcc} = $mail->{bcc}; + $self->{email} = $mail->{to}; - open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); - print OUT $_ while ; - close OUT; - seek IN, 0, 0; + $main::lxdebug->leave_sub(); +} - } 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' => '', - ); - } +sub output_file { + $main::lxdebug->enter_sub(); - print $::request->cgi->header(%headers); + my ($self,$mimeType,$command_formatter) = @_; + my $numbytes = (-s $self->{tmpfile}); + open(IN, "<", $self->{tmpfile}) + or $self->error($self->cleanup . "$self->{tmpfile} : $!"); + binmode IN; - $::locale->with_raw_io(\*STDOUT, sub { print while }); - } - } + $self->{copies} = 1 unless $self->{media} eq 'printer'; - close(IN); - } + chdir("$self->{cwd}"); + for my $i (1 .. $self->{copies}) { + if ($self->{OUT}) { + $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT}); - $self->cleanup; + open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT $_ while ; + close OUT; + seek IN, 0, 0; - chdir("$self->{cwd}"); + } 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(); } @@ -2465,81 +2550,7 @@ 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 - WHERE ( obsolete IS FALSE OR id = ? ) - ORDER BY sortkey |; - $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef); - - $main::lxdebug->leave_sub(); -} - sub new_lastmtime { - $main::lxdebug->enter_sub(); my ($self, $table, $provided_dbh) = @_; @@ -2551,9 +2562,7 @@ sub new_lastmtime { 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}); - $main::lxdebug->leave_sub(); } sub mtime_ischanged { @@ -2647,8 +2656,6 @@ sub create_links { $arap = "ap"; } - $self->all_vc($myconfig, $table, $module); - # get last customers or vendors my ($query, $sth, $ref); @@ -2663,15 +2670,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 ( @@ -2701,6 +2701,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} }; @@ -2754,7 +2755,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 ? @@ -2776,6 +2777,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} }; @@ -2790,7 +2792,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 @@ -2927,6 +2929,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(); @@ -3093,6 +3111,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') @@ -3105,6 +3124,8 @@ sub save_status { # $main::locale->text('MAILED') # $main::locale->text('SCREENED') # $main::locale->text('CANCELED') +# $main::locale->text('IMPORT') +# $main::locale->text('UNIMPORT') # $main::locale->text('invoice') # $main::locale->text('proforma') # $main::locale->text('sales_order') @@ -3160,7 +3181,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