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 departments {
 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 d.id, d.description, d.role
 312                  FROM department d
 313                  ORDER BY 2|;
 314
 315   $sth = $dbh->prepare($query);
 316   $sth->execute || $form->dberror($query);
 317
 318   $form->{ALL} = [];
 319   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 320     push @{ $form->{ALL} }, $ref;
 321   }
 322
 323   $sth->finish;
 324   $dbh->disconnect;
 325
 326   $main::lxdebug->leave_sub();
 327 }
 328
 329 sub get_department {
 330   $main::lxdebug->enter_sub();
 331
 332   my ($self, $myconfig, $form) = @_;
 333
 334   # connect to database
 335   my $dbh = $form->dbconnect($myconfig);
 336
 337   my $query = qq|SELECT d.description, d.role
 338                  FROM department d
 339                  WHERE d.id = ?|;
 340   my $sth = $dbh->prepare($query);
 341   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 342
 343   my $ref = $sth->fetchrow_hashref(NAME_lc);
 344
 345   map { $form->{$_} = $ref->{$_} } keys %$ref;
 346
 347   $sth->finish;
 348
 349   # see if it is in use
 350   $query = qq|SELECT count(*) FROM dpt_trans d
 351               WHERE d.department_id = ?|;
 352   ($form->{orphaned}) = selectrow_query($form, $dbh, $query, $form->{id});
 353
 354   $form->{orphaned} = !$form->{orphaned};
 355   $sth->finish;
 356
 357   $dbh->disconnect;
 358
 359   $main::lxdebug->leave_sub();
 360 }
 361
 362 sub save_department {
 363   $main::lxdebug->enter_sub();
 364
 365   my ($self, $myconfig, $form) = @_;
 366
 367   # connect to database
 368   my $dbh = $form->dbconnect($myconfig);
 369
 370   my @values = ($form->{description}, $form->{role});
 371   if ($form->{id}) {
 372     $query = qq|UPDATE department SET
 373                 description = ?, role = ?
 374                 WHERE id = ?|;
 375     push(@values, $form->{id});
 376   } else {
 377     $query = qq|INSERT INTO department
 378                 (description, role)
 379                 VALUES (?, ?)|;
 380   }
 381   do_query($form, $dbh, $query, @values);
 382
 383   $dbh->disconnect;
 384
 385   $main::lxdebug->leave_sub();
 386 }
 387
 388 sub delete_department {
 389   $main::lxdebug->enter_sub();
 390
 391   my ($self, $myconfig, $form) = @_;
 392
 393   # connect to database
 394   my $dbh = $form->dbconnect($myconfig);
 395
 396   $query = qq|DELETE FROM department
 397               WHERE id = ?|;
 398   do_query($form, $dbh, $query, $form->{id});
 399
 400   $dbh->disconnect;
 401
 402   $main::lxdebug->leave_sub();
 403 }
 404
 405 sub lead {
 406   $main::lxdebug->enter_sub();
 407
 408   my ($self, $myconfig, $form) = @_;
 409
 410   # connect to database
 411   my $dbh = $form->dbconnect($myconfig);
 412
 413   my $query = qq|SELECT id, lead
 414                  FROM leads
 415                  ORDER BY 2|;
 416
 417   $sth = $dbh->prepare($query);
 418   $sth->execute || $form->dberror($query);
 419
 420   $form->{ALL};
 421   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 422     push @{ $form->{ALL} }, $ref;
 423   }
 424
 425   $sth->finish;
 426   $dbh->disconnect;
 427
 428   $main::lxdebug->leave_sub();
 429 }
 430
 431 sub get_lead {
 432   $main::lxdebug->enter_sub();
 433
 434   my ($self, $myconfig, $form) = @_;
 435
 436   # connect to database
 437   my $dbh = $form->dbconnect($myconfig);
 438
 439   my $query =
 440     qq|SELECT l.id, l.lead | .
 441     qq|FROM leads l | .
 442     qq|WHERE l.id = ?|;
 443   my $sth = $dbh->prepare($query);
 444   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 445
 446   my $ref = $sth->fetchrow_hashref(NAME_lc);
 447
 448   map { $form->{$_} = $ref->{$_} } keys %$ref;
 449
 450   $sth->finish;
 451
 452   $dbh->disconnect;
 453
 454   $main::lxdebug->leave_sub();
 455 }
 456
 457 sub save_lead {
 458   $main::lxdebug->enter_sub();
 459
 460   my ($self, $myconfig, $form) = @_;
 461
 462   # connect to database
 463   my $dbh = $form->dbconnect($myconfig);
 464
 465   my @values = ($form->{description});
 466   # id is the old record
 467   if ($form->{id}) {
 468     $query = qq|UPDATE leads SET
 469                 lead = ?
 470                 WHERE id = ?|;
 471     puhs(@values, $form->{id});
 472   } else {
 473     $query = qq|INSERT INTO leads
 474                 (lead)
 475                 VALUES (?)|;
 476   }
 477   do_query($form, $dbh, $query, @values);
 478
 479   $dbh->disconnect;
 480
 481   $main::lxdebug->leave_sub();
 482 }
 483
 484 sub delete_lead {
 485   $main::lxdebug->enter_sub();
 486
 487   my ($self, $myconfig, $form) = @_;
 488
 489   # connect to database
 490   my $dbh = $form->dbconnect($myconfig);
 491
 492   $query = qq|DELETE FROM leads
 493               WHERE id = ?|;
 494   do_query($form, $dbh, $query, $form->{id});
 495
 496   $dbh->disconnect;
 497
 498   $main::lxdebug->leave_sub();
 499 }
 500
 501 sub business {
 502   $main::lxdebug->enter_sub();
 503
 504   my ($self, $myconfig, $form) = @_;
 505
 506   # connect to database
 507   my $dbh = $form->dbconnect($myconfig);
 508
 509   my $query = qq|SELECT id, description, discount, customernumberinit, salesman
 510                  FROM business
 511                  ORDER BY 2|;
 512
 513   $sth = $dbh->prepare($query);
 514   $sth->execute || $form->dberror($query);
 515
 516   $form->{ALL};
 517   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 518     push @{ $form->{ALL} }, $ref;
 519   }
 520
 521   $sth->finish;
 522   $dbh->disconnect;
 523
 524   $main::lxdebug->leave_sub();
 525 }
 526
 527 sub get_business {
 528   $main::lxdebug->enter_sub();
 529
 530   my ($self, $myconfig, $form) = @_;
 531
 532   # connect to database
 533   my $dbh = $form->dbconnect($myconfig);
 534
 535   my $query =
 536     qq|SELECT b.description, b.discount, b.customernumberinit, b.salesman
 537        FROM business b
 538        WHERE b.id = ?|;
 539   my $sth = $dbh->prepare($query);
 540   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 541
 542   my $ref = $sth->fetchrow_hashref(NAME_lc);
 543
 544   map { $form->{$_} = $ref->{$_} } keys %$ref;
 545
 546   $sth->finish;
 547
 548   $dbh->disconnect;
 549
 550   $main::lxdebug->leave_sub();
 551 }
 552
 553 sub save_business {
 554   $main::lxdebug->enter_sub();
 555
 556   my ($self, $myconfig, $form) = @_;
 557
 558   # connect to database
 559   my $dbh = $form->dbconnect($myconfig);
 560
 561   my @values = ($form->{description}, $form->{discount},
 562                 $form->{customernumberinit}, $form->{salesman} ? 't' : 'f');
 563   # id is the old record
 564   if ($form->{id}) {
 565     $query = qq|UPDATE business SET
 566                 description = ?,
 567                 discount = ?,
 568                 customernumberinit = ?,
 569                 salesman = ?
 570                 WHERE id = ?|;
 571     push(@values, $form->{id});
 572   } else {
 573     $query = qq|INSERT INTO business
 574                 (description, discount, customernumberinit, salesman)
 575                 VALUES (?, ?, ?, ?)|;
 576   }
 577   do_query($form, $dbh, $query, @values);
 578
 579   $dbh->disconnect;
 580
 581   $main::lxdebug->leave_sub();
 582 }
 583
 584 sub delete_business {
 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 business
 593               WHERE id = ?|;
 594   do_query($form, $dbh, $query, $form->{id});
 595
 596   $dbh->disconnect;
 597
 598   $main::lxdebug->leave_sub();
 599 }
 600
 601
 602 sub language {
 603   $main::lxdebug->enter_sub();
 604
 605   my ($self, $myconfig, $form, $return_list) = @_;
 606
 607   # connect to database
 608   my $dbh = $form->dbconnect($myconfig);
 609
 610   my $query =
 611     "SELECT id, description, template_code, article_code, " .
 612     "  output_numberformat, output_dateformat, output_longdates " .
 613     "FROM language ORDER BY description";
 614
 615   $sth = $dbh->prepare($query);
 616   $sth->execute || $form->dberror($query);
 617
 618   my $ary = [];
 619
 620   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 621     push(@{ $ary }, $ref);
 622   }
 623
 624   $sth->finish;
 625   $dbh->disconnect;
 626
 627   $main::lxdebug->leave_sub();
 628
 629   if ($return_list) {
 630     return @{$ary};
 631   } else {
 632     $form->{ALL} = $ary;
 633   }
 634 }
 635
 636 sub get_language {
 637   $main::lxdebug->enter_sub();
 638
 639   my ($self, $myconfig, $form) = @_;
 640
 641   # connect to database
 642   my $dbh = $form->dbconnect($myconfig);
 643
 644   my $query =
 645     "SELECT description, template_code, article_code, " .
 646     "  output_numberformat, output_dateformat, output_longdates " .
 647     "FROM language WHERE id = ?";
 648   my $sth = $dbh->prepare($query);
 649   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
 650
 651   my $ref = $sth->fetchrow_hashref(NAME_lc);
 652
 653   map { $form->{$_} = $ref->{$_} } keys %$ref;
 654
 655   $sth->finish;
 656
 657   $dbh->disconnect;
 658
 659   $main::lxdebug->leave_sub();
 660 }
 661
 662 sub get_language_details {
 663   $main::lxdebug->enter_sub();
 664
 665   my ($self, $myconfig, $form, $id) = @_;
 666
 667   # connect to database
 668   my $dbh = $form->dbconnect($myconfig);
 669
 670   my $query =
 671     "SELECT template_code, " .
 672     "  output_numberformat, output_dateformat, output_longdates " .
 673     "FROM language WHERE id = ?";
 674   my @res = selectrow_query($form, $dbh, $query, $id);
 675   $dbh->disconnect;
 676
 677   $main::lxdebug->leave_sub();
 678
 679   return @res;
 680 }
 681
 682 sub save_language {
 683   $main::lxdebug->enter_sub();
 684
 685   my ($self, $myconfig, $form) = @_;
 686
 687   # connect to database
 688   my $dbh = $form->dbconnect($myconfig);
 689   my (@values, $query);
 690
 691   map({ push(@values, $form->{$_}); }
 692       qw(description template_code article_code
 693          output_numberformat output_dateformat output_longdates));
 694
 695   # id is the old record
 696   if ($form->{id}) {
 697     $query =
 698       "UPDATE language SET " .
 699       "  description = ?, template_code = ?, article_code = ?, " .
 700       "  output_numberformat = ?, output_dateformat = ?, " .
 701       "  output_longdates = ? " .
 702       "WHERE id = ?";
 703     push(@values, $form->{id});
 704   } else {
 705     $query =
 706       "INSERT INTO language (" .
 707       "  description, template_code, article_code, " .
 708       "  output_numberformat, output_dateformat, output_longdates" .
 709       ") VALUES (?, ?, ?, ?, ?, ?)";
 710   }
 711   do_query($form, $dbh, $query, @values);
 712
 713   $dbh->disconnect;
 714
 715   $main::lxdebug->leave_sub();
 716 }
 717
 718 sub delete_language {
 719   $main::lxdebug->enter_sub();
 720
 721   my ($self, $myconfig, $form) = @_;
 722
 723   # connect to database
 724   my $dbh = $form->dbconnect_noauto($myconfig);
 725
 726   foreach my $table (qw(translation_payment_terms units_language)) {
 727     my $query = qq|DELETE FROM $table WHERE language_id = ?|;
 728     do_query($form, $dbh, $query, $form->{"id"});
 729   }
 730
 731   $query = "DELETE FROM language WHERE id = ?";
 732   do_query($form, $dbh, $query, $form->{"id"});
 733
 734   $dbh->commit();
 735   $dbh->disconnect;
 736
 737   $main::lxdebug->leave_sub();
 738 }
 739
 740
 741 sub buchungsgruppe {
 742   $main::lxdebug->enter_sub();
 743
 744   my ($self, $myconfig, $form) = @_;
 745
 746   # connect to database
 747   my $dbh = $form->dbconnect($myconfig);
 748
 749   my $query = qq|SELECT id, description,
 750                  inventory_accno_id,
 751                  (SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
 752                  income_accno_id_0,
 753                  (SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
 754                  expense_accno_id_0,
 755                  (SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
 756                  income_accno_id_1,
 757                  (SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
 758                  expense_accno_id_1,
 759                  (SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
 760                  income_accno_id_2,
 761                  (SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
 762                  expense_accno_id_2,
 763                  (select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
 764                  income_accno_id_3,
 765                  (SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
 766                  expense_accno_id_3,
 767                  (SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
 768                  FROM buchungsgruppen
 769                  ORDER BY sortkey|;
 770
 771   $sth = $dbh->prepare($query);
 772   $sth->execute || $form->dberror($query);
 773
 774   $form->{ALL} = [];
 775   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 776     push @{ $form->{ALL} }, $ref;
 777   }
 778
 779   $sth->finish;
 780   $dbh->disconnect;
 781
 782   $main::lxdebug->leave_sub();
 783 }
 784
 785 sub get_buchungsgruppe {
 786   $main::lxdebug->enter_sub();
 787
 788   my ($self, $myconfig, $form) = @_;
 789
 790   # connect to database
 791   my $dbh = $form->dbconnect($myconfig);
 792
 793   if ($form->{id}) {
 794     my $query =
 795       qq|SELECT description, inventory_accno_id,
 796          (SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
 797          income_accno_id_0,
 798          (SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
 799          expense_accno_id_0,
 800          (SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
 801          income_accno_id_1,
 802          (SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
 803          expense_accno_id_1,
 804          (SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
 805          income_accno_id_2,
 806          (SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
 807          expense_accno_id_2,
 808          (select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
 809          income_accno_id_3,
 810          (SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
 811          expense_accno_id_3,
 812          (SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
 813          FROM buchungsgruppen
 814          WHERE id = ?|;
 815     my $sth = $dbh->prepare($query);
 816     $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 817
 818     my $ref = $sth->fetchrow_hashref(NAME_lc);
 819
 820     map { $form->{$_} = $ref->{$_} } keys %$ref;
 821
 822     $sth->finish;
 823
 824     my $query =
 825       qq|SELECT count(id) = 0 AS orphaned
 826          FROM parts
 827          WHERE buchungsgruppen_id = ?|;
 828     ($form->{orphaned}) = selectrow_arra($query, undef, $form->{id});
 829     $form->dberror($query . " ($form->{id})") if ($dbh->err);
 830   }
 831
 832   $query = "SELECT inventory_accno_id, income_accno_id, expense_accno_id ".
 833     "FROM defaults";
 834   ($form->{"std_inventory_accno_id"}, $form->{"std_income_accno_id"},
 835    $form->{"std_expense_accno_id"}) = $dbh->selectrow_array($query);
 836
 837   my $module = "IC";
 838   $query = qq|SELECT c.accno, c.description, c.link, c.id,
 839               d.inventory_accno_id, d.income_accno_id, d.expense_accno_id
 840               FROM chart c, defaults d
 841               WHERE c.link LIKE '%$module%'
 842               ORDER BY c.accno|;
 843
 844
 845   my $sth = $dbh->prepare($query);
 846   $sth->execute || $form->dberror($query);
 847   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 848     foreach my $key (split(/:/, $ref->{link})) {
 849       if (!$form->{"std_inventory_accno_id"} && ($key eq "IC")) {
 850         $form->{"std_inventory_accno_id"} = $ref->{"id"};
 851       }
 852       if ($key =~ /$module/) {
 853         if (   ($ref->{id} eq $ref->{inventory_accno_id})
 854             || ($ref->{id} eq $ref->{income_accno_id})
 855             || ($ref->{id} eq $ref->{expense_accno_id})) {
 856           push @{ $form->{"${module}_links"}{$key} },
 857             { accno       => $ref->{accno},
 858               description => $ref->{description},
 859               selected    => "selected",
 860               id          => $ref->{id} };
 861         } else {
 862           push @{ $form->{"${module}_links"}{$key} },
 863             { accno       => $ref->{accno},
 864               description => $ref->{description},
 865               selected    => "",
 866               id          => $ref->{id} };
 867         }
 868       }
 869     }
 870   }
 871   $sth->finish;
 872
 873
 874   $dbh->disconnect;
 875
 876   $main::lxdebug->leave_sub();
 877 }
 878
 879 sub save_buchungsgruppe {
 880   $main::lxdebug->enter_sub();
 881
 882   my ($self, $myconfig, $form) = @_;
 883
 884   # connect to database
 885   my $dbh = $form->dbconnect($myconfig);
 886
 887   my @values = ($form->{description}, $form->{inventory_accno_id},
 888                 $form->{income_accno_id_0}, $form->{expense_accno_id_0},
 889                 $form->{income_accno_id_1}, $form->{expense_accno_id_1},
 890                 $form->{income_accno_id_2}, $form->{expense_accno_id_2},
 891                 $form->{income_accno_id_3}, $form->{expense_accno_id_3});
 892
 893   my $query;
 894
 895   # id is the old record
 896   if ($form->{id}) {
 897     $query = qq|UPDATE buchungsgruppen SET
 898                 description = ?, inventory_accno_id = ?,
 899                 income_accno_id_0 = ?, expense_accno_id_0 = ?,
 900                 income_accno_id_1 = ?, expense_accno_id_1 = ?,
 901                 income_accno_id_2 = ?, expense_accno_id_2 = ?,
 902                 income_accno_id_3 = ?, expense_accno_id_3 = ?
 903                 WHERE id = ?|;
 904     push(@values, $form->{id});
 905   } else {
 906     $query = qq|SELECT COALESCE(MAX(sortkey) + 1, 1) FROM buchungsgruppen|;
 907     my ($sortkey) = $dbh->selectrow_array($query);
 908     $form->dberror($query) if ($dbh->err);
 909     push(@values, $sortkey);
 910     $query = qq|INSERT INTO buchungsgruppen
 911                 (description, inventory_accno_id,
 912                 income_accno_id_0, expense_accno_id_0,
 913                 income_accno_id_1, expense_accno_id_1,
 914                 income_accno_id_2, expense_accno_id_2,
 915                 income_accno_id_3, expense_accno_id_3,
 916                 sortkey)
 917                 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
 918   }
 919   do_query($form, $dbh, $query, @values);
 920
 921   $dbh->disconnect;
 922
 923   $main::lxdebug->leave_sub();
 924 }
 925
 926 sub delete_buchungsgruppe {
 927   $main::lxdebug->enter_sub();
 928
 929   my ($self, $myconfig, $form) = @_;
 930
 931   # connect to database
 932   my $dbh = $form->dbconnect($myconfig);
 933
 934   $query = qq|DELETE FROM buchungsgruppen WHERE id = ?|;
 935   do_query($form, $dbh, $query, $form->{id});
 936
 937   $dbh->disconnect;
 938
 939   $main::lxdebug->leave_sub();
 940 }
 941
 942 sub swap_sortkeys {
 943   $main::lxdebug->enter_sub();
 944
 945   my ($self, $myconfig, $form, $table) = @_;
 946
 947   # connect to database
 948   my $dbh = $form->dbconnect_noauto($myconfig);
 949
 950   my $query =
 951     qq|SELECT
 952        (SELECT sortkey FROM $table WHERE id = ?) AS sortkey1,
 953        (SELECT sortkey FROM $table WHERE id = ?) AS sortkey2|;
 954   my @values = ($form->{"id1"}, $form->{"id2"});
 955   my @sortkeys = selectrow_query($form, $dbh, $query, @values);
 956   $main::lxdebug->dump(0, "v", \@values);
 957   $main::lxdebug->dump(0, "s", \@sortkeys);
 958
 959   $query = qq|UPDATE $table SET sortkey = ? WHERE id = ?|;
 960   my $sth = $dbh->prepare($query);
 961   $sth->execute($sortkeys[1], $form->{"id1"}) ||
 962     $form->dberror($query . " ($sortkeys[1], $form->{id1})");
 963   $sth->execute($sortkeys[0], $form->{"id2"}) ||
 964     $form->dberror($query . " ($sortkeys[0], $form->{id2})");
 965   $sth->finish();
 966
 967   $dbh->commit();
 968   $dbh->disconnect;
 969
 970   $main::lxdebug->leave_sub();
 971 }
 972
 973 sub printer {
 974   $main::lxdebug->enter_sub();
 975
 976   my ($self, $myconfig, $form) = @_;
 977
 978   # connect to database
 979   my $dbh = $form->dbconnect($myconfig);
 980
 981   my $query = qq|SELECT id, printer_description, template_code, printer_command
 982                  FROM printers
 983                  ORDER BY 2|;
 984
 985   $sth = $dbh->prepare($query);
 986   $sth->execute || $form->dberror($query);
 987
 988   $form->{"ALL"} = [];
 989   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 990     push @{ $form->{ALL} }, $ref;
 991   }
 992
 993   $sth->finish;
 994   $dbh->disconnect;
 995
 996   $main::lxdebug->leave_sub();
 997 }
 998
 999 sub get_printer {
1000   $main::lxdebug->enter_sub();
1001
1002   my ($self, $myconfig, $form) = @_;
1003
1004   # connect to database
1005   my $dbh = $form->dbconnect($myconfig);
1006
1007   my $query =
1008     qq|SELECT p.printer_description, p.template_code, p.printer_command
1009        FROM printers p
1010        WHERE p.id = ?|;
1011   my $sth = $dbh->prepare($query);
1012   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
1013
1014   my $ref = $sth->fetchrow_hashref(NAME_lc);
1015
1016   map { $form->{$_} = $ref->{$_} } keys %$ref;
1017
1018   $sth->finish;
1019
1020   $dbh->disconnect;
1021
1022   $main::lxdebug->leave_sub();
1023 }
1024
1025 sub save_printer {
1026   $main::lxdebug->enter_sub();
1027
1028   my ($self, $myconfig, $form) = @_;
1029
1030   # connect to database
1031   my $dbh = $form->dbconnect($myconfig);
1032
1033   my @values = ($form->{printer_description},
1034                 $form->{template_code},
1035                 $form->{printer_command});
1036
1037   # id is the old record
1038   if ($form->{id}) {
1039     $query = qq|UPDATE printers SET
1040                 printer_description = ?, template_code = ?, printer_command = ?
1041                 WHERE id = ?|;
1042     push(@values, $form->{id});
1043   } else {
1044     $query = qq|INSERT INTO printers
1045                 (printer_description, template_code, printer_command)
1046                 VALUES (?, ?, ?)|;
1047   }
1048   do_query($form, $dbh, $query, @values);
1049
1050   $dbh->disconnect;
1051
1052   $main::lxdebug->leave_sub();
1053 }
1054
1055 sub delete_printer {
1056   $main::lxdebug->enter_sub();
1057
1058   my ($self, $myconfig, $form) = @_;
1059
1060   # connect to database
1061   my $dbh = $form->dbconnect($myconfig);
1062
1063   $query = qq|DELETE FROM printers
1064               WHERE id = ?|;
1065   do_query($form, $dbh, $query, $form->{id});
1066
1067   $dbh->disconnect;
1068
1069   $main::lxdebug->leave_sub();
1070 }
1071
1072 sub payment {
1073   $main::lxdebug->enter_sub();
1074
1075   my ($self, $myconfig, $form) = @_;
1076
1077   # connect to database
1078   my $dbh = $form->dbconnect($myconfig);
1079
1080   my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
1081
1082   $sth = $dbh->prepare($query);
1083   $sth->execute || $form->dberror($query);
1084
1085   $form->{ALL} = [];
1086   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1087     push @{ $form->{ALL} }, $ref;
1088   }
1089
1090   $sth->finish;
1091   $dbh->disconnect;
1092
1093   $main::lxdebug->leave_sub();
1094 }
1095
1096 sub get_payment {
1097   $main::lxdebug->enter_sub();
1098
1099   my ($self, $myconfig, $form) = @_;
1100
1101   # connect to database
1102   my $dbh = $form->dbconnect($myconfig);
1103
1104   my $query = qq|SELECT * FROM payment_terms WHERE id = ?|;
1105   my $sth = $dbh->prepare($query);
1106   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
1107
1108   my $ref = $sth->fetchrow_hashref(NAME_lc);
1109   map { $form->{$_} = $ref->{$_} } keys %$ref;
1110   $sth->finish();
1111
1112   $query =
1113     qq|SELECT t.language_id, t.description_long, l.description AS language | .
1114     qq|FROM translation_payment_terms t | .
1115     qq|LEFT JOIN language l ON t.language_id = l.id | .
1116     qq|WHERE t.payment_terms_id = ? | .
1117     qq|UNION | .
1118     qq|SELECT l.id AS language_id, NULL AS description_long, | .
1119     qq|  l.description AS language | .
1120     qq|FROM language l|;
1121   $sth = $dbh->prepare($query);
1122   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
1123
1124   my %mapping;
1125   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1126     $mapping{ $ref->{"language_id"} } = $ref
1127       unless (defined($mapping{ $ref->{"language_id"} }));
1128   }
1129   $sth->finish;
1130
1131   $form->{"TRANSLATION"} = [sort({ $a->{"language"} cmp $b->{"language"} }
1132                                  values(%mapping))];
1133
1134   $dbh->disconnect;
1135
1136   $main::lxdebug->leave_sub();
1137 }
1138
1139 sub save_payment {
1140   $main::lxdebug->enter_sub();
1141
1142   my ($self, $myconfig, $form) = @_;
1143
1144   # connect to database
1145   my $dbh = $form->dbconnect_noauto($myconfig);
1146
1147   my $query;
1148
1149   if (!$form->{id}) {
1150     $query = qq|SELECT nextval('id'), COALESCE(MAX(sortkey) + 1, 1) | .
1151       qq|FROM payment_terms|;
1152     my $sortkey;
1153     ($form->{id}, $sortkey) = selectrow_query($form, $dbh, $query);
1154
1155     $query = qq|INSERT INTO payment_terms (id, sortkey) VALUES (?, ?)|;
1156     do_query($form, $dbh, $query, $form->{id}, $sortkey);
1157
1158   } else {
1159     $query =
1160       qq|DELETE FROM translation_payment_terms | .
1161       qq|WHERE payment_terms_id = ?|;
1162     do_query($form, $dbh, $query, $form->{"id"});
1163   }
1164
1165   $query = qq|UPDATE payment_terms SET
1166               description = ?, description_long = ?,
1167               ranking = ?,
1168               terms_netto = ?, terms_skonto = ?,
1169               percent_skonto = ?
1170               WHERE id = ?|;
1171   my @values = ($form->{description}, $form->{description_long},
1172                 $form->{ranking} * 1,
1173                 $form->{terms_netto} * 1, $form->{terms_skonto} * 1,
1174                 $form->{percent_skonto} * 1,
1175                 $form->{id});
1176   do_query($form, $dbh, $query, @values);
1177
1178   $query = qq|SELECT id FROM language|;
1179   my @language_ids;
1180   my $sth = $dbh->prepare($query);
1181   $sth->execute() || $form->dberror($query);
1182
1183   while (my ($id) = $sth->fetchrow_array()) {
1184     push(@language_ids, $id);
1185   }
1186   $sth->finish();
1187
1188   $query =
1189     qq|INSERT INTO translation_payment_terms | .
1190     qq|(language_id, payment_terms_id, description_long) | .
1191     qq|VALUES (?, ?, ?)|;
1192   $sth = $dbh->prepare($query);
1193
1194   foreach my $language_id (@language_ids) {
1195     do_statement($form, $sth, $query, $language_id, $form->{"id"},
1196                  $form->{"description_long_${language_id}"});
1197   }
1198   $sth->finish();
1199
1200   $dbh->commit();
1201   $dbh->disconnect;
1202
1203   $main::lxdebug->leave_sub();
1204 }
1205
1206 sub delete_payment {
1207   $main::lxdebug->enter_sub();
1208
1209   my ($self, $myconfig, $form) = @_;
1210
1211   # connect to database
1212   my $dbh = $form->dbconnect_noauto($myconfig);
1213
1214   my $query =
1215     qq|DELETE FROM translation_payment_terms WHERE payment_terms_id = ?|;
1216   do_query($form, $dbh, $query, $form->{"id"});
1217
1218   $query = qq|DELETE FROM payment_terms WHERE id = ?|;
1219   do_query($form, $dbh, $query, $form->{"id"});
1220
1221   $dbh->commit();
1222   $dbh->disconnect;
1223
1224   $main::lxdebug->leave_sub();
1225 }
1226
1227 sub load_template {
1228   $main::lxdebug->enter_sub();
1229
1230   my ($self, $form) = @_;
1231
1232   open(TEMPLATE, "$form->{file}") or $form->error("$form->{file} : $!");
1233
1234   while (<TEMPLATE>) {
1235     $form->{body} .= $_;
1236   }
1237
1238   close(TEMPLATE);
1239
1240   $main::lxdebug->leave_sub();
1241 }
1242
1243 sub save_template {
1244   $main::lxdebug->enter_sub();
1245
1246   my ($self, $form) = @_;
1247
1248   open(TEMPLATE, ">$form->{file}") or $form->error("$form->{file} : $!");
1249
1250   # strip
1251   $form->{body} =~ s/\r\n/\n/g;
1252   print TEMPLATE $form->{body};
1253
1254   close(TEMPLATE);
1255
1256   $main::lxdebug->leave_sub();
1257 }
1258
1259 sub save_preferences {
1260   $main::lxdebug->enter_sub();
1261
1262   my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_;
1263
1264   map { ($form->{$_}) = split(/--/, $form->{$_}) }
1265     qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno);
1266
1267   my @a;
1268   $form->{curr} =~ s/ //g;
1269   map { push(@a, uc pack "A3", $_) if $_ } split(/:/, $form->{curr});
1270   $form->{curr} = join ':', @a;
1271
1272   # connect to database
1273   my $dbh = $form->dbconnect_noauto($myconfig);
1274
1275   # these defaults are database wide
1276   # user specific variables are in myconfig
1277   # save defaults
1278   my $query =
1279     qq|UPDATE defaults SET | .
1280     qq|inventory_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?), | .
1281     qq|income_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?), | .
1282     qq|expense_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?), | .
1283     qq|fxgain_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?), | .
1284     qq|fxloss_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?), | .
1285     qq|invnumber = ?, | .
1286     qq|cnnumber  = ?, | .
1287     qq|sonumber = ?, | .
1288     qq|ponumber = ?, | .
1289     qq|sqnumber = ?, | .
1290     qq|rfqnumber = ?, | .
1291     qq|customernumber = ?, | .
1292     qq|vendornumber = ?, | .
1293     qq|articlenumber = ?, | .
1294     qq|servicenumber = ?, | .
1295     qq|yearend = ?, | .
1296     qq|curr = ?, | .
1297     qq|businessnumber = ?|;
1298   my @values = ($form->{inventory_accno}, $form->{income_accno},
1299                 $form->{expense_accno},
1300                 $form->{fxgain_accno}, $form->{fxloss_accno},
1301                 $form->{invnumber}, $form->{cnnumber},
1302                 $form->{sonumber}, $form->{ponumber},
1303                 $form->{sqnumber}, $form->{rfqnumber},
1304                 $form->{customernumber}, $form->{vendornumber},
1305                 $form->{articlenumber}, $form->{servicenumber},
1306                 $form->{yearend}, $form->{curr},
1307                 $form->{businessnumber});
1308   do_query($form, $dbh, $query, @values);
1309
1310   # update name
1311   $query = qq|UPDATE employee
1312               SET name = ?
1313               WHERE login = ?|;
1314   do_query($form, $dbh, $query, $form->{name}, $form->{login});
1315
1316   my $rc = $dbh->commit;
1317   $dbh->disconnect;
1318
1319   # save first currency in myconfig
1320   $form->{currency} = substr($form->{curr}, 0, 3);
1321
1322   my $myconfig = new User "$memberfile", "$form->{login}";
1323
1324   foreach my $item (keys %$form) {
1325     $myconfig->{$item} = $form->{$item};
1326   }
1327
1328   $myconfig->save_member($memberfile, $userspath);
1329
1330   if ($webdav) {
1331     @webdavdirs =
1332       qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
1333     foreach $directory (@webdavdirs) {
1334       $file = "webdav/" . $directory . "/webdav-user";
1335       if ($myconfig->{$directory}) {
1336         open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1337         while (<HTACCESS>) {
1338           ($login, $password) = split(/:/, $_);
1339           if ($login ne $form->{login}) {
1340             $newfile .= $_;
1341           }
1342         }
1343         close(HTACCESS);
1344         open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1345         $newfile .= $myconfig->{login} . ":" . $myconfig->{password} . "\n";
1346         print(HTACCESS $newfile);
1347         close(HTACCESS);
1348       } else {
1349         $form->{$directory} = 0;
1350         open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1351         while (<HTACCESS>) {
1352           ($login, $password) = split(/:/, $_);
1353           if ($login ne $form->{login}) {
1354             $newfile .= $_;
1355           }
1356         }
1357         close(HTACCESS);
1358         open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1359         print(HTACCESS $newfile);
1360         close(HTACCESS);
1361       }
1362     }
1363   }
1364
1365   $main::lxdebug->leave_sub();
1366
1367   return $rc;
1368 }
1369
1370 sub defaultaccounts {
1371   $main::lxdebug->enter_sub();
1372
1373   my ($self, $myconfig, $form) = @_;
1374
1375   # connect to database
1376   my $dbh = $form->dbconnect($myconfig);
1377
1378   # get defaults from defaults table
1379   my $query = qq|SELECT * FROM defaults|;
1380   my $sth   = $dbh->prepare($query);
1381   $sth->execute || $form->dberror($query);
1382
1383   $form->{defaults}             = $sth->fetchrow_hashref(NAME_lc);
1384   $form->{defaults}{IC}         = $form->{defaults}{inventory_accno_id};
1385   $form->{defaults}{IC_income}  = $form->{defaults}{income_accno_id};
1386   $form->{defaults}{IC_expense} = $form->{defaults}{expense_accno_id};
1387   $form->{defaults}{FX_gain}    = $form->{defaults}{fxgain_accno_id};
1388   $form->{defaults}{FX_loss}    = $form->{defaults}{fxloss_accno_id};
1389
1390   $sth->finish;
1391
1392   $query = qq|SELECT c.id, c.accno, c.description, c.link
1393               FROM chart c
1394               WHERE c.link LIKE '%IC%'
1395               ORDER BY c.accno|;
1396   $sth = $dbh->prepare($query);
1397   $sth->execute || $self->dberror($query);
1398
1399   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1400     foreach my $key (split(/:/, $ref->{link})) {
1401       if ($key =~ /IC/) {
1402         $nkey = $key;
1403         if ($key =~ /cogs/) {
1404           $nkey = "IC_expense";
1405         }
1406         if ($key =~ /sale/) {
1407           $nkey = "IC_income";
1408         }
1409         %{ $form->{IC}{$nkey}{ $ref->{accno} } } = (
1410                                              id          => $ref->{id},
1411                                              description => $ref->{description}
1412         );
1413       }
1414     }
1415   }
1416   $sth->finish;
1417
1418   $query = qq|SELECT c.id, c.accno, c.description
1419               FROM chart c
1420               WHERE c.category = 'I'
1421               AND c.charttype = 'A'
1422               ORDER BY c.accno|;
1423   $sth = $dbh->prepare($query);
1424   $sth->execute || $self->dberror($query);
1425
1426   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1427     %{ $form->{IC}{FX_gain}{ $ref->{accno} } } = (
1428                                              id          => $ref->{id},
1429                                              description => $ref->{description}
1430     );
1431   }
1432   $sth->finish;
1433
1434   $query = qq|SELECT c.id, c.accno, c.description
1435               FROM chart c
1436               WHERE c.category = 'E'
1437               AND c.charttype = 'A'
1438               ORDER BY c.accno|;
1439   $sth = $dbh->prepare($query);
1440   $sth->execute || $self->dberror($query);
1441
1442   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1443     %{ $form->{IC}{FX_loss}{ $ref->{accno} } } = (
1444                                              id          => $ref->{id},
1445                                              description => $ref->{description}
1446     );
1447   }
1448   $sth->finish;
1449
1450   # now get the tax rates and numbers
1451   $query = qq|SELECT c.id, c.accno, c.description,
1452               t.rate * 100 AS rate, t.taxnumber
1453               FROM chart c, tax t
1454               WHERE c.id = t.chart_id|;
1455
1456   $sth = $dbh->prepare($query);
1457   $sth->execute || $form->dberror($query);
1458
1459   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1460     $form->{taxrates}{ $ref->{accno} }{id}          = $ref->{id};
1461     $form->{taxrates}{ $ref->{accno} }{description} = $ref->{description};
1462     $form->{taxrates}{ $ref->{accno} }{taxnumber}   = $ref->{taxnumber}
1463       if $ref->{taxnumber};
1464     $form->{taxrates}{ $ref->{accno} }{rate} = $ref->{rate} if $ref->{rate};
1465   }
1466
1467   $sth->finish;
1468   $dbh->disconnect;
1469
1470   $main::lxdebug->leave_sub();
1471 }
1472
1473 sub closedto {
1474   $main::lxdebug->enter_sub();
1475
1476   my ($self, $myconfig, $form) = @_;
1477
1478   my $dbh = $form->dbconnect($myconfig);
1479
1480   my $query = qq|SELECT closedto, revtrans FROM defaults|;
1481   my $sth   = $dbh->prepare($query);
1482   $sth->execute || $form->dberror($query);
1483
1484   ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
1485
1486   $sth->finish;
1487
1488   $dbh->disconnect;
1489
1490   $main::lxdebug->leave_sub();
1491 }
1492
1493 sub closebooks {
1494   $main::lxdebug->enter_sub();
1495
1496   my ($self, $myconfig, $form) = @_;
1497
1498   my $dbh = $form->dbconnect($myconfig);
1499
1500   my ($query, @values);
1501
1502   if ($form->{revtrans}) {
1503     $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '1'|;
1504
1505   } elsif ($form->{closedto}) {
1506     $query = qq|UPDATE defaults SET closedto = ?, revtrans = '0'|;
1507     @values = (conv_date($form->{closedto}));
1508
1509   } else {
1510     $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '0'|;
1511   }
1512
1513   # set close in defaults
1514   do_query($form, $dbh, $query, @values);
1515
1516   $dbh->disconnect;
1517
1518   $main::lxdebug->leave_sub();
1519 }
1520
1521 sub get_base_unit {
1522   my ($self, $units, $unit_name, $factor) = @_;
1523
1524   $factor = 1 unless ($factor);
1525
1526   my $unit = $units->{$unit_name};
1527
1528   if (!defined($unit) || !$unit->{"base_unit"} ||
1529       ($unit_name eq $unit->{"base_unit"})) {
1530     return ($unit_name, $factor);
1531   }
1532
1533   return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"});
1534 }
1535
1536 sub retrieve_units {
1537   $main::lxdebug->enter_sub();
1538
1539   my ($self, $myconfig, $form, $type, $prefix) = @_;
1540
1541   my $dbh = $form->dbconnect($myconfig);
1542
1543   my $query = "SELECT *, base_unit AS original_base_unit FROM units";
1544   my @values;
1545   if ($type) {
1546     $query .= " WHERE (type = ?)";
1547     @values = ($type);
1548   }
1549
1550   my $sth = $dbh->prepare($query);
1551   $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
1552
1553   my $units = {};
1554   while (my $ref = $sth->fetchrow_hashref()) {
1555     $units->{$ref->{"name"}} = $ref;
1556   }
1557   $sth->finish();
1558
1559   my $query_lang = "SELECT id, template_code FROM language ORDER BY description";
1560   $sth = $dbh->prepare($query_lang);
1561   $sth->execute() || $form->dberror($query_lang);
1562   my @languages;
1563   while ($ref = $sth->fetchrow_hashref()) {
1564     push(@languages, $ref);
1565   }
1566   $sth->finish();
1567
1568   $query_lang = "SELECT ul.localized, ul.localized_plural, l.id, l.template_code " .
1569     "FROM units_language ul " .
1570     "LEFT JOIN language l ON ul.language_id = l.id " .
1571     "WHERE ul.unit = ?";
1572   $sth = $dbh->prepare($query_lang);
1573
1574   foreach my $unit (values(%{$units})) {
1575     ($unit->{"${prefix}base_unit"}, $unit->{"${prefix}factor"}) = AM->get_base_unit($units, $unit->{"name"});
1576
1577     $unit->{"LANGUAGES"} = {};
1578     foreach my $lang (@languages) {
1579       $unit->{"LANGUAGES"}->{$lang->{"template_code"}} = { "template_code" => $lang->{"template_code"} };
1580     }
1581
1582     $sth->execute($unit->{"name"}) || $form->dberror($query_lang . " (" . $unit->{"name"} . ")");
1583     while ($ref = $sth->fetchrow_hashref()) {
1584       map({ $unit->{"LANGUAGES"}->{$ref->{"template_code"}}->{$_} = $ref->{$_} } keys(%{$ref}));
1585     }
1586   }
1587   $sth->finish();
1588
1589   $dbh->disconnect();
1590
1591   $main::lxdebug->leave_sub();
1592
1593   return $units;
1594 }
1595
1596 sub translate_units {
1597   $main::lxdebug->enter_sub();
1598
1599   my ($self, $form, $template_code, $unit, $amount) = @_;
1600
1601   my $units = $self->retrieve_units(\%main::myconfig, $form);
1602
1603   my $h = $units->{$unit}->{"LANGUAGES"}->{$template_code};
1604   my $new_unit = $unit;
1605   if ($h) {
1606     if (($amount != 1) && $h->{"localized_plural"}) {
1607       $new_unit = $h->{"localized_plural"};
1608     } elsif ($h->{"localized"}) {
1609       $new_unit = $h->{"localized"};
1610     }
1611   }
1612
1613   $main::lxdebug->leave_sub();
1614
1615   return $new_unit;
1616 }
1617
1618 sub units_in_use {
1619   $main::lxdebug->enter_sub();
1620
1621   my ($self, $myconfig, $form, $units) = @_;
1622
1623   my $dbh = $form->dbconnect($myconfig);
1624
1625   map({ $_->{"in_use"} = 0; } values(%{$units}));
1626
1627   foreach my $unit (values(%{$units})) {
1628     my $base_unit = $unit->{"original_base_unit"};
1629     while ($base_unit) {
1630       $units->{$base_unit}->{"in_use"} = 1;
1631       $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"});
1632       push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"});
1633       $base_unit = $units->{$base_unit}->{"original_base_unit"};
1634     }
1635   }
1636
1637   foreach my $unit (values(%{$units})) {
1638     map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}});
1639
1640     foreach my $table (qw(parts invoice orderitems)) {
1641       my $query = "SELECT COUNT(*) FROM $table WHERE unit ";
1642
1643       if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) {
1644         $query .= "= " . $dbh->quote($unit->{"name"});
1645       } else {
1646         $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," .
1647           join(",", map({ $dbh->quote($_) } @{$unit->{"DEPENDING_UNITS"}})) . ")";
1648       }
1649
1650       my ($count) = $dbh->selectrow_array($query);
1651       $form->dberror($query) if ($dbh->err);
1652
1653       if ($count) {
1654         $unit->{"in_use"} = 1;
1655         last;
1656       }
1657     }
1658   }
1659
1660   $dbh->disconnect();
1661
1662   $main::lxdebug->leave_sub();
1663 }
1664
1665 sub unit_select_data {
1666   $main::lxdebug->enter_sub();
1667
1668   my ($self, $units, $selected, $empty_entry) = @_;
1669
1670   my $select = [];
1671
1672   if ($empty_entry) {
1673     push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" });
1674   }
1675
1676   foreach my $unit (sort({ $a->{"sortkey"} <=> $b->{"sortkey"} } keys(%{$units}))) {
1677     push(@{$select}, { "name" => $unit,
1678                        "base_unit" => $units->{$unit}->{"base_unit"},
1679                        "factor" => $units->{$unit}->{"factor"},
1680                        "selected" => ($unit eq $selected) ? "selected" : "" });
1681   }
1682
1683   $main::lxdebug->leave_sub();
1684
1685   return $select;
1686 }
1687
1688 sub unit_select_html {
1689   $main::lxdebug->enter_sub();
1690
1691   my ($self, $units, $name, $selected, $convertible_into) = @_;
1692
1693   my $select = "<select name=${name}>";
1694
1695   foreach my $unit (sort({ $a->{"sortkey"} <=> $b->{"sortkey"} } keys(%{$units}))) {
1696     if (!$convertible_into ||
1697         ($units->{$convertible_into} &&
1698          ($units->{$convertible_into}->{"base_unit"} eq $units->{$unit}->{"base_unit"}))) {
1699       $select .= "<option" . (($unit eq $selected) ? " selected" : "") . ">${unit}</option>";
1700     }
1701   }
1702   $select .= "</select>";
1703
1704   $main::lxdebug->leave_sub();
1705
1706   return $select;
1707 }
1708
1709 sub add_unit {
1710   $main::lxdebug->enter_sub();
1711
1712   my ($self, $myconfig, $form, $name, $base_unit, $factor, $type, $languages) = @_;
1713
1714   my $dbh = $form->dbconnect_noauto($myconfig);
1715
1716   my $query = qq|SELECT COALESCE(MAX(sortkey), 0) + 1 FROM units|;
1717   my ($sortkey) = selectrow_query($form, $dbh, $query);
1718
1719   $query = "INSERT INTO units (name, base_unit, factor, type, sortkey) " .
1720     "VALUES (?, ?, ?, ?, ?)";
1721   do_query($form, $dbh, $query, $name, $base_unit, $factor, $type, $sortkey);
1722
1723   if ($languages) {
1724     $query = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
1725     my $sth = $dbh->prepare($query);
1726     foreach my $lang (@{$languages}) {
1727       my @values = ($name, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
1728       $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
1729     }
1730     $sth->finish();
1731   }
1732
1733   $dbh->commit();
1734   $dbh->disconnect();
1735
1736   $main::lxdebug->leave_sub();
1737 }
1738
1739 sub save_units {
1740   $main::lxdebug->enter_sub();
1741
1742   my ($self, $myconfig, $form, $type, $units, $delete_units) = @_;
1743
1744   my $dbh = $form->dbconnect_noauto($myconfig);
1745
1746   my ($base_unit, $unit, $sth, $query);
1747
1748   $query = "DELETE FROM units_language";
1749   $dbh->do($query) || $form->dberror($query);
1750
1751   if ($delete_units && (0 != scalar(@{$delete_units}))) {
1752     $query = "DELETE FROM units WHERE name IN (";
1753     map({ $query .= "?," } @{$delete_units});
1754     substr($query, -1, 1) = ")";
1755     $dbh->do($query, undef, @{$delete_units}) ||
1756       $form->dberror($query . " (" . join(", ", @{$delete_units}) . ")");
1757   }
1758
1759   $query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?";
1760   $sth = $dbh->prepare($query);
1761
1762   my $query_lang = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
1763   my $sth_lang = $dbh->prepare($query_lang);
1764
1765   foreach $unit (values(%{$units})) {
1766     $unit->{"depth"} = 0;
1767     my $base_unit = $unit;
1768     while ($base_unit->{"base_unit"}) {
1769       $unit->{"depth"}++;
1770       $base_unit = $units->{$base_unit->{"base_unit"}};
1771     }
1772   }
1773
1774   foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) {
1775     if ($unit->{"LANGUAGES"}) {
1776       foreach my $lang (@{$unit->{"LANGUAGES"}}) {
1777         next unless ($lang->{"id"} && $lang->{"localized"});
1778         my @values = ($unit->{"name"}, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
1779         $sth_lang->execute(@values) || $form->dberror($query_lang . " (" . join(", ", @values) . ")");
1780       }
1781     }
1782
1783     next if ($unit->{"unchanged_unit"});
1784
1785     my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"});
1786     $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
1787   }
1788
1789   $sth->finish();
1790   $sth_lang->finish();
1791   $dbh->commit();
1792   $dbh->disconnect();
1793
1794   $main::lxdebug->leave_sub();
1795 }
1796
1797 sub swap_units {
1798   $main::lxdebug->enter_sub();
1799
1800   my ($self, $myconfig, $form, $dir, $name_1, $unit_type) = @_;
1801
1802   my $dbh = $form->dbconnect_noauto($myconfig);
1803
1804   my $query;
1805
1806   $query = qq|SELECT sortkey FROM units WHERE name = ?|;
1807   my ($sortkey_1) = selectrow_query($form, $dbh, $query, $name_1);
1808
1809   $query =
1810     qq|SELECT sortkey FROM units | .
1811     qq|WHERE sortkey | . ($dir eq "down" ? ">" : "<") . qq| ? AND type = ? | .
1812     qq|ORDER BY sortkey | . ($dir eq "down" ? "ASC" : "DESC") . qq| LIMIT 1|;
1813   my ($sortkey_2) = selectrow_query($form, $dbh, $query, $sortkey_1, $unit_type);
1814
1815   if (defined($sortkey_1)) {
1816     $query = qq|SELECT name FROM units WHERE sortkey = ${sortkey_2}|;
1817     my ($name_2) = selectrow_query($form, $dbh, $query);
1818
1819     if (defined($name_2)) {
1820       $query = qq|UPDATE units SET sortkey = ? WHERE name = ?|;
1821       my $sth = $dbh->prepare($query);
1822
1823       do_statement($form, $sth, $query, $sortkey_1, $name_2);
1824       do_statement($form, $sth, $query, $sortkey_2, $name_1);
1825     }
1826   }
1827
1828   $dbh->commit();
1829   $dbh->disconnect();
1830
1831   $main::lxdebug->leave_sub();
1832 }
1833
1834 1;