Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision d319704a

Von Moritz Bunkus vor etwa 19 Jahren hinzugefügt

  • ID d319704a66e9be64da837ccea10af6774c2b0838
  • Nachfolger 0576299f

Alle Dateien durch Perltidy laufen lassen. Die verwendeten Optionen sind am Ende der neu hinzugefuegten Datei doc/programmierstilrichtlinien.txt zu finden.

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

  
47
  # connect to database
48
  my $dbh = $form->dbconnect($myconfig);
49

  
50
  my $query = qq|SELECT c.accno, c.description, c.charttype, c.gifi_accno,
51
                 c.category, c.link, c.taxkey_id, c.pos_ustva, c.pos_bwa, c.pos_bilanz,c.pos_eur
52
                 FROM chart c
53
	         WHERE c.id = $form->{id}|;
54

  
55
  my $sth = $dbh->prepare($query);
56
  $sth->execute || $form->dberror($query);
57

  
58
  my $ref = $sth->fetchrow_hashref(NAME_lc);
59

  
60
  foreach my $key (keys %$ref) {
61
    $form->{"$key"} = $ref->{"$key"};
62
  }
63

  
64
  $sth->finish;
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
sub save_account {
108
  $main::lxdebug->enter_sub();
109

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

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

  
115
  # sanity check, can't have AR with AR_...
116
  if ($form->{AR} || $form->{AP} || $form->{IC}) {
117
    map { delete $form->{$_} }
118
      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},            $form->{AR_amount},
123
                    $form->{AR_tax},        $form->{AR_paid},
124
                    $form->{AP},            $form->{AP_amount},
125
                    $form->{AP_tax},        $form->{AP_paid},
126
                    $form->{IC},            $form->{IC_sale},
127
                    $form->{IC_cogs},       $form->{IC_taxpart},
128
                    $form->{IC_income},     $form->{IC_expense},
129
                    $form->{IC_taxservice}, $form->{CT_tax}
130
    ) {
131
    $form->{link} .= "${item}:" if ($item);
132
  }
133
  chop $form->{link};
134

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

  
138
  # strip blanks from accno
139
  map { $form->{$_} =~ s/ //g; } qw(accno);
140

  
141
  my ($query, $sth);
142

  
143
  if ($form->{id} eq "NULL") {
144
    $form->{id} = "";
145
  }
146

  
147
  map({ $form->{$_} = "NULL" unless ($form->{$_}); }
148
      qw(pos_ustva pos_bwa pos_bilanz pos_eur));
149

  
150
  if ($form->{id}) {
151
    $query = qq|UPDATE chart SET
152
                accno = '$form->{accno}',
153
		description = '$form->{description}',
154
		charttype = '$form->{charttype}',
155
		gifi_accno = '$form->{gifi_accno}',
156
		category = '$form->{category}',
157
		link = '$form->{link}',
158
                taxkey_id = $form->{taxkey_id},
159
                pos_ustva = $form->{pos_ustva},
160
                pos_bwa   = $form->{pos_bwa},
161
                pos_bilanz = $form->{pos_bilanz},
162
                pos_eur = $form->{pos_eur}
163
		WHERE id = $form->{id}|;
164
  } else {
165

  
166
    $query = qq|INSERT INTO chart 
167
                (accno, description, charttype, gifi_accno, category, link, taxkey_id, pos_ustva, pos_bwa, pos_bilanz,pos_eur)
168
                VALUES ('$form->{accno}', '$form->{description}',
169
		'$form->{charttype}', '$form->{gifi_accno}',
170
		'$form->{category}', '$form->{link}', $form->{taxkey_id}, $form->{pos_ustva}, $form->{pos_bwa}, $form->{pos_bilanz}, $form->{pos_eur})|;
171
  }
172
  $dbh->do($query) || $form->dberror($query);
173

  
174
  if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{CT_tax}) {
175

  
176
    my $chart_id = $form->{id};
177

  
178
    unless ($form->{id}) {
179

  
180
      # get id from chart
181
      $query = qq|SELECT c.id
182
                  FROM chart c
183
		  WHERE c.accno = '$form->{accno}'|;
184
      $sth = $dbh->prepare($query);
185
      $sth->execute || $form->dberror($query);
186

  
187
      ($chart_id) = $sth->fetchrow_array;
188
      $sth->finish;
189
    }
190

  
191
    # add account if it doesn't exist in tax
192
    $query = qq|SELECT t.chart_id
193
                FROM tax t
194
		WHERE t.chart_id = $chart_id|;
195
    $sth = $dbh->prepare($query);
196
    $sth->execute || $form->dberror($query);
197

  
198
    my ($tax_id) = $sth->fetchrow_array;
199
    $sth->finish;
200

  
201
    # add tax if it doesn't exist
202
    unless ($tax_id) {
203
      $query = qq|INSERT INTO tax (chart_id, rate)
204
                  VALUES ($chart_id, 0)|;
205
      $dbh->do($query) || $form->dberror($query);
206
    }
207
  } else {
208

  
209
    # remove tax
210
    if ($form->{id}) {
211
      $query = qq|DELETE FROM tax
212
		  WHERE chart_id = $form->{id}|;
213
      $dbh->do($query) || $form->dberror($query);
214
    }
215
  }
216

  
217
  # commit
218
  my $rc = $dbh->commit;
219
  $dbh->disconnect;
220

  
221
  $main::lxdebug->leave_sub();
222

  
223
  return $rc;
224
}
225

  
226
sub delete_account {
227
  $main::lxdebug->enter_sub();
228

  
229
  my ($self, $myconfig, $form) = @_;
230

  
231
  # connect to database, turn off AutoCommit
232
  my $dbh = $form->dbconnect_noauto($myconfig);
233

  
234
  my $query = qq|SELECT count(*) FROM acc_trans a
235
                 WHERE a.chart_id = $form->{id}|;
236
  my $sth = $dbh->prepare($query);
237
  $sth->execute || $form->dberror($query);
238

  
239
  if ($sth->fetchrow_array) {
240
    $sth->finish;
241
    $dbh->disconnect;
242
    $main::lxdebug->leave_sub();
243
    return;
244
  }
245
  $sth->finish;
246

  
247
  # delete chart of account record
248
  $query = qq|DELETE FROM chart
249
              WHERE id = $form->{id}|;
250
  $dbh->do($query) || $form->dberror($query);
251

  
252
  # set inventory_accno_id, income_accno_id, expense_accno_id to defaults
253
  $query = qq|UPDATE parts
254
              SET inventory_accno_id = 
255
	                 (SELECT inventory_accno_id FROM defaults)
256
	      WHERE inventory_accno_id = $form->{id}|;
257
  $dbh->do($query) || $form->dberror($query);
258

  
259
  $query = qq|UPDATE parts
260
              SET income_accno_id =
261
	                 (SELECT income_accno_id FROM defaults)
262
	      WHERE income_accno_id = $form->{id}|;
263
  $dbh->do($query) || $form->dberror($query);
264

  
265
  $query = qq|UPDATE parts
266
              SET expense_accno_id =
267
	                 (SELECT expense_accno_id FROM defaults)
268
	      WHERE expense_accno_id = $form->{id}|;
269
  $dbh->do($query) || $form->dberror($query);
270

  
271
  foreach my $table (qw(partstax customertax vendortax tax)) {
272
    $query = qq|DELETE FROM $table
273
		WHERE chart_id = $form->{id}|;
274
    $dbh->do($query) || $form->dberror($query);
275
  }
276

  
277
  # commit and redirect
278
  my $rc = $dbh->commit;
279
  $dbh->disconnect;
280

  
281
  $main::lxdebug->leave_sub();
282

  
283
  return $rc;
284
}
285

  
286
sub gifi_accounts {
287
  $main::lxdebug->enter_sub();
288

  
289
  my ($self, $myconfig, $form) = @_;
290

  
291
  # connect to database
292
  my $dbh = $form->dbconnect($myconfig);
293

  
294
  my $query = qq|SELECT accno, description
295
                 FROM gifi
296
		 ORDER BY accno|;
297

  
298
  $sth = $dbh->prepare($query);
299
  $sth->execute || $form->dberror($query);
300

  
301
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
302
    push @{ $form->{ALL} }, $ref;
303
  }
304

  
305
  $sth->finish;
306
  $dbh->disconnect;
307

  
308
  $main::lxdebug->leave_sub();
309
}
310

  
311
sub get_gifi {
312
  $main::lxdebug->enter_sub();
313

  
314
  my ($self, $myconfig, $form) = @_;
315

  
316
  # connect to database
317
  my $dbh = $form->dbconnect($myconfig);
318

  
319
  my $query = qq|SELECT g.accno, g.description
320
                 FROM gifi g
321
	         WHERE g.accno = '$form->{accno}'|;
322
  my $sth = $dbh->prepare($query);
323
  $sth->execute || $form->dberror($query);
324

  
325
  my $ref = $sth->fetchrow_hashref(NAME_lc);
326

  
327
  map { $form->{$_} = $ref->{$_} } keys %$ref;
328

  
329
  $sth->finish;
330

  
331
  # check for transactions
332
  $query = qq|SELECT count(*) FROM acc_trans a, chart c, gifi g
333
              WHERE c.gifi_accno = g.accno
334
	      AND a.chart_id = c.id
335
	      AND g.accno = '$form->{accno}'|;
336
  $sth = $dbh->prepare($query);
337
  $sth->execute || $form->dberror($query);
338

  
339
  ($form->{orphaned}) = $sth->fetchrow_array;
340
  $sth->finish;
341
  $form->{orphaned} = !$form->{orphaned};
342

  
343
  $dbh->disconnect;
344

  
345
  $main::lxdebug->leave_sub();
346
}
347

  
348
sub save_gifi {
349
  $main::lxdebug->enter_sub();
350

  
351
  my ($self, $myconfig, $form) = @_;
352

  
353
  # connect to database
354
  my $dbh = $form->dbconnect($myconfig);
355

  
356
  $form->{description} =~ s/\'/\'\'/g;
357

  
358
  # id is the old account number!
359
  if ($form->{id}) {
360
    $query = qq|UPDATE gifi SET
361
                accno = '$form->{accno}',
362
		description = '$form->{description}'
363
		WHERE accno = '$form->{id}'|;
364
  } else {
365
    $query = qq|INSERT INTO gifi 
366
                (accno, description)
367
                VALUES ('$form->{accno}', '$form->{description}')|;
368
  }
369
  $dbh->do($query) || $form->dberror($query);
370

  
371
  $dbh->disconnect;
372

  
373
  $main::lxdebug->leave_sub();
374
}
375

  
376
sub delete_gifi {
377
  $main::lxdebug->enter_sub();
378

  
379
  my ($self, $myconfig, $form) = @_;
380

  
381
  # connect to database
382
  my $dbh = $form->dbconnect($myconfig);
383

  
384
  # id is the old account number!
385
  $query = qq|DELETE FROM gifi
386
	      WHERE accno = '$form->{id}'|;
387
  $dbh->do($query) || $form->dberror($query);
388

  
389
  $dbh->disconnect;
390

  
391
  $main::lxdebug->leave_sub();
392
}
393

  
394
sub warehouses {
395
  $main::lxdebug->enter_sub();
396

  
397
  my ($self, $myconfig, $form) = @_;
398

  
399
  # connect to database
400
  my $dbh = $form->dbconnect($myconfig);
401

  
402
  my $query = qq|SELECT id, description
403
                 FROM warehouse
404
		 ORDER BY 2|;
405

  
406
  $sth = $dbh->prepare($query);
407
  $sth->execute || $form->dberror($query);
408

  
409
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
410
    push @{ $form->{ALL} }, $ref;
411
  }
412

  
413
  $sth->finish;
414
  $dbh->disconnect;
415

  
416
  $main::lxdebug->leave_sub();
417
}
418

  
419
sub get_warehouse {
420
  $main::lxdebug->enter_sub();
421

  
422
  my ($self, $myconfig, $form) = @_;
423

  
424
  # connect to database
425
  my $dbh = $form->dbconnect($myconfig);
426

  
427
  my $query = qq|SELECT w.description
428
                 FROM warehouse w
429
	         WHERE w.id = $form->{id}|;
430
  my $sth = $dbh->prepare($query);
431
  $sth->execute || $form->dberror($query);
432

  
433
  my $ref = $sth->fetchrow_hashref(NAME_lc);
434

  
435
  map { $form->{$_} = $ref->{$_} } keys %$ref;
436

  
437
  $sth->finish;
438

  
439
  # see if it is in use
440
  $query = qq|SELECT count(*) FROM inventory i
441
              WHERE i.warehouse_id = $form->{id}|;
442
  $sth = $dbh->prepare($query);
443
  $sth->execute || $form->dberror($query);
444

  
445
  ($form->{orphaned}) = $sth->fetchrow_array;
446
  $form->{orphaned} = !$form->{orphaned};
447
  $sth->finish;
448

  
449
  $dbh->disconnect;
450

  
451
  $main::lxdebug->leave_sub();
452
}
453

  
454
sub save_warehouse {
455
  $main::lxdebug->enter_sub();
456

  
457
  my ($self, $myconfig, $form) = @_;
458

  
459
  # connect to database
460
  my $dbh = $form->dbconnect($myconfig);
461

  
462
  $form->{description} =~ s/\'/\'\'/g;
463

  
464
  if ($form->{id}) {
465
    $query = qq|UPDATE warehouse SET
466
		description = '$form->{description}'
467
		WHERE id = $form->{id}|;
468
  } else {
469
    $query = qq|INSERT INTO warehouse
470
                (description)
471
                VALUES ('$form->{description}')|;
472
  }
473
  $dbh->do($query) || $form->dberror($query);
474

  
475
  $dbh->disconnect;
476

  
477
  $main::lxdebug->leave_sub();
478
}
479

  
480
sub delete_warehouse {
481
  $main::lxdebug->enter_sub();
482

  
483
  my ($self, $myconfig, $form) = @_;
484

  
485
  # connect to database
486
  my $dbh = $form->dbconnect($myconfig);
487

  
488
  $query = qq|DELETE FROM warehouse
489
	      WHERE id = $form->{id}|;
490
  $dbh->do($query) || $form->dberror($query);
491

  
492
  $dbh->disconnect;
493

  
494
  $main::lxdebug->leave_sub();
495
}
496

  
497
sub departments {
498
  $main::lxdebug->enter_sub();
499

  
500
  my ($self, $myconfig, $form) = @_;
501

  
502
  # connect to database
503
  my $dbh = $form->dbconnect($myconfig);
504

  
505
  my $query = qq|SELECT d.id, d.description, d.role
506
                 FROM department d
507
		 ORDER BY 2|;
508

  
509
  $sth = $dbh->prepare($query);
510
  $sth->execute || $form->dberror($query);
511

  
512
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
513
    push @{ $form->{ALL} }, $ref;
514
  }
515

  
516
  $sth->finish;
517
  $dbh->disconnect;
518

  
519
  $main::lxdebug->leave_sub();
520
}
521

  
522
sub get_department {
523
  $main::lxdebug->enter_sub();
524

  
525
  my ($self, $myconfig, $form) = @_;
526

  
527
  # connect to database
528
  my $dbh = $form->dbconnect($myconfig);
529

  
530
  my $query = qq|SELECT d.description, d.role
531
                 FROM department d
532
	         WHERE d.id = $form->{id}|;
533
  my $sth = $dbh->prepare($query);
534
  $sth->execute || $form->dberror($query);
535

  
536
  my $ref = $sth->fetchrow_hashref(NAME_lc);
537

  
538
  map { $form->{$_} = $ref->{$_} } keys %$ref;
539

  
540
  $sth->finish;
541

  
542
  # see if it is in use
543
  $query = qq|SELECT count(*) FROM dpt_trans d
544
              WHERE d.department_id = $form->{id}|;
545
  $sth = $dbh->prepare($query);
546
  $sth->execute || $form->dberror($query);
547

  
548
  ($form->{orphaned}) = $sth->fetchrow_array;
549
  $form->{orphaned} = !$form->{orphaned};
550
  $sth->finish;
551

  
552
  $dbh->disconnect;
553

  
554
  $main::lxdebug->leave_sub();
555
}
556

  
557
sub save_department {
558
  $main::lxdebug->enter_sub();
559

  
560
  my ($self, $myconfig, $form) = @_;
561

  
562
  # connect to database
563
  my $dbh = $form->dbconnect($myconfig);
564

  
565
  $form->{description} =~ s/\'/\'\'/g;
566

  
567
  if ($form->{id}) {
568
    $query = qq|UPDATE department SET
569
		description = '$form->{description}',
570
		role = '$form->{role}'
571
		WHERE id = $form->{id}|;
572
  } else {
573
    $query = qq|INSERT INTO department 
574
                (description, role)
575
                VALUES ('$form->{description}', '$form->{role}')|;
576
  }
577
  $dbh->do($query) || $form->dberror($query);
578

  
579
  $dbh->disconnect;
580

  
581
  $main::lxdebug->leave_sub();
582
}
583

  
584
sub delete_department {
585
  $main::lxdebug->enter_sub();
586

  
587
  my ($self, $myconfig, $form) = @_;
588

  
589
  # connect to database
590
  my $dbh = $form->dbconnect($myconfig);
591

  
592
  $query = qq|DELETE FROM department
593
	      WHERE id = $form->{id}|;
594
  $dbh->do($query) || $form->dberror($query);
595

  
596
  $dbh->disconnect;
597

  
598
  $main::lxdebug->leave_sub();
599
}
600

  
601
sub business {
602
  $main::lxdebug->enter_sub();
603

  
604
  my ($self, $myconfig, $form) = @_;
605

  
606
  # connect to database
607
  my $dbh = $form->dbconnect($myconfig);
608

  
609
  my $query = qq|SELECT id, description, discount, customernumberinit, salesman
610
                 FROM business
611
		 ORDER BY 2|;
612

  
613
  $sth = $dbh->prepare($query);
614
  $sth->execute || $form->dberror($query);
615

  
616
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
617
    push @{ $form->{ALL} }, $ref;
618
  }
619

  
620
  $sth->finish;
621
  $dbh->disconnect;
622

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

  
626
sub get_business {
627
  $main::lxdebug->enter_sub();
628

  
629
  my ($self, $myconfig, $form) = @_;
630

  
631
  # connect to database
632
  my $dbh = $form->dbconnect($myconfig);
633

  
634
  my $query =
635
    qq|SELECT b.description, b.discount, b.customernumberinit, b.salesman
636
                 FROM business b
637
	         WHERE b.id = $form->{id}|;
638
  my $sth = $dbh->prepare($query);
639
  $sth->execute || $form->dberror($query);
640

  
641
  my $ref = $sth->fetchrow_hashref(NAME_lc);
642

  
643
  map { $form->{$_} = $ref->{$_} } keys %$ref;
644

  
645
  $sth->finish;
646

  
647
  $dbh->disconnect;
648

  
649
  $main::lxdebug->leave_sub();
650
}
651

  
652
sub save_business {
653
  $main::lxdebug->enter_sub();
654

  
655
  my ($self, $myconfig, $form) = @_;
656

  
657
  # connect to database
658
  my $dbh = $form->dbconnect($myconfig);
659

  
660
  $form->{description} =~ s/\'/\'\'/g;
661
  $form->{discount} /= 100;
662
  $form->{salesman} *= 1;
663

  
664
  # id is the old record
665
  if ($form->{id}) {
666
    $query = qq|UPDATE business SET
667
		description = '$form->{description}',
668
		discount = $form->{discount},
669
                customernumberinit = '$form->{customernumberinit}',
670
                salesman = '$form->{salesman}'
671
		WHERE id = $form->{id}|;
672
  } else {
673
    $query = qq|INSERT INTO business 
674
                (description, discount, customernumberinit, salesman)
675
                VALUES ('$form->{description}', $form->{discount}, '$form->{customernumberinit}', '$form->{salesman}')|;
676
  }
677
  $dbh->do($query) || $form->dberror($query);
678

  
679
  $dbh->disconnect;
680

  
681
  $main::lxdebug->leave_sub();
682
}
683

  
684
sub delete_business {
685
  $main::lxdebug->enter_sub();
686

  
687
  my ($self, $myconfig, $form) = @_;
688

  
689
  # connect to database
690
  my $dbh = $form->dbconnect($myconfig);
691

  
692
  $query = qq|DELETE FROM business
693
	      WHERE id = $form->{id}|;
694
  $dbh->do($query) || $form->dberror($query);
695

  
696
  $dbh->disconnect;
697

  
698
  $main::lxdebug->leave_sub();
699
}
700

  
701
sub sic {
702
  $main::lxdebug->enter_sub();
703

  
704
  my ($self, $myconfig, $form) = @_;
705

  
706
  # connect to database
707
  my $dbh = $form->dbconnect($myconfig);
708

  
709
  my $query = qq|SELECT code, sictype, description
710
                 FROM sic
711
		 ORDER BY code|;
712

  
713
  $sth = $dbh->prepare($query);
714
  $sth->execute || $form->dberror($query);
715

  
716
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
717
    push @{ $form->{ALL} }, $ref;
718
  }
719

  
720
  $sth->finish;
721
  $dbh->disconnect;
722

  
723
  $main::lxdebug->leave_sub();
724
}
725

  
726
sub get_sic {
727
  $main::lxdebug->enter_sub();
728

  
729
  my ($self, $myconfig, $form) = @_;
730

  
731
  # connect to database
732
  my $dbh = $form->dbconnect($myconfig);
733

  
734
  my $query = qq|SELECT s.code, s.sictype, s.description
735
                 FROM sic s
736
	         WHERE s.code = '$form->{code}'|;
737
  my $sth = $dbh->prepare($query);
738
  $sth->execute || $form->dberror($query);
739

  
740
  my $ref = $sth->fetchrow_hashref(NAME_lc);
741

  
742
  map { $form->{$_} = $ref->{$_} } keys %$ref;
743

  
744
  $sth->finish;
745

  
746
  $dbh->disconnect;
747

  
748
  $main::lxdebug->leave_sub();
749
}
750

  
751
sub save_sic {
752
  $main::lxdebug->enter_sub();
753

  
754
  my ($self, $myconfig, $form) = @_;
755

  
756
  # connect to database
757
  my $dbh = $form->dbconnect($myconfig);
758

  
759
  $form->{code}        =~ s/\'/\'\'/g;
760
  $form->{description} =~ s/\'/\'\'/g;
761

  
762
  # if there is an id
763
  if ($form->{id}) {
764
    $query = qq|UPDATE sic SET
765
                code = '$form->{code}',
766
		sictype = '$form->{sictype}',
767
		description = '$form->{description}'
768
		WHERE code = '$form->{id}'|;
769
  } else {
770
    $query = qq|INSERT INTO sic 
771
                (code, sictype, description)
772
                VALUES ('$form->{code}', '$form->{sictype}', '$form->{description}')|;
773
  }
774
  $dbh->do($query) || $form->dberror($query);
775

  
776
  $dbh->disconnect;
777

  
778
  $main::lxdebug->leave_sub();
779
}
780

  
781
sub delete_sic {
782
  $main::lxdebug->enter_sub();
783

  
784
  my ($self, $myconfig, $form) = @_;
785

  
786
  # connect to database
787
  my $dbh = $form->dbconnect($myconfig);
788

  
789
  $query = qq|DELETE FROM sic
790
	      WHERE code = '$form->{code}'|;
791
  $dbh->do($query) || $form->dberror($query);
792

  
793
  $dbh->disconnect;
794

  
795
  $main::lxdebug->leave_sub();
796
}
797

  
798
sub load_template {
799
  $main::lxdebug->enter_sub();
800

  
801
  my ($self, $form) = @_;
802

  
803
  open(TEMPLATE, "$form->{file}") or $form->error("$form->{file} : $!");
804

  
805
  while (<TEMPLATE>) {
806
    $form->{body} .= $_;
807
  }
808

  
809
  close(TEMPLATE);
810

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

  
814
sub save_template {
815
  $main::lxdebug->enter_sub();
816

  
817
  my ($self, $form) = @_;
818

  
819
  open(TEMPLATE, ">$form->{file}") or $form->error("$form->{file} : $!");
820

  
821
  # strip
822
  $form->{body} =~ s/\r\n/\n/g;
823
  print TEMPLATE $form->{body};
824

  
825
  close(TEMPLATE);
826

  
827
  $main::lxdebug->leave_sub();
828
}
829

  
830
sub save_preferences {
831
  $main::lxdebug->enter_sub();
832

  
833
  my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_;
834

  
835
  map { ($form->{$_}) = split /--/, $form->{$_} }
836
    qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno);
837

  
838
  my @a;
839
  $form->{curr} =~ s/ //g;
840
  map { push(@a, uc pack "A3", $_) if $_ } split /:/, $form->{curr};
841
  $form->{curr} = join ':', @a;
842

  
843
  # connect to database
844
  my $dbh = $form->dbconnect_noauto($myconfig);
845

  
846
  # these defaults are database wide
847
  # user specific variables are in myconfig
848
  # save defaults
849
  my $query = qq|UPDATE defaults SET
850
                 inventory_accno_id = 
851
		     (SELECT c.id FROM chart c
852
		                WHERE c.accno = '$form->{inventory_accno}'),
853
                 income_accno_id =
854
		     (SELECT c.id FROM chart c
855
		                WHERE c.accno = '$form->{income_accno}'),
856
	         expense_accno_id =
857
		     (SELECT c.id FROM chart c
858
		                WHERE c.accno = '$form->{expense_accno}'),
859
	         fxgain_accno_id =
860
		     (SELECT c.id FROM chart c
861
		                WHERE c.accno = '$form->{fxgain_accno}'),
862
	         fxloss_accno_id =
863
		     (SELECT c.id FROM chart c
864
		                WHERE c.accno = '$form->{fxloss_accno}'),
865
	         invnumber = '$form->{invnumber}',
866
	         sonumber = '$form->{sonumber}',
867
	         ponumber = '$form->{ponumber}',
868
		 sqnumber = '$form->{sqnumber}',
869
		 rfqnumber = '$form->{rfqnumber}',
870
                 customernumber = '$form->{customernumber}',
871
		 vendornumber = '$form->{vendornumber}',
872
                 articlenumber = '$form->{articlenumber}',
873
                 servicenumber = '$form->{servicenumber}',
874
                 yearend = '$form->{yearend}',
875
		 curr = '$form->{curr}',
876
		 weightunit = '$form->{weightunit}',
877
		 businessnumber = '$form->{businessnumber}'
878
		|;
879
  $dbh->do($query) || $form->dberror($query);
880

  
881
  # update name
882
  my $name = $form->{name};
883
  $name =~ s/\'/\'\'/g;
884
  $query = qq|UPDATE employee
885
              SET name = '$name'
886
	      WHERE login = '$form->{login}'|;
887
  $dbh->do($query) || $form->dberror($query);
888

  
889
  foreach my $item (split / /, $form->{taxaccounts}) {
890
    $query = qq|UPDATE tax
891
		SET rate = | . ($form->{$item} / 100) . qq|,
892
		taxnumber = '$form->{"taxnumber_$item"}'
893
		WHERE chart_id = $item|;
894
    $dbh->do($query) || $form->dberror($query);
895
  }
896

  
897
  my $rc = $dbh->commit;
898
  $dbh->disconnect;
899

  
900
  # save first currency in myconfig
901
  $form->{currency} = substr($form->{curr}, 0, 3);
902

  
903
  my $myconfig = new User "$memberfile", "$form->{login}";
904

  
905
  foreach my $item (keys %$form) {
906
    $myconfig->{$item} = $form->{$item};
907
  }
908

  
909
  $myconfig->save_member($memberfile, $userspath);
910

  
911
  if ($webdav) {
912
    @webdavdirs =
913
      qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
914
    foreach $directory (@webdavdirs) {
915
      $file = "webdav/" . $directory . "/webdav-user";
916
      if ($myconfig->{$directory}) {
917
        open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
918
        while (<HTACCESS>) {
919
          ($login, $password) = split(/:/, $_);
920
          if ($login ne $form->{login}) {
921
            $newfile .= $_;
922
          }
923
        }
924
        close(HTACCESS);
925
        open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
926
        $newfile .= $myconfig->{login} . ":" . $myconfig->{password} . "\n";
927
        print(HTACCESS $newfile);
928
        close(HTACCESS);
929
      } else {
930
        $form->{$directory} = 0;
931
        open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
932
        while (<HTACCESS>) {
933
          ($login, $password) = split(/:/, $_);
934
          if ($login ne $form->{login}) {
935
            $newfile .= $_;
936
          }
937
        }
938
        close(HTACCESS);
939
        open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
940
        print(HTACCESS $newfile);
941
        close(HTACCESS);
942
      }
943
    }
944
  }
945

  
946
  $main::lxdebug->leave_sub();
947

  
948
  return $rc;
949
}
950

  
951
sub defaultaccounts {
952
  $main::lxdebug->enter_sub();
953

  
954
  my ($self, $myconfig, $form) = @_;
955

  
956
  # connect to database
957
  my $dbh = $form->dbconnect($myconfig);
958

  
959
  # get defaults from defaults table
960
  my $query = qq|SELECT * FROM defaults|;
961
  my $sth   = $dbh->prepare($query);
962
  $sth->execute || $form->dberror($query);
963

  
964
  $form->{defaults}             = $sth->fetchrow_hashref(NAME_lc);
965
  $form->{defaults}{IC}         = $form->{defaults}{inventory_accno_id};
966
  $form->{defaults}{IC_income}  = $form->{defaults}{income_accno_id};
967
  $form->{defaults}{IC_expense} = $form->{defaults}{expense_accno_id};
968
  $form->{defaults}{FX_gain}    = $form->{defaults}{fxgain_accno_id};
969
  $form->{defaults}{FX_loss}    = $form->{defaults}{fxloss_accno_id};
970

  
971
  $sth->finish;
972

  
973
  $query = qq|SELECT c.id, c.accno, c.description, c.link
974
              FROM chart c
975
              WHERE c.link LIKE '%IC%'
976
              ORDER BY c.accno|;
977
  $sth = $dbh->prepare($query);
978
  $sth->execute || $self->dberror($query);
979

  
980
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
981
    foreach my $key (split(/:/, $ref->{link})) {
982
      if ($key =~ /IC/) {
983
        $nkey = $key;
984
        if ($key =~ /cogs/) {
985
          $nkey = "IC_expense";
986
        }
987
        if ($key =~ /sale/) {
988
          $nkey = "IC_income";
989
        }
990
        %{ $form->{IC}{$nkey}{ $ref->{accno} } } = (
991
                                             id          => $ref->{id},
992
                                             description => $ref->{description}
993
        );
994
      }
995
    }
996
  }
997
  $sth->finish;
998

  
999
  $query = qq|SELECT c.id, c.accno, c.description
1000
              FROM chart c
1001
	      WHERE c.category = 'I'
1002
	      AND c.charttype = 'A'
1003
              ORDER BY c.accno|;
1004
  $sth = $dbh->prepare($query);
1005
  $sth->execute || $self->dberror($query);
1006

  
1007
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1008
    %{ $form->{IC}{FX_gain}{ $ref->{accno} } } = (
1009
                                             id          => $ref->{id},
1010
                                             description => $ref->{description}
1011
    );
1012
  }
1013
  $sth->finish;
1014

  
1015
  $query = qq|SELECT c.id, c.accno, c.description
1016
              FROM chart c
1017
	      WHERE c.category = 'E'
1018
	      AND c.charttype = 'A'
1019
              ORDER BY c.accno|;
1020
  $sth = $dbh->prepare($query);
1021
  $sth->execute || $self->dberror($query);
1022

  
1023
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1024
    %{ $form->{IC}{FX_loss}{ $ref->{accno} } } = (
1025
                                             id          => $ref->{id},
1026
                                             description => $ref->{description}
1027
    );
1028
  }
1029
  $sth->finish;
1030

  
1031
  # now get the tax rates and numbers
1032
  $query = qq|SELECT c.id, c.accno, c.description,
1033
              t.rate * 100 AS rate, t.taxnumber
1034
              FROM chart c, tax t
1035
	      WHERE c.id = t.chart_id|;
1036

  
1037
  $sth = $dbh->prepare($query);
1038
  $sth->execute || $form->dberror($query);
1039

  
1040
  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1041
    $form->{taxrates}{ $ref->{accno} }{id}          = $ref->{id};
1042
    $form->{taxrates}{ $ref->{accno} }{description} = $ref->{description};
1043
    $form->{taxrates}{ $ref->{accno} }{taxnumber}   = $ref->{taxnumber}
1044
      if $ref->{taxnumber};
1045
    $form->{taxrates}{ $ref->{accno} }{rate} = $ref->{rate} if $ref->{rate};
1046
  }
1047

  
1048
  $sth->finish;
1049
  $dbh->disconnect;
1050

  
1051
  $main::lxdebug->leave_sub();
1052
}
1053

  
1054
sub backup {
1055
  $main::lxdebug->enter_sub();
1056

  
1057
  my ($self, $myconfig, $form, $userspath) = @_;
1058

  
1059
  my $mail;
1060
  my $err;
1061
  my $boundary = time;
1062
  my $tmpfile  =
1063
    "$userspath/$boundary.$myconfig->{dbname}-$form->{dbversion}.sql";
1064
  my $out = $form->{OUT};
1065
  $form->{OUT} = ">$tmpfile";
1066

  
1067
  if ($form->{media} eq 'email') {
1068

  
1069
    use SL::Mailer;
1070
    $mail = new Mailer;
1071

  
1072
    $mail->{to}      = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1073
    $mail->{from}    = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1074
    $mail->{subject} =
1075
      "Lx-Office Backup / $myconfig->{dbname}-$form->{dbversion}.sql";
1076
    @{ $mail->{attachments} } = ($tmpfile);
1077
    $mail->{version} = $form->{version};
1078
    $mail->{fileid}  = "$boundary.";
1079

  
1080
    $myconfig->{signature} =~ s/\\n/\r\n/g;
1081
    $mail->{message} = "--\n$myconfig->{signature}";
1082

  
1083
  }
1084

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

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

  
1090
  my @sequences = ();
1091
  my @functions = ();
1092
  my @triggers  = ();
1093
  my @indices   = ();
1094
  my %tablespecs;
1095

  
1096
  my $query = "";
1097
  my @quote_chars;
1098

  
1099
  while (<FH>) {
1100

  
1101
    # Remove DOS and Unix style line endings.
1102
    s/[\r\n]//g;
1103

  
1104
    # ignore comments or empty lines
1105
    next if /^(--.*|\s+)$/;
1106

  
1107
    for (my $i = 0; $i < length($_); $i++) {
1108
      my $char = substr($_, $i, 1);
1109

  
1110
      # Are we inside a string?
1111
      if (@quote_chars) {
1112
        if ($char eq $quote_chars[-1]) {
1113
          pop(@quote_chars);
1114
        }
1115
        $query .= $char;
1116

  
1117
      } else {
1118
        if (($char eq "'") || ($char eq "\"")) {
1119
          push(@quote_chars, $char);
1120

  
1121
        } elsif ($char eq ";") {
1122

  
1123
          # Query is complete. Check for triggers and functions.
1124
          if ($query =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1125
            push(@functions, $query);
1126

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

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

  
1133
          } elsif ($query =~ /^create\s+table\s+\"?(\w+)\"?/i) {
1134
            $tablespecs{$1} = $query;
1135

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

  
1139
          }
1140

  
1141
          $query = "";
1142
          $char  = "";
1143
        }
1144

  
1145
        $query .= $char;
1146
      }
1147
    }
1148
  }
1149
  close(FH);
1150

  
1151
  # connect to database
1152
  my $dbh = $form->dbconnect($myconfig);
1153

  
1154
  # get all the tables
1155
  my @tables = $dbh->tables('', '', 'customer', '', { noprefix => 0 });
1156

  
1157
  my $today = scalar localtime;
1158

  
1159
  $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost};
1160

  
1161
  print OUT qq|-- Lx-Office Backup
1162
-- Dataset: $myconfig->{dbname}
1163
-- Version: $form->{dbversion}
1164
-- Host: $myconfig->{dbhost}
1165
-- Login: $form->{login}
1166
-- User: $myconfig->{name}
1167
-- Date: $today
1168
--
1169
-- set options
1170
$myconfig->{dboptions};
1171
--
1172
|;
1173

  
1174
  print OUT "-- DROP Sequences\n";
1175
  my $item;
1176
  foreach $item (@sequences) {
1177
    print OUT qq|DROP SEQUENCE $item;\n|;
1178
  }
1179

  
1180
  print OUT "-- DROP Triggers\n";
1181

  
1182
  foreach $item (@triggers) {
1183
    if ($item =~ /^create\s+trigger\s+\"?(\w+)\"?\s+.*on\s+\"?(\w+)\"?\s+/i) {
1184
      print OUT qq|DROP TRIGGER "$1" ON "$2";\n|;
1185
    }
1186
  }
1187

  
1188
  print OUT "-- DROP Functions\n";
1189

  
1190
  foreach $item (@functions) {
1191
    if ($item =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1192
      print OUT qq|DROP FUNCTION "$1" ();\n|;
1193
    }
1194
  }
1195

  
1196
  foreach $table (@tables) {
1197
    if (!($table =~ /^sql_.*/)) {
1198
      my $query = qq|SELECT * FROM $table|;
1199

  
1200
      my $sth = $dbh->prepare($query);
1201
      $sth->execute || $form->dberror($query);
1202

  
1203
      $query = "INSERT INTO $table (";
1204
      map { $query .= qq|$sth->{NAME}->[$_],| }
1205
        (0 .. $sth->{NUM_OF_FIELDS} - 1);
1206
      chop $query;
1207

  
1208
      $query .= ") VALUES";
1209

  
1210
      if ($tablespecs{$table}) {
1211
        print(OUT "--\n");
1212
        print(OUT "DROP TABLE $table;\n");
1213
        print(OUT $tablespecs{$table}, ";\n");
1214
      } else {
1215
        print(OUT "--\n");
1216
        print(OUT "DELETE FROM $table;\n");
1217
      }
1218
      while (my @arr = $sth->fetchrow_array) {
1219

  
1220
        $fields = "(";
1221
        foreach my $item (@arr) {
1222
          if (defined $item) {
1223
            $item =~ s/\'/\'\'/g;
1224
            $fields .= qq|'$item',|;
1225
          } else {
1226
            $fields .= 'NULL,';
1227
          }
1228
        }
1229

  
1230
        chop $fields;
1231
        $fields .= ")";
1232

  
1233
        print OUT qq|$query $fields;\n|;
1234
      }
1235

  
1236
      $sth->finish;
1237
    }
1238
  }
1239

  
1240
  # create indices, sequences, functions and triggers
1241

  
1242
  print(OUT "-- CREATE Indices\n");
1243
  map({ print(OUT "$_;\n"); } @indices);
1244

  
1245
  print OUT "-- CREATE Sequences\n";
1246
  foreach $item (@sequences) {
1247
    $query = qq|SELECT last_value FROM $item|;
1248
    $sth   = $dbh->prepare($query);
1249
    $sth->execute || $form->dberror($query);
1250
    my ($id) = $sth->fetchrow_array;
1251
    $sth->finish;
1252

  
1253
    print OUT qq|--
1254
CREATE SEQUENCE $item START $id;
1255
|;
1256
  }
1257

  
1258
  print OUT "-- CREATE Functions\n";
1259

  
1260
  # functions
1261
  map { print(OUT $_, ";\n"); } @functions;
1262

  
1263
  print OUT "-- CREATE Triggers\n";
1264

  
1265
  # triggers
1266
  map { print(OUT $_, ";\n"); } @triggers;
1267

  
1268
  close(OUT);
1269

  
1270
  $dbh->disconnect;
1271

  
1272
  # compress backup
1273
  my @args = ("gzip", "$tmpfile");
1274
  system(@args) == 0 or $form->error("$args[0] : $?");
1275

  
1276
  $tmpfile .= ".gz";
1277

  
1278
  if ($form->{media} eq 'email') {
1279
    @{ $mail->{attachments} } = ($tmpfile);
1280
    $err = $mail->send($out);
1281
  }
1282

  
1283
  if ($form->{media} eq 'file') {
1284

  
1285
    open(IN,  "$tmpfile") or $form->error("$tmpfile : $!");
1286
    open(OUT, ">-")       or $form->error("STDOUT : $!");
1287

  
1288
    print OUT qq|Content-Type: application/x-tar-gzip;
1289
Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}.sql.gz"
1290

  
1291
|;
1292

  
1293
    while (<IN>) {
1294
      print OUT $_;
1295
    }
1296

  
1297
    close(IN);
1298
    close(OUT);
1299

  
1300
  }
1301

  
1302
  unlink "$tmpfile";
1303

  
1304
  $main::lxdebug->leave_sub();
1305
}
1306

  
1307
sub closedto {
1308
  $main::lxdebug->enter_sub();
1309

  
1310
  my ($self, $myconfig, $form) = @_;
1311

  
1312
  my $dbh = $form->dbconnect($myconfig);
1313

  
1314
  my $query = qq|SELECT closedto, revtrans FROM defaults|;
1315
  my $sth   = $dbh->prepare($query);
1316
  $sth->execute || $form->dberror($query);
1317

  
1318
  ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
1319

  
1320
  $sth->finish;
1321

  
1322
  $dbh->disconnect;
1323

  
1324
  $main::lxdebug->leave_sub();
1325
}
1326

  
1327
sub closebooks {
1328
  $main::lxdebug->enter_sub();
1329

  
1330
  my ($self, $myconfig, $form) = @_;
1331

  
1332
  my $dbh = $form->dbconnect($myconfig);
1333

  
1334
  if ($form->{revtrans}) {
1335

  
1336
    $query = qq|UPDATE defaults SET closedto = NULL,
1337
				    revtrans = '1'|;
1338
  } else {
1339
    if ($form->{closedto}) {
1340

  
1341
      $query = qq|UPDATE defaults SET closedto = '$form->{closedto}',
1342
				      revtrans = '0'|;
1343
    } else {
1344

  
1345
      $query = qq|UPDATE defaults SET closedto = NULL,
1346
				      revtrans = '0'|;
1347
    }
1348
  }
1349

  
1350
  # set close in defaults
1351
  $dbh->do($query) || $form->dberror($query);
1352

  
1353
  $dbh->disconnect;
1354

  
1355
  $main::lxdebug->leave_sub();
1356
}
1357

  
1358
1;
1359

  
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
package AP;
36

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

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

  
42
  # connect to database
43
  my $dbh = $form->dbconnect_noauto($myconfig);
44

  
45
  my ($null, $taxrate, $amount);
46
  my $exchangerate = 0;
47

  
48
  ($null, $form->{department_id}) = split(/--/, $form->{department});
49
  $form->{department_id} *= 1;
50

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

  
58
    $form->{exchangerate} =
59
      ($exchangerate)
60
      ? $exchangerate
61
      : $form->parse_amount($myconfig, $form->{exchangerate});
62
  }
63

  
64
  # reverse and parse amounts
65
  for my $i (1 .. 1) {
66
    $form->{"amount_$i"} =
67
      $form->round_amount(
68
                         $form->parse_amount($myconfig, $form->{"amount_$i"}) *
69
                           $form->{exchangerate} * -1,
70
                         2);
71
    $amount += ($form->{"amount_$i"} * -1);
72
  }
73

  
74
  # this is for ap
75
  $form->{amount} = $amount;
76

  
77
  # taxincluded doesn't make sense if there is no amount
78
  $form->{taxincluded} = 0 if ($form->{amount} == 0);
79

  
80
  $query =
81
    qq| SELECT c.accno, t.rate FROM chart c, tax t where c.id=t.chart_id AND t.taxkey=$form->{taxkey}|;
82
  $sth = $dbh->prepare($query);
83
  $sth->execute || $form->dberror($query);
84
  ($form->{AP}{"tax"}, $form->{taxrate}) = $sth->fetchrow_array;
85
  $sth->finish;
86

  
87
  $formtax = $form->parse_amount($myconfig, $form->{"tax"});
88

  
89
  $form->{"tax"} = $form->{amount} * $form->{taxrate};
90
  $form->{"tax"} =
91
    $form->round_amount($form->{"tax"} * $form->{exchangerate}, 2) * -1;
92

  
93
  if ($form->{taxcheck}) {
94
    $form->{"tax"} = $formtax * -1;
95
  }
96

  
97
  $form->{total_tax} += ($form->{"tax"} * -1);
98

  
99
  # adjust paidaccounts if there is no date in the last row
100
  $form->{paidaccounts}-- unless ($form->{"datepaid_$form->{paidaccounts}"});
101

  
102
  $form->{invpaid} = 0;
103

  
104
  # add payments
105
  for my $i (1 .. $form->{paidaccounts}) {
106
    $form->{"paid_$i"} =
107
      $form->round_amount($form->parse_amount($myconfig, $form->{"paid_$i"}),
108
                          2);
109

  
110
    $form->{invpaid} += $form->{"paid_$i"};
111
    $form->{datepaid} = $form->{"datepaid_$i"};
112

  
113
  }
114

  
115
  $form->{invpaid} =
116
    $form->round_amount($form->{invpaid} * $form->{exchangerate}, 2);
117

  
118
  if ($form->{taxincluded} *= 1) {
119
    for $i (1 .. 1) {
120
      $tax =
121
        $form->{"amount_$i"} - ($form->{"amount_$i"} / ($form->{taxrate} + 1));
122
      if ($form->{taxcheck}) {
123
        $tax = $formtax * -1;
124
      }
... Dieser Diff wurde abgeschnitten, weil er die maximale Anzahl anzuzeigender Zeilen überschreitet.

Auch abrufbar als: Unified diff