1 #=====================================================================
2 # SQL-Ledger Accounting
3 # Copyright (C) 1998-2003
5 # Author: Dieter Simader
6 # Email: dsimader@sql-ledger.org
7 # Web: http://www.sql-ledger.org
9 # Contributors: Thomas Bayen <bayen@gmx.de>
10 # Antti Kaihola <akaihola@siba.fi>
11 # Moritz Bunkus (tex code)
13 # This program is free software; you can redistribute it and/or modify
14 # it under the terms of the GNU General Public License as published by
15 # the Free Software Foundation; either version 2 of the License, or
16 # (at your option) any later version.
18 # This program is distributed in the hope that it will be useful,
19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 # GNU General Public License for more details.
22 # You should have received a copy of the GNU General Public License
23 # along with this program; if not, write to the Free Software
24 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25 #======================================================================
26 # Utilities for parsing forms
27 # and supporting routines for linking account numbers
28 # used in AR, AP and IS, IR modules
30 #======================================================================
40 read(STDIN, $_, $ENV{CONTENT_LENGTH});
42 if ($ENV{QUERY_STRING}) {
43 $_ = $ENV{QUERY_STRING};
50 foreach $item (split(/&/)) {
51 ($key, $value) = split(/=/, $item);
52 $self->{$key} = &unescape("",$value);
55 $self->{action} = lc $self->{action};
56 $self->{action} =~ s/( |-|,)/_/g;
58 $self->{version} = "2.0.8";
59 $self->{dbversion} = "2.0.8";
71 map { print "$_ = $self->{$_}\n" } (sort keys %{$self});
77 my ($self, $str, $beenthere) = @_;
79 # for Apache 2 we escape strings twice
80 if (($ENV{SERVER_SOFTWARE} =~ /Apache\/2/) && !$beenthere) {
81 $str = $self->escape($str, 1);
84 $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
91 my ($self, $str) = @_;
96 $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
104 my ($self, $msg) = @_;
106 if ($ENV{HTTP_USER_AGENT}) {
109 print qq|Content-Type: text/html
111 <body bgcolor=ffffff>
113 <h2><font color=red>Error!</font></h2>
125 if ($self->{error_function}) {
126 &{ $self->{error_function} }($msg);
137 my ($self, $msg) = @_;
139 if ($ENV{HTTP_USER_AGENT}) {
142 if (!$self->{header}) {
155 if ($self->{info_function}) {
156 &{ $self->{info_function} }($msg);
166 my ($self, $str, $cols, $maxrows) = @_;
170 map { $rows += int ((length $_)/$cols) + 1 } (split /\r/, $str);
172 $rows = $maxrows if (defined $maxrows && ($rows > $maxrows));
180 my ($self, $msg) = @_;
182 $self->error("$msg\n".$DBI::errstr);
188 my ($self, $name, $msg) = @_;
190 if ($self->{$name} =~ /^\s*$/) {
199 my ($nocache, $stylesheet, $charset);
201 # use expire tag to prevent caching
202 # $nocache = qq|<META HTTP-EQUIV="Expires" CONTENT="Tue, 01 Jan 1980 1:00:00 GMT">
203 # <META HTTP-EQUIV="Pragma" CONTENT="no-cache">
206 if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) {
207 $stylesheet = qq|<LINK REL="stylesheet" HREF="css/$self->{stylesheet}" TYPE="text/css" TITLE="SQL-Ledger style sheet">
211 if ($self->{charset}) {
212 $charset = qq|<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$self->{charset}">
216 $self->{titlebar} = ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar};
218 print qq|Content-Type: text/html
220 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
222 <title>$self->{titlebar}</title>
234 my ($self, $msg) = @_;
236 if ($self->{callback}) {
238 ($script, $argv) = split(/\?/, $self->{callback});
240 exec ("perl", "$script", $argv);
244 if ($ENV{HTTP_USER_AGENT}) {
247 print qq|Content-Type: text/html
249 <body bgcolor=ffffff>
269 my ($self, @columns) = @_;
271 @columns = grep !/^$self->{sort}$/, @columns;
272 splice @columns, 0, 0, $self->{sort};
280 my ($self, $myconfig, $amount, $places, $dash) = @_;
282 if ($places =~ /\d/) {
283 $amount = $self->round_amount($amount, $places);
286 # is the amount negative
287 my $negative = ($amount < 0);
290 if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00')) {
291 my ($whole, $dec) = split /\./, "$amount";
293 $amount = join '', reverse split //, $whole;
295 if ($myconfig->{numberformat} eq '1,000.00') {
296 $amount =~ s/\d{3,}?/$&,/g;
298 $amount = join '', reverse split //, $amount;
299 $amount .= "\.$dec" if ($dec ne "");
302 if ($myconfig->{numberformat} eq '1.000,00') {
303 $amount =~ s/\d{3,}?/$&./g;
305 $amount = join '', reverse split //, $amount;
306 $amount .= ",$dec" if ($dec ne "");
309 if ($myconfig->{numberformat} eq '1000,00') {
311 $amount .= ",$dec" if ($dec ne "");
315 $amount = ($negative) ? "($amount)" : "$amount";
316 } elsif ($dash =~ /DRCR/) {
317 $amount = ($negative) ? "$amount DR" : "$amount CR";
319 $amount = ($negative) ? "-$amount" : "$amount";
323 if ($dash eq "0" && $places) {
324 if ($myconfig->{numberformat} eq '1.000,00') {
325 $amount = "0".","."0" x $places;
327 $amount = "0"."."."0" x $places;
330 $amount = ($dash ne "") ? "$dash" : "";
340 my ($self, $myconfig, $amount) = @_;
342 if (($myconfig->{numberformat} eq '1.000,00') ||
343 ($myconfig->{numberformat} eq '1000,00')) {
350 return ($amount * 1);
356 my ($self, $amount, $places) = @_;
358 # $places = 3 if $places == 2;
360 if (($places * 1) >= 0) {
361 # compensate for perl behaviour, add 1/10^$places+3
362 sprintf("%.${places}f", $amount + (1 / (10 ** ($places + 3))) * (($amount > 0) ? 1 : -1));
365 sprintf("%.f", $amount / (10 ** $places) + (($amount > 0) ? 0.1 : -0.1)) * (10 ** $places);
372 my ($self, $myconfig, $userspath) = @_;
375 # Some variables used for page breaks
376 my ($chars_per_line, $lines_on_first_page, $lines_on_second_page) = (0, 0, 0);
377 my ($current_page, $current_line) = (1, 1);
382 open(IN, "$self->{templates}/$self->{IN}") or $self->error("$self->{IN} : $!");
387 $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
389 # OUT is used for the media, screen, printer, email
390 # for postscript we store a copy in a temporary file
392 $self->{tmpfile} = "$userspath/${fileid}.$self->{IN}";
393 if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') {
395 $self->{OUT} = ">$self->{tmpfile}";
400 open(OUT, "$self->{OUT}") or $self->error("$self->{OUT} : $!");
402 open(OUT, ">-") or $self->error("STDOUT : $!");
407 # first we generate a tmpfile
408 # read file and replace <%variable%>
416 # detect pagebreak block and its parameters
417 if (/<%pagebreak ([0-9]+) ([0-9]+) ([0-9]+)%>/) {
418 $chars_per_line = $1;
419 $lines_on_first_page = $2;
420 $lines_on_second_page = $3;
423 last if (/<\%end pagebreak%>/);
432 # this one we need for the count
434 $var =~ s/<%foreach (.+?)%>/$1/;
442 # display contents of $self->{number}[] array
443 for $i (0 .. $#{ $self->{$var} }) {
446 # Try to detect whether a manual page break is necessary
447 # but only if there was a <%pagebreak ...%> block before
449 if ($chars_per_line) {
450 my $lines = int(length($self->{"description"}[$i]) / $chars_per_line + 0.95);
453 if ($current_page == 1) {
454 $lpp = $lines_on_first_page;
456 $lpp = $lines_on_second_page;
459 # Yes we need a manual page break
460 if (($current_line + $lines) > $lpp) {
463 # replace the special variables <%sumcarriedforward%>
466 my $psum = $self->format_amount($myconfig, $sum, 2);
467 $pb =~ s/<%sumcarriedforward%>/$psum/g;
468 $pb =~ s/<%lastpage%>/$current_page/g;
470 # only "normal" variables are supported here
471 # (no <%if, no <%foreach, no <%include)
473 $pb =~ s/<%(.+?)%>/$self->{$1}/g;
475 # page break block is ready to rock
480 $current_line += $lines;
482 $sum += $self->parse_amount($myconfig, $self->{"linetotal"}[$i]);
486 # don't parse par, we need it for each line
488 s/<%(.+?)%>/$self->{$1}[$i]/mg;
494 # if not comes before if!
496 # check if it is not set and display
498 s/<%if not (.+?)%>/$1/;
500 unless ($self->{$_}) {
519 # check if it is set and display
541 # check for <%include filename%>
546 $var =~ s/<%include (.+?)%>/$1/;
548 # mangle filename if someone tries to be cute
551 # prevent the infinite loop!
552 next if ($self->{"$var"});
554 open(INC, "$self->{templates}/$var") or $self->error($self->cleanup."$self->{templates}/$var : $!");
563 s/<%(.+?)%>/$self->{$1}/g;
571 # Convert the tex file to postscript
572 if ($self->{format} =~ /(postscript|pdf)/) {
575 $self->{cwd} = cwd();
576 chdir("$userspath") or $self->error($self->cleanup."chdir : $!");
578 $self->{tmpfile} =~ s/$userspath\///g;
580 # DS. added screen and email option in addition to printer
582 if ($self->{format} eq 'postscript') {
583 system("latex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err");
584 $self->error($self->cleanup) if ($?);
586 $self->{tmpfile} =~ s/tex$/dvi/;
588 system("dvips $self->{tmpfile} -o -q > /dev/null");
589 $self->error($self->cleanup."dvips : $!") if ($?);
590 $self->{tmpfile} =~ s/dvi$/ps/;
592 if ($self->{format} eq 'pdf') {
593 system("pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err");
594 $self->error($self->cleanup) if ($?);
595 $self->{tmpfile} =~ s/tex$/pdf/;
600 if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') {
602 if ($self->{media} eq 'email') {
606 my $mail = new Mailer;
608 $self->{email} =~ s/,/>,</g;
610 map { $mail->{$_} = $self->{$_} } qw(cc bcc subject message version format charset);
611 $mail->{to} = qq|"$self->{name}" <$self->{email}>|;
612 $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
613 $mail->{fileid} = "$fileid.";
615 # if we send html or plain text inline
616 if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
617 $mail->{contenttype} = "text/html";
619 $mail->{message} =~ s/\r\n/<br>\n/g;
620 $myconfig->{signature} =~ s/\\n/<br>\n/g;
621 $mail->{message} .= "<br>\n--<br>\n$myconfig->{signature}\n<br>";
623 open(IN, $self->{tmpfile}) or $self->error($self->cleanup."$self->{tmpfile} : $!");
625 $mail->{message} .= $_;
632 @{ $mail->{attachments} } = ($self->{tmpfile});
634 $myconfig->{signature} =~ s/\\n/\r\n/g;
635 $mail->{message} .= "\r\n--\r\n$myconfig->{signature}";
639 my $err = $mail->send($out);
640 $self->error($self->cleanup."$err") if ($err);
645 open(IN, $self->{tmpfile}) or $self->error($self->cleanup."$self->{tmpfile} : $!");
647 $self->{copies} = 1 unless $self->{media} eq 'printer';
649 for my $i (1 .. $self->{copies}) {
652 open(OUT, $self->{OUT}) or $self->error($self->cleanup."$self->{OUT} : $!");
654 open(OUT, ">-") or $self->error($self->cleanup."$!: STDOUT");
657 print qq|Content-Type: application/$self->{format}; name="$self->{tmpfile}"
658 Content-Disposition: filename="$self->{tmpfile}"
685 if (-f "$self->{tmpfile}.err") {
686 open(FH, "$self->{tmpfile}.err");
691 if ($self->{tmpfile}) {
693 $self->{tmpfile} =~ s/\.\w+$//g;
694 my $tmpfile = $self->{tmpfile};
695 unlink(<$tmpfile.*>);
699 chdir("$self->{cwd}");
707 my ($self, @fields) = @_;
709 my $format = $self->{format};
710 if ($self->{format} =~ /(postscript|pdf)/) {
714 my %replace = ( 'order' => { 'html' => [ quotemeta('\n'), '
\r' ],
715 'tex' => [ '&', quotemeta('\n'), '
\r',
716 '\$', '%', '_', '#', quotemeta('^'),
717 '{', '}', '<', '>', '£' ] },
719 quotemeta('\n') => '<br>', '
\r' => '<br>'
722 '&' => '\&', '\$' => '\$', '%' => '\%', '_' => '\_',
723 '#' => '\#', quotemeta('^') => '\^\\', '{' => '\{', '}' => '\}',
724 '<' => '$<$', '>' => '$>$',
725 quotemeta('\n') => '\newline ', '
\r' => '\newline ',
730 foreach my $key (@{ $replace{order}{$format} }) {
731 map { $self->{$_} =~ s/$key/$replace{$format}{$key}/g; } @fields;
738 my ($self, $date, $myconfig) = @_;
742 my $spc = $myconfig->{dateformat};
744 $spc = substr($spc, 1, 1);
753 if ($myconfig->{dateformat} =~ /^yy/) {
754 ($yy, $mm, $dd) = split /$spc/, $date;
756 if ($myconfig->{dateformat} =~ /^mm/) {
757 ($mm, $dd, $yy) = split /$spc/, $date;
759 if ($myconfig->{dateformat} =~ /^dd/) {
760 ($dd, $mm, $yy) = split /$spc/, $date;
765 $yy = ($yy < 70) ? $yy + 2000 : $yy;
766 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
768 $dd = "0$dd" if ($dd < 10);
769 $mm = "0$mm" if ($mm < 10);
780 # Database routines used throughout
783 my ($self, $myconfig) = @_;
785 # connect to database
786 my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}) or $self->dberror;
789 if ($myconfig->{dboptions}) {
790 $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
798 sub dbconnect_noauto {
799 my ($self, $myconfig) = @_;
801 # connect to database
802 $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, {AutoCommit => 0}) or $self->dberror;
805 if ($myconfig->{dboptions}) {
806 $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
815 my ($self, $dbh, $table, $field, $where, $value) = @_;
817 # if we have a value, go do it
819 # retrieve balance from table
820 my $query = "SELECT $field FROM $table WHERE $where";
821 my $sth = $dbh->prepare($query);
823 $sth->execute || $self->dberror($query);
824 my ($balance) = $sth->fetchrow_array;
829 $query = "UPDATE $table SET $field = $balance WHERE $where";
830 $dbh->do($query) || $self->dberror($query);
836 sub update_exchangerate {
837 my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
839 # some sanity check for currency
840 return if ($curr eq '');
842 my $query = qq|SELECT curr FROM exchangerate
844 AND transdate = '$transdate'|;
845 my $sth = $dbh->prepare($query);
846 $sth->execute || $self->dberror($query);
849 if ($buy != 0 && $sell != 0) {
850 $set = "buy = $buy, sell = $sell";
851 } elsif ($buy != 0) {
853 } elsif ($sell != 0) {
854 $set = "sell = $sell";
857 if ($sth->fetchrow_array) {
858 $query = qq|UPDATE exchangerate
861 AND transdate = '$transdate'|;
863 $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
864 VALUES ('$curr', $buy, $sell, '$transdate')|;
867 $dbh->do($query) || $self->dberror($query);
872 sub get_exchangerate {
873 my ($self, $dbh, $curr, $transdate, $fld) = @_;
875 my $query = qq|SELECT $fld FROM exchangerate
877 AND transdate = '$transdate'|;
878 my $sth = $dbh->prepare($query);
879 $sth->execute || $self->dberror($query);
881 my ($exchangerate) = $sth->fetchrow_array;
889 sub delete_exchangerate {
890 my ($self, $dbh) = @_;
895 my $query = qq|SELECT DISTINCT transdate
897 WHERE trans_id = $self->{id}|;
898 my $sth = $dbh->prepare($query);
899 $sth->execute || $self->dberror($query);
901 while ($transdate = $sth->fetchrow_array) {
902 push @transdate, $transdate;
906 $query = qq|SELECT transdate FROM acc_trans
907 WHERE ar.id = trans_id
908 AND ar.curr = '$self->{currency}'
910 (SELECT transdate FROM acc_trans
911 WHERE trans_id = $self->{id})
912 AND trans_id != $self->{id}
913 UNION SELECT transdate FROM acc_trans
914 WHERE ap.id = trans_id
915 AND ap.curr = '$self->{currency}'
917 (SELECT transdate FROM acc_trans
918 WHERE trans_id = $self->{id})
919 AND trans_id != $self->{id}
920 UNION SELECT transdate FROM oe
921 WHERE oe.curr = '$self->{currency}'
923 (SELECT transdate FROM acc_trans
924 WHERE trans_id = $self->{id})|;
925 $sth = $dbh->prepare($query);
926 $sth->execute || $self->dberror($query);
928 while ($transdate = $sth->fetchrow_array) {
929 @transdate = grep !/^$transdate$/, @transdate;
933 foreach $transdate (@transdate) {
934 $query = qq|DELETE FROM exchangerate
935 WHERE curr = '$self->{currency}'
936 AND transdate = '$transdate'|;
937 $dbh->do($query) || $self->dberror($query);
943 sub check_exchangerate {
944 my ($self, $myconfig, $currency, $transdate, $fld) = @_;
946 return "" unless $transdate;
948 my $dbh = $self->dbconnect($myconfig);
950 my $query = qq|SELECT $fld FROM exchangerate
951 WHERE curr = '$currency'
952 AND transdate = '$transdate'|;
953 my $sth = $dbh->prepare($query);
954 $sth->execute || $self->dberror($query);
956 my ($exchangerate) = $sth->fetchrow_array;
966 my ($self, $dbh, $id) = @_;
969 foreach my $item (qw(name addr1 addr2 addr3 addr4 contact phone fax email)) {
970 if ($self->{"shipto$item"}) {
971 $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
973 $self->{"shipto$item"} =~ s/'/''/g;
977 my $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptoaddr1,
978 shiptoaddr2, shiptoaddr3, shiptoaddr4, shiptocontact,
979 shiptophone, shiptofax, shiptoemail) VALUES ($id,
980 '$self->{shiptoname}', '$self->{shiptoaddr1}',
981 '$self->{shiptoaddr2}', '$self->{shiptoaddr3}',
982 '$self->{shiptoaddr4}', '$self->{shiptocontact}',
983 '$self->{shiptophone}', '$self->{shiptofax}',
984 '$self->{shiptoemail}')|;
985 $dbh->do($query) || $self->dberror($query);
992 my ($self, $dbh) = @_;
994 my $query = qq|SELECT name FROM employee
995 WHERE login = '$self->{login}'|;
996 my $sth = $dbh->prepare($query);
997 $sth->execute || $self->dberror($query);
999 ($self->{employee}) = $sth->fetchrow_array;
1005 # this sub gets the id and name from $table
1007 my ($self, $myconfig, $table) = @_;
1009 # connect to database
1010 my $dbh = $self->dbconnect($myconfig);
1012 my $name = $self->like(lc $self->{$table});
1013 my $query = qq~SELECT id, name,
1014 addr1 || ' ' || addr2 || ' ' || addr3 || ' ' || addr4 AS address
1016 WHERE lower(name) LIKE '$name'
1018 my $sth = $dbh->prepare($query);
1020 $sth->execute || $self->dberror($query);
1023 while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
1024 push(@{ $self->{name_list} }, $ref);
1035 # the selection sub is used in the AR, AP, IS, IR and OE module
1038 my ($self, $myconfig, $table) = @_;
1040 my $dbh = $self->dbconnect($myconfig);
1042 my $query = qq|SELECT count(*) FROM $table|;
1043 my $sth = $dbh->prepare($query);
1044 $sth->execute || $self->dberror($query);
1045 my ($count) = $sth->fetchrow_array;
1048 # build selection list
1049 if ($count < $myconfig->{vclimit}) {
1050 $query = qq|SELECT id, name
1053 $sth = $dbh->prepare($query);
1054 $sth->execute || $self->dberror($query);
1056 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1057 push @{ $self->{"all_$table"} }, $ref;
1070 my ($self, $module, $myconfig, $table) = @_;
1072 $self->all_vc($myconfig, $table);
1074 # get last customers or vendors
1077 my $dbh = $self->dbconnect($myconfig);
1082 # now get the account numbers
1083 $query = qq|SELECT accno, description, link
1085 WHERE link LIKE '%$module%'
1087 $sth = $dbh->prepare($query);
1088 $sth->execute || $self->dberror($query);
1090 $self->{accounts} = "";
1091 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1093 foreach my $key (split(/:/, $ref->{link})) {
1094 if ($key =~ /$module/) {
1095 # cross reference for keys
1096 $xkeyref{$ref->{accno}} = $key;
1098 push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno},
1099 description => $ref->{description} };
1101 $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
1109 my $arap = ($table eq 'customer') ? 'ar' : 'ap';
1111 $query = qq|SELECT a.invnumber, a.transdate,
1112 a.${table}_id, a.datepaid, a.duedate, a.ordnumber,
1113 a.taxincluded, a.curr AS currency, a.notes, c.name AS $table,
1114 a.amount AS oldinvtotal, a.paid AS oldtotalpaid
1115 FROM $arap a, $table c
1116 WHERE a.${table}_id = c.id
1117 AND a.id = $self->{id}|;
1118 $sth = $dbh->prepare($query);
1119 $sth->execute || $self->dberror($query);
1121 $ref = $sth->fetchrow_hashref(NAME_lc);
1122 foreach $key (keys %$ref) {
1123 $self->{$key} = $ref->{$key};
1127 # get amounts from individual entries
1128 $query = qq|SELECT c.accno, c.description, a.source, a.amount,
1129 a.transdate, a.cleared, a.project_id, p.projectnumber
1131 JOIN chart c ON (c.id = a.chart_id)
1132 LEFT JOIN project p ON (a.project_id = p.id)
1133 WHERE a.trans_id = $self->{id}
1134 AND a.fx_transaction = '0'
1135 ORDER BY transdate|;
1136 $sth = $dbh->prepare($query);
1137 $sth->execute || $self->dberror($query);
1139 my $fld = ($table eq 'customer') ? 'buy' : 'sell';
1140 # get exchangerate for currency
1141 $self->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
1143 # store amounts in {acc_trans}{$key} for multiple accounts
1144 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1145 $ref->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
1147 push @{ $self->{acc_trans}{$xkeyref{$ref->{accno}}} }, $ref;
1152 $query = qq|SELECT d.curr AS currencies, d.closedto, d.revtrans,
1153 (SELECT c.accno FROM chart c
1154 WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
1155 (SELECT c.accno FROM chart c
1156 WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
1158 $sth = $dbh->prepare($query);
1159 $sth->execute || $self->dberror($query);
1161 $ref = $sth->fetchrow_hashref(NAME_lc);
1162 map { $self->{$_} = $ref->{$_} } keys %$ref;
1168 $query = qq|SELECT current_date AS transdate,
1169 d.curr AS currencies, d.closedto, d.revtrans,
1170 (SELECT c.accno FROM chart c
1171 WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
1172 (SELECT c.accno FROM chart c
1173 WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
1175 $sth = $dbh->prepare($query);
1176 $sth->execute || $self->dberror($query);
1178 $ref = $sth->fetchrow_hashref(NAME_lc);
1179 map { $self->{$_} = $ref->{$_} } keys %$ref;
1182 if ($self->{"$self->{vc}_id"}) {
1183 # only setup currency
1184 ($self->{currency}) = split /:/, $self->{currencies};
1188 $self->lastname_used($dbh, $myconfig, $table, $module);
1190 my $fld = ($table eq 'customer') ? 'buy' : 'sell';
1191 # get exchangerate for currency
1192 $self->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
1204 my ($self, $dbh, $myconfig, $table, $module) = @_;
1206 my $arap = ($table eq 'customer') ? "ar" : "ap";
1207 $arap = 'oe' if ($self->{type} =~ /_order/);
1209 my $query = qq|SELECT id FROM $arap
1210 WHERE id IN (SELECT MAX(id) FROM $arap
1211 WHERE ${table}_id > 0)|;
1212 my $sth = $dbh->prepare($query);
1213 $sth->execute || $self->dberror($query);
1215 my ($trans_id) = $sth->fetchrow_array;
1219 $query = qq|SELECT ct.name, a.curr, a.${table}_id,
1220 current_date + ct.terms AS duedate
1222 JOIN $table ct ON (a.${table}_id = ct.id)
1223 WHERE a.id = $trans_id|;
1224 $sth = $dbh->prepare($query);
1225 $sth->execute || $self->dberror($query);
1227 ($self->{$table}, $self->{currency}, $self->{"${table}_id"}, $self->{duedate}) = $sth->fetchrow_array;
1235 my ($self, $myconfig, $thisdate, $days) = @_;
1237 my $dbh = $self->dbconnect($myconfig);
1242 my $dateformat = $myconfig->{dateformat};
1243 $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
1245 $query = qq|SELECT to_date('$thisdate', '$dateformat') + $days AS thisdate
1247 $sth = $dbh->prepare($query);
1248 $sth->execute || $self->dberror($query);
1250 $query = qq|SELECT current_date AS thisdate
1252 $sth = $dbh->prepare($query);
1253 $sth->execute || $self->dberror($query);
1256 ($thisdate) = $sth->fetchrow_array;
1267 my ($self, $string) = @_;
1269 unless ($string =~ /%/) {
1270 $string = "%$string%";
1273 $string =~ s/'/''/g;
1280 my ($self, $flds, $new, $count, $numrows) = @_;
1284 map { push @ndx, { num => $new->[$_-1]->{runningnumber}, ndx => $_ } } (1 .. $count);
1288 foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
1290 $j = $item->{ndx} - 1;
1291 map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
1295 for $i ($count + 1 .. $numrows) {
1296 map { delete $self->{"${_}_$i"} } @{$flds};
1306 my ($type, $country, $NLS_file) = @_;
1310 if ($country && -d "locale/$country") {
1311 $self->{countrycode} = $country;
1312 eval { require "locale/$country/$NLS_file"; };
1315 $self->{NLS_file} = $NLS_file;
1317 push @{ $self->{LONG_MONTH} }, ("January", "February", "March", "April", "May ", "June", "July", "August", "September", "October", "November", "December");
1318 push @{ $self->{SHORT_MONTH} }, (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
1326 my ($self, $text) = @_;
1328 return (exists $self{texts}{$text}) ? $self{texts}{$text} : $text;
1334 my ($self, $text) = @_;
1336 if (exists $self{subs}{$text}) {
1337 $text = $self{subs}{$text};
1339 if ($self->{countrycode} && $self->{NLS_file}) {
1340 Form->error("$text not defined in locale/$self->{countrycode}/$self->{NLS_file}");
1350 my ($self, $myconfig, $date, $longformat) = @_;
1353 my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
1357 $spc = $myconfig->{dateformat};
1359 $spc = substr($spc, 1, 1);
1368 if ($myconfig->{dateformat} =~ /^yy/) {
1369 ($yy, $mm, $dd) = split /$spc/, $date;
1371 if ($myconfig->{dateformat} =~ /^mm/) {
1372 ($mm, $dd, $yy) = split /$spc/, $date;
1374 if ($myconfig->{dateformat} =~ /^dd/) {
1375 ($dd, $mm, $yy) = split /$spc/, $date;
1380 $yy = ($yy < 70) ? $yy + 2000 : $yy;
1381 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
1383 if ($myconfig->{dateformat} =~ /^dd/) {
1384 $longdate = "$dd. ".&text($self, $self->{$longmonth}[$mm])." $yy";
1386 $longdate = &text($self, $self->{$longmonth}[$mm])." $dd, $yy";