epic-s6ts
[kivitendo-erp.git] / SL / BP.pm
1 #=====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (C) 2003
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 #  Contributors:
16 #
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
21 #
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
25 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
29 # MA 02110-1335, USA.
30 #======================================================================
31 #
32 # Batch printing module backend routines
33 #
34 #======================================================================
35
36 package BP;
37
38 use SL::DBUtils;
39 use SL::DB;
40
41 use strict;
42
43 sub payment_accounts {
44   $main::lxdebug->enter_sub();
45
46   my ($self, $myconfig, $form) = @_;
47
48   # connect to database
49   my $dbh = SL::DB->client->dbh;
50
51   my $query =
52     qq|SELECT DISTINCT ON (s.chart_id) c.accno, c.description | .
53     qq|FROM status s, chart c | .
54     qq|WHERE s.chart_id = c.id AND s.formname = ?|;
55   my $sth = $dbh->prepare($query);
56   $sth->execute($form->{type}) || $form->dberror($query . " ($form->{type})");
57
58   $form->{accounts} = [];
59   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
60     push @{ $form->{accounts} }, $ref;
61   }
62
63   $sth->finish;
64
65   $main::lxdebug->leave_sub();
66 }
67
68 sub get_spoolfiles {
69   $main::lxdebug->enter_sub();
70
71   my ($self, $myconfig, $form) = @_;
72
73   my $dbh = SL::DB->client->dbh;
74
75   my ($query, $arap, @values);
76   my $invnumber = "invnumber";
77
78   my $vc = $form->{vc} eq "customer" ? "customer" : "vendor";
79
80   if ($form->{type} eq 'check' || $form->{type} eq 'receipt') {
81
82     $arap = ($form->{type} eq 'check') ? "ap" : "ar";
83     my ($accno) = split /--/, $form->{account};
84
85     $query =
86       qq|SELECT a.id, s.spoolfile, vc.name, ac.transdate, a.invnumber, | .
87       qq|  a.invoice, '$arap' AS module | .
88       qq|FROM status s, chart c, $vc vc, $arap a, acc_trans ac | .
89       qq|WHERE s.formname = ? | .
90       qq|  AND s.chart_id = c.id | .
91       qq|  AND c.accno = ? | .
92       qq|  AND s.trans_id = a.id | .
93       qq|  AND a.${vc}_id = vc.id | .
94       qq|  AND ac.trans_id = s.trans_id | .
95       qq|  AND ac.chart_id = c.id | .
96       qq|  AND NOT ac.fx_transaction|;
97     @values = ($form->{type}, $accno);
98
99   } else {
100     $arap = "ar";
101     my $invoice = "a.invoice";
102     my $quonumber = "a.quonumber";
103
104     if ($form->{type} =~ /_(order|quotation)$/) {
105       $invnumber = "ordnumber";
106       $arap      = "oe";
107       $invoice   = '0';
108     }
109
110     if ($form->{type} eq 'packing_list') {
111       $invnumber = "donumber";
112       $arap      = "delivery_orders";
113       $invoice   = '0';
114       $quonumber = '0';
115     }
116
117     $query =
118       qq|SELECT a.id, a.$invnumber AS invnumber, a.ordnumber, $quonumber, | .
119       qq|  a.transdate, $invoice AS invoice, '$arap' AS module, vc.name, | .
120       qq|  s.spoolfile | .
121       qq|FROM $arap a, ${vc} vc, status s | .
122       qq|WHERE s.trans_id = a.id | .
123       qq|  AND s.spoolfile IS NOT NULL | .
124     ($form->{type} eq 'packing_list'
125     ? qq|  AND s.formname IN (?, ?) |
126     : qq|  AND s.formname = ? |) .
127       qq|  AND a.${vc}_id = vc.id|;
128     @values = ($form->{type});
129
130     if ($form->{type} eq 'packing_list') {
131       @values = qw(sales_delivery_order purchase_delivery_order);
132     }
133   }
134
135   if ($form->{"${vc}_id"}) {
136     $query .= qq| AND a.${vc}_id = ?|;
137     push(@values, conv_i($form->{"${vc}_id"}));
138   } elsif ($form->{ $vc }) {
139     $query .= " AND vc.name ILIKE ?";
140     push(@values, like($form->{ $vc }));
141   }
142   foreach my $column (qw(invnumber ordnumber quonumber donumber)) {
143     if ($form->{$column}) {
144       $query .= " AND a.$column ILIKE ?";
145       push(@values, like($form->{$column}));
146     }
147   }
148
149   if ($form->{type} =~ /(invoice|sales_order|sales_quotation|purchase_order|request_quotation|packing_list)$/) {
150     if ($form->{transdatefrom}) {
151       $query .= " AND a.transdate >= ?";
152       push(@values, $form->{transdatefrom});
153     }
154     if ($form->{transdateto}) {
155       $query .= " AND a.transdate <= ?";
156       push(@values, $form->{transdateto});
157     }
158   }
159
160   my @a = ("transdate", $invnumber, "name");
161   my $sortorder = join ', ', $form->sort_columns(@a);
162
163   if (grep({ $_ eq $form->{sort} }
164            qw(transdate invnumber ordnumber quonumber donumber name))) {
165     $sortorder = $form->{sort};
166   }
167
168   $query .= " ORDER BY $sortorder";
169
170   my $sth = $dbh->prepare($query);
171   $sth->execute(@values) ||
172     $form->dberror($query . " (" . join(", ", @values) . ")");
173
174   $form->{SPOOL} = [];
175   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
176     push @{ $form->{SPOOL} }, $ref;
177   }
178
179   $sth->finish;
180
181   $main::lxdebug->leave_sub();
182 }
183
184 sub delete_spool {
185   $main::lxdebug->enter_sub();
186
187   my ($self, $myconfig, $form) = @_;
188
189   my $spool = $::lx_office_conf{paths}->{spool};
190
191   SL::DB->client->with_transaction(sub {
192     my $dbh = SL::DB->client->dbh;
193
194     my $query;
195
196     if ($form->{type} =~ /(check|receipt)/) {
197       $query = qq|DELETE FROM status WHERE spoolfile = ?|;
198     } else {
199       $query =
200         qq|UPDATE status SET spoolfile = NULL, printed = '1' | .
201         qq|WHERE spoolfile = ?|;
202     }
203     my $sth = $dbh->prepare($query) || $form->dberror($query);
204
205     foreach my $i (1 .. $form->{rowcount}) {
206       if ($form->{"checked_$i"}) {
207         $sth->execute($form->{"spoolfile_$i"}) || $form->dberror($query);
208         $sth->finish;
209       }
210     }
211
212     foreach my $i (1 .. $form->{rowcount}) {
213       if ($form->{"checked_$i"}) {
214         unlink(qq|$spool/$form->{"spoolfile_$i"}|);
215       }
216     }
217     1;
218   }) or do { die SL::DB->client->error };
219
220   $main::lxdebug->leave_sub();
221   return 1;
222 }
223
224 sub print_spool {
225   $main::lxdebug->enter_sub();
226
227   my ($self, $myconfig, $form, $output) = @_;
228
229   my $spool = $::lx_office_conf{paths}->{spool};
230
231   # connect to database
232   my $dbh = SL::DB->client->dbh;
233
234   my $query =
235     qq|UPDATE status SET printed = '1' | .
236     qq|WHERE formname = ? AND spoolfile = ?|;
237   my $sth = $dbh->prepare($query) || $form->dberror($query);
238
239   foreach my $i (1 .. $form->{rowcount}) {
240     if ($form->{"checked_$i"}) {
241       # $output is safe ( = does not come directly from the browser).
242       open(OUT, $output) or $form->error("$output : $!");
243
244       $form->{"spoolfile_$i"} =~ s|.*/||;
245       my $spoolfile = qq|$spool/$form->{"spoolfile_$i"}|;
246
247       # send file to printer
248       open(IN, $spoolfile) or $form->error("$spoolfile : $!");
249
250       while (<IN>) {
251         print OUT $_;
252       }
253       close(IN);
254       close(OUT);
255
256       $sth->execute($form->{type}, $form->{"spoolfile_$i"}) ||
257         $form->dberror($query . " ($form->{type}, " . $form->{"spoolfile_$i"} . ")");
258       $sth->finish;
259
260     }
261   }
262
263   $main::lxdebug->leave_sub();
264 }
265
266 1;