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