Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 4dbb0995

Von Moritz Bunkus vor mehr als 19 Jahren hinzugefügt

  • ID 4dbb09950c9f5596646537c12d991c99086fe7c1
  • Nachfolger ee072e4f

unstable-Zweig als Kopie des "alten" trunks erstellt.

Unterschiede anzeigen:

SL/AM.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) 2001
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
# Administration module
32
#    Chart of Accounts
33
#    template routines
34
#    preferences
35
#
36
#======================================================================
37

  
38
package AM;
39

  
40
sub get_account {
41
  $main::lxdebug->enter_sub();
42

  
43
  my ($self, $myconfig, $form) = @_;
44
  
45
  $form->{id} = "NULL" unless ($form->{id});
46
  # connect to database
47
  my $dbh = $form->dbconnect($myconfig);
48

  
49
  my $query = qq|SELECT c.accno, c.description, c.charttype, c.gifi_accno,
50
                 c.category, c.link, c.taxkey_id, c.pos_ustva, c.pos_bwa, c.pos_bilanz,c.pos_eur
51
                 FROM chart c
52
	         WHERE c.id = $form->{id}|;
53
  
54
  my $sth = $dbh->prepare($query);
55
  $sth->execute || $form->dberror($query);
56

  
57
  my $ref = $sth->fetchrow_hashref(NAME_lc);
58
  
59
  foreach my $key (keys %$ref) {
60
    $form->{"$key"} = $ref->{"$key"};
61
  }
62

  
63
  $sth->finish;
64

  
65

  
66
  # get default accounts
67
  $query = qq|SELECT inventory_accno_id, income_accno_id, expense_accno_id
68
              FROM defaults|;
69
  $sth = $dbh->prepare($query);
70
  $sth->execute || $form->dberror($query);
71

  
72
  $ref = $sth->fetchrow_hashref(NAME_lc);
73

  
74
  map { $form->{$_} = $ref->{$_} } keys %ref;
75

  
76
  $sth->finish;
77

  
78
  # get taxkeys and description
79
  $query = qq|SELECT taxkey, taxdescription 
80
              FROM tax|;
81
  $sth = $dbh->prepare($query);
82
  $sth->execute || $form->dberror($query);
83

  
84
  $ref = $sth->fetchrow_hashref(NAME_lc);
85

  
86
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
87
    push @{ $form->{TAXKEY} }, $ref;
88
  }
89

  
90
  $sth->finish;
91

  
92
  # check if we have any transactions
93
  $query = qq|SELECT a.trans_id FROM acc_trans a
94
              WHERE a.chart_id = $form->{id}|;
95
  $sth = $dbh->prepare($query);
96
  $sth->execute || $form->dberror($query);
97

  
98
  ($form->{orphaned}) = $sth->fetchrow_array;
99
  $form->{orphaned} = !$form->{orphaned};
100
  $sth->finish;
101

  
102
  $dbh->disconnect;
103

  
104
  $main::lxdebug->leave_sub();
105
}
106

  
107

  
108
sub save_account {
109
  $main::lxdebug->enter_sub();
110

  
111
  my ($self, $myconfig, $form) = @_;
112

  
113
  # connect to database, turn off AutoCommit
114
  my $dbh = $form->dbconnect_noauto($myconfig);
115

  
116
  # sanity check, can't have AR with AR_...
117
  if ($form->{AR} || $form->{AP} || $form->{IC}) {
118
    map { delete $form->{$_} } qw(AR_amount AR_tax AR_paid AP_amount AP_tax AP_paid IC_sale IC_cogs IC_taxpart IC_income IC_expense IC_taxservice CT_tax);
119
  }
120
  
121
  $form->{link} = "";
122
  foreach my $item ($form->{AR},
123
		    $form->{AR_amount},
124
                    $form->{AR_tax},
125
                    $form->{AR_paid},
126
                    $form->{AP},
127
		    $form->{AP_amount},
128
		    $form->{AP_tax},
129
		    $form->{AP_paid},
130
		    $form->{IC},
131
		    $form->{IC_sale},
132
		    $form->{IC_cogs},
133
		    $form->{IC_taxpart},
134
		    $form->{IC_income},
135
		    $form->{IC_expense},
136
		    $form->{IC_taxservice},
137
		    $form->{CT_tax}
138
		    ) {
139
     $form->{link} .= "${item}:" if ($item);
140
  }
141
  chop $form->{link};
142

  
143
  # if we have an id then replace the old record
144
  $form->{description} =~ s/\'/\'\'/g;
145

  
146
  # strip blanks from accno
147
  map { $form->{$_} =~ s/ //g; } qw(accno);
148
  
149
  my ($query, $sth);
150
  
151
  if ($form->{id}eq "NULL") {
152
    $form->{id}="";
153
    }
154
  
155
  map({ $form->{$_} = "NULL" unless ($form->{$_}); } qw(pos_ustva pos_bwa pos_bilanz pos_eur));  
156

  
157
  if ($form->{id}) {
158
    $query = qq|UPDATE chart SET
159
                accno = '$form->{accno}',
160
		description = '$form->{description}',
161
		charttype = '$form->{charttype}',
162
		gifi_accno = '$form->{gifi_accno}',
163
		category = '$form->{category}',
164
		link = '$form->{link}',
165
                taxkey_id = $form->{taxkey_id},
166
                pos_ustva = $form->{pos_ustva},
167
                pos_bwa   = $form->{pos_bwa},
168
                pos_bilanz = $form->{pos_bilanz},
169
                pos_eur = $form->{pos_eur}
170
		WHERE id = $form->{id}|;
171
  } else {
172
     
173
    $query = qq|INSERT INTO chart 
174
                (accno, description, charttype, gifi_accno, category, link, taxkey_id, pos_ustva, pos_bwa, pos_bilanz,pos_eur)
175
                VALUES ('$form->{accno}', '$form->{description}',
176
		'$form->{charttype}', '$form->{gifi_accno}',
177
		'$form->{category}', '$form->{link}', $form->{taxkey_id}, $form->{pos_ustva}, $form->{pos_bwa}, $form->{pos_bilanz}, $form->{pos_eur})|;
178
  }
179
  $dbh->do($query) || $form->dberror($query);
180
  
181

  
182
  if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{CT_tax}) {
183

  
184
    my $chart_id = $form->{id};
185
    
186
    unless ($form->{id}) {
187
      # get id from chart
188
      $query = qq|SELECT c.id
189
                  FROM chart c
190
		  WHERE c.accno = '$form->{accno}'|;
191
      $sth = $dbh->prepare($query);
192
      $sth->execute || $form->dberror($query);
193

  
194
      ($chart_id) = $sth->fetchrow_array;
195
      $sth->finish;
196
    }
197
    
198
    # add account if it doesn't exist in tax
199
    $query = qq|SELECT t.chart_id
200
                FROM tax t
201
		WHERE t.chart_id = $chart_id|;
202
    $sth = $dbh->prepare($query);
203
    $sth->execute || $form->dberror($query);
204

  
205
    my ($tax_id) = $sth->fetchrow_array;
206
    $sth->finish;
207
    
208
    # add tax if it doesn't exist
209
    unless ($tax_id) {
210
      $query = qq|INSERT INTO tax (chart_id, rate)
211
                  VALUES ($chart_id, 0)|;
212
      $dbh->do($query) || $form->dberror($query);
213
    }
214
  } else {
215
    # remove tax
216
    if ($form->{id}) {
217
      $query = qq|DELETE FROM tax
218
		  WHERE chart_id = $form->{id}|;
219
      $dbh->do($query) || $form->dberror($query);
220
    }
221
  }
222

  
223

  
224
  # commit
225
  my $rc = $dbh->commit;
226
  $dbh->disconnect;
227

  
228
  $main::lxdebug->leave_sub();
229

  
230
  return $rc;
231
}
232

  
233

  
234

  
235
sub delete_account {
236
  $main::lxdebug->enter_sub();
237

  
238
  my ($self, $myconfig, $form) = @_;
239

  
240
  # connect to database, turn off AutoCommit
241
  my $dbh = $form->dbconnect_noauto($myconfig);
242

  
243
  my $query = qq|SELECT count(*) FROM acc_trans a
244
                 WHERE a.chart_id = $form->{id}|;
245
  my $sth = $dbh->prepare($query);
246
  $sth->execute || $form->dberror($query);
247

  
248
  if ($sth->fetchrow_array) {
249
    $sth->finish;
250
    $dbh->disconnect;
251
    $main::lxdebug->leave_sub();
252
    return;
253
  }
254
  $sth->finish;
255

  
256

  
257
  # delete chart of account record
258
  $query = qq|DELETE FROM chart
259
              WHERE id = $form->{id}|;
260
  $dbh->do($query) || $form->dberror($query);
261

  
262
  # set inventory_accno_id, income_accno_id, expense_accno_id to defaults
263
  $query = qq|UPDATE parts
264
              SET inventory_accno_id = 
265
	                 (SELECT inventory_accno_id FROM defaults)
266
	      WHERE inventory_accno_id = $form->{id}|;
267
  $dbh->do($query) || $form->dberror($query);
268
  
269
  $query = qq|UPDATE parts
270
              SET income_accno_id =
271
	                 (SELECT income_accno_id FROM defaults)
272
	      WHERE income_accno_id = $form->{id}|;
273
  $dbh->do($query) || $form->dberror($query);
274
  
275
  $query = qq|UPDATE parts
276
              SET expense_accno_id =
277
	                 (SELECT expense_accno_id FROM defaults)
278
	      WHERE expense_accno_id = $form->{id}|;
279
  $dbh->do($query) || $form->dberror($query);
280
  
281
  foreach my $table (qw(partstax customertax vendortax tax)) {
282
    $query = qq|DELETE FROM $table
283
		WHERE chart_id = $form->{id}|;
284
    $dbh->do($query) || $form->dberror($query);
285
  }
286

  
287
  # commit and redirect
288
  my $rc = $dbh->commit;
289
  $dbh->disconnect;
290

  
291
  $main::lxdebug->leave_sub();
292

  
293
  return $rc;
294
}
295

  
296

  
297
sub gifi_accounts {
298
  $main::lxdebug->enter_sub();
299

  
300
  my ($self, $myconfig, $form) = @_;
301
  
302
  # connect to database
303
  my $dbh = $form->dbconnect($myconfig);
304

  
305
  my $query = qq|SELECT accno, description
306
                 FROM gifi
307
		 ORDER BY accno|;
308

  
309
  $sth = $dbh->prepare($query);
310
  $sth->execute || $form->dberror($query);
311

  
312
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
313
    push @{ $form->{ALL} }, $ref;
314
  }
315

  
316
  $sth->finish;
317
  $dbh->disconnect;
318
  
319
  $main::lxdebug->leave_sub();
320
}
321

  
322

  
323

  
324
sub get_gifi {
325
  $main::lxdebug->enter_sub();
326

  
327
  my ($self, $myconfig, $form) = @_;
328

  
329
  # connect to database
330
  my $dbh = $form->dbconnect($myconfig);
331
  
332
  my $query = qq|SELECT g.accno, g.description
333
                 FROM gifi g
334
	         WHERE g.accno = '$form->{accno}'|;
335
  my $sth = $dbh->prepare($query);
336
  $sth->execute || $form->dberror($query);
337

  
338
  my $ref = $sth->fetchrow_hashref(NAME_lc);
339
  
340
  map { $form->{$_} = $ref->{$_} } keys %$ref;
341

  
342
  $sth->finish;
343

  
344
  # check for transactions
345
  $query = qq|SELECT count(*) FROM acc_trans a, chart c, gifi g
346
              WHERE c.gifi_accno = g.accno
347
	      AND a.chart_id = c.id
348
	      AND g.accno = '$form->{accno}'|;
349
  $sth = $dbh->prepare($query);
350
  $sth->execute || $form->dberror($query);
351

  
352
  ($form->{orphaned}) = $sth->fetchrow_array;
353
  $sth->finish;
354
  $form->{orphaned} = !$form->{orphaned};
355

  
356
  $dbh->disconnect;
357

  
358
  $main::lxdebug->leave_sub();
359
}
360

  
361

  
362
sub save_gifi {
363
  $main::lxdebug->enter_sub();
364

  
365
  my ($self, $myconfig, $form) = @_;
366
  
367
  # connect to database
368
  my $dbh = $form->dbconnect($myconfig);
369
  
370
  $form->{description} =~ s/\'/\'\'/g;
371

  
372
  # id is the old account number!
373
  if ($form->{id}) {
374
    $query = qq|UPDATE gifi SET
375
                accno = '$form->{accno}',
376
		description = '$form->{description}'
377
		WHERE accno = '$form->{id}'|;
378
  } else {
379
    $query = qq|INSERT INTO gifi 
380
                (accno, description)
381
                VALUES ('$form->{accno}', '$form->{description}')|;
382
  }
383
  $dbh->do($query) || $form->dberror($query);
384
  
385
  $dbh->disconnect;
386

  
387
  $main::lxdebug->leave_sub();
388
}
389

  
390

  
391
sub delete_gifi {
392
  $main::lxdebug->enter_sub();
393

  
394
  my ($self, $myconfig, $form) = @_;
395
  
396
  # connect to database
397
  my $dbh = $form->dbconnect($myconfig);
398
  
399
  # id is the old account number!
400
  $query = qq|DELETE FROM gifi
401
	      WHERE accno = '$form->{id}'|;
402
  $dbh->do($query) || $form->dberror($query);
403
  
404
  $dbh->disconnect;
405

  
406
  $main::lxdebug->leave_sub();
407
}
408

  
409

  
410
sub warehouses {
411
  $main::lxdebug->enter_sub();
412

  
413
  my ($self, $myconfig, $form) = @_;
414
  
415
  # connect to database
416
  my $dbh = $form->dbconnect($myconfig);
417

  
418
  my $query = qq|SELECT id, description
419
                 FROM warehouse
420
		 ORDER BY 2|;
421

  
422
  $sth = $dbh->prepare($query);
423
  $sth->execute || $form->dberror($query);
424

  
425
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
426
    push @{ $form->{ALL} }, $ref;
427
  }
428

  
429
  $sth->finish;
430
  $dbh->disconnect;
431
  
432
  $main::lxdebug->leave_sub();
433
}
434

  
435

  
436

  
437
sub get_warehouse {
438
  $main::lxdebug->enter_sub();
439

  
440
  my ($self, $myconfig, $form) = @_;
441

  
442
  # connect to database
443
  my $dbh = $form->dbconnect($myconfig);
444
  
445
  my $query = qq|SELECT w.description
446
                 FROM warehouse w
447
	         WHERE w.id = $form->{id}|;
448
  my $sth = $dbh->prepare($query);
449
  $sth->execute || $form->dberror($query);
450

  
451
  my $ref = $sth->fetchrow_hashref(NAME_lc);
452
  
453
  map { $form->{$_} = $ref->{$_} } keys %$ref;
454

  
455
  $sth->finish;
456

  
457
  # see if it is in use
458
  $query = qq|SELECT count(*) FROM inventory i
459
              WHERE i.warehouse_id = $form->{id}|;
460
  $sth = $dbh->prepare($query);
461
  $sth->execute || $form->dberror($query);
462

  
463
  ($form->{orphaned}) = $sth->fetchrow_array;
464
  $form->{orphaned} = !$form->{orphaned};
465
  $sth->finish;
466

  
467
  $dbh->disconnect;
468

  
469
  $main::lxdebug->leave_sub();
470
}
471

  
472

  
473
sub save_warehouse {
474
  $main::lxdebug->enter_sub();
475

  
476
  my ($self, $myconfig, $form) = @_;
477
  
478
  # connect to database
479
  my $dbh = $form->dbconnect($myconfig);
480
  
481
  $form->{description} =~ s/\'/\'\'/g;
482

  
483
  if ($form->{id}) {
484
    $query = qq|UPDATE warehouse SET
485
		description = '$form->{description}'
486
		WHERE id = $form->{id}|;
487
  } else {
488
    $query = qq|INSERT INTO warehouse
489
                (description)
490
                VALUES ('$form->{description}')|;
491
  }
492
  $dbh->do($query) || $form->dberror($query);
493
  
494
  $dbh->disconnect;
495

  
496
  $main::lxdebug->leave_sub();
497
}
498

  
499

  
500
sub delete_warehouse {
501
  $main::lxdebug->enter_sub();
502

  
503
  my ($self, $myconfig, $form) = @_;
504
  
505
  # connect to database
506
  my $dbh = $form->dbconnect($myconfig);
507
  
508
  $query = qq|DELETE FROM warehouse
509
	      WHERE id = $form->{id}|;
510
  $dbh->do($query) || $form->dberror($query);
511
  
512
  $dbh->disconnect;
513

  
514
  $main::lxdebug->leave_sub();
515
}
516

  
517

  
518

  
519
sub departments {
520
  $main::lxdebug->enter_sub();
521

  
522
  my ($self, $myconfig, $form) = @_;
523
  
524
  # connect to database
525
  my $dbh = $form->dbconnect($myconfig);
526

  
527
  my $query = qq|SELECT d.id, d.description, d.role
528
                 FROM department d
529
		 ORDER BY 2|;
530

  
531
  $sth = $dbh->prepare($query);
532
  $sth->execute || $form->dberror($query);
533

  
534
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
535
    push @{ $form->{ALL} }, $ref;
536
  }
537

  
538
  $sth->finish;
539
  $dbh->disconnect;
540
  
541
  $main::lxdebug->leave_sub();
542
}
543

  
544

  
545

  
546
sub get_department {
547
  $main::lxdebug->enter_sub();
548

  
549
  my ($self, $myconfig, $form) = @_;
550

  
551
  # connect to database
552
  my $dbh = $form->dbconnect($myconfig);
553
  
554
  my $query = qq|SELECT d.description, d.role
555
                 FROM department d
556
	         WHERE d.id = $form->{id}|;
557
  my $sth = $dbh->prepare($query);
558
  $sth->execute || $form->dberror($query);
559

  
560
  my $ref = $sth->fetchrow_hashref(NAME_lc);
561
  
562
  map { $form->{$_} = $ref->{$_} } keys %$ref;
563

  
564
  $sth->finish;
565

  
566
  # see if it is in use
567
  $query = qq|SELECT count(*) FROM dpt_trans d
568
              WHERE d.department_id = $form->{id}|;
569
  $sth = $dbh->prepare($query);
570
  $sth->execute || $form->dberror($query);
571

  
572
  ($form->{orphaned}) = $sth->fetchrow_array;
573
  $form->{orphaned} = !$form->{orphaned};
574
  $sth->finish;
575

  
576
  $dbh->disconnect;
577

  
578
  $main::lxdebug->leave_sub();
579
}
580

  
581

  
582
sub save_department {
583
  $main::lxdebug->enter_sub();
584

  
585
  my ($self, $myconfig, $form) = @_;
586
  
587
  # connect to database
588
  my $dbh = $form->dbconnect($myconfig);
589
  
590
  $form->{description} =~ s/\'/\'\'/g;
591

  
592
  if ($form->{id}) {
593
    $query = qq|UPDATE department SET
594
		description = '$form->{description}',
595
		role = '$form->{role}'
596
		WHERE id = $form->{id}|;
597
  } else {
598
    $query = qq|INSERT INTO department 
599
                (description, role)
600
                VALUES ('$form->{description}', '$form->{role}')|;
601
  }
602
  $dbh->do($query) || $form->dberror($query);
603
  
604
  $dbh->disconnect;
605

  
606
  $main::lxdebug->leave_sub();
607
}
608

  
609

  
610
sub delete_department {
611
  $main::lxdebug->enter_sub();
612

  
613
  my ($self, $myconfig, $form) = @_;
614
  
615
  # connect to database
616
  my $dbh = $form->dbconnect($myconfig);
617
  
618
  $query = qq|DELETE FROM department
619
	      WHERE id = $form->{id}|;
620
  $dbh->do($query) || $form->dberror($query);
621
  
622
  $dbh->disconnect;
623

  
624
  $main::lxdebug->leave_sub();
625
}
626

  
627

  
628
sub business {
629
  $main::lxdebug->enter_sub();
630

  
631
  my ($self, $myconfig, $form) = @_;
632
  
633
  # connect to database
634
  my $dbh = $form->dbconnect($myconfig);
635

  
636
  my $query = qq|SELECT id, description, discount, customernumberinit, salesman
637
                 FROM business
638
		 ORDER BY 2|;
639

  
640
  $sth = $dbh->prepare($query);
641
  $sth->execute || $form->dberror($query);
642

  
643
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
644
    push @{ $form->{ALL} }, $ref;
645
  }
646

  
647
  $sth->finish;
648
  $dbh->disconnect;
649
  
650
  $main::lxdebug->leave_sub();
651
}
652

  
653

  
654

  
655
sub get_business {
656
  $main::lxdebug->enter_sub();
657

  
658
  my ($self, $myconfig, $form) = @_;
659

  
660
  # connect to database
661
  my $dbh = $form->dbconnect($myconfig);
662
  
663
  my $query = qq|SELECT b.description, b.discount, b.customernumberinit, b.salesman
664
                 FROM business b
665
	         WHERE b.id = $form->{id}|;
666
  my $sth = $dbh->prepare($query);
667
  $sth->execute || $form->dberror($query);
668

  
669
  my $ref = $sth->fetchrow_hashref(NAME_lc);
670
  
671
  map { $form->{$_} = $ref->{$_} } keys %$ref;
672

  
673
  $sth->finish;
674

  
675
  $dbh->disconnect;
676

  
677
  $main::lxdebug->leave_sub();
678
}
679

  
680

  
681
sub save_business {
682
  $main::lxdebug->enter_sub();
683

  
684
  my ($self, $myconfig, $form) = @_;
685
  
686
  # connect to database
687
  my $dbh = $form->dbconnect($myconfig);
688
  
689
  $form->{description} =~ s/\'/\'\'/g;
690
  $form->{discount} /= 100;
691
  $form->{salesman} *= 1;
692
  
693
  # id is the old record
694
  if ($form->{id}) {
695
    $query = qq|UPDATE business SET
696
		description = '$form->{description}',
697
		discount = $form->{discount},
698
                customernumberinit = '$form->{customernumberinit}',
699
                salesman = '$form->{salesman}'
700
		WHERE id = $form->{id}|;
701
  } else {
702
    $query = qq|INSERT INTO business 
703
                (description, discount, customernumberinit, salesman)
704
                VALUES ('$form->{description}', $form->{discount}, '$form->{customernumberinit}', '$form->{salesman}')|;
705
  }
706
  $dbh->do($query) || $form->dberror($query);
707
  
708
  $dbh->disconnect;
709

  
710
  $main::lxdebug->leave_sub();
711
}
712

  
713

  
714
sub delete_business {
715
  $main::lxdebug->enter_sub();
716

  
717
  my ($self, $myconfig, $form) = @_;
718
  
719
  # connect to database
720
  my $dbh = $form->dbconnect($myconfig);
721
  
722
  $query = qq|DELETE FROM business
723
	      WHERE id = $form->{id}|;
724
  $dbh->do($query) || $form->dberror($query);
725
  
726
  $dbh->disconnect;
727

  
728
  $main::lxdebug->leave_sub();
729
}
730

  
731

  
732
sub sic {
733
  $main::lxdebug->enter_sub();
734

  
735
  my ($self, $myconfig, $form) = @_;
736
  
737
  # connect to database
738
  my $dbh = $form->dbconnect($myconfig);
739

  
740
  my $query = qq|SELECT code, sictype, description
741
                 FROM sic
742
		 ORDER BY code|;
743

  
744
  $sth = $dbh->prepare($query);
745
  $sth->execute || $form->dberror($query);
746

  
747
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
748
    push @{ $form->{ALL} }, $ref;
749
  }
750

  
751
  $sth->finish;
752
  $dbh->disconnect;
753
  
754
  $main::lxdebug->leave_sub();
755
}
756

  
757

  
758

  
759
sub get_sic {
760
  $main::lxdebug->enter_sub();
761

  
762
  my ($self, $myconfig, $form) = @_;
763

  
764
  # connect to database
765
  my $dbh = $form->dbconnect($myconfig);
766
  
767
  my $query = qq|SELECT s.code, s.sictype, s.description
768
                 FROM sic s
769
	         WHERE s.code = '$form->{code}'|;
770
  my $sth = $dbh->prepare($query);
771
  $sth->execute || $form->dberror($query);
772

  
773
  my $ref = $sth->fetchrow_hashref(NAME_lc);
774
  
775
  map { $form->{$_} = $ref->{$_} } keys %$ref;
776

  
777
  $sth->finish;
778

  
779
  $dbh->disconnect;
780

  
781
  $main::lxdebug->leave_sub();
782
}
783

  
784

  
785
sub save_sic {
786
  $main::lxdebug->enter_sub();
787

  
788
  my ($self, $myconfig, $form) = @_;
789
  
790
  # connect to database
791
  my $dbh = $form->dbconnect($myconfig);
792
  
793
  $form->{code} =~ s/\'/\'\'/g;
794
  $form->{description} =~ s/\'/\'\'/g;
795
  
796
  # if there is an id
797
  if ($form->{id}) {
798
    $query = qq|UPDATE sic SET
799
                code = '$form->{code}',
800
		sictype = '$form->{sictype}',
801
		description = '$form->{description}'
802
		WHERE code = '$form->{id}'|;
803
  } else {
804
    $query = qq|INSERT INTO sic 
805
                (code, sictype, description)
806
                VALUES ('$form->{code}', '$form->{sictype}', '$form->{description}')|;
807
  }
808
  $dbh->do($query) || $form->dberror($query);
809
  
810
  $dbh->disconnect;
811

  
812
  $main::lxdebug->leave_sub();
813
}
814

  
815

  
816
sub delete_sic {
817
  $main::lxdebug->enter_sub();
818

  
819
  my ($self, $myconfig, $form) = @_;
820
  
821
  # connect to database
822
  my $dbh = $form->dbconnect($myconfig);
823
  
824
  $query = qq|DELETE FROM sic
825
	      WHERE code = '$form->{code}'|;
826
  $dbh->do($query) || $form->dberror($query);
827
  
828
  $dbh->disconnect;
829

  
830
  $main::lxdebug->leave_sub();
831
}
832

  
833

  
834
sub load_template {
835
  $main::lxdebug->enter_sub();
836

  
837
  my ($self, $form) = @_;
838
  
839
  open(TEMPLATE, "$form->{file}") or $form->error("$form->{file} : $!");
840

  
841
  while (<TEMPLATE>) {
842
    $form->{body} .= $_;
843
  }
844

  
845
  close(TEMPLATE);
846

  
847
  $main::lxdebug->leave_sub();
848
}
849

  
850

  
851
sub save_template {
852
  $main::lxdebug->enter_sub();
853

  
854
  my ($self, $form) = @_;
855
  
856
  open(TEMPLATE, ">$form->{file}") or $form->error("$form->{file} : $!");
857
  
858
  # strip 
859
  $form->{body} =~ s/\r\n/\n/g;
860
  print TEMPLATE $form->{body};
861

  
862
  close(TEMPLATE);
863

  
864
  $main::lxdebug->leave_sub();
865
}
866

  
867

  
868

  
869
sub save_preferences {
870
  $main::lxdebug->enter_sub();
871

  
872
  my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_;
873

  
874
  map { ($form->{$_}) = split /--/, $form->{$_} } qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno);
875
  
876
  my @a;
877
  $form->{curr} =~ s/ //g;
878
  map { push(@a, uc pack "A3", $_) if $_ } split /:/, $form->{curr};
879
  $form->{curr} = join ':', @a;
880
    
881
  # connect to database
882
  my $dbh = $form->dbconnect_noauto($myconfig);
883
  
884
  # these defaults are database wide
885
  # user specific variables are in myconfig
886
  # save defaults
887
  my $query = qq|UPDATE defaults SET
888
                 inventory_accno_id = 
889
		     (SELECT c.id FROM chart c
890
		                WHERE c.accno = '$form->{inventory_accno}'),
891
                 income_accno_id =
892
		     (SELECT c.id FROM chart c
893
		                WHERE c.accno = '$form->{income_accno}'),
894
	         expense_accno_id =
895
		     (SELECT c.id FROM chart c
896
		                WHERE c.accno = '$form->{expense_accno}'),
897
	         fxgain_accno_id =
898
		     (SELECT c.id FROM chart c
899
		                WHERE c.accno = '$form->{fxgain_accno}'),
900
	         fxloss_accno_id =
901
		     (SELECT c.id FROM chart c
902
		                WHERE c.accno = '$form->{fxloss_accno}'),
903
	         invnumber = '$form->{invnumber}',
904
	         sonumber = '$form->{sonumber}',
905
	         ponumber = '$form->{ponumber}',
906
		 sqnumber = '$form->{sqnumber}',
907
		 rfqnumber = '$form->{rfqnumber}',
908
                 customernumber = '$form->{customernumber}',
909
		 vendornumber = '$form->{vendornumber}',
910
                 articlenumber = '$form->{articlenumber}',
911
                 servicenumber = '$form->{servicenumber}',
912
                 yearend = '$form->{yearend}',
913
		 curr = '$form->{curr}',
914
		 weightunit = '$form->{weightunit}',
915
		 businessnumber = '$form->{businessnumber}'
916
		|;
917
  $dbh->do($query) || $form->dberror($query);
918

  
919
  # update name
920
  my $name = $form->{name};
921
  $name =~ s/\'/\'\'/g;
922
  $query = qq|UPDATE employee
923
              SET name = '$name'
924
	      WHERE login = '$form->{login}'|;
925
  $dbh->do($query) || $form->dberror($query);
926
  
927
  foreach my $item (split / /, $form->{taxaccounts}) {
928
    $query = qq|UPDATE tax
929
		SET rate = |.($form->{$item} / 100).qq|,
930
		taxnumber = '$form->{"taxnumber_$item"}'
931
		WHERE chart_id = $item|;
932
    $dbh->do($query) || $form->dberror($query);
933
  }
934

  
935
  my $rc = $dbh->commit;
936
  $dbh->disconnect;
937

  
938
  # save first currency in myconfig
939
  $form->{currency} = substr($form->{curr},0,3);
940
  
941
  my $myconfig = new User "$memberfile", "$form->{login}";
942
  
943
  foreach my $item (keys %$form) {
944
    $myconfig->{$item} = $form->{$item};
945
  }
946

  
947
  $myconfig->save_member($memberfile, $userspath);
948
  
949
  if ($webdav) {
950
    @webdavdirs = qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
951
    foreach $directory (@webdavdirs) {
952
	$file = "webdav/".$directory."/webdav-user";
953
    	if ($myconfig->{$directory}) {
954
		open (HTACCESS, "$file") or die "cannot open webdav-user $!\n";
955
		while (<HTACCESS>) {
956
			($login,$password) = split(/:/, $_);
957
			if ($login ne $form->{login}) {
958
				$newfile .= $_;
959
			}
960
		}
961
		close (HTACCESS);
962
		open (HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
963
		$newfile .= $myconfig->{login}.":".$myconfig->{password}."\n";
964
		print (HTACCESS $newfile);
965
		close (HTACCESS);
966
		}
967
		else {
968
		$form->{$directory} = 0;
969
		open (HTACCESS, "$file") or die "cannot open webdav-user $!\n";
970
		while (<HTACCESS>) {
971
			($login,$password) = split(/:/, $_);
972
			if ($login ne $form->{login}) {
973
				$newfile .= $_;
974
			}
975
		}
976
		close (HTACCESS);
977
		open (HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
978
		print (HTACCESS $newfile);
979
		close (HTACCESS);
980
		}
981
      }
982
  }    
983

  
984
  $main::lxdebug->leave_sub();
985

  
986
  return $rc;
987
}
988

  
989

  
990
sub defaultaccounts {
991
  $main::lxdebug->enter_sub();
992

  
993
  my ($self, $myconfig, $form) = @_;
994
  
995
  # connect to database
996
  my $dbh = $form->dbconnect($myconfig);
997
  
998
  # get defaults from defaults table
999
  my $query = qq|SELECT * FROM defaults|;
1000
  my $sth = $dbh->prepare($query);
1001
  $sth->execute || $form->dberror($query);
1002
  
1003
  $form->{defaults} = $sth->fetchrow_hashref(NAME_lc);
1004
  $form->{defaults}{IC} = $form->{defaults}{inventory_accno_id};
1005
  $form->{defaults}{IC_income} = $form->{defaults}{income_accno_id};
1006
  $form->{defaults}{IC_expense} = $form->{defaults}{expense_accno_id};
1007
  $form->{defaults}{FX_gain} = $form->{defaults}{fxgain_accno_id};
1008
  $form->{defaults}{FX_loss} = $form->{defaults}{fxloss_accno_id};
1009
  
1010
  
1011
  $sth->finish;
1012

  
1013

  
1014
  $query = qq|SELECT c.id, c.accno, c.description, c.link
1015
              FROM chart c
1016
              WHERE c.link LIKE '%IC%'
1017
              ORDER BY c.accno|;
1018
  $sth = $dbh->prepare($query);
1019
  $sth->execute || $self->dberror($query);
1020

  
1021
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1022
    foreach my $key (split(/:/, $ref->{link})) {
1023
      if ($key =~ /IC/) {
1024
	$nkey = $key;
1025
	if ($key =~ /cogs/) {
1026
	  $nkey = "IC_expense";
1027
	}
1028
	if ($key =~ /sale/) {
1029
	  $nkey = "IC_income";
1030
	}
1031
        %{ $form->{IC}{$nkey}{$ref->{accno}} } = ( id => $ref->{id},
1032
                                        description => $ref->{description} );
1033
      }
1034
    }
1035
  }
1036
  $sth->finish;
1037

  
1038

  
1039
  $query = qq|SELECT c.id, c.accno, c.description
1040
              FROM chart c
1041
	      WHERE c.category = 'I'
1042
	      AND c.charttype = 'A'
1043
              ORDER BY c.accno|;
1044
  $sth = $dbh->prepare($query);
1045
  $sth->execute || $self->dberror($query);
1046

  
1047
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1048
    %{ $form->{IC}{FX_gain}{$ref->{accno}} } = ( id => $ref->{id},
1049
                                      description => $ref->{description} );
1050
  }
1051
  $sth->finish;
1052

  
1053
  $query = qq|SELECT c.id, c.accno, c.description
1054
              FROM chart c
1055
	      WHERE c.category = 'E'
1056
	      AND c.charttype = 'A'
1057
              ORDER BY c.accno|;
1058
  $sth = $dbh->prepare($query);
1059
  $sth->execute || $self->dberror($query);
1060

  
1061
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1062
    %{ $form->{IC}{FX_loss}{$ref->{accno}} } = ( id => $ref->{id},
1063
                                      description => $ref->{description} );
1064
  }
1065
  $sth->finish;
1066

  
1067

  
1068
  # now get the tax rates and numbers
1069
  $query = qq|SELECT c.id, c.accno, c.description,
1070
              t.rate * 100 AS rate, t.taxnumber
1071
              FROM chart c, tax t
1072
	      WHERE c.id = t.chart_id|;
1073

  
1074
  $sth = $dbh->prepare($query);
1075
  $sth->execute || $form->dberror($query);
1076

  
1077
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1078
    $form->{taxrates}{$ref->{accno}}{id} = $ref->{id};
1079
    $form->{taxrates}{$ref->{accno}}{description} = $ref->{description};
1080
    $form->{taxrates}{$ref->{accno}}{taxnumber} = $ref->{taxnumber} if $ref->{taxnumber};
1081
    $form->{taxrates}{$ref->{accno}}{rate} = $ref->{rate} if $ref->{rate};
1082
  }
1083

  
1084
  $sth->finish;
1085
  $dbh->disconnect;
1086
  
1087
  $main::lxdebug->leave_sub();
1088
}
1089

  
1090

  
1091
sub backup {
1092
  $main::lxdebug->enter_sub();
1093

  
1094
  my ($self, $myconfig, $form, $userspath) = @_;
1095
  
1096
  my $mail;
1097
  my $err;
1098
  my $boundary = time;
1099
  my $tmpfile = "$userspath/$boundary.$myconfig->{dbname}-$form->{dbversion}.sql";
1100
  my $out = $form->{OUT};
1101
  $form->{OUT} = ">$tmpfile";
1102
  
1103
  if ($form->{media} eq 'email') {
1104
   
1105
    use SL::Mailer;
1106
    $mail = new Mailer;
1107

  
1108
    $mail->{to} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1109
    $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1110
    $mail->{subject} = "Lx-Office Backup / $myconfig->{dbname}-$form->{dbversion}.sql";
1111
    @{ $mail->{attachments} } = ($tmpfile);
1112
    $mail->{version} = $form->{version};
1113
    $mail->{fileid} = "$boundary.";
1114

  
1115
    $myconfig->{signature} =~ s/\\n/\r\n/g;
1116
    $mail->{message} = "--\n$myconfig->{signature}";
1117
    
1118
  }
1119

  
1120

  
1121
  open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!");
1122

  
1123
  # get sequences, functions and triggers
1124
  open(FH, "sql/lx-office.sql") or $form->error("sql/lx-office.sql : $!");
1125

  
1126
  my @sequences = ();
1127
  my @functions = ();
1128
  my @triggers = ();
1129
  my @indices = ();
1130
  my %tablespecs;
1131
 
1132
  my $query = "";
1133
  my @quote_chars;
1134

  
1135
  while (<FH>) {
1136
    # Remove DOS and Unix style line endings.
1137
    s/[\r\n]//g;
1138

  
1139
    # ignore comments or empty lines
1140
    next if /^(--.*|\s+)$/;
1141

  
1142
    for (my $i = 0; $i < length($_); $i++) {
1143
      my $char = substr($_, $i, 1);
1144

  
1145
      # Are we inside a string?
1146
      if (@quote_chars) {
1147
        if ($char eq $quote_chars[-1]) {
1148
          pop(@quote_chars);
1149
        }
1150
        $query .= $char;
1151

  
1152
      } else {
1153
        if (($char eq "'") || ($char eq "\"")) {
1154
          push(@quote_chars, $char);
1155

  
1156
        } elsif ($char eq ";") {
1157
          # Query is complete. Check for triggers and functions.
1158
          if ($query =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1159
            push(@functions, $query);
1160

  
1161
          } elsif ($query =~ /^create\s+trigger\s+\"?(\w+)\"?/i) {
1162
            push(@triggers, $query);
1163

  
1164
          } elsif ($query =~ /^create\s+sequence\s+\"?(\w+)\"?/i) {
1165
            push(@sequences, $1);
1166

  
1167
          } elsif ($query =~ /^create\s+table\s+\"?(\w+)\"?/i) {
1168
            $tablespecs{$1} = $query;
1169

  
1170
          } elsif ($query =~ /^create\s+index\s+\"?(\w+)\"?/i) {
1171
            push(@indices, $query);
1172

  
1173
          }
1174

  
1175
          $query = "";
1176
          $char = "";
1177
        }
1178

  
1179
        $query .= $char;
1180
      }
1181
    }
1182
  }
1183
  close(FH);
1184

  
1185

  
1186
  # connect to database
1187
  my $dbh = $form->dbconnect($myconfig);
1188

  
1189
  # get all the tables
1190
  my @tables = $dbh->tables( '', '', 'customer', '', {noprefix => 0});
1191

  
1192
  my $today = scalar localtime;
1193

  
1194
  $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost};
1195
  
1196
  print OUT qq|-- Lx-Office Backup
1197
-- Dataset: $myconfig->{dbname}
1198
-- Version: $form->{dbversion}
1199
-- Host: $myconfig->{dbhost}
1200
-- Login: $form->{login}
1201
-- User: $myconfig->{name}
1202
-- Date: $today
1203
--
1204
-- set options
1205
$myconfig->{dboptions};
1206
--
1207
|;
1208

  
1209
  print OUT "-- DROP Sequences\n";
1210
  my $item;
1211
  foreach $item (@sequences) {
1212
    print OUT qq|DROP SEQUENCE $item;\n|;
1213
  }
1214

  
1215
  print OUT "-- DROP Triggers\n";
1216
  
1217
  foreach $item (@triggers) {
1218
  	if ($item =~ /^create\s+trigger\s+\"?(\w+)\"?\s+.*on\s+\"?(\w+)\"?\s+/i) {
1219
      print OUT qq|DROP TRIGGER "$1" ON "$2";\n|;
1220
    }
1221
  }
1222
  
1223
  print OUT "-- DROP Functions\n";
1224
  
1225
  foreach $item (@functions) {
1226
    if ($item =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1227
      print OUT qq|DROP FUNCTION "$1" ();\n|;
1228
    }
1229
  }
1230
  
1231
  foreach $table (@tables) {
1232
    if (!($table =~ /^sql_.*/)) {
1233
      my $query = qq|SELECT * FROM $table|;
1234

  
1235
      my $sth = $dbh->prepare($query);
1236
      $sth->execute || $form->dberror($query);
1237

  
1238
      $query = "INSERT INTO $table (";
1239
      map { $query .= qq|$sth->{NAME}->[$_],| } (0 .. $sth->{NUM_OF_FIELDS} - 1);
1240
      chop $query;
1241

  
1242
      $query .= ") VALUES";
1243

  
1244
      if ($tablespecs{$table}) {
1245
        print(OUT "--\n");
1246
        print(OUT "DROP TABLE $table;\n");
1247
        print(OUT $tablespecs{$table}, ";\n");
1248
      } else {
1249
        print(OUT "--\n");
1250
        print(OUT "DELETE FROM $table;\n");
1251
      }
1252
      while (my @arr = $sth->fetchrow_array) {
1253

  
1254
        $fields = "(";
1255
        foreach my $item (@arr) {
1256
          if (defined $item) {
1257
            $item =~ s/\'/\'\'/g;
1258
            $fields .= qq|'$item',|;
1259
          } else {
1260
            $fields .= 'NULL,';
1261
          }
1262
        }
1263

  
1264
        chop $fields;
1265
        $fields .= ")";
1266

  
1267
        print OUT qq|$query $fields;\n|;
1268
      }
1269

  
1270
      $sth->finish;
1271
    }
1272
  }
1273

  
1274

  
1275
  # create indices, sequences, functions and triggers
1276

  
1277
  print(OUT "-- CREATE Indices\n");
1278
  map({ print(OUT "$_;\n"); } @indices);
1279

  
1280
  print OUT "-- CREATE Sequences\n";
1281
  foreach $item (@sequences) {
1282
    $query = qq|SELECT last_value FROM $item|;
1283
    $sth = $dbh->prepare($query);
1284
    $sth->execute || $form->dberror($query);
1285
    my ($id) = $sth->fetchrow_array;
1286
    $sth->finish;
1287
  
1288
    print OUT qq|--
1289
CREATE SEQUENCE $item START $id;
1290
|;
1291
  }
1292

  
1293
  print OUT "-- CREATE Functions\n";
1294

  
1295
  # functions
1296
  map { print(OUT $_, ";\n"); } @functions;
1297

  
1298
  print OUT "-- CREATE Triggers\n";
1299
  
1300
  # triggers
1301
  map { print(OUT $_, ";\n"); } @triggers;
1302

  
1303

  
1304
  close(OUT);
1305
  
1306
  $dbh->disconnect;
1307

  
1308
  # compress backup
1309
  my @args = ("gzip", "$tmpfile");
1310
  system(@args) == 0 or $form->error("$args[0] : $?");
1311
  
1312
  $tmpfile .= ".gz";
1313

  
1314
  if ($form->{media} eq 'email') {
1315
    @{ $mail->{attachments} } = ($tmpfile);
1316
    $err = $mail->send($out);
1317
  }
1318
  
1319
  
1320
  if ($form->{media} eq 'file') {
1321
    
1322
    open(IN, "$tmpfile") or $form->error("$tmpfile : $!");
1323
    open(OUT, ">-") or $form->error("STDOUT : $!");
1324
   
1325
    print OUT qq|Content-Type: application/x-tar-gzip;
1326
Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}.sql.gz"
1327

  
1328
|;
1329

  
1330
    while (<IN>) {
1331
      print OUT $_;
1332
    }
1333

  
1334
    close(IN);
1335
    close(OUT);
1336
    
1337
  }
1338

  
1339
  unlink "$tmpfile";
1340
   
1341
  $main::lxdebug->leave_sub();
1342
}
1343

  
1344

  
1345
sub closedto {
1346
  $main::lxdebug->enter_sub();
1347

  
1348
  my ($self, $myconfig, $form) = @_;
1349

  
1350
  my $dbh = $form->dbconnect($myconfig);
1351

  
1352
  my $query = qq|SELECT closedto, revtrans FROM defaults|;
1353
  my $sth = $dbh->prepare($query);
1354
  $sth->execute || $form->dberror($query);
1355

  
1356
  ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
1357
  
1358
  $sth->finish;
1359
  
1360
  $dbh->disconnect;
1361

  
1362
  $main::lxdebug->leave_sub();
1363
}
1364

  
1365
 
1366
sub closebooks {
1367
  $main::lxdebug->enter_sub();
1368

  
1369
  my ($self, $myconfig, $form) = @_;
1370

  
1371
  my $dbh = $form->dbconnect($myconfig);
1372

  
1373
  if ($form->{revtrans}) {
1374
   
1375
    $query = qq|UPDATE defaults SET closedto = NULL,
1376
				    revtrans = '1'|;
1377
  } else {
1378
    if ($form->{closedto}) {
1379
    
1380
      $query = qq|UPDATE defaults SET closedto = '$form->{closedto}',
1381
				      revtrans = '0'|;
1382
    } else {
1383
      
1384
      $query = qq|UPDATE defaults SET closedto = NULL,
1385
				      revtrans = '0'|;
1386
    }
1387
  }
1388

  
1389
  # set close in defaults
1390
  $dbh->do($query) || $form->dberror($query);
1391
  
1392
  $dbh->disconnect;
1393
  
1394
  $main::lxdebug->leave_sub();
1395
}
1396

  
1397

  
1398
1;
1399

  
SL/AP.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) 2001
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
# Accounts Payables database backend routines
32
#
33
#======================================================================
34

  
35

  
36
package AP;
37

  
38
sub post_transaction {
39
  $main::lxdebug->enter_sub();
40

  
41
  my ($self, $myconfig, $form) = @_;
42

  
43
  # connect to database
44
  my $dbh = $form->dbconnect_noauto($myconfig);
45
  
46
  my ($null, $taxrate, $amount);
47
  my $exchangerate = 0;
48
  
49
  ($null, $form->{department_id}) = split(/--/, $form->{department});
50
  $form->{department_id} *= 1;
51

  
52
  if ($form->{currency} eq $form->{defaultcurrency}) {
53
    $form->{exchangerate} = 1;
54
  } else {
55
    $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, 'sell');
56

  
57
    $form->{exchangerate} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{exchangerate});
58
  }
59

  
60
  # reverse and parse amounts
61
  for my $i (1 .. 1) {
62
    $form->{"amount_$i"} = $form->round_amount($form->parse_amount($myconfig, $form->{"amount_$i"}) * $form->{exchangerate} * -1, 2);
63
    $amount += ($form->{"amount_$i"} * -1);
64
  }
65

  
66
  # this is for ap
67
  $form->{amount} = $amount;
68

  
69
  # taxincluded doesn't make sense if there is no amount
70
  $form->{taxincluded} = 0 if ($form->{amount} == 0);
71
  
72
  $query = qq| SELECT c.accno, t.rate FROM chart c, tax t where c.id=t.chart_id AND t.taxkey=$form->{taxkey}|;
73
  $sth = $dbh->prepare($query);
74
  $sth->execute || $form->dberror($query);  
75
  ($form->{AP}{"tax"}, $form->{taxrate}) =  $sth->fetchrow_array;
76
  $sth->finish;
77
  
78
  $formtax = $form->parse_amount($myconfig, $form->{"tax"});
79
  
80
  $form->{"tax"} = $form->{amount} * $form->{taxrate};
81
  $form->{"tax"} = $form->round_amount($form->{"tax"} * $form->{exchangerate}, 2) * -1;
82
  
83
  if ($form->{taxcheck}) {
84
    $form->{"tax"} = $formtax * -1;
... Dieser Diff wurde abgeschnitten, weil er die maximale Anzahl anzuzeigender Zeilen überschreitet.

Auch abrufbar als: Unified diff