Merge von 740 aus unstable: Bugfix 179
[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., 675 Mass Ave, Cambridge, MA 02139, USA.
29 #======================================================================
30 #
31 # Batch printing module backend routines
32 #
33 #======================================================================
34
35 package BP;
36
37 sub get_vc {
38   $main::lxdebug->enter_sub();
39
40   my ($self, $myconfig, $form) = @_;
41
42   # connect to database
43   my $dbh = $form->dbconnect($myconfig);
44
45   my %arap = (invoice           => 'ar',
46               packing_list      => 'ar',
47               sales_order       => 'oe',
48               purchase_order    => 'oe',
49               sales_quotation   => 'oe',
50               request_quotation => 'oe',
51               check             => 'ap',
52               receipt           => 'ar');
53
54   $query = qq|SELECT count(*)
55               FROM (SELECT DISTINCT ON (vc.id) vc.id
56                     FROM $form->{vc} vc, $arap{$form->{type}} a, status s
57                     WHERE a.$form->{vc}_id = vc.id
58                     AND s.trans_id = a.id
59                     AND s.formname = '$form->{type}'
60                     AND s.spoolfile IS NOT NULL) AS total|;
61
62   my $sth = $dbh->prepare($query);
63   $sth->execute || $form->dberror($query);
64   my ($count) = $sth->fetchrow_array;
65   $sth->finish;
66
67   # build selection list
68   if ($count < $myconfig->{vclimit}) {
69     $query = qq|SELECT DISTINCT ON (vc.id) vc.id, vc.name
70                 FROM $form->{vc} vc, $arap{$form->{type}} a, status s
71                 WHERE a.$form->{vc}_id = vc.id
72                 AND s.trans_id = a.id
73                 AND s.formname = '$form->{type}'
74                 AND s.spoolfile IS NOT NULL|;
75   }
76   $sth = $dbh->prepare($query);
77   $sth->execute || $form->dberror($query);
78
79   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
80     push @{ $form->{"all_$form->{vc}"} }, $ref;
81   }
82
83   $sth->finish;
84   $dbh->disconnect;
85
86   $main::lxdebug->leave_sub();
87 }
88
89 sub payment_accounts {
90   $main::lxdebug->enter_sub();
91
92   my ($self, $myconfig, $form) = @_;
93
94   # connect to database
95   my $dbh = $form->dbconnect($myconfig);
96
97   my $query = qq|SELECT DISTINCT ON (s.chart_id) c.accno, c.description
98                  FROM status s, chart c
99                  WHERE s.chart_id = c.id
100                  AND s.formname = '$form->{type}'|;
101   my $sth = $dbh->prepare($query);
102   $sth->execute || $form->dberror($query);
103
104   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
105     push @{ $form->{accounts} }, $ref;
106   }
107
108   $sth->finish;
109   $dbh->disconnect;
110
111   $main::lxdebug->leave_sub();
112 }
113
114 sub get_spoolfiles {
115   $main::lxdebug->enter_sub();
116
117   my ($self, $myconfig, $form) = @_;
118
119   # connect to database
120   my $dbh = $form->dbconnect($myconfig);
121
122   my ($query, $arap);
123   my $invnumber = "invnumber";
124
125   if ($form->{type} eq 'check' || $form->{type} eq 'receipt') {
126
127     $arap = ($form->{type} eq 'check') ? "ap" : "ar";
128     my ($accno) = split /--/, $form->{account};
129
130     $query = qq|SELECT a.id, s.spoolfile, vc.name, ac.transdate, a.invnumber,
131                 a.invoice, '$arap' AS module
132                 FROM status s, chart c, $form->{vc} vc, $arap a, acc_trans ac
133                 WHERE s.formname = '$form->{type}'
134                 AND s.chart_id = c.id
135                 AND c.accno = '$accno'
136                 AND s.trans_id = a.id
137                 AND a.$form->{vc}_id = vc.id
138                 AND ac.trans_id = s.trans_id
139                 AND ac.chart_id = c.id
140                 AND NOT ac.fx_transaction|;
141   } else {
142
143     $arap = "ar";
144     my $invoice = "a.invoice";
145
146     if ($form->{type} =~ /_(order|quotation)$/) {
147       $invnumber = "ordnumber";
148       $arap      = "oe";
149       $invoice   = '0';
150     }
151
152     $query = qq|SELECT a.id, a.$invnumber AS invnumber, a.ordnumber,
153                 a.quonumber, a.transdate, $invoice AS invoice,
154                 '$arap' AS module, vc.name, s.spoolfile
155                 FROM $arap a, $form->{vc} vc, status s
156                 WHERE s.trans_id = a.id
157                 AND s.spoolfile IS NOT NULL
158                 AND s.formname = '$form->{type}'
159                 AND a.$form->{vc}_id = vc.id|;
160   }
161
162   if ($form->{"$form->{vc}_id"}) {
163     $query .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|;
164   } else {
165     if ($form->{ $form->{vc} }) {
166       my $name = $form->like(lc $form->{ $form->{vc} });
167       $query .= " AND lower(vc.name) LIKE '$name'";
168     }
169   }
170   if ($form->{invnumber}) {
171     my $number = $form->like(lc $form->{invnumber});
172     $query .= " AND lower(a.invnumber) LIKE '$number'";
173   }
174   if ($form->{ordnumber}) {
175     my $ordnumber = $form->like(lc $form->{ordnumber});
176     $query .= " AND lower(a.ordnumber) LIKE '$ordnumber'";
177   }
178   if ($form->{quonumber}) {
179     my $quonumber = $form->like(lc $form->{quonumber});
180     $query .= " AND lower(a.quonumber) LIKE '$quonumber'";
181   }
182
183   #  $query .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom};
184   #  $query .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto};
185
186   my @a = (transdate, $invnumber, name);
187   my $sortorder = join ', ', $form->sort_columns(@a);
188   $sortorder = $form->{sort} if $form->{sort};
189
190   $query .= " ORDER by $sortorder";
191
192   my $sth = $dbh->prepare($query);
193   $sth->execute || $form->dberror($query);
194
195   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
196     push @{ $form->{SPOOL} }, $ref;
197   }
198
199   $sth->finish;
200   $dbh->disconnect;
201
202   $main::lxdebug->leave_sub();
203 }
204
205 sub delete_spool {
206   $main::lxdebug->enter_sub();
207
208   my ($self, $myconfig, $form, $spool) = @_;
209
210   # connect to database, turn AutoCommit off
211   my $dbh = $form->dbconnect_noauto($myconfig);
212
213   my $query;
214
215   if ($form->{type} =~ /(check|receipt)/) {
216     $query = qq|DELETE FROM status
217                 WHERE spoolfile = ?|;
218   } else {
219     $query = qq|UPDATE status SET
220                  spoolfile = NULL,
221                  printed = '1'
222                  WHERE spoolfile = ?|;
223   }
224   my $sth = $dbh->prepare($query) || $form->dberror($query);
225
226   foreach my $i (1 .. $form->{rowcount}) {
227     if ($form->{"checked_$i"}) {
228       $sth->execute($form->{"spoolfile_$i"}) || $form->dberror($query);
229       $sth->finish;
230     }
231   }
232
233   # commit
234   my $rc = $dbh->commit;
235   $dbh->disconnect;
236
237   if ($rc) {
238     foreach my $i (1 .. $form->{rowcount}) {
239       $_ = qq|$spool/$form->{"spoolfile_$i"}|;
240       if ($form->{"checked_$i"}) {
241         unlink;
242       }
243     }
244   }
245
246   $main::lxdebug->leave_sub();
247
248   return $rc;
249 }
250
251 sub print_spool {
252   $main::lxdebug->enter_sub();
253
254   my ($self, $myconfig, $form, $spool) = @_;
255
256   # connect to database
257   my $dbh = $form->dbconnect($myconfig);
258
259   my $query = qq|UPDATE status SET
260                  printed = '1'
261                  WHERE formname = '$form->{type}'
262                  AND spoolfile = ?|;
263   my $sth = $dbh->prepare($query) || $form->dberror($query);
264
265   foreach my $i (1 .. $form->{rowcount}) {
266     if ($form->{"checked_$i"}) {
267       open(OUT, $form->{OUT}) or $form->error("$form->{OUT} : $!");
268
269       $spoolfile = qq|$spool/$form->{"spoolfile_$i"}|;
270
271       # send file to printer
272       open(IN, $spoolfile) or $form->error("$spoolfile : $!");
273
274       while (<IN>) {
275         print OUT $_;
276       }
277       close(IN);
278       close(OUT);
279
280       $sth->execute($form->{"spoolfile_$i"}) || $form->dberror($query);
281       $sth->finish;
282
283     }
284   }
285
286   $dbh->disconnect;
287
288   $main::lxdebug->leave_sub();
289 }
290
291 1;
292