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;