+sub redirect {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $msg) = @_;
+
+ if (!$self->{callback}) {
+ $self->info($msg);
+
+ } else {
+ $self->_store_redirect_info_in_session;
+ print $::form->redirect_header($self->{callback});
+ }
+
+ ::end_of_request();
+
+ $main::lxdebug->leave_sub();
+}
+
+# sort of columns removed - empty sub
+sub sort_columns {
+ $main::lxdebug->enter_sub();
+
+ my ($self, @columns) = @_;
+
+ $main::lxdebug->leave_sub();
+
+ return @columns;
+}
+#
+sub format_amount {
+ $main::lxdebug->enter_sub(2);
+
+ 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;
+ $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 (abs($places || 0) - length ($p[1]||''))); # 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;
+ return scalar(eval($amount)) * 1 ;
+}
+
+sub round_amount {
+ my ($self, $amount, $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 $amount_str = sprintf '%.*f', $places + 10, 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 ($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;
+ $self->cleanup;
+ chdir("$self->{cwd}");
+
+ $::lxdebug->leave_sub();
+
+ return;
+ }
+
+ Common::copy_file_to_webdav_folder($self) if $copy_to_webdav;
+
+ if ($self->{media} eq 'email') {
+
+ my $mail = new Mailer;
+
+ 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);
+
+ } else {
+
+ 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 }];
+ }
+
+ $mail->{message} .= $full_signature;
+ }
+
+ my $err = $mail->send();
+ $self->error($self->cleanup . "$err") if ($err);
+
+ } else {
+
+ $self->{OUT} = $out;
+ $self->{OUT_MODE} = $out_mode;
+
+ 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}");
+ #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});
+
+ 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' => $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' => '',
+ );
+ }
+
+ print $::request->cgi->header(%headers);
+
+ $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
+ }
+ }
+
+ close(IN);
+ }
+
+ $self->cleanup;
+
+ chdir("$self->{cwd}");
+ $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'),
+ );
+
+ $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'
+ : 'ord';
+
+ $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();
+
+ } 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
+
+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;
+}
+
+sub get_standard_dbh {
+ $main::lxdebug->enter_sub(2);
+
+ 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;
+ }
+
+ $standard_dbh ||= $self->dbconnect_noauto($myconfig);
+
+ $main::lxdebug->leave_sub(2);
+
+ return $standard_dbh;
+}
+
+sub set_standard_dbh {
+ my ($self, $dbh) = @_;
+ my $old_dbh = $standard_dbh;
+ $standard_dbh = $dbh;
+
+ return $old_dbh;
+}
+
+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);
+
+ if ($buy == 0) {
+ $buy = "";
+ }
+ if ($sell == 0) {
+ $sell = "";
+ }
+
+ $buy = conv_i($buy, "NULL");
+ $sell = conv_i($sell, "NULL");
+
+ my $set;
+ if ($buy != 0 && $sell != 0) {
+ $set = "buy = $buy, sell = $sell";
+ } elsif ($buy != 0) {
+ $set = "buy = $buy";
+ } elsif ($sell != 0) {
+ $set = "sell = $sell";
+ }
+
+ if ($sth->fetchrow_array) {
+ $query = qq|UPDATE exchangerate
+ SET $set
+ WHERE currency_id = (SELECT id FROM currencies WHERE name = ?)
+ AND transdate = ?|;
+
+ } else {
+ $query = qq|INSERT INTO exchangerate (currency_id, buy, sell, transdate)
+ VALUES ((SELECT id FROM currencies WHERE name = ?), $buy, $sell, ?)|;
+ }
+ $sth->finish;
+ do_query($self, $dbh, $query, $curr, $transdate);
+
+ $main::lxdebug->leave_sub();
+}
+
+sub save_exchangerate {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;
+
+ my $dbh = $self->dbconnect($myconfig);
+
+ my ($buy, $sell);
projects / mfinanz.git / blobdiff