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 use Data::Dumper;
  41 use SL::DBUtils;
  42
  43 sub get_account {
  44   $main::lxdebug->enter_sub();
  45
  46   my ($self, $myconfig, $form) = @_;
  47
  48   # connect to database
  49   my $dbh = $form->dbconnect($myconfig);
  50   my $query =
  51     qq!SELECT c.accno, c.description, c.charttype, c.gifi_accno, c.category,! .
  52     qq!  c.link, c.pos_bilanz, c.pos_eur, c.new_chart_id, c.valid_from, ! .
  53     qq!  c.pos_bwa, ! .
  54     qq!  tk.taxkey_id, tk.pos_ustva, tk.tax_id, ! .
  55     qq!  tk.tax_id || '--' || tk.taxkey_id AS tax, tk.startdate ! .
  56     qq!FROM chart c ! .
  57     qq!LEFT JOIN taxkeys tk ! .
  58     qq!ON (c.id=tk.chart_id AND tk.id = ! .
  59     qq!  (SELECT id FROM taxkeys ! .
  60     qq!   WHERE taxkeys.chart_id = c.id AND startdate <= current_date ! .
  61     qq!   ORDER BY startdate DESC LIMIT 1)) ! .
  62     qq!WHERE c.id = ?!;
  63
  64   my $sth = $dbh->prepare($query);
  65   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
  66
  67   my $ref = $sth->fetchrow_hashref(NAME_lc);
  68
  69   foreach my $key (keys %$ref) {
  70     $form->{"$key"} = $ref->{"$key"};
  71   }
  72
  73   $sth->finish;
  74
  75   # get default accounts
  76   $query = qq|SELECT inventory_accno_id, income_accno_id, expense_accno_id
  77               FROM defaults|;
  78   $sth = $dbh->prepare($query);
  79   $sth->execute || $form->dberror($query);
  80
  81   $ref = $sth->fetchrow_hashref(NAME_lc);
  82
  83   map { $form->{$_} = $ref->{$_} } keys %ref;
  84
  85   $sth->finish;
  86
  87   # get taxkeys and description
  88   $query = qq§SELECT id, taxkey,id||'--'||taxkey AS tax, taxdescription
  89               FROM tax ORDER BY taxkey§;
  90   $sth = $dbh->prepare($query);
  91   $sth->execute || $form->dberror($query);
  92
  93   $form->{TAXKEY} = [];
  94
  95   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
  96     push @{ $form->{TAXKEY} }, $ref;
  97   }
  98
  99   $sth->finish;
 100   if ($form->{id}) {
 101     # get new accounts
 102     $query = qq|SELECT id, accno,description
 103                 FROM chart WHERE link = ?|;
 104     $sth = $dbh->prepare($query);
 105     $sth->execute($form->{link}) || $form->dberror($query . " ($form->{link})");
 106
 107     $form->{NEWACCOUNT} = [];
 108     while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 109       push @{ $form->{NEWACCOUNT} }, $ref;
 110     }
 111
 112     $sth->finish;
 113   }
 114   # check if we have any transactions
 115   $query = qq|SELECT a.trans_id FROM acc_trans a
 116               WHERE a.chart_id = ?|;
 117   $sth = $dbh->prepare($query);
 118   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 119
 120   ($form->{orphaned}) = $sth->fetchrow_array;
 121   $form->{orphaned} = !$form->{orphaned};
 122   $sth->finish;
 123
 124   # check if new account is active
 125   $form->{new_chart_valid} = 0;
 126   if ($form->{new_chart_id}) {
 127     $query = qq|SELECT current_date-valid_from FROM chart
 128                 WHERE id = ?|;
 129     my ($count) = selectrow_query($form, $dbh, $query, $form->{id});
 130     if ($count >=0) {
 131       $form->{new_chart_valid} = 1;
 132     }
 133     $sth->finish;
 134   }
 135
 136   $dbh->disconnect;
 137
 138   $main::lxdebug->leave_sub();
 139 }
 140
 141 sub save_account {
 142   $main::lxdebug->enter_sub();
 143
 144   my ($self, $myconfig, $form) = @_;
 145
 146   # connect to database, turn off AutoCommit
 147   my $dbh = $form->dbconnect_noauto($myconfig);
 148
 149   # sanity check, can't have AR with AR_...
 150   if ($form->{AR} || $form->{AP} || $form->{IC}) {
 151     map { delete $form->{$_} }
 152       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);
 153   }
 154
 155   $form->{link} = "";
 156   foreach my $item ($form->{AR},            $form->{AR_amount},
 157                     $form->{AR_tax},        $form->{AR_paid},
 158                     $form->{AP},            $form->{AP_amount},
 159                     $form->{AP_tax},        $form->{AP_paid},
 160                     $form->{IC},            $form->{IC_sale},
 161                     $form->{IC_cogs},       $form->{IC_taxpart},
 162                     $form->{IC_income},     $form->{IC_expense},
 163                     $form->{IC_taxservice}, $form->{CT_tax}
 164     ) {
 165     $form->{link} .= "${item}:" if ($item);
 166   }
 167   chop $form->{link};
 168
 169   # strip blanks from accno
 170   map { $form->{$_} =~ s/ //g; } qw(accno);
 171
 172   my ($query, $sth);
 173
 174   if ($form->{id} eq "NULL") {
 175     $form->{id} = "";
 176   }
 177
 178   my @values;
 179
 180   my ($tax_id, $taxkey) = split(/--/, $form->{tax});
 181   my $startdate = $form->{startdate} ? $form->{startdate} : "1970-01-01";
 182
 183   if ($form->{id} && $form->{orphaned}) {
 184     $query = qq|UPDATE chart SET
 185                 accno = ?, description = ?, charttype = ?,
 186                 gifi_accno = ?, category = ?, link = ?,
 187                 taxkey_id = ?,
 188                 pos_ustva = ?, pos_bwa   = ?, pos_bilanz = ?,
 189                 pos_eur = ?, new_chart_id = ?, valid_from = ?
 190                 WHERE id = ?|;
 191     @values = ($form->{accno}, $form->{description}, $form->{charttype},
 192                $form->{gifi_accno}, $form->{category}, $form->{link},
 193                conv_i($taxkey),
 194                conv_i($form->{pos_ustva}), conv_i($form->{pos_bwa}),
 195                conv_i($form->{pos_bilanz}), conv_i($form->{pos_eur}),
 196                conv_i($form->{new_chart_id}),
 197                conv_date($form->{valid_from}),
 198                $form->{id});
 199
 200   } elsif ($form->{id} && !$form->{new_chart_valid}) {
 201     $query = qq|UPDATE chart SET new_chart_id = ?, valid_from = ?
 202                 WHERE id = ?|;
 203     @values = (conv_i($form->{new_chart_id}), conv_date($form->{valid_from}),
 204                $form->{id});
 205   } else {
 206     $query = qq|INSERT INTO chart
 207                 (accno, description, charttype,
 208                  gifi_accno, category, link,
 209                  taxkey_id,
 210                  pos_ustva, pos_bwa, pos_bilanz, pos_eur,
 211                  new_chart_id, valid_from)
 212                 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
 213     @values = ($form->{accno}, $form->{description}, $form->{charttype},
 214                $form->{gifi_accno}, $form->{category}, $form->{link},
 215                conv_i($taxkey),
 216                conv_i($form->{pos_ustva}), conv_i($form->{pos_bwa}),
 217                conv_i($form->{pos_bilanz}), conv_i($form->{pos_eur}),
 218                conv_i($form->{new_chart_id}),
 219                conv_date($form->{valid_from}));
 220
 221   }
 222   do_query($form, $dbh, $query, @values);
 223
 224   #Save Taxes
 225   if (!$form->{id}) {
 226     $query =
 227       qq|INSERT INTO taxkeys | .
 228       qq|(chart_id, tax_id, taxkey_id, pos_ustva, startdate) | .
 229       qq|VALUES ((SELECT id FROM chart WHERE accno = ?), ?, ?, ?, ?)|;
 230     do_query($form, $dbh, $query,
 231              $form->{accno}, conv_i($tax_id), conv_i($taxkey),
 232              conv_i($form->{pos_ustva}), conv_date($startdate));
 233
 234   } else {
 235     $query = qq|DELETE FROM taxkeys WHERE chart_id = ? AND tax_id = ?|;
 236     do_query($form, $dbh, $query, $form->{id}, conv_i($tax_id));
 237
 238     $query =
 239       qq|INSERT INTO taxkeys | .
 240       qq|(chart_id, tax_id, taxkey_id, pos_ustva, startdate) | .
 241       qq|VALUES (?, ?, ?, ?, ?)|;
 242     do_query($form, $dbh, $query,
 243              $form->{id}, conv_i($tax_id), conv_i($taxkey),
 244              conv_i($form->{pos_ustva}), conv_date($startdate));
 245   }
 246
 247   # commit
 248   my $rc = $dbh->commit;
 249   $dbh->disconnect;
 250
 251   $main::lxdebug->leave_sub();
 252
 253   return $rc;
 254 }
 255
 256 sub delete_account {
 257   $main::lxdebug->enter_sub();
 258
 259   my ($self, $myconfig, $form) = @_;
 260
 261   # connect to database, turn off AutoCommit
 262   my $dbh = $form->dbconnect_noauto($myconfig);
 263
 264   my $query = qq|SELECT count(*) FROM acc_trans a
 265                  WHERE a.chart_id = ?|;
 266   my ($count) = selectrow_query($form, $dbh, $query, $form->{id});
 267
 268   if ($count) {
 269     $dbh->disconnect;
 270     $main::lxdebug->leave_sub();
 271     return;
 272   }
 273
 274   # set inventory_accno_id, income_accno_id, expense_accno_id to defaults
 275   foreach my $type (qw(inventory income expense)) {
 276     $query =
 277       qq|UPDATE parts | .
 278       qq|SET ${type}_accno_id = (SELECT ${type}_accno_id FROM defaults) | .
 279       qq|WHERE ${type}_accno_id = ?|;
 280     do_query($form, $dbh, $query, $form->{id});
 281   }
 282
 283   foreach my $table (qw(partstax customertax vendortax tax)) {
 284     $query = qq|DELETE FROM $table
 285                 WHERE chart_id = ?|;
 286     do_query($form, $dbh, $query, $form->{id});
 287   }
 288
 289   # delete chart of account record
 290   $query = qq|DELETE FROM chart
 291               WHERE id = ?|;
 292   do_query($form, $dbh, $query, $form->{id});
 293
 294   # commit and redirect
 295   my $rc = $dbh->commit;
 296   $dbh->disconnect;
 297
 298   $main::lxdebug->leave_sub();
 299
 300   return $rc;
 301 }
 302
 303 sub gifi_accounts {
 304   $main::lxdebug->enter_sub();
 305
 306   my ($self, $myconfig, $form) = @_;
 307
 308   # connect to database
 309   my $dbh = $form->dbconnect($myconfig);
 310
 311   my $query = qq|SELECT accno, description
 312                  FROM gifi
 313                  ORDER BY accno|;
 314
 315   $sth = $dbh->prepare($query);
 316   $sth->execute || $form->dberror($query);
 317
 318   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 319     push @{ $form->{ALL} }, $ref;
 320   }
 321
 322   $sth->finish;
 323   $dbh->disconnect;
 324
 325   $main::lxdebug->leave_sub();
 326 }
 327
 328 sub get_gifi {
 329   $main::lxdebug->enter_sub();
 330
 331   my ($self, $myconfig, $form) = @_;
 332
 333   # connect to database
 334   my $dbh = $form->dbconnect($myconfig);
 335
 336   my $query = qq|SELECT g.accno, g.description
 337                  FROM gifi g
 338                  WHERE g.accno = '$form->{accno}'|;
 339   my $sth = $dbh->prepare($query);
 340   $sth->execute || $form->dberror($query);
 341
 342   my $ref = $sth->fetchrow_hashref(NAME_lc);
 343
 344   map { $form->{$_} = $ref->{$_} } keys %$ref;
 345
 346   $sth->finish;
 347
 348   # check for transactions
 349   $query = qq|SELECT count(*) FROM acc_trans a, chart c, gifi g
 350               WHERE c.gifi_accno = g.accno
 351               AND a.chart_id = c.id
 352               AND g.accno = '$form->{accno}'|;
 353   $sth = $dbh->prepare($query);
 354   $sth->execute || $form->dberror($query);
 355
 356   ($form->{orphaned}) = $sth->fetchrow_array;
 357   $sth->finish;
 358   $form->{orphaned} = !$form->{orphaned};
 359
 360   $dbh->disconnect;
 361
 362   $main::lxdebug->leave_sub();
 363 }
 364
 365 sub save_gifi {
 366   $main::lxdebug->enter_sub();
 367
 368   my ($self, $myconfig, $form) = @_;
 369
 370   # connect to database
 371   my $dbh = $form->dbconnect($myconfig);
 372
 373   $form->{description} =~ s/\'/\'\'/g;
 374
 375   # id is the old account number!
 376   if ($form->{id}) {
 377     $query = qq|UPDATE gifi SET
 378                 accno = '$form->{accno}',
 379                 description = '$form->{description}'
 380                 WHERE accno = '$form->{id}'|;
 381   } else {
 382     $query = qq|INSERT INTO gifi
 383                 (accno, description)
 384                 VALUES ('$form->{accno}', '$form->{description}')|;
 385   }
 386   $dbh->do($query) || $form->dberror($query);
 387
 388   $dbh->disconnect;
 389
 390   $main::lxdebug->leave_sub();
 391 }
 392
 393 sub delete_gifi {
 394   $main::lxdebug->enter_sub();
 395
 396   my ($self, $myconfig, $form) = @_;
 397
 398   # connect to database
 399   my $dbh = $form->dbconnect($myconfig);
 400
 401   # id is the old account number!
 402   $query = qq|DELETE FROM gifi
 403               WHERE accno = '$form->{id}'|;
 404   $dbh->do($query) || $form->dberror($query);
 405
 406   $dbh->disconnect;
 407
 408   $main::lxdebug->leave_sub();
 409 }
 410
 411 sub warehouses {
 412   $main::lxdebug->enter_sub();
 413
 414   my ($self, $myconfig, $form) = @_;
 415
 416   # connect to database
 417   my $dbh = $form->dbconnect($myconfig);
 418
 419   my $query = qq|SELECT id, description
 420                  FROM warehouse
 421                  ORDER BY 2|;
 422
 423   $sth = $dbh->prepare($query);
 424   $sth->execute || $form->dberror($query);
 425
 426   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 427     push @{ $form->{ALL} }, $ref;
 428   }
 429
 430   $sth->finish;
 431   $dbh->disconnect;
 432
 433   $main::lxdebug->leave_sub();
 434 }
 435
 436 sub get_warehouse {
 437   $main::lxdebug->enter_sub();
 438
 439   my ($self, $myconfig, $form) = @_;
 440
 441   # connect to database
 442   my $dbh = $form->dbconnect($myconfig);
 443
 444   my $query = qq|SELECT w.description
 445                  FROM warehouse w
 446                  WHERE w.id = $form->{id}|;
 447   my $sth = $dbh->prepare($query);
 448   $sth->execute || $form->dberror($query);
 449
 450   my $ref = $sth->fetchrow_hashref(NAME_lc);
 451
 452   map { $form->{$_} = $ref->{$_} } keys %$ref;
 453
 454   $sth->finish;
 455
 456   # see if it is in use
 457   $query = qq|SELECT count(*) FROM inventory i
 458               WHERE i.warehouse_id = $form->{id}|;
 459   $sth = $dbh->prepare($query);
 460   $sth->execute || $form->dberror($query);
 461
 462   ($form->{orphaned}) = $sth->fetchrow_array;
 463   $form->{orphaned} = !$form->{orphaned};
 464   $sth->finish;
 465
 466   $dbh->disconnect;
 467
 468   $main::lxdebug->leave_sub();
 469 }
 470
 471 sub save_warehouse {
 472   $main::lxdebug->enter_sub();
 473
 474   my ($self, $myconfig, $form) = @_;
 475
 476   # connect to database
 477   my $dbh = $form->dbconnect($myconfig);
 478
 479   $form->{description} =~ s/\'/\'\'/g;
 480
 481   if ($form->{id}) {
 482     $query = qq|UPDATE warehouse SET
 483                 description = '$form->{description}'
 484                 WHERE id = $form->{id}|;
 485   } else {
 486     $query = qq|INSERT INTO warehouse
 487                 (description)
 488                 VALUES ('$form->{description}')|;
 489   }
 490   $dbh->do($query) || $form->dberror($query);
 491
 492   $dbh->disconnect;
 493
 494   $main::lxdebug->leave_sub();
 495 }
 496
 497 sub delete_warehouse {
 498   $main::lxdebug->enter_sub();
 499
 500   my ($self, $myconfig, $form) = @_;
 501
 502   # connect to database
 503   my $dbh = $form->dbconnect($myconfig);
 504
 505   $query = qq|DELETE FROM warehouse
 506               WHERE id = $form->{id}|;
 507   $dbh->do($query) || $form->dberror($query);
 508
 509   $dbh->disconnect;
 510
 511   $main::lxdebug->leave_sub();
 512 }
 513
 514 sub departments {
 515   $main::lxdebug->enter_sub();
 516
 517   my ($self, $myconfig, $form) = @_;
 518
 519   # connect to database
 520   my $dbh = $form->dbconnect($myconfig);
 521
 522   my $query = qq|SELECT d.id, d.description, d.role
 523                  FROM department d
 524                  ORDER BY 2|;
 525
 526   $sth = $dbh->prepare($query);
 527   $sth->execute || $form->dberror($query);
 528
 529   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 530     push @{ $form->{ALL} }, $ref;
 531   }
 532
 533   $sth->finish;
 534   $dbh->disconnect;
 535
 536   $main::lxdebug->leave_sub();
 537 }
 538
 539 sub get_department {
 540   $main::lxdebug->enter_sub();
 541
 542   my ($self, $myconfig, $form) = @_;
 543
 544   # connect to database
 545   my $dbh = $form->dbconnect($myconfig);
 546
 547   my $query = qq|SELECT d.description, d.role
 548                  FROM department d
 549                  WHERE d.id = $form->{id}|;
 550   my $sth = $dbh->prepare($query);
 551   $sth->execute || $form->dberror($query);
 552
 553   my $ref = $sth->fetchrow_hashref(NAME_lc);
 554
 555   map { $form->{$_} = $ref->{$_} } keys %$ref;
 556
 557   $sth->finish;
 558
 559   # see if it is in use
 560   $query = qq|SELECT count(*) FROM dpt_trans d
 561               WHERE d.department_id = $form->{id}|;
 562   $sth = $dbh->prepare($query);
 563   $sth->execute || $form->dberror($query);
 564
 565   ($form->{orphaned}) = $sth->fetchrow_array;
 566   $form->{orphaned} = !$form->{orphaned};
 567   $sth->finish;
 568
 569   $dbh->disconnect;
 570
 571   $main::lxdebug->leave_sub();
 572 }
 573
 574 sub save_department {
 575   $main::lxdebug->enter_sub();
 576
 577   my ($self, $myconfig, $form) = @_;
 578
 579   # connect to database
 580   my $dbh = $form->dbconnect($myconfig);
 581
 582   $form->{description} =~ s/\'/\'\'/g;
 583
 584   if ($form->{id}) {
 585     $query = qq|UPDATE department SET
 586                 description = '$form->{description}',
 587                 role = '$form->{role}'
 588                 WHERE id = $form->{id}|;
 589   } else {
 590     $query = qq|INSERT INTO department
 591                 (description, role)
 592                 VALUES ('$form->{description}', '$form->{role}')|;
 593   }
 594   $dbh->do($query) || $form->dberror($query);
 595
 596   $dbh->disconnect;
 597
 598   $main::lxdebug->leave_sub();
 599 }
 600
 601 sub delete_department {
 602   $main::lxdebug->enter_sub();
 603
 604   my ($self, $myconfig, $form) = @_;
 605
 606   # connect to database
 607   my $dbh = $form->dbconnect($myconfig);
 608
 609   $query = qq|DELETE FROM department
 610               WHERE id = $form->{id}|;
 611   $dbh->do($query) || $form->dberror($query);
 612
 613   $dbh->disconnect;
 614
 615   $main::lxdebug->leave_sub();
 616 }
 617
 618 sub lead {
 619   $main::lxdebug->enter_sub();
 620
 621   my ($self, $myconfig, $form) = @_;
 622
 623   # connect to database
 624   my $dbh = $form->dbconnect($myconfig);
 625
 626   my $query = qq|SELECT id, lead
 627                  FROM leads
 628                  ORDER BY 2|;
 629
 630   $sth = $dbh->prepare($query);
 631   $sth->execute || $form->dberror($query);
 632
 633   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 634     push @{ $form->{ALL} }, $ref;
 635   }
 636
 637   $sth->finish;
 638   $dbh->disconnect;
 639
 640   $main::lxdebug->leave_sub();
 641 }
 642
 643 sub get_lead {
 644   $main::lxdebug->enter_sub();
 645
 646   my ($self, $myconfig, $form) = @_;
 647
 648   # connect to database
 649   my $dbh = $form->dbconnect($myconfig);
 650
 651   my $query =
 652     qq|SELECT l.id, l.lead
 653                  FROM leads l
 654                  WHERE l.id = $form->{id}|;
 655   my $sth = $dbh->prepare($query);
 656   $sth->execute || $form->dberror($query);
 657
 658   my $ref = $sth->fetchrow_hashref(NAME_lc);
 659
 660   map { $form->{$_} = $ref->{$_} } keys %$ref;
 661
 662   $sth->finish;
 663
 664   $dbh->disconnect;
 665
 666   $main::lxdebug->leave_sub();
 667 }
 668
 669 sub save_lead {
 670   $main::lxdebug->enter_sub();
 671
 672   my ($self, $myconfig, $form) = @_;
 673
 674   # connect to database
 675   my $dbh = $form->dbconnect($myconfig);
 676
 677   $form->{lead} =~ s/\'/\'\'/g;
 678
 679   # id is the old record
 680   if ($form->{id}) {
 681     $query = qq|UPDATE leads SET
 682                 lead = '$form->{description}'
 683                 WHERE id = $form->{id}|;
 684   } else {
 685     $query = qq|INSERT INTO leads
 686                 (lead)
 687                 VALUES ('$form->{description}')|;
 688   }
 689   $dbh->do($query) || $form->dberror($query);
 690
 691   $dbh->disconnect;
 692
 693   $main::lxdebug->leave_sub();
 694 }
 695
 696 sub delete_lead {
 697   $main::lxdebug->enter_sub();
 698
 699   my ($self, $myconfig, $form) = @_;
 700
 701   # connect to database
 702   my $dbh = $form->dbconnect($myconfig);
 703
 704   $query = qq|DELETE FROM leads
 705               WHERE id = $form->{id}|;
 706   $dbh->do($query) || $form->dberror($query);
 707
 708   $dbh->disconnect;
 709
 710   $main::lxdebug->leave_sub();
 711 }
 712
 713 sub business {
 714   $main::lxdebug->enter_sub();
 715
 716   my ($self, $myconfig, $form) = @_;
 717
 718   # connect to database
 719   my $dbh = $form->dbconnect($myconfig);
 720
 721   my $query = qq|SELECT id, description, discount, customernumberinit, salesman
 722                  FROM business
 723                  ORDER BY 2|;
 724
 725   $sth = $dbh->prepare($query);
 726   $sth->execute || $form->dberror($query);
 727
 728   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 729     push @{ $form->{ALL} }, $ref;
 730   }
 731
 732   $sth->finish;
 733   $dbh->disconnect;
 734
 735   $main::lxdebug->leave_sub();
 736 }
 737
 738 sub get_business {
 739   $main::lxdebug->enter_sub();
 740
 741   my ($self, $myconfig, $form) = @_;
 742
 743   # connect to database
 744   my $dbh = $form->dbconnect($myconfig);
 745
 746   my $query =
 747     qq|SELECT b.description, b.discount, b.customernumberinit, b.salesman
 748                  FROM business b
 749                  WHERE b.id = $form->{id}|;
 750   my $sth = $dbh->prepare($query);
 751   $sth->execute || $form->dberror($query);
 752
 753   my $ref = $sth->fetchrow_hashref(NAME_lc);
 754
 755   map { $form->{$_} = $ref->{$_} } keys %$ref;
 756
 757   $sth->finish;
 758
 759   $dbh->disconnect;
 760
 761   $main::lxdebug->leave_sub();
 762 }
 763
 764 sub save_business {
 765   $main::lxdebug->enter_sub();
 766
 767   my ($self, $myconfig, $form) = @_;
 768
 769   # connect to database
 770   my $dbh = $form->dbconnect($myconfig);
 771
 772   $form->{description} =~ s/\'/\'\'/g;
 773   $form->{discount} /= 100;
 774   $form->{salesman} *= 1;
 775
 776   # id is the old record
 777   if ($form->{id}) {
 778     $query = qq|UPDATE business SET
 779                 description = '$form->{description}',
 780                 discount = $form->{discount},
 781                 customernumberinit = '$form->{customernumberinit}',
 782                 salesman = '$form->{salesman}'
 783                 WHERE id = $form->{id}|;
 784   } else {
 785     $query = qq|INSERT INTO business
 786                 (description, discount, customernumberinit, salesman)
 787                 VALUES ('$form->{description}', $form->{discount}, '$form->{customernumberinit}', '$form->{salesman}')|;
 788   }
 789   $dbh->do($query) || $form->dberror($query);
 790
 791   $dbh->disconnect;
 792
 793   $main::lxdebug->leave_sub();
 794 }
 795
 796 sub delete_business {
 797   $main::lxdebug->enter_sub();
 798
 799   my ($self, $myconfig, $form) = @_;
 800
 801   # connect to database
 802   my $dbh = $form->dbconnect($myconfig);
 803
 804   $query = qq|DELETE FROM business
 805               WHERE id = $form->{id}|;
 806   $dbh->do($query) || $form->dberror($query);
 807
 808   $dbh->disconnect;
 809
 810   $main::lxdebug->leave_sub();
 811 }
 812
 813
 814 sub language {
 815   $main::lxdebug->enter_sub();
 816
 817   my ($self, $myconfig, $form, $return_list) = @_;
 818
 819   # connect to database
 820   my $dbh = $form->dbconnect($myconfig);
 821
 822   my $query =
 823     "SELECT id, description, template_code, article_code, " .
 824     "  output_numberformat, output_dateformat, output_longdates " .
 825     "FROM language ORDER BY description";
 826
 827   $sth = $dbh->prepare($query);
 828   $sth->execute || $form->dberror($query);
 829
 830   my $ary = [];
 831
 832   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 833     push(@{ $ary }, $ref);
 834   }
 835
 836   $sth->finish;
 837   $dbh->disconnect;
 838
 839   $main::lxdebug->leave_sub();
 840
 841   if ($return_list) {
 842     return @{$ary};
 843   } else {
 844     $form->{ALL} = $ary;
 845   }
 846 }
 847
 848 sub get_language {
 849   $main::lxdebug->enter_sub();
 850
 851   my ($self, $myconfig, $form) = @_;
 852
 853   # connect to database
 854   my $dbh = $form->dbconnect($myconfig);
 855
 856   my $query =
 857     "SELECT description, template_code, article_code, " .
 858     "  output_numberformat, output_dateformat, output_longdates " .
 859     "FROM language WHERE id = ?";
 860   my $sth = $dbh->prepare($query);
 861   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
 862
 863   my $ref = $sth->fetchrow_hashref(NAME_lc);
 864
 865   map { $form->{$_} = $ref->{$_} } keys %$ref;
 866
 867   $sth->finish;
 868
 869   $dbh->disconnect;
 870
 871   $main::lxdebug->leave_sub();
 872 }
 873
 874 sub get_language_details {
 875   $main::lxdebug->enter_sub();
 876
 877   my ($self, $myconfig, $form, $id) = @_;
 878
 879   # connect to database
 880   my $dbh = $form->dbconnect($myconfig);
 881
 882   my $query =
 883     "SELECT template_code, " .
 884     "  output_numberformat, output_dateformat, output_longdates " .
 885     "FROM language WHERE id = ?";
 886   my @res = $dbh->selectrow_array($query, undef, $id);
 887   $dbh->disconnect;
 888
 889   $main::lxdebug->leave_sub();
 890
 891   return @res;
 892 }
 893
 894 sub save_language {
 895   $main::lxdebug->enter_sub();
 896
 897   my ($self, $myconfig, $form) = @_;
 898
 899   # connect to database
 900   my $dbh = $form->dbconnect($myconfig);
 901   my (@values, $query);
 902
 903   map({ push(@values, $form->{$_}); }
 904       qw(description template_code article_code
 905          output_numberformat output_dateformat output_longdates));
 906
 907   # id is the old record
 908   if ($form->{id}) {
 909     $query =
 910       "UPDATE language SET " .
 911       "  description = ?, template_code = ?, article_code = ?, " .
 912       "  output_numberformat = ?, output_dateformat = ?, " .
 913       "  output_longdates = ? " .
 914       "WHERE id = ?";
 915     push(@values, $form->{id});
 916   } else {
 917     $query =
 918       "INSERT INTO language (" .
 919       "  description, template_code, article_code, " .
 920       "  output_numberformat, output_dateformat, output_longdates" .
 921       ") VALUES (?, ?, ?, ?, ?, ?)";
 922   }
 923   $dbh->do($query, undef, @values) ||
 924     $form->dberror($query . " (" . join(", ", @values) . ")");
 925
 926   $dbh->disconnect;
 927
 928   $main::lxdebug->leave_sub();
 929 }
 930
 931 sub delete_language {
 932   $main::lxdebug->enter_sub();
 933
 934   my ($self, $myconfig, $form) = @_;
 935
 936   # connect to database
 937   my $dbh = $form->dbconnect_noauto($myconfig);
 938
 939   foreach my $table (qw(translation_payment_terms units_language)) {
 940     my $query = qq|DELETE FROM $table WHERE language_id = ?|;
 941     do_query($form, $dbh, $query, $form->{"id"});
 942   }
 943
 944   $query = "DELETE FROM language WHERE id = ?";
 945   do_query($form, $dbh, $query, $form->{"id"});
 946
 947   $dbh->commit();
 948   $dbh->disconnect;
 949
 950   $main::lxdebug->leave_sub();
 951 }
 952
 953
 954 sub buchungsgruppe {
 955   $main::lxdebug->enter_sub();
 956
 957   my ($self, $myconfig, $form) = @_;
 958
 959   # connect to database
 960   my $dbh = $form->dbconnect($myconfig);
 961
 962   my $query = qq|SELECT id, description,
 963                  inventory_accno_id,
 964                  (SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
 965                  income_accno_id_0,
 966                  (SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
 967                  expense_accno_id_0,
 968                  (SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
 969                  income_accno_id_1,
 970                  (SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
 971                  expense_accno_id_1,
 972                  (SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
 973                  income_accno_id_2,
 974                  (SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
 975                  expense_accno_id_2,
 976                  (select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
 977                  income_accno_id_3,
 978                  (SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
 979                  expense_accno_id_3,
 980                  (SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
 981                  FROM buchungsgruppen
 982                  ORDER BY sortkey|;
 983
 984   $sth = $dbh->prepare($query);
 985   $sth->execute || $form->dberror($query);
 986
 987   $form->{ALL} = [];
 988   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 989     push @{ $form->{ALL} }, $ref;
 990   }
 991
 992   $sth->finish;
 993   $dbh->disconnect;
 994
 995   $main::lxdebug->leave_sub();
 996 }
 997
 998 sub get_buchungsgruppe {
 999   $main::lxdebug->enter_sub();
1000
1001   my ($self, $myconfig, $form) = @_;
1002
1003   # connect to database
1004   my $dbh = $form->dbconnect($myconfig);
1005
1006   if ($form->{id}) {
1007     my $query =
1008       qq|SELECT description, inventory_accno_id,
1009          (SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
1010          income_accno_id_0,
1011          (SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
1012          expense_accno_id_0,
1013          (SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
1014          income_accno_id_1,
1015          (SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
1016          expense_accno_id_1,
1017          (SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
1018          income_accno_id_2,
1019          (SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
1020          expense_accno_id_2,
1021          (select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
1022          income_accno_id_3,
1023          (SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
1024          expense_accno_id_3,
1025          (SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
1026          FROM buchungsgruppen
1027          WHERE id = ?|;
1028     my $sth = $dbh->prepare($query);
1029     $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
1030
1031     my $ref = $sth->fetchrow_hashref(NAME_lc);
1032
1033     map { $form->{$_} = $ref->{$_} } keys %$ref;
1034
1035     $sth->finish;
1036
1037     my $query =
1038       qq|SELECT count(id) = 0 AS orphaned
1039          FROM parts
1040          WHERE buchungsgruppen_id = ?|;
1041     ($form->{orphaned}) = $dbh->selectrow_array($query, undef, $form->{id});
1042     $form->dberror($query . " ($form->{id})") if ($dbh->err);
1043   }
1044
1045   $query = "SELECT inventory_accno_id, income_accno_id, expense_accno_id ".
1046     "FROM defaults";
1047   ($form->{"std_inventory_accno_id"}, $form->{"std_income_accno_id"},
1048    $form->{"std_expense_accno_id"}) = $dbh->selectrow_array($query);
1049
1050   my $module = "IC";
1051   $query = qq|SELECT c.accno, c.description, c.link, c.id,
1052               d.inventory_accno_id, d.income_accno_id, d.expense_accno_id
1053               FROM chart c, defaults d
1054               WHERE c.link LIKE '%$module%'
1055               ORDER BY c.accno|;
1056
1057
1058   my $sth = $dbh->prepare($query);
1059   $sth->execute || $form->dberror($query);
1060   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1061     foreach my $key (split(/:/, $ref->{link})) {
1062       if (!$form->{"std_inventory_accno_id"} && ($key eq "IC")) {
1063         $form->{"std_inventory_accno_id"} = $ref->{"id"};
1064       }
1065       if ($key =~ /$module/) {
1066         if (   ($ref->{id} eq $ref->{inventory_accno_id})
1067             || ($ref->{id} eq $ref->{income_accno_id})
1068             || ($ref->{id} eq $ref->{expense_accno_id})) {
1069           push @{ $form->{"${module}_links"}{$key} },
1070             { accno       => $ref->{accno},
1071               description => $ref->{description},
1072               selected    => "selected",
1073               id          => $ref->{id} };
1074         } else {
1075           push @{ $form->{"${module}_links"}{$key} },
1076             { accno       => $ref->{accno},
1077               description => $ref->{description},
1078               selected    => "",
1079               id          => $ref->{id} };
1080         }
1081       }
1082     }
1083   }
1084   $sth->finish;
1085
1086
1087   $dbh->disconnect;
1088
1089   $main::lxdebug->leave_sub();
1090 }
1091
1092 sub save_buchungsgruppe {
1093   $main::lxdebug->enter_sub();
1094
1095   my ($self, $myconfig, $form) = @_;
1096
1097   # connect to database
1098   my $dbh = $form->dbconnect($myconfig);
1099
1100   my @values = ($form->{description}, $form->{inventory_accno_id},
1101                 $form->{income_accno_id_0}, $form->{expense_accno_id_0},
1102                 $form->{income_accno_id_1}, $form->{expense_accno_id_1},
1103                 $form->{income_accno_id_2}, $form->{expense_accno_id_2},
1104                 $form->{income_accno_id_3}, $form->{expense_accno_id_3});
1105
1106   my $query;
1107
1108   # id is the old record
1109   if ($form->{id}) {
1110     $query = qq|UPDATE buchungsgruppen SET
1111                 description = ?, inventory_accno_id = ?,
1112                 income_accno_id_0 = ?, expense_accno_id_0 = ?,
1113                 income_accno_id_1 = ?, expense_accno_id_1 = ?,
1114                 income_accno_id_2 = ?, expense_accno_id_2 = ?,
1115                 income_accno_id_3 = ?, expense_accno_id_3 = ?
1116                 WHERE id = ?|;
1117     push(@values, $form->{id});
1118   } else {
1119     $query = qq|SELECT COALESCE(MAX(sortkey) + 1, 1) FROM buchungsgruppen|;
1120     my ($sortkey) = $dbh->selectrow_array($query);
1121     $form->dberror($query) if ($dbh->err);
1122     push(@values, $sortkey);
1123     $query = qq|INSERT INTO buchungsgruppen
1124                 (description, inventory_accno_id,
1125                 income_accno_id_0, expense_accno_id_0,
1126                 income_accno_id_1, expense_accno_id_1,
1127                 income_accno_id_2, expense_accno_id_2,
1128                 income_accno_id_3, expense_accno_id_3,
1129                 sortkey)
1130                 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
1131   }
1132   do_query($form, $dbh, $query, @values);
1133
1134   $dbh->disconnect;
1135
1136   $main::lxdebug->leave_sub();
1137 }
1138
1139 sub delete_buchungsgruppe {
1140   $main::lxdebug->enter_sub();
1141
1142   my ($self, $myconfig, $form) = @_;
1143
1144   # connect to database
1145   my $dbh = $form->dbconnect($myconfig);
1146
1147   $query = qq|DELETE FROM buchungsgruppen WHERE id = ?|;
1148   do_query($form, $dbh, $query, $form->{id});
1149
1150   $dbh->disconnect;
1151
1152   $main::lxdebug->leave_sub();
1153 }
1154
1155 sub swap_sortkeys {
1156   $main::lxdebug->enter_sub();
1157
1158   my ($self, $myconfig, $form, $table) = @_;
1159
1160   # connect to database
1161   my $dbh = $form->dbconnect_noauto($myconfig);
1162
1163   my $query =
1164     qq|SELECT
1165        (SELECT sortkey FROM $table WHERE id = ?) AS sortkey1,
1166        (SELECT sortkey FROM $table WHERE id = ?) AS sortkey2|;
1167   my @values = ($form->{"id1"}, $form->{"id2"});
1168   my @sortkeys = selectrow_query($form, $dbh, $query, @values);
1169   $main::lxdebug->dump(0, "v", \@values);
1170   $main::lxdebug->dump(0, "s", \@sortkeys);
1171
1172   $query = qq|UPDATE $table SET sortkey = ? WHERE id = ?|;
1173   my $sth = $dbh->prepare($query);
1174   $sth->execute($sortkeys[1], $form->{"id1"}) ||
1175     $form->dberror($query . " ($sortkeys[1], $form->{id1})");
1176   $sth->execute($sortkeys[0], $form->{"id2"}) ||
1177     $form->dberror($query . " ($sortkeys[0], $form->{id2})");
1178   $sth->finish();
1179
1180   $dbh->commit();
1181   $dbh->disconnect;
1182
1183   $main::lxdebug->leave_sub();
1184 }
1185
1186 sub printer {
1187   $main::lxdebug->enter_sub();
1188
1189   my ($self, $myconfig, $form) = @_;
1190
1191   # connect to database
1192   my $dbh = $form->dbconnect($myconfig);
1193
1194   my $query = qq|SELECT id, printer_description, template_code, printer_command
1195                  FROM printers
1196                  ORDER BY 2|;
1197
1198   $sth = $dbh->prepare($query);
1199   $sth->execute || $form->dberror($query);
1200
1201   $form->{"ALL"} = [];
1202   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1203     push @{ $form->{ALL} }, $ref;
1204   }
1205
1206   $sth->finish;
1207   $dbh->disconnect;
1208
1209   $main::lxdebug->leave_sub();
1210 }
1211
1212 sub get_printer {
1213   $main::lxdebug->enter_sub();
1214
1215   my ($self, $myconfig, $form) = @_;
1216
1217   # connect to database
1218   my $dbh = $form->dbconnect($myconfig);
1219
1220   my $query =
1221     qq|SELECT p.printer_description, p.template_code, p.printer_command
1222                  FROM printers p
1223                  WHERE p.id = $form->{id}|;
1224   my $sth = $dbh->prepare($query);
1225   $sth->execute || $form->dberror($query);
1226
1227   my $ref = $sth->fetchrow_hashref(NAME_lc);
1228
1229   map { $form->{$_} = $ref->{$_} } keys %$ref;
1230
1231   $sth->finish;
1232
1233   $dbh->disconnect;
1234
1235   $main::lxdebug->leave_sub();
1236 }
1237
1238 sub save_printer {
1239   $main::lxdebug->enter_sub();
1240
1241   my ($self, $myconfig, $form) = @_;
1242
1243   # connect to database
1244   my $dbh = $form->dbconnect($myconfig);
1245
1246   $form->{printer_description} =~ s/\'/\'\'/g;
1247   $form->{printer_command} =~ s/\'/\'\'/g;
1248   $form->{template_code} =~ s/\'/\'\'/g;
1249
1250
1251   # id is the old record
1252   if ($form->{id}) {
1253     $query = qq|UPDATE printers SET
1254                 printer_description = '$form->{printer_description}',
1255                 template_code = '$form->{template_code}',
1256                 printer_command = '$form->{printer_command}'
1257                 WHERE id = $form->{id}|;
1258   } else {
1259     $query = qq|INSERT INTO printers
1260                 (printer_description, template_code, printer_command)
1261                 VALUES ('$form->{printer_description}', '$form->{template_code}', '$form->{printer_command}')|;
1262   }
1263   $dbh->do($query) || $form->dberror($query);
1264
1265   $dbh->disconnect;
1266
1267   $main::lxdebug->leave_sub();
1268 }
1269
1270 sub delete_printer {
1271   $main::lxdebug->enter_sub();
1272
1273   my ($self, $myconfig, $form) = @_;
1274
1275   # connect to database
1276   my $dbh = $form->dbconnect($myconfig);
1277
1278   $query = qq|DELETE FROM printers
1279               WHERE id = $form->{id}|;
1280   $dbh->do($query) || $form->dberror($query);
1281
1282   $dbh->disconnect;
1283
1284   $main::lxdebug->leave_sub();
1285 }
1286
1287 sub payment {
1288   $main::lxdebug->enter_sub();
1289
1290   my ($self, $myconfig, $form) = @_;
1291
1292   # connect to database
1293   my $dbh = $form->dbconnect($myconfig);
1294
1295   my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
1296
1297   $sth = $dbh->prepare($query);
1298   $sth->execute || $form->dberror($query);
1299
1300   $form->{ALL} = [];
1301   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1302     push @{ $form->{ALL} }, $ref;
1303   }
1304
1305   $sth->finish;
1306   $dbh->disconnect;
1307
1308   $main::lxdebug->leave_sub();
1309 }
1310
1311 sub get_payment {
1312   $main::lxdebug->enter_sub();
1313
1314   my ($self, $myconfig, $form) = @_;
1315
1316   # connect to database
1317   my $dbh = $form->dbconnect($myconfig);
1318
1319   my $query = qq|SELECT * FROM payment_terms WHERE id = ?|;
1320   my $sth = $dbh->prepare($query);
1321   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
1322
1323   my $ref = $sth->fetchrow_hashref(NAME_lc);
1324   map { $form->{$_} = $ref->{$_} } keys %$ref;
1325   $sth->finish();
1326
1327   $query =
1328     qq|SELECT t.language_id, t.description_long, l.description AS language | .
1329     qq|FROM translation_payment_terms t | .
1330     qq|LEFT JOIN language l ON t.language_id = l.id | .
1331     qq|WHERE t.payment_terms_id = ? | .
1332     qq|UNION | .
1333     qq|SELECT l.id AS language_id, NULL AS description_long, | .
1334     qq|l.description AS language | .
1335     qq|FROM language l|;
1336   $sth = $dbh->prepare($query);
1337   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
1338
1339   my %mapping;
1340   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1341     $mapping{ $ref->{"language_id"} } = $ref
1342       unless (defined($mapping{ $ref->{"language_id"} }));
1343   }
1344   $sth->finish;
1345
1346   $form->{"TRANSLATION"} = [sort({ $a->{"language"} cmp $b->{"language"} }
1347                                  values(%mapping))];
1348
1349   $dbh->disconnect;
1350
1351   $main::lxdebug->leave_sub();
1352 }
1353
1354 sub save_payment {
1355   $main::lxdebug->enter_sub();
1356
1357   my ($self, $myconfig, $form) = @_;
1358
1359   # connect to database
1360   my $dbh = $form->dbconnect_noauto($myconfig);
1361
1362   my $query;
1363
1364   if (!$form->{id}) {
1365     $query = qq|SELECT nextval('id'), COALESCE(MAX(sortkey) + 1, 1) | .
1366       qq|FROM payment_terms|;
1367     my $sortkey;
1368     ($form->{id}, $sortkey) = selectrow_query($form, $dbh, $query);
1369
1370     $query = qq|INSERT INTO payment_terms (id, sortkey) VALUES (?, ?)|;
1371     do_query($form, $dbh, $query, $form->{id}, $sortkey);
1372
1373   } else {
1374     $query =
1375       qq|DELETE FROM translation_payment_terms | .
1376       qq|WHERE payment_terms_id = ?|;
1377     do_query($form, $dbh, $query, $form->{"id"});
1378   }
1379
1380   $query = qq|UPDATE payment_terms SET
1381               description = ?, description_long = ?,
1382               ranking = ?,
1383               terms_netto = ?, terms_skonto = ?,
1384               percent_skonto = ?
1385               WHERE id = ?|;
1386   my @values = ($form->{description}, $form->{description_long},
1387                 $form->{ranking} * 1,
1388                 $form->{terms_netto} * 1, $form->{terms_skonto} * 1,
1389                 $form->{percent_skonto} * 1,
1390                 $form->{id});
1391   do_query($form, $dbh, $query, @values);
1392
1393   $query = qq|SELECT id FROM language|;
1394   my @language_ids;
1395   my $sth = $dbh->prepare($query);
1396   $sth->execute() || $form->dberror($query);
1397
1398   while (my ($id) = $sth->fetchrow_array()) {
1399     push(@language_ids, $id);
1400   }
1401   $sth->finish();
1402
1403   $query =
1404     qq|INSERT INTO translation_payment_terms | .
1405     qq|(language_id, payment_terms_id, description_long) | .
1406     qq|VALUES (?, ?, ?)|;
1407   $sth = $dbh->prepare($query);
1408
1409   foreach my $language_id (@language_ids) {
1410     do_statement($form, $sth, $query, $language_id, $form->{"id"},
1411                  $form->{"description_long_${language_id}"});
1412   }
1413   $sth->finish();
1414
1415   $dbh->commit();
1416   $dbh->disconnect;
1417
1418   $main::lxdebug->leave_sub();
1419 }
1420
1421 sub delete_payment {
1422   $main::lxdebug->enter_sub();
1423
1424   my ($self, $myconfig, $form) = @_;
1425
1426   # connect to database
1427   my $dbh = $form->dbconnect_noauto($myconfig);
1428
1429   my $query =
1430     qq|DELETE FROM translation_payment_terms WHERE payment_terms_id = ?|;
1431   do_query($form, $dbh, $query, $form->{"id"});
1432
1433   $query = qq|DELETE FROM payment_terms WHERE id = ?|;
1434   do_query($form, $dbh, $query, $form->{"id"});
1435
1436   $dbh->commit();
1437   $dbh->disconnect;
1438
1439   $main::lxdebug->leave_sub();
1440 }
1441
1442 sub sic {
1443   $main::lxdebug->enter_sub();
1444
1445   my ($self, $myconfig, $form) = @_;
1446
1447   # connect to database
1448   my $dbh = $form->dbconnect($myconfig);
1449
1450   my $query = qq|SELECT code, sictype, description
1451                  FROM sic
1452                  ORDER BY code|;
1453
1454   $sth = $dbh->prepare($query);
1455   $sth->execute || $form->dberror($query);
1456
1457   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1458     push @{ $form->{ALL} }, $ref;
1459   }
1460
1461   $sth->finish;
1462   $dbh->disconnect;
1463
1464   $main::lxdebug->leave_sub();
1465 }
1466
1467 sub get_sic {
1468   $main::lxdebug->enter_sub();
1469
1470   my ($self, $myconfig, $form) = @_;
1471
1472   # connect to database
1473   my $dbh = $form->dbconnect($myconfig);
1474
1475   my $query = qq|SELECT s.code, s.sictype, s.description
1476                  FROM sic s
1477                  WHERE s.code = '$form->{code}'|;
1478   my $sth = $dbh->prepare($query);
1479   $sth->execute || $form->dberror($query);
1480
1481   my $ref = $sth->fetchrow_hashref(NAME_lc);
1482
1483   map { $form->{$_} = $ref->{$_} } keys %$ref;
1484
1485   $sth->finish;
1486
1487   $dbh->disconnect;
1488
1489   $main::lxdebug->leave_sub();
1490 }
1491
1492 sub save_sic {
1493   $main::lxdebug->enter_sub();
1494
1495   my ($self, $myconfig, $form) = @_;
1496
1497   # connect to database
1498   my $dbh = $form->dbconnect($myconfig);
1499
1500   $form->{code}        =~ s/\'/\'\'/g;
1501   $form->{description} =~ s/\'/\'\'/g;
1502
1503   # if there is an id
1504   if ($form->{id}) {
1505     $query = qq|UPDATE sic SET
1506                 code = '$form->{code}',
1507                 sictype = '$form->{sictype}',
1508                 description = '$form->{description}'
1509                 WHERE code = '$form->{id}'|;
1510   } else {
1511     $query = qq|INSERT INTO sic
1512                 (code, sictype, description)
1513                 VALUES ('$form->{code}', '$form->{sictype}', '$form->{description}')|;
1514   }
1515   $dbh->do($query) || $form->dberror($query);
1516
1517   $dbh->disconnect;
1518
1519   $main::lxdebug->leave_sub();
1520 }
1521
1522 sub delete_sic {
1523   $main::lxdebug->enter_sub();
1524
1525   my ($self, $myconfig, $form) = @_;
1526
1527   # connect to database
1528   my $dbh = $form->dbconnect($myconfig);
1529
1530   $query = qq|DELETE FROM sic
1531               WHERE code = '$form->{code}'|;
1532   $dbh->do($query) || $form->dberror($query);
1533
1534   $dbh->disconnect;
1535
1536   $main::lxdebug->leave_sub();
1537 }
1538
1539 sub load_template {
1540   $main::lxdebug->enter_sub();
1541
1542   my ($self, $form) = @_;
1543
1544   open(TEMPLATE, "$form->{file}") or $form->error("$form->{file} : $!");
1545
1546   while (<TEMPLATE>) {
1547     $form->{body} .= $_;
1548   }
1549
1550   close(TEMPLATE);
1551
1552   $main::lxdebug->leave_sub();
1553 }
1554
1555 sub save_template {
1556   $main::lxdebug->enter_sub();
1557
1558   my ($self, $form) = @_;
1559
1560   open(TEMPLATE, ">$form->{file}") or $form->error("$form->{file} : $!");
1561
1562   # strip
1563   $form->{body} =~ s/\r\n/\n/g;
1564   print TEMPLATE $form->{body};
1565
1566   close(TEMPLATE);
1567
1568   $main::lxdebug->leave_sub();
1569 }
1570
1571 sub save_preferences {
1572   $main::lxdebug->enter_sub();
1573
1574   my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_;
1575
1576   map { ($form->{$_}) = split(/--/, $form->{$_}) }
1577     qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno);
1578
1579   my @a;
1580   $form->{curr} =~ s/ //g;
1581   map { push(@a, uc pack "A3", $_) if $_ } split(/:/, $form->{curr});
1582   $form->{curr} = join ':', @a;
1583
1584   # connect to database
1585   my $dbh = $form->dbconnect_noauto($myconfig);
1586
1587   # these defaults are database wide
1588   # user specific variables are in myconfig
1589   # save defaults
1590   my $query = qq|UPDATE defaults SET
1591                  inventory_accno_id =
1592                      (SELECT c.id FROM chart c
1593                                 WHERE c.accno = '$form->{inventory_accno}'),
1594                  income_accno_id =
1595                      (SELECT c.id FROM chart c
1596                                 WHERE c.accno = '$form->{income_accno}'),
1597                  expense_accno_id =
1598                      (SELECT c.id FROM chart c
1599                                 WHERE c.accno = '$form->{expense_accno}'),
1600                  fxgain_accno_id =
1601                      (SELECT c.id FROM chart c
1602                                 WHERE c.accno = '$form->{fxgain_accno}'),
1603                  fxloss_accno_id =
1604                      (SELECT c.id FROM chart c
1605                                 WHERE c.accno = '$form->{fxloss_accno}'),
1606                  invnumber = '$form->{invnumber}',
1607                  cnnumber  = '$form->{cnnumber}',
1608                  sonumber = '$form->{sonumber}',
1609                  ponumber = '$form->{ponumber}',
1610                  sqnumber = '$form->{sqnumber}',
1611                  rfqnumber = '$form->{rfqnumber}',
1612                  customernumber = '$form->{customernumber}',
1613                  vendornumber = '$form->{vendornumber}',
1614                  articlenumber = '$form->{articlenumber}',
1615                  servicenumber = '$form->{servicenumber}',
1616                  yearend = '$form->{yearend}',
1617                  curr = '$form->{curr}',
1618                  businessnumber = '$form->{businessnumber}'
1619                 |;
1620   $dbh->do($query) || $form->dberror($query);
1621
1622   # update name
1623   my $name = $form->{name};
1624   $name =~ s/\'/\'\'/g;
1625   $query = qq|UPDATE employee
1626               SET name = '$name'
1627               WHERE login = '$form->{login}'|;
1628   $dbh->do($query) || $form->dberror($query);
1629
1630 #   foreach my $item (split(/ /, $form->{taxaccounts})) {
1631 #     $query = qq|UPDATE tax
1632 #               SET rate = | . ($form->{$item} / 100) . qq|,
1633 #               taxnumber = '$form->{"taxnumber_$item"}'
1634 #               WHERE chart_id = $item|;
1635 #     $dbh->do($query) || $form->dberror($query);
1636 #   }
1637
1638   my $rc = $dbh->commit;
1639   $dbh->disconnect;
1640
1641   # save first currency in myconfig
1642   $form->{currency} = substr($form->{curr}, 0, 3);
1643
1644   my $myconfig = new User "$memberfile", "$form->{login}";
1645
1646   foreach my $item (keys %$form) {
1647     $myconfig->{$item} = $form->{$item};
1648   }
1649
1650   $myconfig->save_member($memberfile, $userspath);
1651
1652   if ($webdav) {
1653     @webdavdirs =
1654       qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
1655     foreach $directory (@webdavdirs) {
1656       $file = "webdav/" . $directory . "/webdav-user";
1657       if ($myconfig->{$directory}) {
1658         open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1659         while (<HTACCESS>) {
1660           ($login, $password) = split(/:/, $_);
1661           if ($login ne $form->{login}) {
1662             $newfile .= $_;
1663           }
1664         }
1665         close(HTACCESS);
1666         open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1667         $newfile .= $myconfig->{login} . ":" . $myconfig->{password} . "\n";
1668         print(HTACCESS $newfile);
1669         close(HTACCESS);
1670       } else {
1671         $form->{$directory} = 0;
1672         open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1673         while (<HTACCESS>) {
1674           ($login, $password) = split(/:/, $_);
1675           if ($login ne $form->{login}) {
1676             $newfile .= $_;
1677           }
1678         }
1679         close(HTACCESS);
1680         open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1681         print(HTACCESS $newfile);
1682         close(HTACCESS);
1683       }
1684     }
1685   }
1686
1687   $main::lxdebug->leave_sub();
1688
1689   return $rc;
1690 }
1691
1692 sub defaultaccounts {
1693   $main::lxdebug->enter_sub();
1694
1695   my ($self, $myconfig, $form) = @_;
1696
1697   # connect to database
1698   my $dbh = $form->dbconnect($myconfig);
1699
1700   # get defaults from defaults table
1701   my $query = qq|SELECT * FROM defaults|;
1702   my $sth   = $dbh->prepare($query);
1703   $sth->execute || $form->dberror($query);
1704
1705   $form->{defaults}             = $sth->fetchrow_hashref(NAME_lc);
1706   $form->{defaults}{IC}         = $form->{defaults}{inventory_accno_id};
1707   $form->{defaults}{IC_income}  = $form->{defaults}{income_accno_id};
1708   $form->{defaults}{IC_expense} = $form->{defaults}{expense_accno_id};
1709   $form->{defaults}{FX_gain}    = $form->{defaults}{fxgain_accno_id};
1710   $form->{defaults}{FX_loss}    = $form->{defaults}{fxloss_accno_id};
1711
1712   $sth->finish;
1713
1714   $query = qq|SELECT c.id, c.accno, c.description, c.link
1715               FROM chart c
1716               WHERE c.link LIKE '%IC%'
1717               ORDER BY c.accno|;
1718   $sth = $dbh->prepare($query);
1719   $sth->execute || $self->dberror($query);
1720
1721   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1722     foreach my $key (split(/:/, $ref->{link})) {
1723       if ($key =~ /IC/) {
1724         $nkey = $key;
1725         if ($key =~ /cogs/) {
1726           $nkey = "IC_expense";
1727         }
1728         if ($key =~ /sale/) {
1729           $nkey = "IC_income";
1730         }
1731         %{ $form->{IC}{$nkey}{ $ref->{accno} } } = (
1732                                              id          => $ref->{id},
1733                                              description => $ref->{description}
1734         );
1735       }
1736     }
1737   }
1738   $sth->finish;
1739
1740   $query = qq|SELECT c.id, c.accno, c.description
1741               FROM chart c
1742               WHERE c.category = 'I'
1743               AND c.charttype = 'A'
1744               ORDER BY c.accno|;
1745   $sth = $dbh->prepare($query);
1746   $sth->execute || $self->dberror($query);
1747
1748   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1749     %{ $form->{IC}{FX_gain}{ $ref->{accno} } } = (
1750                                              id          => $ref->{id},
1751                                              description => $ref->{description}
1752     );
1753   }
1754   $sth->finish;
1755
1756   $query = qq|SELECT c.id, c.accno, c.description
1757               FROM chart c
1758               WHERE c.category = 'E'
1759               AND c.charttype = 'A'
1760               ORDER BY c.accno|;
1761   $sth = $dbh->prepare($query);
1762   $sth->execute || $self->dberror($query);
1763
1764   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1765     %{ $form->{IC}{FX_loss}{ $ref->{accno} } } = (
1766                                              id          => $ref->{id},
1767                                              description => $ref->{description}
1768     );
1769   }
1770   $sth->finish;
1771
1772   # now get the tax rates and numbers
1773   $query = qq|SELECT c.id, c.accno, c.description,
1774               t.rate * 100 AS rate, t.taxnumber
1775               FROM chart c, tax t
1776               WHERE c.id = t.chart_id|;
1777
1778   $sth = $dbh->prepare($query);
1779   $sth->execute || $form->dberror($query);
1780
1781   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1782     $form->{taxrates}{ $ref->{accno} }{id}          = $ref->{id};
1783     $form->{taxrates}{ $ref->{accno} }{description} = $ref->{description};
1784     $form->{taxrates}{ $ref->{accno} }{taxnumber}   = $ref->{taxnumber}
1785       if $ref->{taxnumber};
1786     $form->{taxrates}{ $ref->{accno} }{rate} = $ref->{rate} if $ref->{rate};
1787   }
1788
1789   $sth->finish;
1790   $dbh->disconnect;
1791
1792   $main::lxdebug->leave_sub();
1793 }
1794
1795 sub backup {
1796   $main::lxdebug->enter_sub();
1797
1798   my ($self, $myconfig, $form, $userspath) = @_;
1799
1800   my $mail;
1801   my $err;
1802   my $boundary = time;
1803   my $tmpfile  =
1804     "$userspath/$boundary.$myconfig->{dbname}-$form->{dbversion}.sql";
1805   my $out = $form->{OUT};
1806   $form->{OUT} = ">$tmpfile";
1807
1808   if ($form->{media} eq 'email') {
1809
1810     use SL::Mailer;
1811     $mail = new Mailer;
1812
1813     $mail->{to}      = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1814     $mail->{from}    = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1815     $mail->{subject} =
1816       "Lx-Office Backup / $myconfig->{dbname}-$form->{dbversion}.sql";
1817     @{ $mail->{attachments} } = ($tmpfile);
1818     $mail->{version} = $form->{version};
1819     $mail->{fileid}  = "$boundary.";
1820
1821     $myconfig->{signature} =~ s/\\n/\r\n/g;
1822     $mail->{message} = "--\n$myconfig->{signature}";
1823
1824   }
1825
1826   open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!");
1827
1828   # get sequences, functions and triggers
1829   open(FH, "sql/lx-office.sql") or $form->error("sql/lx-office.sql : $!");
1830
1831   my @sequences = ();
1832   my @functions = ();
1833   my @triggers  = ();
1834   my @indices   = ();
1835   my %tablespecs;
1836
1837   my $query = "";
1838   my @quote_chars;
1839
1840   while (<FH>) {
1841
1842     # Remove DOS and Unix style line endings.
1843     s/[\r\n]//g;
1844
1845     # ignore comments or empty lines
1846     next if /^(--.*|\s+)$/;
1847
1848     for (my $i = 0; $i < length($_); $i++) {
1849       my $char = substr($_, $i, 1);
1850
1851       # Are we inside a string?
1852       if (@quote_chars) {
1853         if ($char eq $quote_chars[-1]) {
1854           pop(@quote_chars);
1855         }
1856         $query .= $char;
1857
1858       } else {
1859         if (($char eq "'") || ($char eq "\"")) {
1860           push(@quote_chars, $char);
1861
1862         } elsif ($char eq ";") {
1863
1864           # Query is complete. Check for triggers and functions.
1865           if ($query =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1866             push(@functions, $query);
1867
1868           } elsif ($query =~ /^create\s+trigger\s+\"?(\w+)\"?/i) {
1869             push(@triggers, $query);
1870
1871           } elsif ($query =~ /^create\s+sequence\s+\"?(\w+)\"?/i) {
1872             push(@sequences, $1);
1873
1874           } elsif ($query =~ /^create\s+table\s+\"?(\w+)\"?/i) {
1875             $tablespecs{$1} = $query;
1876
1877           } elsif ($query =~ /^create\s+index\s+\"?(\w+)\"?/i) {
1878             push(@indices, $query);
1879
1880           }
1881
1882           $query = "";
1883           $char  = "";
1884         }
1885
1886         $query .= $char;
1887       }
1888     }
1889   }
1890   close(FH);
1891
1892   # connect to database
1893   my $dbh = $form->dbconnect($myconfig);
1894
1895   # get all the tables
1896   my @tables = $dbh->tables('', '', 'customer', '', { noprefix => 0 });
1897
1898   my $today = scalar localtime;
1899
1900   $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost};
1901
1902   print OUT qq|-- Lx-Office Backup
1903 -- Dataset: $myconfig->{dbname}
1904 -- Version: $form->{dbversion}
1905 -- Host: $myconfig->{dbhost}
1906 -- Login: $form->{login}
1907 -- User: $myconfig->{name}
1908 -- Date: $today
1909 --
1910 -- set options
1911 $myconfig->{dboptions};
1912 --
1913 |;
1914
1915   print OUT "-- DROP Sequences\n";
1916   my $item;
1917   foreach $item (@sequences) {
1918     print OUT qq|DROP SEQUENCE $item;\n|;
1919   }
1920
1921   print OUT "-- DROP Triggers\n";
1922
1923   foreach $item (@triggers) {
1924     if ($item =~ /^create\s+trigger\s+\"?(\w+)\"?\s+.*on\s+\"?(\w+)\"?\s+/i) {
1925       print OUT qq|DROP TRIGGER "$1" ON "$2";\n|;
1926     }
1927   }
1928
1929   print OUT "-- DROP Functions\n";
1930
1931   foreach $item (@functions) {
1932     if ($item =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1933       print OUT qq|DROP FUNCTION "$1" ();\n|;
1934     }
1935   }
1936
1937   foreach $table (@tables) {
1938     if (!($table =~ /^sql_.*/)) {
1939       my $query = qq|SELECT * FROM $table|;
1940
1941       my $sth = $dbh->prepare($query);
1942       $sth->execute || $form->dberror($query);
1943
1944       $query = "INSERT INTO $table (";
1945       map { $query .= qq|$sth->{NAME}->[$_],| }
1946         (0 .. $sth->{NUM_OF_FIELDS} - 1);
1947       chop $query;
1948
1949       $query .= ") VALUES";
1950
1951       if ($tablespecs{$table}) {
1952         print(OUT "--\n");
1953         print(OUT "DROP TABLE $table;\n");
1954         print(OUT $tablespecs{$table}, ";\n");
1955       } else {
1956         print(OUT "--\n");
1957         print(OUT "DELETE FROM $table;\n");
1958       }
1959       while (my @arr = $sth->fetchrow_array) {
1960
1961         $fields = "(";
1962         foreach my $item (@arr) {
1963           if (defined $item) {
1964             $item =~ s/\'/\'\'/g;
1965             $fields .= qq|'$item',|;
1966           } else {
1967             $fields .= 'NULL,';
1968           }
1969         }
1970
1971         chop $fields;
1972         $fields .= ")";
1973
1974         print OUT qq|$query $fields;\n|;
1975       }
1976
1977       $sth->finish;
1978     }
1979   }
1980
1981   # create indices, sequences, functions and triggers
1982
1983   print(OUT "-- CREATE Indices\n");
1984   map({ print(OUT "$_;\n"); } @indices);
1985
1986   print OUT "-- CREATE Sequences\n";
1987   foreach $item (@sequences) {
1988     $query = qq|SELECT last_value FROM $item|;
1989     $sth   = $dbh->prepare($query);
1990     $sth->execute || $form->dberror($query);
1991     my ($id) = $sth->fetchrow_array;
1992     $sth->finish;
1993
1994     print OUT qq|--
1995 CREATE SEQUENCE $item START $id;
1996 |;
1997   }
1998
1999   print OUT "-- CREATE Functions\n";
2000
2001   # functions
2002   map { print(OUT $_, ";\n"); } @functions;
2003
2004   print OUT "-- CREATE Triggers\n";
2005
2006   # triggers
2007   map { print(OUT $_, ";\n"); } @triggers;
2008
2009   close(OUT);
2010
2011   $dbh->disconnect;
2012
2013   # compress backup
2014   my @args = ("gzip", "$tmpfile");
2015   system(@args) == 0 or $form->error("$args[0] : $?");
2016
2017   $tmpfile .= ".gz";
2018
2019   if ($form->{media} eq 'email') {
2020     @{ $mail->{attachments} } = ($tmpfile);
2021     $err = $mail->send($out);
2022   }
2023
2024   if ($form->{media} eq 'file') {
2025
2026     open(IN,  "$tmpfile") or $form->error("$tmpfile : $!");
2027     open(OUT, ">-")       or $form->error("STDOUT : $!");
2028
2029     print OUT qq|Content-Type: application/x-tar-gzip;
2030 Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}.sql.gz"
2031
2032 |;
2033
2034     while (<IN>) {
2035       print OUT $_;
2036     }
2037
2038     close(IN);
2039     close(OUT);
2040
2041   }
2042
2043   unlink "$tmpfile";
2044
2045   $main::lxdebug->leave_sub();
2046 }
2047
2048 sub closedto {
2049   $main::lxdebug->enter_sub();
2050
2051   my ($self, $myconfig, $form) = @_;
2052
2053   my $dbh = $form->dbconnect($myconfig);
2054
2055   my $query = qq|SELECT closedto, revtrans FROM defaults|;
2056   my $sth   = $dbh->prepare($query);
2057   $sth->execute || $form->dberror($query);
2058
2059   ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
2060
2061   $sth->finish;
2062
2063   $dbh->disconnect;
2064
2065   $main::lxdebug->leave_sub();
2066 }
2067
2068 sub closebooks {
2069   $main::lxdebug->enter_sub();
2070
2071   my ($self, $myconfig, $form) = @_;
2072
2073   my $dbh = $form->dbconnect($myconfig);
2074
2075   if ($form->{revtrans}) {
2076
2077     $query = qq|UPDATE defaults SET closedto = NULL,
2078                                     revtrans = '1'|;
2079   } elsif ($form->{closedto}) {
2080
2081     $query = qq|UPDATE defaults SET closedto = '$form->{closedto}',
2082                                       revtrans = '0'|;
2083   } else {
2084
2085     $query = qq|UPDATE defaults SET closedto = NULL,
2086                                       revtrans = '0'|;
2087   }
2088
2089   # set close in defaults
2090   $dbh->do($query) || $form->dberror($query);
2091
2092   $dbh->disconnect;
2093
2094   $main::lxdebug->leave_sub();
2095 }
2096
2097 sub get_base_unit {
2098   my ($self, $units, $unit_name, $factor) = @_;
2099
2100   $factor = 1 unless ($factor);
2101
2102   my $unit = $units->{$unit_name};
2103
2104   if (!defined($unit) || !$unit->{"base_unit"} ||
2105       ($unit_name eq $unit->{"base_unit"})) {
2106     return ($unit_name, $factor);
2107   }
2108
2109   return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"});
2110 }
2111
2112 sub retrieve_units {
2113   $main::lxdebug->enter_sub();
2114
2115   my ($self, $myconfig, $form, $type, $prefix) = @_;
2116
2117   my $dbh = $form->dbconnect($myconfig);
2118
2119   my $query = "SELECT *, base_unit AS original_base_unit FROM units";
2120   my @values;
2121   if ($type) {
2122     $query .= " WHERE (type = ?)";
2123     @values = ($type);
2124   }
2125
2126   my $sth = $dbh->prepare($query);
2127   $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
2128
2129   my $units = {};
2130   while (my $ref = $sth->fetchrow_hashref()) {
2131     $units->{$ref->{"name"}} = $ref;
2132   }
2133   $sth->finish();
2134
2135   my $query_lang = "SELECT id, template_code FROM language ORDER BY description";
2136   $sth = $dbh->prepare($query_lang);
2137   $sth->execute() || $form->dberror($query_lang);
2138   my @languages;
2139   while ($ref = $sth->fetchrow_hashref()) {
2140     push(@languages, $ref);
2141   }
2142   $sth->finish();
2143
2144   $query_lang = "SELECT ul.localized, ul.localized_plural, l.id, l.template_code " .
2145     "FROM units_language ul " .
2146     "LEFT JOIN language l ON ul.language_id = l.id " .
2147     "WHERE ul.unit = ?";
2148   $sth = $dbh->prepare($query_lang);
2149
2150   foreach my $unit (values(%{$units})) {
2151     ($unit->{"${prefix}base_unit"}, $unit->{"${prefix}factor"}) = AM->get_base_unit($units, $unit->{"name"});
2152
2153     $unit->{"LANGUAGES"} = {};
2154     foreach my $lang (@languages) {
2155       $unit->{"LANGUAGES"}->{$lang->{"template_code"}} = { "template_code" => $lang->{"template_code"} };
2156     }
2157
2158     $sth->execute($unit->{"name"}) || $form->dberror($query_lang . " (" . $unit->{"name"} . ")");
2159     while ($ref = $sth->fetchrow_hashref()) {
2160       map({ $unit->{"LANGUAGES"}->{$ref->{"template_code"}}->{$_} = $ref->{$_} } keys(%{$ref}));
2161     }
2162   }
2163   $sth->finish();
2164
2165   $dbh->disconnect();
2166
2167   $main::lxdebug->leave_sub();
2168
2169   return $units;
2170 }
2171
2172 sub translate_units {
2173   $main::lxdebug->enter_sub();
2174
2175   my ($self, $form, $template_code, $unit, $amount) = @_;
2176
2177   my $units = $self->retrieve_units(\%main::myconfig, $form);
2178
2179   my $h = $units->{$unit}->{"LANGUAGES"}->{$template_code};
2180   my $new_unit = $unit;
2181   if ($h) {
2182     if (($amount != 1) && $h->{"localized_plural"}) {
2183       $new_unit = $h->{"localized_plural"};
2184     } elsif ($h->{"localized"}) {
2185       $new_unit = $h->{"localized"};
2186     }
2187   }
2188
2189   $main::lxdebug->leave_sub();
2190
2191   return $new_unit;
2192 }
2193
2194 sub units_in_use {
2195   $main::lxdebug->enter_sub();
2196
2197   my ($self, $myconfig, $form, $units) = @_;
2198
2199   my $dbh = $form->dbconnect($myconfig);
2200
2201   foreach my $unit (values(%{$units})) {
2202     my $base_unit = $unit->{"original_base_unit"};
2203     while ($base_unit) {
2204       $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"});
2205       push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"});
2206       $base_unit = $units->{$base_unit}->{"original_base_unit"};
2207     }
2208   }
2209
2210   foreach my $unit (values(%{$units})) {
2211     $unit->{"in_use"} = 0;
2212     map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}});
2213
2214     foreach my $table (qw(parts invoice orderitems)) {
2215       my $query = "SELECT COUNT(*) FROM $table WHERE unit ";
2216
2217       if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) {
2218         $query .= "= " . $dbh->quote($unit->{"name"});
2219       } else {
2220         $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," . join(",", @{$unit->{"DEPENDING_UNITS"}}) . ")";
2221       }
2222
2223       my ($count) = $dbh->selectrow_array($query);
2224       $form->dberror($query) if ($dbh->err);
2225
2226       if ($count) {
2227         $unit->{"in_use"} = 1;
2228         last;
2229       }
2230     }
2231   }
2232
2233   $dbh->disconnect();
2234
2235   $main::lxdebug->leave_sub();
2236 }
2237
2238 sub unit_select_data {
2239   $main::lxdebug->enter_sub();
2240
2241   my ($self, $units, $selected, $empty_entry) = @_;
2242
2243   my $select = [];
2244
2245   if ($empty_entry) {
2246     push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" });
2247   }
2248
2249   foreach my $unit (sort({ $a->{"sortkey"} <=> $b->{"sortkey"} } keys(%{$units}))) {
2250     push(@{$select}, { "name" => $unit,
2251                        "base_unit" => $units->{$unit}->{"base_unit"},
2252                        "factor" => $units->{$unit}->{"factor"},
2253                        "selected" => ($unit eq $selected) ? "selected" : "" });
2254   }
2255
2256   $main::lxdebug->leave_sub();
2257
2258   return $select;
2259 }
2260
2261 sub unit_select_html {
2262   $main::lxdebug->enter_sub();
2263
2264   my ($self, $units, $name, $selected, $convertible_into) = @_;
2265
2266   my $select = "<select name=${name}>";
2267
2268   foreach my $unit (sort({ $a->{"sortkey"} <=> $b->{"sortkey"} } keys(%{$units}))) {
2269     if (!$convertible_into ||
2270         ($units->{$convertible_into} &&
2271          ($units->{$convertible_into}->{"base_unit"} eq $units->{$unit}->{"base_unit"}))) {
2272       $select .= "<option" . (($unit eq $selected) ? " selected" : "") . ">${unit}</option>";
2273     }
2274   }
2275   $select .= "</select>";
2276
2277   $main::lxdebug->leave_sub();
2278
2279   return $select;
2280 }
2281
2282 sub add_unit {
2283   $main::lxdebug->enter_sub();
2284
2285   my ($self, $myconfig, $form, $name, $base_unit, $factor, $type, $languages) = @_;
2286
2287   my $dbh = $form->dbconnect_noauto($myconfig);
2288
2289   my $query = qq|SELECT COALESCE(MAX(sortkey), 0) + 1 FROM units|;
2290   my ($sortkey) = selectrow_query($form, $dbh, $query);
2291
2292   $query = "INSERT INTO units (name, base_unit, factor, type, sortkey) " .
2293     "VALUES (?, ?, ?, ?, ?)";
2294   do_query($form, $dbh, $query, $name, $base_unit, $factor, $type, $sortkey);
2295
2296   if ($languages) {
2297     $query = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
2298     my $sth = $dbh->prepare($query);
2299     foreach my $lang (@{$languages}) {
2300       my @values = ($name, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
2301       $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
2302     }
2303     $sth->finish();
2304   }
2305
2306   $dbh->commit();
2307   $dbh->disconnect();
2308
2309   $main::lxdebug->leave_sub();
2310 }
2311
2312 sub save_units {
2313   $main::lxdebug->enter_sub();
2314
2315   my ($self, $myconfig, $form, $type, $units, $delete_units) = @_;
2316
2317   my $dbh = $form->dbconnect_noauto($myconfig);
2318
2319   my ($base_unit, $unit, $sth, $query);
2320
2321   $query = "DELETE FROM units_language";
2322   $dbh->do($query) || $form->dberror($query);
2323
2324   if ($delete_units && (0 != scalar(@{$delete_units}))) {
2325     $query = "DELETE FROM units WHERE name IN (";
2326     map({ $query .= "?," } @{$delete_units});
2327     substr($query, -1, 1) = ")";
2328     $dbh->do($query, undef, @{$delete_units}) ||
2329       $form->dberror($query . " (" . join(", ", @{$delete_units}) . ")");
2330   }
2331
2332   $query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?";
2333   $sth = $dbh->prepare($query);
2334
2335   my $query_lang = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
2336   my $sth_lang = $dbh->prepare($query_lang);
2337
2338   foreach $unit (values(%{$units})) {
2339     $unit->{"depth"} = 0;
2340     my $base_unit = $unit;
2341     while ($base_unit->{"base_unit"}) {
2342       $unit->{"depth"}++;
2343       $base_unit = $units->{$base_unit->{"base_unit"}};
2344     }
2345   }
2346
2347   foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) {
2348     if ($unit->{"LANGUAGES"}) {
2349       foreach my $lang (@{$unit->{"LANGUAGES"}}) {
2350         next unless ($lang->{"id"} && $lang->{"localized"});
2351         my @values = ($unit->{"name"}, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
2352         $sth_lang->execute(@values) || $form->dberror($query_lang . " (" . join(", ", @values) . ")");
2353       }
2354     }
2355
2356     next if ($unit->{"unchanged_unit"});
2357
2358     my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"});
2359     $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
2360   }
2361
2362   $sth->finish();
2363   $sth_lang->finish();
2364   $dbh->commit();
2365   $dbh->disconnect();
2366
2367   $main::lxdebug->leave_sub();
2368 }
2369
2370 sub swap_units {
2371   $main::lxdebug->enter_sub();
2372
2373   my ($self, $myconfig, $form, $dir, $name_1, $unit_type) = @_;
2374
2375   my $dbh = $form->dbconnect_noauto($myconfig);
2376
2377   my $query;
2378
2379   $query = qq|SELECT sortkey FROM units WHERE name = ?|;
2380   my ($sortkey_1) = selectrow_query($form, $dbh, $query, $name_1);
2381
2382   $query =
2383     qq|SELECT sortkey FROM units | .
2384     qq|WHERE sortkey | . ($dir eq "down" ? ">" : "<") . qq| ? AND type = ? | .
2385     qq|ORDER BY sortkey | . ($dir eq "down" ? "ASC" : "DESC") . qq| LIMIT 1|;
2386   my ($sortkey_2) = selectrow_query($form, $dbh, $query, $sortkey_1, $unit_type);
2387
2388   if (defined($sortkey_1)) {
2389     $query = qq|SELECT name FROM units WHERE sortkey = ${sortkey_2}|;
2390     my ($name_2) = selectrow_query($form, $dbh, $query);
2391
2392     if (defined($name_2)) {
2393       $query = qq|UPDATE units SET sortkey = ? WHERE name = ?|;
2394       my $sth = $dbh->prepare($query);
2395
2396       do_statement($form, $sth, $query, $sortkey_1, $name_2);
2397       do_statement($form, $sth, $query, $sortkey_2, $name_1);
2398     }
2399   }
2400
2401   $dbh->commit();
2402   $dbh->disconnect();
2403
2404   $main::lxdebug->leave_sub();
2405 }
2406
2407 1;