# 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
use File::Copy;
use IO::File;
use Math::BigInt;
+use POSIX qw(strftime);
use SL::Auth;
use SL::Auth::DB;
use SL::Auth::LDAP;
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;
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;
-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) = @_;
}
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 {
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));
$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);
}
}
$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 };
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();
'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);
$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});
}
# 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};
# 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' && $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} && $self->doc_storage_enabled)
+ {
+ $self->{attachment_filename} ||= $self->generate_attachment_filename;
+ $self->store_pdf($self);
+ }
$self->cleanup;
chdir("$self->{cwd}");
Common::copy_file_to_webdav_folder($self) if $copy_to_webdav;
+ if ( !$self->{preview} && $ext_for_format eq 'pdf' && $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/<br>\n/g;
- $full_signature =~ s/\n/<br>\n/g;
- $mail->{message} .= $full_signature;
-
- open(IN, "<:encoding(UTF-8)", $self->{tmpfile})
- or $self->error($self->cleanup . "$self->{tmpfile} : $!");
- $mail->{message} .= $_ while <IN>;
- 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/<br>\n/g;
+ $full_signature =~ s/\n/<br>\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 <IN>;
+ 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 <IN>;
- 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 <IN> });
- }
- }
+ 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 <IN>;
+ 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 <IN> });
+ }
+ }
+ close(IN);
$main::lxdebug->leave_sub();
}
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 $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();
}
# 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 $dbh = SL::DB->client->dbh;
- my $self = shift;
- my $myconfig = shift || \%::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;
+ 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();
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();
}
}
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;
}
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;
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 {
}
}
+# 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();
# 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
$arap = "ap";
}
- $self->all_vc($myconfig, $table, $module);
-
# get last customers or vendors
my ($query, $sth, $ref);
}
# 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 (
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} };
}
# 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 ?
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} };
$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
$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();
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();
}
#--- 4 locale ---#
# $main::locale->text('SAVED')
+# $main::locale->text('SCREENED')
# $main::locale->text('DELETED')
# $main::locale->text('ADDED')
# $main::locale->text('PAYMENT POSTED')
# $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')
$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();
}
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
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|;