+ $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;
+}
+
+sub format_amount_units {
+ $main::lxdebug->enter_sub();
+
+ my $self = shift;
+ my %params = @_;
+
+ my $myconfig = \%main::myconfig;
+ my $amount = $params{amount} * 1;
+ my $places = $params{places};
+ my $part_unit_name = $params{part_unit};
+ my $amount_unit_name = $params{amount_unit};
+ my $conv_units = $params{conv_units};
+ my $max_places = $params{max_places};
+
+ if (!$part_unit_name) {
+ $main::lxdebug->leave_sub();
+ return '';
+ }
+
+ my $all_units = AM->retrieve_all_units;
+
+ if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
+ $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
+ }
+
+ if (!scalar @{ $conv_units }) {
+ my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name;
+ $main::lxdebug->leave_sub();
+ return $result;
+ }
+
+ my $part_unit = $all_units->{$part_unit_name};
+ my $conv_unit = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit;
+
+ $amount *= $conv_unit->{factor};
+
+ my @values;
+ my $num;
+
+ foreach my $unit (@$conv_units) {
+ my $last = $unit->{name} eq $part_unit->{name};
+ if (!$last) {
+ $num = int($amount / $unit->{factor});
+ $amount -= $num * $unit->{factor};
+ }
+
+ if ($last ? $amount : $num) {
+ push @values, { "unit" => $unit->{name},
+ "amount" => $last ? $amount / $unit->{factor} : $num,
+ "places" => $last ? $places : 0 };
+ }
+
+ last if $last;
+ }
+
+ if (!@values) {
+ push @values, { "unit" => $part_unit_name,
+ "amount" => 0,
+ "places" => 0 };
+ }
+
+ my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values;
+
+ $main::lxdebug->leave_sub();
+
+ return $result;
+}
+
+sub format_string {
+ $main::lxdebug->enter_sub(2);
+
+ my $self = shift;
+ my $input = shift;
+
+ $input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx;
+ $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
+ $input =~ s/\#\#/\#/g;
+
+ $main::lxdebug->leave_sub(2);
+
+ return $input;
+}
+
+#
+
+sub parse_amount {
+ $main::lxdebug->enter_sub(2);
+
+ 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{ (?<! [\d.] ) 0+ (?= [1-9] ) }{}gx;
+
+ return scalar(eval($amount)) * 1 ;
+}
+
+sub round_amount {
+ my ($self, $amount, $places, $adjust) = @_;
+
+ return 0 if !defined $amount;
+
+ $places //= 0;
+
+ if ($adjust) {
+ my $precision = $::instance_conf->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 parse_template {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $myconfig) = @_;
+ my ($out, $out_mode);
+
+ local (*IN, *OUT);
+
+ my $defaults = SL::DB::Default->get;
+ my $userspath = $::lx_office_conf{paths}->{userspath};
+
+ $self->{"cwd"} = getcwd();
+ $self->{"tmpdir"} = $self->{cwd} . "/${userspath}";
+
+ my $ext_for_format;
+
+ my $template_type;
+ if ($self->{"format"} =~ /(opendocument|oasis)/i) {
+ $template_type = 'OpenDocument';
+ $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
+
+ } elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
+ $template_type = 'LaTeX';
+ $ext_for_format = 'pdf';
+
+ } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
+ $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';
+
+ } elsif ( defined $self->{'format'}) {
+ $self->error("Outputformat not defined. This may be a future feature: $self->{'format'}");
+
+ } elsif ( $self->{'format'} eq '' ) {
+ $self->error("No Outputformat given: $self->{'format'}");
+
+ } else { #Catch the rest
+ $self->error("Outputformat not defined: $self->{'format'}");
+ }
+
+ my $template = SL::Template::create(type => $template_type,
+ file_name => $self->{IN},
+ form => $self,
+ myconfig => $myconfig,
+ userspath => $userspath,
+ %{ $self->{TEMPLATE_DRIVER_OPTIONS} || {} });
+
+ # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be.
+ $self->{"notes"} = $self->{ $self->{"formname"} . "notes" } if exists $self->{ $self->{"formname"} . "notes" };
+
+ if (!$self->{employee_id}) {
+ $self->{"employee_${_}"} = $myconfig->{$_} for qw(email tel fax name signature);
+ $self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
+ }
+
+ $self->{"myconfig_${_}"} = $myconfig->{$_} for grep { $_ ne 'dbpasswd' } keys %{ $myconfig };
+ $self->{$_} = $defaults->$_ for qw(co_ustid);
+ $self->{"myconfig_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
+ $self->{AUTH} = $::auth;
+ $self->{INSTANCE_CONF} = $::instance_conf;
+ $self->{LOCALE} = $::locale;
+ $self->{LXCONFIG} = $::lx_office_conf;
+ $self->{LXDEBUG} = $::lxdebug;
+ $self->{MYCONFIG} = \%::myconfig;
+
+ $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
+
+ # 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',
+ SUFFIX => '.' . ($suffix || 'tex'),
+ DIR => $userspath,
+ UNLINK => ($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})? 0 : 1,
+ );
+ close $temp_fh;
+ (undef, undef, $self->{template_meta}{tmpfile}) = File::Spec->splitpath( $self->{tmpfile} );
+
+ $out = $self->{OUT};
+ $out_mode = $self->{OUT_MODE} || '>';
+ $self->{OUT} = "$self->{tmpfile}";
+ $self->{OUT_MODE} = '>';
+
+ my $result;
+ my $command_formatter = sub {
+ my ($out_mode, $out) = @_;
+ return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
+ };
+
+ if ($self->{OUT}) {
+ $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+ open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!");
+ } else {
+ *OUT = ($::dispatcher->get_standard_filehandles)[1];
+ $self->header;
+ }
+
+ if (!$template->parse(*OUT)) {
+ $self->cleanup();
+ $self->error("$self->{IN} : " . $template->get_error());
+ }
+
+ 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 ) {
+ $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}");
+
+ $::lxdebug->leave_sub();
+
+ return;
+ }
+
+ 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)->id;
+ }
+ 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};
+
+ $self->cleanup;
+
+ chdir("$self->{cwd}");
+ $main::lxdebug->leave_sub();
+}
+
+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;
+}
+
+sub send_email {
+ $main::lxdebug->enter_sub();
+ my ($self, $myconfig, $ext_for_format) = @_;
+ my $mail = Mailer->new;
+
+ map { $mail->{$_} = $self->{$_} }
+ qw(cc subject message version format);
+
+ $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->{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, "<", $self->{tmpfile})
+ or $self->error($self->cleanup . "$self->{tmpfile} : $!");
+ $mail->{message} .= $_ while <IN>;
+ 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 };
+ }
+ }
+ }
+ 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 => $attfile->get_file,
+ id => $attfile->id,
+ type => $attfile->mime_type,
+ name => $attfile->file_name,
+ content => $attfile->get_content };
+ }
+ }
+ $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;
+
+ #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();
+}
+
+sub get_formname_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});
+
+ my %formname_translations = (
+ bin_list => $main::locale->text('Bin List'),
+ credit_note => $main::locale->text('Credit Note'),
+ invoice => $main::locale->text('Invoice'),
+ pick_list => $main::locale->text('Pick List'),
+ proforma => $main::locale->text('Proforma Invoice'),
+ purchase_order => $main::locale->text('Purchase Order'),
+ request_quotation => $main::locale->text('RFQ'),
+ sales_order => $main::locale->text('Confirmation'),
+ sales_quotation => $main::locale->text('Quotation'),
+ storno_invoice => $main::locale->text('Storno Invoice'),
+ sales_delivery_order => $main::locale->text('Delivery Order'),
+ purchase_delivery_order => $main::locale->text('Delivery Order'),
+ dunning => $main::locale->text('Dunning'),
+ letter => $main::locale->text('Letter'),
+ ic_supply => $main::locale->text('Intra-Community supply'),
+ );
+
+ $main::lxdebug->leave_sub();
+ return $formname_translations{$formname};
+}
+
+sub get_number_prefix_for_type {
+ $main::lxdebug->enter_sub();
+ my ($self) = @_;
+
+ my $prefix =
+ (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv'
+ : ($self->{type} =~ /_quotation$/) ? 'quo'
+ : ($self->{type} =~ /_delivery_order$/) ? 'do'
+ : ($self->{type} =~ /letter/) ? 'letter'
+ : 'ord';
+
+ # better default like this?
+ # : ($self->{type} =~ /(sales|purcharse)_order/ : 'ord';
+ # : 'prefix_undefined';
+
+ $main::lxdebug->leave_sub();
+ return $prefix;
+}
+
+sub get_extension_for_format {
+ $main::lxdebug->enter_sub();
+ my ($self) = @_;
+
+ my $extension = $self->{format} =~ /pdf/i ? ".pdf"
+ : $self->{format} =~ /postscript/i ? ".ps"
+ : $self->{format} =~ /opendocument/i ? ".odt"
+ : $self->{format} =~ /excel/i ? ".xls"
+ : $self->{format} =~ /html/i ? ".html"
+ : "";
+
+ $main::lxdebug->leave_sub();
+ return $extension;
+}
+
+sub generate_attachment_filename {
+ $main::lxdebug->enter_sub();
+ my ($self) = @_;
+
+ $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
+ my $recipient_locale = Locale->new($self->{recipient_locale});
+
+ my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
+ my $prefix = $self->get_number_prefix_for_type();
+
+ if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
+ $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
+
+ } elsif ($attachment_filename && $self->{"${prefix}number"}) {
+ $attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
+
+ } elsif ($attachment_filename) {
+ $attachment_filename .= $self->get_extension_for_format();
+
+ } else {
+ $attachment_filename = "";
+ }
+
+ $attachment_filename = $main::locale->quote_special_chars('filenames', $attachment_filename);
+ $attachment_filename =~ s|[\s/\\]+|_|g;
+
+ $main::lxdebug->leave_sub();
+ return $attachment_filename;
+}
+
+sub generate_email_subject {
+ $main::lxdebug->enter_sub();
+ my ($self) = @_;
+
+ my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
+ my $prefix = $self->get_number_prefix_for_type();
+
+ if ($subject && $self->{"${prefix}number"}) {
+ $subject .= " " . $self->{"${prefix}number"}
+ }
+
+ $main::lxdebug->leave_sub();
+ return $subject;
+}
+
+sub cleanup {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $application) = @_;
+
+ my $error_code = $?;
+
+ chdir("$self->{tmpdir}");
+
+ my @err = ();
+ if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
+ push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');
+
+ } elsif (-f "$self->{tmpfile}.err") {
+ open(FH, "<:encoding(UTF-8)", "$self->{tmpfile}.err");
+ @err = <FH>;
+ close(FH);
+ }
+
+ if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) {
+ $self->{tmpfile} =~ s|.*/||g;
+ # strip extension
+ $self->{tmpfile} =~ s/\.\w+$//g;
+ my $tmpfile = $self->{tmpfile};
+ unlink(<$tmpfile.*>);
+ }
+
+ chdir("$self->{cwd}");
+
+ $main::lxdebug->leave_sub();
+
+ return "@err";
+}
+
+sub datetonum {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $date, $myconfig) = @_;
+ my ($yy, $mm, $dd);
+
+ if ($date && $date =~ /\D/) {
+
+ if ($myconfig->{dateformat} =~ /^yy/) {
+ ($yy, $mm, $dd) = split /\D/, $date;
+ }
+ if ($myconfig->{dateformat} =~ /^mm/) {
+ ($mm, $dd, $yy) = split /\D/, $date;
+ }
+ if ($myconfig->{dateformat} =~ /^dd/) {
+ ($dd, $mm, $yy) = split /\D/, $date;
+ }
+
+ $dd *= 1;
+ $mm *= 1;
+ $yy = ($yy < 70) ? $yy + 2000 : $yy;
+ $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
+
+ $dd = "0$dd" if ($dd < 10);
+ $mm = "0$mm" if ($mm < 10);
+
+ $date = "$yy$mm$dd";
+ }
+
+ $main::lxdebug->leave_sub();
+
+ return $date;
+}
+
+# Database routines used throughout
+# DB Handling got moved to SL::DB, these are only shims for compatibility
+
+sub dbconnect {
+ SL::DB->client->dbh;
+}
+
+sub get_standard_dbh {
+ my $dbh = SL::DB->client->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);
+ }
+
+ SL::DB->client->dbh;
+}
+
+sub disconnect_standard_dbh {
+ SL::DB->client->dbh->rollback;
+}
+
+# /database
+
+sub date_closed {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $date, $myconfig) = @_;
+ my $dbh = $self->get_standard_dbh;
+
+ my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
+ my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));
+
+ # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke,
+ # es ist sicher ein conv_date vorher IMMER auszuführen.
+ # Testfälle ohne definiertes closedto:
+ # Leere Datumseingabe i.O.
+ # SELECT 1 FROM defaults WHERE '' < closedto
+ # normale Zahlungsbuchung über Rechnungsmaske i.O.
+ # SELECT 1 FROM defaults WHERE '10.05.2011' < closedto
+ # Testfälle mit definiertem closedto (30.04.2011):
+ # Leere Datumseingabe i.O.
+ # SELECT 1 FROM defaults WHERE '' < closedto
+ # normale Buchung im geschloßenem Zeitraum i.O.
+ # SELECT 1 FROM defaults WHERE '21.04.2011' < closedto
+ # Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden!
+ # normale Buchung in aktiver Buchungsperiode i.O.
+ # SELECT 1 FROM defaults WHERE '01.05.2011' < closedto
+
+ my ($closed) = $sth->fetchrow_array;
+
+ $main::lxdebug->leave_sub();
+
+ return $closed;
+}
+
+# prevents bookings to the to far away future
+sub date_max_future {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $date, $myconfig) = @_;
+ my $dbh = $self->get_standard_dbh;
+
+ my $query = "SELECT 1 FROM defaults WHERE ? - current_date > max_future_booking_interval";
+ my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));
+
+ my ($max_future_booking_interval) = $sth->fetchrow_array;
+
+ $main::lxdebug->leave_sub();
+
+ return $max_future_booking_interval;
+}
+
+
+sub update_balance {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $dbh, $table, $field, $where, $value, @values) = @_;
+
+ # if we have a value, go do it
+ if ($value != 0) {
+
+ # retrieve balance from table
+ my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE";
+ my $sth = prepare_execute_query($self, $dbh, $query, @values);
+ my ($balance) = $sth->fetchrow_array;
+ $sth->finish;
+
+ $balance += $value;
+
+ # update balance
+ $query = "UPDATE $table SET $field = $balance WHERE $where";
+ do_query($self, $dbh, $query, @values);
+ }
+ $main::lxdebug->leave_sub();
+}
+
+sub update_exchangerate {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
+ my ($query);
+ # some sanity check for currency
+ if ($curr eq '') {
+ $main::lxdebug->leave_sub();
+ return;
+ }
+ $query = qq|SELECT name AS curr FROM currencies WHERE id=(SELECT currency_id FROM defaults)|;
+
+ my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
+
+ if ($curr eq $defaultcurrency) {
+ $main::lxdebug->leave_sub();
+ return;
+ }
+
+ $query = qq|SELECT e.currency_id FROM exchangerate e
+ WHERE e.currency_id = (SELECT cu.id FROM currencies cu WHERE cu.name=?) AND e.transdate = ?
+ FOR UPDATE|;
+ my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
projects / mfinanz.git / blobdiff