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   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_department {
 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 d.description, d.role
 337                  FROM department d
 338                  WHERE d.id = $form->{id}|;
 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   # see if it is in use
 349   $query = qq|SELECT count(*) FROM dpt_trans d
 350               WHERE d.department_id = $form->{id}|;
 351   $sth = $dbh->prepare($query);
 352   $sth->execute || $form->dberror($query);
 353
 354   ($form->{orphaned}) = $sth->fetchrow_array;
 355   $form->{orphaned} = !$form->{orphaned};
 356   $sth->finish;
 357
 358   $dbh->disconnect;
 359
 360   $main::lxdebug->leave_sub();
 361 }
 362
 363 sub save_department {
 364   $main::lxdebug->enter_sub();
 365
 366   my ($self, $myconfig, $form) = @_;
 367
 368   # connect to database
 369   my $dbh = $form->dbconnect($myconfig);
 370
 371   $form->{description} =~ s/\'/\'\'/g;
 372
 373   if ($form->{id}) {
 374     $query = qq|UPDATE department SET
 375                 description = '$form->{description}',
 376                 role = '$form->{role}'
 377                 WHERE id = $form->{id}|;
 378   } else {
 379     $query = qq|INSERT INTO department
 380                 (description, role)
 381                 VALUES ('$form->{description}', '$form->{role}')|;
 382   }
 383   $dbh->do($query) || $form->dberror($query);
 384
 385   $dbh->disconnect;
 386
 387   $main::lxdebug->leave_sub();
 388 }
 389
 390 sub delete_department {
 391   $main::lxdebug->enter_sub();
 392
 393   my ($self, $myconfig, $form) = @_;
 394
 395   # connect to database
 396   my $dbh = $form->dbconnect($myconfig);
 397
 398   $query = qq|DELETE FROM department
 399               WHERE id = $form->{id}|;
 400   $dbh->do($query) || $form->dberror($query);
 401
 402   $dbh->disconnect;
 403
 404   $main::lxdebug->leave_sub();
 405 }
 406
 407 sub lead {
 408   $main::lxdebug->enter_sub();
 409
 410   my ($self, $myconfig, $form) = @_;
 411
 412   # connect to database
 413   my $dbh = $form->dbconnect($myconfig);
 414
 415   my $query = qq|SELECT id, lead
 416                  FROM leads
 417                  ORDER BY 2|;
 418
 419   $sth = $dbh->prepare($query);
 420   $sth->execute || $form->dberror($query);
 421
 422   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 423     push @{ $form->{ALL} }, $ref;
 424   }
 425
 426   $sth->finish;
 427   $dbh->disconnect;
 428
 429   $main::lxdebug->leave_sub();
 430 }
 431
 432 sub get_lead {
 433   $main::lxdebug->enter_sub();
 434
 435   my ($self, $myconfig, $form) = @_;
 436
 437   # connect to database
 438   my $dbh = $form->dbconnect($myconfig);
 439
 440   my $query =
 441     qq|SELECT l.id, l.lead
 442                  FROM leads l
 443                  WHERE l.id = $form->{id}|;
 444   my $sth = $dbh->prepare($query);
 445   $sth->execute || $form->dberror($query);
 446
 447   my $ref = $sth->fetchrow_hashref(NAME_lc);
 448
 449   map { $form->{$_} = $ref->{$_} } keys %$ref;
 450
 451   $sth->finish;
 452
 453   $dbh->disconnect;
 454
 455   $main::lxdebug->leave_sub();
 456 }
 457
 458 sub save_lead {
 459   $main::lxdebug->enter_sub();
 460
 461   my ($self, $myconfig, $form) = @_;
 462
 463   # connect to database
 464   my $dbh = $form->dbconnect($myconfig);
 465
 466   $form->{lead} =~ s/\'/\'\'/g;
 467
 468   # id is the old record
 469   if ($form->{id}) {
 470     $query = qq|UPDATE leads SET
 471                 lead = '$form->{description}'
 472                 WHERE id = $form->{id}|;
 473   } else {
 474     $query = qq|INSERT INTO leads
 475                 (lead)
 476                 VALUES ('$form->{description}')|;
 477   }
 478   $dbh->do($query) || $form->dberror($query);
 479
 480   $dbh->disconnect;
 481
 482   $main::lxdebug->leave_sub();
 483 }
 484
 485 sub delete_lead {
 486   $main::lxdebug->enter_sub();
 487
 488   my ($self, $myconfig, $form) = @_;
 489
 490   # connect to database
 491   my $dbh = $form->dbconnect($myconfig);
 492
 493   $query = qq|DELETE FROM leads
 494               WHERE id = $form->{id}|;
 495   $dbh->do($query) || $form->dberror($query);
 496
 497   $dbh->disconnect;
 498
 499   $main::lxdebug->leave_sub();
 500 }
 501
 502 sub business {
 503   $main::lxdebug->enter_sub();
 504
 505   my ($self, $myconfig, $form) = @_;
 506
 507   # connect to database
 508   my $dbh = $form->dbconnect($myconfig);
 509
 510   my $query = qq|SELECT id, description, discount, customernumberinit, salesman
 511                  FROM business
 512                  ORDER BY 2|;
 513
 514   $sth = $dbh->prepare($query);
 515   $sth->execute || $form->dberror($query);
 516
 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 = $form->{id}|;
 539   my $sth = $dbh->prepare($query);
 540   $sth->execute || $form->dberror($query);
 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   $form->{description} =~ s/\'/\'\'/g;
 562   $form->{discount} /= 100;
 563   $form->{salesman} *= 1;
 564
 565   # id is the old record
 566   if ($form->{id}) {
 567     $query = qq|UPDATE business SET
 568                 description = '$form->{description}',
 569                 discount = $form->{discount},
 570                 customernumberinit = '$form->{customernumberinit}',
 571                 salesman = '$form->{salesman}'
 572                 WHERE id = $form->{id}|;
 573   } else {
 574     $query = qq|INSERT INTO business
 575                 (description, discount, customernumberinit, salesman)
 576                 VALUES ('$form->{description}', $form->{discount}, '$form->{customernumberinit}', '$form->{salesman}')|;
 577   }
 578   $dbh->do($query) || $form->dberror($query);
 579
 580   $dbh->disconnect;
 581
 582   $main::lxdebug->leave_sub();
 583 }
 584
 585 sub delete_business {
 586   $main::lxdebug->enter_sub();
 587
 588   my ($self, $myconfig, $form) = @_;
 589
 590   # connect to database
 591   my $dbh = $form->dbconnect($myconfig);
 592
 593   $query = qq|DELETE FROM business
 594               WHERE id = $form->{id}|;
 595   $dbh->do($query) || $form->dberror($query);
 596
 597   $dbh->disconnect;
 598
 599   $main::lxdebug->leave_sub();
 600 }
 601
 602
 603 sub language {
 604   $main::lxdebug->enter_sub();
 605
 606   my ($self, $myconfig, $form, $return_list) = @_;
 607
 608   # connect to database
 609   my $dbh = $form->dbconnect($myconfig);
 610
 611   my $query =
 612     "SELECT id, description, template_code, article_code, " .
 613     "  output_numberformat, output_dateformat, output_longdates " .
 614     "FROM language ORDER BY description";
 615
 616   $sth = $dbh->prepare($query);
 617   $sth->execute || $form->dberror($query);
 618
 619   my $ary = [];
 620
 621   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 622     push(@{ $ary }, $ref);
 623   }
 624
 625   $sth->finish;
 626   $dbh->disconnect;
 627
 628   $main::lxdebug->leave_sub();
 629
 630   if ($return_list) {
 631     return @{$ary};
 632   } else {
 633     $form->{ALL} = $ary;
 634   }
 635 }
 636
 637 sub get_language {
 638   $main::lxdebug->enter_sub();
 639
 640   my ($self, $myconfig, $form) = @_;
 641
 642   # connect to database
 643   my $dbh = $form->dbconnect($myconfig);
 644
 645   my $query =
 646     "SELECT description, template_code, article_code, " .
 647     "  output_numberformat, output_dateformat, output_longdates " .
 648     "FROM language WHERE id = ?";
 649   my $sth = $dbh->prepare($query);
 650   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
 651
 652   my $ref = $sth->fetchrow_hashref(NAME_lc);
 653
 654   map { $form->{$_} = $ref->{$_} } keys %$ref;
 655
 656   $sth->finish;
 657
 658   $dbh->disconnect;
 659
 660   $main::lxdebug->leave_sub();
 661 }
 662
 663 sub get_language_details {
 664   $main::lxdebug->enter_sub();
 665
 666   my ($self, $myconfig, $form, $id) = @_;
 667
 668   # connect to database
 669   my $dbh = $form->dbconnect($myconfig);
 670
 671   my $query =
 672     "SELECT template_code, " .
 673     "  output_numberformat, output_dateformat, output_longdates " .
 674     "FROM language WHERE id = ?";
 675   my @res = $dbh->selectrow_array($query, undef, $id);
 676   $dbh->disconnect;
 677
 678   $main::lxdebug->leave_sub();
 679
 680   return @res;
 681 }
 682
 683 sub save_language {
 684   $main::lxdebug->enter_sub();
 685
 686   my ($self, $myconfig, $form) = @_;
 687
 688   # connect to database
 689   my $dbh = $form->dbconnect($myconfig);
 690   my (@values, $query);
 691
 692   map({ push(@values, $form->{$_}); }
 693       qw(description template_code article_code
 694          output_numberformat output_dateformat output_longdates));
 695
 696   # id is the old record
 697   if ($form->{id}) {
 698     $query =
 699       "UPDATE language SET " .
 700       "  description = ?, template_code = ?, article_code = ?, " .
 701       "  output_numberformat = ?, output_dateformat = ?, " .
 702       "  output_longdates = ? " .
 703       "WHERE id = ?";
 704     push(@values, $form->{id});
 705   } else {
 706     $query =
 707       "INSERT INTO language (" .
 708       "  description, template_code, article_code, " .
 709       "  output_numberformat, output_dateformat, output_longdates" .
 710       ") VALUES (?, ?, ?, ?, ?, ?)";
 711   }
 712   $dbh->do($query, undef, @values) ||
 713     $form->dberror($query . " (" . join(", ", @values) . ")");
 714
 715   $dbh->disconnect;
 716
 717   $main::lxdebug->leave_sub();
 718 }
 719
 720 sub delete_language {
 721   $main::lxdebug->enter_sub();
 722
 723   my ($self, $myconfig, $form) = @_;
 724
 725   # connect to database
 726   my $dbh = $form->dbconnect_noauto($myconfig);
 727
 728   foreach my $table (qw(translation_payment_terms units_language)) {
 729     my $query = qq|DELETE FROM $table WHERE language_id = ?|;
 730     do_query($form, $dbh, $query, $form->{"id"});
 731   }
 732
 733   $query = "DELETE FROM language WHERE id = ?";
 734   do_query($form, $dbh, $query, $form->{"id"});
 735
 736   $dbh->commit();
 737   $dbh->disconnect;
 738
 739   $main::lxdebug->leave_sub();
 740 }
 741
 742
 743 sub buchungsgruppe {
 744   $main::lxdebug->enter_sub();
 745
 746   my ($self, $myconfig, $form) = @_;
 747
 748   # connect to database
 749   my $dbh = $form->dbconnect($myconfig);
 750
 751   my $query = qq|SELECT id, description,
 752                  inventory_accno_id,
 753                  (SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
 754                  income_accno_id_0,
 755                  (SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
 756                  expense_accno_id_0,
 757                  (SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
 758                  income_accno_id_1,
 759                  (SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
 760                  expense_accno_id_1,
 761                  (SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
 762                  income_accno_id_2,
 763                  (SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
 764                  expense_accno_id_2,
 765                  (select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
 766                  income_accno_id_3,
 767                  (SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
 768                  expense_accno_id_3,
 769                  (SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
 770                  FROM buchungsgruppen
 771                  ORDER BY sortkey|;
 772
 773   $sth = $dbh->prepare($query);
 774   $sth->execute || $form->dberror($query);
 775
 776   $form->{ALL} = [];
 777   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 778     push @{ $form->{ALL} }, $ref;
 779   }
 780
 781   $sth->finish;
 782   $dbh->disconnect;
 783
 784   $main::lxdebug->leave_sub();
 785 }
 786
 787 sub get_buchungsgruppe {
 788   $main::lxdebug->enter_sub();
 789
 790   my ($self, $myconfig, $form) = @_;
 791
 792   # connect to database
 793   my $dbh = $form->dbconnect($myconfig);
 794
 795   if ($form->{id}) {
 796     my $query =
 797       qq|SELECT description, inventory_accno_id,
 798          (SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
 799          income_accno_id_0,
 800          (SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
 801          expense_accno_id_0,
 802          (SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
 803          income_accno_id_1,
 804          (SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
 805          expense_accno_id_1,
 806          (SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
 807          income_accno_id_2,
 808          (SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
 809          expense_accno_id_2,
 810          (select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
 811          income_accno_id_3,
 812          (SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
 813          expense_accno_id_3,
 814          (SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
 815          FROM buchungsgruppen
 816          WHERE id = ?|;
 817     my $sth = $dbh->prepare($query);
 818     $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 819
 820     my $ref = $sth->fetchrow_hashref(NAME_lc);
 821
 822     map { $form->{$_} = $ref->{$_} } keys %$ref;
 823
 824     $sth->finish;
 825
 826     my $query =
 827       qq|SELECT count(id) = 0 AS orphaned
 828          FROM parts
 829          WHERE buchungsgruppen_id = ?|;
 830     ($form->{orphaned}) = $dbh->selectrow_array($query, undef, $form->{id});
 831     $form->dberror($query . " ($form->{id})") if ($dbh->err);
 832   }
 833
 834   $query = "SELECT inventory_accno_id, income_accno_id, expense_accno_id ".
 835     "FROM defaults";
 836   ($form->{"std_inventory_accno_id"}, $form->{"std_income_accno_id"},
 837    $form->{"std_expense_accno_id"}) = $dbh->selectrow_array($query);
 838
 839   my $module = "IC";
 840   $query = qq|SELECT c.accno, c.description, c.link, c.id,
 841               d.inventory_accno_id, d.income_accno_id, d.expense_accno_id
 842               FROM chart c, defaults d
 843               WHERE c.link LIKE '%$module%'
 844               ORDER BY c.accno|;
 845
 846
 847   my $sth = $dbh->prepare($query);
 848   $sth->execute || $form->dberror($query);
 849   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 850     foreach my $key (split(/:/, $ref->{link})) {
 851       if (!$form->{"std_inventory_accno_id"} && ($key eq "IC")) {
 852         $form->{"std_inventory_accno_id"} = $ref->{"id"};
 853       }
 854       if ($key =~ /$module/) {
 855         if (   ($ref->{id} eq $ref->{inventory_accno_id})
 856             || ($ref->{id} eq $ref->{income_accno_id})
 857             || ($ref->{id} eq $ref->{expense_accno_id})) {
 858           push @{ $form->{"${module}_links"}{$key} },
 859             { accno       => $ref->{accno},
 860               description => $ref->{description},
 861               selected    => "selected",
 862               id          => $ref->{id} };
 863         } else {
 864           push @{ $form->{"${module}_links"}{$key} },
 865             { accno       => $ref->{accno},
 866               description => $ref->{description},
 867               selected    => "",
 868               id          => $ref->{id} };
 869         }
 870       }
 871     }
 872   }
 873   $sth->finish;
 874
 875
 876   $dbh->disconnect;
 877
 878   $main::lxdebug->leave_sub();
 879 }
 880
 881 sub save_buchungsgruppe {
 882   $main::lxdebug->enter_sub();
 883
 884   my ($self, $myconfig, $form) = @_;
 885
 886   # connect to database
 887   my $dbh = $form->dbconnect($myconfig);
 888
 889   my @values = ($form->{description}, $form->{inventory_accno_id},
 890                 $form->{income_accno_id_0}, $form->{expense_accno_id_0},
 891                 $form->{income_accno_id_1}, $form->{expense_accno_id_1},
 892                 $form->{income_accno_id_2}, $form->{expense_accno_id_2},
 893                 $form->{income_accno_id_3}, $form->{expense_accno_id_3});
 894
 895   my $query;
 896
 897   # id is the old record
 898   if ($form->{id}) {
 899     $query = qq|UPDATE buchungsgruppen SET
 900                 description = ?, inventory_accno_id = ?,
 901                 income_accno_id_0 = ?, expense_accno_id_0 = ?,
 902                 income_accno_id_1 = ?, expense_accno_id_1 = ?,
 903                 income_accno_id_2 = ?, expense_accno_id_2 = ?,
 904                 income_accno_id_3 = ?, expense_accno_id_3 = ?
 905                 WHERE id = ?|;
 906     push(@values, $form->{id});
 907   } else {
 908     $query = qq|SELECT COALESCE(MAX(sortkey) + 1, 1) FROM buchungsgruppen|;
 909     my ($sortkey) = $dbh->selectrow_array($query);
 910     $form->dberror($query) if ($dbh->err);
 911     push(@values, $sortkey);
 912     $query = qq|INSERT INTO buchungsgruppen
 913                 (description, inventory_accno_id,
 914                 income_accno_id_0, expense_accno_id_0,
 915                 income_accno_id_1, expense_accno_id_1,
 916                 income_accno_id_2, expense_accno_id_2,
 917                 income_accno_id_3, expense_accno_id_3,
 918                 sortkey)
 919                 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
 920   }
 921   do_query($form, $dbh, $query, @values);
 922
 923   $dbh->disconnect;
 924
 925   $main::lxdebug->leave_sub();
 926 }
 927
 928 sub delete_buchungsgruppe {
 929   $main::lxdebug->enter_sub();
 930
 931   my ($self, $myconfig, $form) = @_;
 932
 933   # connect to database
 934   my $dbh = $form->dbconnect($myconfig);
 935
 936   $query = qq|DELETE FROM buchungsgruppen WHERE id = ?|;
 937   do_query($form, $dbh, $query, $form->{id});
 938
 939   $dbh->disconnect;
 940
 941   $main::lxdebug->leave_sub();
 942 }
 943
 944 sub swap_sortkeys {
 945   $main::lxdebug->enter_sub();
 946
 947   my ($self, $myconfig, $form, $table) = @_;
 948
 949   # connect to database
 950   my $dbh = $form->dbconnect_noauto($myconfig);
 951
 952   my $query =
 953     qq|SELECT
 954        (SELECT sortkey FROM $table WHERE id = ?) AS sortkey1,
 955        (SELECT sortkey FROM $table WHERE id = ?) AS sortkey2|;
 956   my @values = ($form->{"id1"}, $form->{"id2"});
 957   my @sortkeys = selectrow_query($form, $dbh, $query, @values);
 958   $main::lxdebug->dump(0, "v", \@values);
 959   $main::lxdebug->dump(0, "s", \@sortkeys);
 960
 961   $query = qq|UPDATE $table SET sortkey = ? WHERE id = ?|;
 962   my $sth = $dbh->prepare($query);
 963   $sth->execute($sortkeys[1], $form->{"id1"}) ||
 964     $form->dberror($query . " ($sortkeys[1], $form->{id1})");
 965   $sth->execute($sortkeys[0], $form->{"id2"}) ||
 966     $form->dberror($query . " ($sortkeys[0], $form->{id2})");
 967   $sth->finish();
 968
 969   $dbh->commit();
 970   $dbh->disconnect;
 971
 972   $main::lxdebug->leave_sub();
 973 }
 974
 975 sub printer {
 976   $main::lxdebug->enter_sub();
 977
 978   my ($self, $myconfig, $form) = @_;
 979
 980   # connect to database
 981   my $dbh = $form->dbconnect($myconfig);
 982
 983   my $query = qq|SELECT id, printer_description, template_code, printer_command
 984                  FROM printers
 985                  ORDER BY 2|;
 986
 987   $sth = $dbh->prepare($query);
 988   $sth->execute || $form->dberror($query);
 989
 990   $form->{"ALL"} = [];
 991   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 992     push @{ $form->{ALL} }, $ref;
 993   }
 994
 995   $sth->finish;
 996   $dbh->disconnect;
 997
 998   $main::lxdebug->leave_sub();
 999 }
1000
1001 sub get_printer {
1002   $main::lxdebug->enter_sub();
1003
1004   my ($self, $myconfig, $form) = @_;
1005
1006   # connect to database
1007   my $dbh = $form->dbconnect($myconfig);
1008
1009   my $query =
1010     qq|SELECT p.printer_description, p.template_code, p.printer_command
1011                  FROM printers p
1012                  WHERE p.id = $form->{id}|;
1013   my $sth = $dbh->prepare($query);
1014   $sth->execute || $form->dberror($query);
1015
1016   my $ref = $sth->fetchrow_hashref(NAME_lc);
1017
1018   map { $form->{$_} = $ref->{$_} } keys %$ref;
1019
1020   $sth->finish;
1021
1022   $dbh->disconnect;
1023
1024   $main::lxdebug->leave_sub();
1025 }
1026
1027 sub save_printer {
1028   $main::lxdebug->enter_sub();
1029
1030   my ($self, $myconfig, $form) = @_;
1031
1032   # connect to database
1033   my $dbh = $form->dbconnect($myconfig);
1034
1035   $form->{printer_description} =~ s/\'/\'\'/g;
1036   $form->{printer_command} =~ s/\'/\'\'/g;
1037   $form->{template_code} =~ s/\'/\'\'/g;
1038
1039
1040   # id is the old record
1041   if ($form->{id}) {
1042     $query = qq|UPDATE printers SET
1043                 printer_description = '$form->{printer_description}',
1044                 template_code = '$form->{template_code}',
1045                 printer_command = '$form->{printer_command}'
1046                 WHERE id = $form->{id}|;
1047   } else {
1048     $query = qq|INSERT INTO printers
1049                 (printer_description, template_code, printer_command)
1050                 VALUES ('$form->{printer_description}', '$form->{template_code}', '$form->{printer_command}')|;
1051   }
1052   $dbh->do($query) || $form->dberror($query);
1053
1054   $dbh->disconnect;
1055
1056   $main::lxdebug->leave_sub();
1057 }
1058
1059 sub delete_printer {
1060   $main::lxdebug->enter_sub();
1061
1062   my ($self, $myconfig, $form) = @_;
1063
1064   # connect to database
1065   my $dbh = $form->dbconnect($myconfig);
1066
1067   $query = qq|DELETE FROM printers
1068               WHERE id = $form->{id}|;
1069   $dbh->do($query) || $form->dberror($query);
1070
1071   $dbh->disconnect;
1072
1073   $main::lxdebug->leave_sub();
1074 }
1075
1076 sub payment {
1077   $main::lxdebug->enter_sub();
1078
1079   my ($self, $myconfig, $form) = @_;
1080
1081   # connect to database
1082   my $dbh = $form->dbconnect($myconfig);
1083
1084   my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
1085
1086   $sth = $dbh->prepare($query);
1087   $sth->execute || $form->dberror($query);
1088
1089   $form->{ALL} = [];
1090   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1091     push @{ $form->{ALL} }, $ref;
1092   }
1093
1094   $sth->finish;
1095   $dbh->disconnect;
1096
1097   $main::lxdebug->leave_sub();
1098 }
1099
1100 sub get_payment {
1101   $main::lxdebug->enter_sub();
1102
1103   my ($self, $myconfig, $form) = @_;
1104
1105   # connect to database
1106   my $dbh = $form->dbconnect($myconfig);
1107
1108   my $query = qq|SELECT * FROM payment_terms WHERE id = ?|;
1109   my $sth = $dbh->prepare($query);
1110   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
1111
1112   my $ref = $sth->fetchrow_hashref(NAME_lc);
1113   map { $form->{$_} = $ref->{$_} } keys %$ref;
1114   $sth->finish();
1115
1116   $query =
1117     qq|SELECT t.language_id, t.description_long, l.description AS language | .
1118     qq|FROM translation_payment_terms t | .
1119     qq|LEFT JOIN language l ON t.language_id = l.id | .
1120     qq|WHERE t.payment_terms_id = ? | .
1121     qq|UNION | .
1122     qq|SELECT l.id AS language_id, NULL AS description_long, | .
1123     qq|l.description AS language | .
1124     qq|FROM language l|;
1125   $sth = $dbh->prepare($query);
1126   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
1127
1128   my %mapping;
1129   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1130     $mapping{ $ref->{"language_id"} } = $ref
1131       unless (defined($mapping{ $ref->{"language_id"} }));
1132   }
1133   $sth->finish;
1134
1135   $form->{"TRANSLATION"} = [sort({ $a->{"language"} cmp $b->{"language"} }
1136                                  values(%mapping))];
1137
1138   $dbh->disconnect;
1139
1140   $main::lxdebug->leave_sub();
1141 }
1142
1143 sub save_payment {
1144   $main::lxdebug->enter_sub();
1145
1146   my ($self, $myconfig, $form) = @_;
1147
1148   # connect to database
1149   my $dbh = $form->dbconnect_noauto($myconfig);
1150
1151   my $query;
1152
1153   if (!$form->{id}) {
1154     $query = qq|SELECT nextval('id'), COALESCE(MAX(sortkey) + 1, 1) | .
1155       qq|FROM payment_terms|;
1156     my $sortkey;
1157     ($form->{id}, $sortkey) = selectrow_query($form, $dbh, $query);
1158
1159     $query = qq|INSERT INTO payment_terms (id, sortkey) VALUES (?, ?)|;
1160     do_query($form, $dbh, $query, $form->{id}, $sortkey);
1161
1162   } else {
1163     $query =
1164       qq|DELETE FROM translation_payment_terms | .
1165       qq|WHERE payment_terms_id = ?|;
1166     do_query($form, $dbh, $query, $form->{"id"});
1167   }
1168
1169   $query = qq|UPDATE payment_terms SET
1170               description = ?, description_long = ?,
1171               ranking = ?,
1172               terms_netto = ?, terms_skonto = ?,
1173               percent_skonto = ?
1174               WHERE id = ?|;
1175   my @values = ($form->{description}, $form->{description_long},
1176                 $form->{ranking} * 1,
1177                 $form->{terms_netto} * 1, $form->{terms_skonto} * 1,
1178                 $form->{percent_skonto} * 1,
1179                 $form->{id});
1180   do_query($form, $dbh, $query, @values);
1181
1182   $query = qq|SELECT id FROM language|;
1183   my @language_ids;
1184   my $sth = $dbh->prepare($query);
1185   $sth->execute() || $form->dberror($query);
1186
1187   while (my ($id) = $sth->fetchrow_array()) {
1188     push(@language_ids, $id);
1189   }
1190   $sth->finish();
1191
1192   $query =
1193     qq|INSERT INTO translation_payment_terms | .
1194     qq|(language_id, payment_terms_id, description_long) | .
1195     qq|VALUES (?, ?, ?)|;
1196   $sth = $dbh->prepare($query);
1197
1198   foreach my $language_id (@language_ids) {
1199     do_statement($form, $sth, $query, $language_id, $form->{"id"},
1200                  $form->{"description_long_${language_id}"});
1201   }
1202   $sth->finish();
1203
1204   $dbh->commit();
1205   $dbh->disconnect;
1206
1207   $main::lxdebug->leave_sub();
1208 }
1209
1210 sub delete_payment {
1211   $main::lxdebug->enter_sub();
1212
1213   my ($self, $myconfig, $form) = @_;
1214
1215   # connect to database
1216   my $dbh = $form->dbconnect_noauto($myconfig);
1217
1218   my $query =
1219     qq|DELETE FROM translation_payment_terms WHERE payment_terms_id = ?|;
1220   do_query($form, $dbh, $query, $form->{"id"});
1221
1222   $query = qq|DELETE FROM payment_terms WHERE id = ?|;
1223   do_query($form, $dbh, $query, $form->{"id"});
1224
1225   $dbh->commit();
1226   $dbh->disconnect;
1227
1228   $main::lxdebug->leave_sub();
1229 }
1230
1231 sub sic {
1232   $main::lxdebug->enter_sub();
1233
1234   my ($self, $myconfig, $form) = @_;
1235
1236   # connect to database
1237   my $dbh = $form->dbconnect($myconfig);
1238
1239   my $query = qq|SELECT code, sictype, description
1240                  FROM sic
1241                  ORDER BY code|;
1242
1243   $sth = $dbh->prepare($query);
1244   $sth->execute || $form->dberror($query);
1245
1246   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1247     push @{ $form->{ALL} }, $ref;
1248   }
1249
1250   $sth->finish;
1251   $dbh->disconnect;
1252
1253   $main::lxdebug->leave_sub();
1254 }
1255
1256 sub get_sic {
1257   $main::lxdebug->enter_sub();
1258
1259   my ($self, $myconfig, $form) = @_;
1260
1261   # connect to database
1262   my $dbh = $form->dbconnect($myconfig);
1263
1264   my $query = qq|SELECT s.code, s.sictype, s.description
1265                  FROM sic s
1266                  WHERE s.code = '$form->{code}'|;
1267   my $sth = $dbh->prepare($query);
1268   $sth->execute || $form->dberror($query);
1269
1270   my $ref = $sth->fetchrow_hashref(NAME_lc);
1271
1272   map { $form->{$_} = $ref->{$_} } keys %$ref;
1273
1274   $sth->finish;
1275
1276   $dbh->disconnect;
1277
1278   $main::lxdebug->leave_sub();
1279 }
1280
1281 sub save_sic {
1282   $main::lxdebug->enter_sub();
1283
1284   my ($self, $myconfig, $form) = @_;
1285
1286   # connect to database
1287   my $dbh = $form->dbconnect($myconfig);
1288
1289   $form->{code}        =~ s/\'/\'\'/g;
1290   $form->{description} =~ s/\'/\'\'/g;
1291
1292   # if there is an id
1293   if ($form->{id}) {
1294     $query = qq|UPDATE sic SET
1295                 code = '$form->{code}',
1296                 sictype = '$form->{sictype}',
1297                 description = '$form->{description}'
1298                 WHERE code = '$form->{id}'|;
1299   } else {
1300     $query = qq|INSERT INTO sic
1301                 (code, sictype, description)
1302                 VALUES ('$form->{code}', '$form->{sictype}', '$form->{description}')|;
1303   }
1304   $dbh->do($query) || $form->dberror($query);
1305
1306   $dbh->disconnect;
1307
1308   $main::lxdebug->leave_sub();
1309 }
1310
1311 sub delete_sic {
1312   $main::lxdebug->enter_sub();
1313
1314   my ($self, $myconfig, $form) = @_;
1315
1316   # connect to database
1317   my $dbh = $form->dbconnect($myconfig);
1318
1319   $query = qq|DELETE FROM sic
1320               WHERE code = '$form->{code}'|;
1321   $dbh->do($query) || $form->dberror($query);
1322
1323   $dbh->disconnect;
1324
1325   $main::lxdebug->leave_sub();
1326 }
1327
1328 sub load_template {
1329   $main::lxdebug->enter_sub();
1330
1331   my ($self, $form) = @_;
1332
1333   open(TEMPLATE, "$form->{file}") or $form->error("$form->{file} : $!");
1334
1335   while (<TEMPLATE>) {
1336     $form->{body} .= $_;
1337   }
1338
1339   close(TEMPLATE);
1340
1341   $main::lxdebug->leave_sub();
1342 }
1343
1344 sub save_template {
1345   $main::lxdebug->enter_sub();
1346
1347   my ($self, $form) = @_;
1348
1349   open(TEMPLATE, ">$form->{file}") or $form->error("$form->{file} : $!");
1350
1351   # strip
1352   $form->{body} =~ s/\r\n/\n/g;
1353   print TEMPLATE $form->{body};
1354
1355   close(TEMPLATE);
1356
1357   $main::lxdebug->leave_sub();
1358 }
1359
1360 sub save_preferences {
1361   $main::lxdebug->enter_sub();
1362
1363   my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_;
1364
1365   map { ($form->{$_}) = split(/--/, $form->{$_}) }
1366     qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno);
1367
1368   my @a;
1369   $form->{curr} =~ s/ //g;
1370   map { push(@a, uc pack "A3", $_) if $_ } split(/:/, $form->{curr});
1371   $form->{curr} = join ':', @a;
1372
1373   # connect to database
1374   my $dbh = $form->dbconnect_noauto($myconfig);
1375
1376   # these defaults are database wide
1377   # user specific variables are in myconfig
1378   # save defaults
1379   my $query = qq|UPDATE defaults SET
1380                  inventory_accno_id =
1381                      (SELECT c.id FROM chart c
1382                                 WHERE c.accno = '$form->{inventory_accno}'),
1383                  income_accno_id =
1384                      (SELECT c.id FROM chart c
1385                                 WHERE c.accno = '$form->{income_accno}'),
1386                  expense_accno_id =
1387                      (SELECT c.id FROM chart c
1388                                 WHERE c.accno = '$form->{expense_accno}'),
1389                  fxgain_accno_id =
1390                      (SELECT c.id FROM chart c
1391                                 WHERE c.accno = '$form->{fxgain_accno}'),
1392                  fxloss_accno_id =
1393                      (SELECT c.id FROM chart c
1394                                 WHERE c.accno = '$form->{fxloss_accno}'),
1395                  invnumber = '$form->{invnumber}',
1396                  cnnumber  = '$form->{cnnumber}',
1397                  sonumber = '$form->{sonumber}',
1398                  ponumber = '$form->{ponumber}',
1399                  sqnumber = '$form->{sqnumber}',
1400                  rfqnumber = '$form->{rfqnumber}',
1401                  customernumber = '$form->{customernumber}',
1402                  vendornumber = '$form->{vendornumber}',
1403                  articlenumber = '$form->{articlenumber}',
1404                  servicenumber = '$form->{servicenumber}',
1405                  yearend = '$form->{yearend}',
1406                  curr = '$form->{curr}',
1407                  businessnumber = '$form->{businessnumber}'
1408                 |;
1409   $dbh->do($query) || $form->dberror($query);
1410
1411   # update name
1412   my $name = $form->{name};
1413   $name =~ s/\'/\'\'/g;
1414   $query = qq|UPDATE employee
1415               SET name = '$name'
1416               WHERE login = '$form->{login}'|;
1417   $dbh->do($query) || $form->dberror($query);
1418
1419 #   foreach my $item (split(/ /, $form->{taxaccounts})) {
1420 #     $query = qq|UPDATE tax
1421 #               SET rate = | . ($form->{$item} / 100) . qq|,
1422 #               taxnumber = '$form->{"taxnumber_$item"}'
1423 #               WHERE chart_id = $item|;
1424 #     $dbh->do($query) || $form->dberror($query);
1425 #   }
1426
1427   my $rc = $dbh->commit;
1428   $dbh->disconnect;
1429
1430   # save first currency in myconfig
1431   $form->{currency} = substr($form->{curr}, 0, 3);
1432
1433   my $myconfig = new User "$memberfile", "$form->{login}";
1434
1435   foreach my $item (keys %$form) {
1436     $myconfig->{$item} = $form->{$item};
1437   }
1438
1439   $myconfig->save_member($memberfile, $userspath);
1440
1441   if ($webdav) {
1442     @webdavdirs =
1443       qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
1444     foreach $directory (@webdavdirs) {
1445       $file = "webdav/" . $directory . "/webdav-user";
1446       if ($myconfig->{$directory}) {
1447         open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1448         while (<HTACCESS>) {
1449           ($login, $password) = split(/:/, $_);
1450           if ($login ne $form->{login}) {
1451             $newfile .= $_;
1452           }
1453         }
1454         close(HTACCESS);
1455         open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1456         $newfile .= $myconfig->{login} . ":" . $myconfig->{password} . "\n";
1457         print(HTACCESS $newfile);
1458         close(HTACCESS);
1459       } else {
1460         $form->{$directory} = 0;
1461         open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1462         while (<HTACCESS>) {
1463           ($login, $password) = split(/:/, $_);
1464           if ($login ne $form->{login}) {
1465             $newfile .= $_;
1466           }
1467         }
1468         close(HTACCESS);
1469         open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1470         print(HTACCESS $newfile);
1471         close(HTACCESS);
1472       }
1473     }
1474   }
1475
1476   $main::lxdebug->leave_sub();
1477
1478   return $rc;
1479 }
1480
1481 sub defaultaccounts {
1482   $main::lxdebug->enter_sub();
1483
1484   my ($self, $myconfig, $form) = @_;
1485
1486   # connect to database
1487   my $dbh = $form->dbconnect($myconfig);
1488
1489   # get defaults from defaults table
1490   my $query = qq|SELECT * FROM defaults|;
1491   my $sth   = $dbh->prepare($query);
1492   $sth->execute || $form->dberror($query);
1493
1494   $form->{defaults}             = $sth->fetchrow_hashref(NAME_lc);
1495   $form->{defaults}{IC}         = $form->{defaults}{inventory_accno_id};
1496   $form->{defaults}{IC_income}  = $form->{defaults}{income_accno_id};
1497   $form->{defaults}{IC_expense} = $form->{defaults}{expense_accno_id};
1498   $form->{defaults}{FX_gain}    = $form->{defaults}{fxgain_accno_id};
1499   $form->{defaults}{FX_loss}    = $form->{defaults}{fxloss_accno_id};
1500
1501   $sth->finish;
1502
1503   $query = qq|SELECT c.id, c.accno, c.description, c.link
1504               FROM chart c
1505               WHERE c.link LIKE '%IC%'
1506               ORDER BY c.accno|;
1507   $sth = $dbh->prepare($query);
1508   $sth->execute || $self->dberror($query);
1509
1510   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1511     foreach my $key (split(/:/, $ref->{link})) {
1512       if ($key =~ /IC/) {
1513         $nkey = $key;
1514         if ($key =~ /cogs/) {
1515           $nkey = "IC_expense";
1516         }
1517         if ($key =~ /sale/) {
1518           $nkey = "IC_income";
1519         }
1520         %{ $form->{IC}{$nkey}{ $ref->{accno} } } = (
1521                                              id          => $ref->{id},
1522                                              description => $ref->{description}
1523         );
1524       }
1525     }
1526   }
1527   $sth->finish;
1528
1529   $query = qq|SELECT c.id, c.accno, c.description
1530               FROM chart c
1531               WHERE c.category = 'I'
1532               AND c.charttype = 'A'
1533               ORDER BY c.accno|;
1534   $sth = $dbh->prepare($query);
1535   $sth->execute || $self->dberror($query);
1536
1537   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1538     %{ $form->{IC}{FX_gain}{ $ref->{accno} } } = (
1539                                              id          => $ref->{id},
1540                                              description => $ref->{description}
1541     );
1542   }
1543   $sth->finish;
1544
1545   $query = qq|SELECT c.id, c.accno, c.description
1546               FROM chart c
1547               WHERE c.category = 'E'
1548               AND c.charttype = 'A'
1549               ORDER BY c.accno|;
1550   $sth = $dbh->prepare($query);
1551   $sth->execute || $self->dberror($query);
1552
1553   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1554     %{ $form->{IC}{FX_loss}{ $ref->{accno} } } = (
1555                                              id          => $ref->{id},
1556                                              description => $ref->{description}
1557     );
1558   }
1559   $sth->finish;
1560
1561   # now get the tax rates and numbers
1562   $query = qq|SELECT c.id, c.accno, c.description,
1563               t.rate * 100 AS rate, t.taxnumber
1564               FROM chart c, tax t
1565               WHERE c.id = t.chart_id|;
1566
1567   $sth = $dbh->prepare($query);
1568   $sth->execute || $form->dberror($query);
1569
1570   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1571     $form->{taxrates}{ $ref->{accno} }{id}          = $ref->{id};
1572     $form->{taxrates}{ $ref->{accno} }{description} = $ref->{description};
1573     $form->{taxrates}{ $ref->{accno} }{taxnumber}   = $ref->{taxnumber}
1574       if $ref->{taxnumber};
1575     $form->{taxrates}{ $ref->{accno} }{rate} = $ref->{rate} if $ref->{rate};
1576   }
1577
1578   $sth->finish;
1579   $dbh->disconnect;
1580
1581   $main::lxdebug->leave_sub();
1582 }
1583
1584 sub backup {
1585   $main::lxdebug->enter_sub();
1586
1587   my ($self, $myconfig, $form, $userspath) = @_;
1588
1589   my $mail;
1590   my $err;
1591   my $boundary = time;
1592   my $tmpfile  =
1593     "$userspath/$boundary.$myconfig->{dbname}-$form->{dbversion}.sql";
1594   my $out = $form->{OUT};
1595   $form->{OUT} = ">$tmpfile";
1596
1597   if ($form->{media} eq 'email') {
1598
1599     use SL::Mailer;
1600     $mail = new Mailer;
1601
1602     $mail->{to}      = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1603     $mail->{from}    = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1604     $mail->{subject} =
1605       "Lx-Office Backup / $myconfig->{dbname}-$form->{dbversion}.sql";
1606     @{ $mail->{attachments} } = ($tmpfile);
1607     $mail->{version} = $form->{version};
1608     $mail->{fileid}  = "$boundary.";
1609
1610     $myconfig->{signature} =~ s/\\n/\r\n/g;
1611     $mail->{message} = "--\n$myconfig->{signature}";
1612
1613   }
1614
1615   open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!");
1616
1617   # get sequences, functions and triggers
1618   open(FH, "sql/lx-office.sql") or $form->error("sql/lx-office.sql : $!");
1619
1620   my @sequences = ();
1621   my @functions = ();
1622   my @triggers  = ();
1623   my @indices   = ();
1624   my %tablespecs;
1625
1626   my $query = "";
1627   my @quote_chars;
1628
1629   while (<FH>) {
1630
1631     # Remove DOS and Unix style line endings.
1632     s/[\r\n]//g;
1633
1634     # ignore comments or empty lines
1635     next if /^(--.*|\s+)$/;
1636
1637     for (my $i = 0; $i < length($_); $i++) {
1638       my $char = substr($_, $i, 1);
1639
1640       # Are we inside a string?
1641       if (@quote_chars) {
1642         if ($char eq $quote_chars[-1]) {
1643           pop(@quote_chars);
1644         }
1645         $query .= $char;
1646
1647       } else {
1648         if (($char eq "'") || ($char eq "\"")) {
1649           push(@quote_chars, $char);
1650
1651         } elsif ($char eq ";") {
1652
1653           # Query is complete. Check for triggers and functions.
1654           if ($query =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1655             push(@functions, $query);
1656
1657           } elsif ($query =~ /^create\s+trigger\s+\"?(\w+)\"?/i) {
1658             push(@triggers, $query);
1659
1660           } elsif ($query =~ /^create\s+sequence\s+\"?(\w+)\"?/i) {
1661             push(@sequences, $1);
1662
1663           } elsif ($query =~ /^create\s+table\s+\"?(\w+)\"?/i) {
1664             $tablespecs{$1} = $query;
1665
1666           } elsif ($query =~ /^create\s+index\s+\"?(\w+)\"?/i) {
1667             push(@indices, $query);
1668
1669           }
1670
1671           $query = "";
1672           $char  = "";
1673         }
1674
1675         $query .= $char;
1676       }
1677     }
1678   }
1679   close(FH);
1680
1681   # connect to database
1682   my $dbh = $form->dbconnect($myconfig);
1683
1684   # get all the tables
1685   my @tables = $dbh->tables('', '', 'customer', '', { noprefix => 0 });
1686
1687   my $today = scalar localtime;
1688
1689   $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost};
1690
1691   print OUT qq|-- Lx-Office Backup
1692 -- Dataset: $myconfig->{dbname}
1693 -- Version: $form->{dbversion}
1694 -- Host: $myconfig->{dbhost}
1695 -- Login: $form->{login}
1696 -- User: $myconfig->{name}
1697 -- Date: $today
1698 --
1699 -- set options
1700 $myconfig->{dboptions};
1701 --
1702 |;
1703
1704   print OUT "-- DROP Sequences\n";
1705   my $item;
1706   foreach $item (@sequences) {
1707     print OUT qq|DROP SEQUENCE $item;\n|;
1708   }
1709
1710   print OUT "-- DROP Triggers\n";
1711
1712   foreach $item (@triggers) {
1713     if ($item =~ /^create\s+trigger\s+\"?(\w+)\"?\s+.*on\s+\"?(\w+)\"?\s+/i) {
1714       print OUT qq|DROP TRIGGER "$1" ON "$2";\n|;
1715     }
1716   }
1717
1718   print OUT "-- DROP Functions\n";
1719
1720   foreach $item (@functions) {
1721     if ($item =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1722       print OUT qq|DROP FUNCTION "$1" ();\n|;
1723     }
1724   }
1725
1726   foreach $table (@tables) {
1727     if (!($table =~ /^sql_.*/)) {
1728       my $query = qq|SELECT * FROM $table|;
1729
1730       my $sth = $dbh->prepare($query);
1731       $sth->execute || $form->dberror($query);
1732
1733       $query = "INSERT INTO $table (";
1734       map { $query .= qq|$sth->{NAME}->[$_],| }
1735         (0 .. $sth->{NUM_OF_FIELDS} - 1);
1736       chop $query;
1737
1738       $query .= ") VALUES";
1739
1740       if ($tablespecs{$table}) {
1741         print(OUT "--\n");
1742         print(OUT "DROP TABLE $table;\n");
1743         print(OUT $tablespecs{$table}, ";\n");
1744       } else {
1745         print(OUT "--\n");
1746         print(OUT "DELETE FROM $table;\n");
1747       }
1748       while (my @arr = $sth->fetchrow_array) {
1749
1750         $fields = "(";
1751         foreach my $item (@arr) {
1752           if (defined $item) {
1753             $item =~ s/\'/\'\'/g;
1754             $fields .= qq|'$item',|;
1755           } else {
1756             $fields .= 'NULL,';
1757           }
1758         }
1759
1760         chop $fields;
1761         $fields .= ")";
1762
1763         print OUT qq|$query $fields;\n|;
1764       }
1765
1766       $sth->finish;
1767     }
1768   }
1769
1770   # create indices, sequences, functions and triggers
1771
1772   print(OUT "-- CREATE Indices\n");
1773   map({ print(OUT "$_;\n"); } @indices);
1774
1775   print OUT "-- CREATE Sequences\n";
1776   foreach $item (@sequences) {
1777     $query = qq|SELECT last_value FROM $item|;
1778     $sth   = $dbh->prepare($query);
1779     $sth->execute || $form->dberror($query);
1780     my ($id) = $sth->fetchrow_array;
1781     $sth->finish;
1782
1783     print OUT qq|--
1784 CREATE SEQUENCE $item START $id;
1785 |;
1786   }
1787
1788   print OUT "-- CREATE Functions\n";
1789
1790   # functions
1791   map { print(OUT $_, ";\n"); } @functions;
1792
1793   print OUT "-- CREATE Triggers\n";
1794
1795   # triggers
1796   map { print(OUT $_, ";\n"); } @triggers;
1797
1798   close(OUT);
1799
1800   $dbh->disconnect;
1801
1802   # compress backup
1803   my @args = ("gzip", "$tmpfile");
1804   system(@args) == 0 or $form->error("$args[0] : $?");
1805
1806   $tmpfile .= ".gz";
1807
1808   if ($form->{media} eq 'email') {
1809     @{ $mail->{attachments} } = ($tmpfile);
1810     $err = $mail->send($out);
1811   }
1812
1813   if ($form->{media} eq 'file') {
1814
1815     open(IN,  "$tmpfile") or $form->error("$tmpfile : $!");
1816     open(OUT, ">-")       or $form->error("STDOUT : $!");
1817
1818     print OUT qq|Content-Type: application/x-tar-gzip;
1819 Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}.sql.gz"
1820
1821 |;
1822
1823     while (<IN>) {
1824       print OUT $_;
1825     }
1826
1827     close(IN);
1828     close(OUT);
1829
1830   }
1831
1832   unlink "$tmpfile";
1833
1834   $main::lxdebug->leave_sub();
1835 }
1836
1837 sub closedto {
1838   $main::lxdebug->enter_sub();
1839
1840   my ($self, $myconfig, $form) = @_;
1841
1842   my $dbh = $form->dbconnect($myconfig);
1843
1844   my $query = qq|SELECT closedto, revtrans FROM defaults|;
1845   my $sth   = $dbh->prepare($query);
1846   $sth->execute || $form->dberror($query);
1847
1848   ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
1849
1850   $sth->finish;
1851
1852   $dbh->disconnect;
1853
1854   $main::lxdebug->leave_sub();
1855 }
1856
1857 sub closebooks {
1858   $main::lxdebug->enter_sub();
1859
1860   my ($self, $myconfig, $form) = @_;
1861
1862   my $dbh = $form->dbconnect($myconfig);
1863
1864   if ($form->{revtrans}) {
1865
1866     $query = qq|UPDATE defaults SET closedto = NULL,
1867                                     revtrans = '1'|;
1868   } elsif ($form->{closedto}) {
1869
1870     $query = qq|UPDATE defaults SET closedto = '$form->{closedto}',
1871                                       revtrans = '0'|;
1872   } else {
1873
1874     $query = qq|UPDATE defaults SET closedto = NULL,
1875                                       revtrans = '0'|;
1876   }
1877
1878   # set close in defaults
1879   $dbh->do($query) || $form->dberror($query);
1880
1881   $dbh->disconnect;
1882
1883   $main::lxdebug->leave_sub();
1884 }
1885
1886 sub get_base_unit {
1887   my ($self, $units, $unit_name, $factor) = @_;
1888
1889   $factor = 1 unless ($factor);
1890
1891   my $unit = $units->{$unit_name};
1892
1893   if (!defined($unit) || !$unit->{"base_unit"} ||
1894       ($unit_name eq $unit->{"base_unit"})) {
1895     return ($unit_name, $factor);
1896   }
1897
1898   return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"});
1899 }
1900
1901 sub retrieve_units {
1902   $main::lxdebug->enter_sub();
1903
1904   my ($self, $myconfig, $form, $type, $prefix) = @_;
1905
1906   my $dbh = $form->dbconnect($myconfig);
1907
1908   my $query = "SELECT *, base_unit AS original_base_unit FROM units";
1909   my @values;
1910   if ($type) {
1911     $query .= " WHERE (type = ?)";
1912     @values = ($type);
1913   }
1914
1915   my $sth = $dbh->prepare($query);
1916   $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
1917
1918   my $units = {};
1919   while (my $ref = $sth->fetchrow_hashref()) {
1920     $units->{$ref->{"name"}} = $ref;
1921   }
1922   $sth->finish();
1923
1924   my $query_lang = "SELECT id, template_code FROM language ORDER BY description";
1925   $sth = $dbh->prepare($query_lang);
1926   $sth->execute() || $form->dberror($query_lang);
1927   my @languages;
1928   while ($ref = $sth->fetchrow_hashref()) {
1929     push(@languages, $ref);
1930   }
1931   $sth->finish();
1932
1933   $query_lang = "SELECT ul.localized, ul.localized_plural, l.id, l.template_code " .
1934     "FROM units_language ul " .
1935     "LEFT JOIN language l ON ul.language_id = l.id " .
1936     "WHERE ul.unit = ?";
1937   $sth = $dbh->prepare($query_lang);
1938
1939   foreach my $unit (values(%{$units})) {
1940     ($unit->{"${prefix}base_unit"}, $unit->{"${prefix}factor"}) = AM->get_base_unit($units, $unit->{"name"});
1941
1942     $unit->{"LANGUAGES"} = {};
1943     foreach my $lang (@languages) {
1944       $unit->{"LANGUAGES"}->{$lang->{"template_code"}} = { "template_code" => $lang->{"template_code"} };
1945     }
1946
1947     $sth->execute($unit->{"name"}) || $form->dberror($query_lang . " (" . $unit->{"name"} . ")");
1948     while ($ref = $sth->fetchrow_hashref()) {
1949       map({ $unit->{"LANGUAGES"}->{$ref->{"template_code"}}->{$_} = $ref->{$_} } keys(%{$ref}));
1950     }
1951   }
1952   $sth->finish();
1953
1954   $dbh->disconnect();
1955
1956   $main::lxdebug->leave_sub();
1957
1958   return $units;
1959 }
1960
1961 sub translate_units {
1962   $main::lxdebug->enter_sub();
1963
1964   my ($self, $form, $template_code, $unit, $amount) = @_;
1965
1966   my $units = $self->retrieve_units(\%main::myconfig, $form);
1967
1968   my $h = $units->{$unit}->{"LANGUAGES"}->{$template_code};
1969   my $new_unit = $unit;
1970   if ($h) {
1971     if (($amount != 1) && $h->{"localized_plural"}) {
1972       $new_unit = $h->{"localized_plural"};
1973     } elsif ($h->{"localized"}) {
1974       $new_unit = $h->{"localized"};
1975     }
1976   }
1977
1978   $main::lxdebug->leave_sub();
1979
1980   return $new_unit;
1981 }
1982
1983 sub units_in_use {
1984   $main::lxdebug->enter_sub();
1985
1986   my ($self, $myconfig, $form, $units) = @_;
1987
1988   my $dbh = $form->dbconnect($myconfig);
1989
1990   foreach my $unit (values(%{$units})) {
1991     my $base_unit = $unit->{"original_base_unit"};
1992     while ($base_unit) {
1993       $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"});
1994       push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"});
1995       $base_unit = $units->{$base_unit}->{"original_base_unit"};
1996     }
1997   }
1998
1999   foreach my $unit (values(%{$units})) {
2000     $unit->{"in_use"} = 0;
2001     map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}});
2002
2003     foreach my $table (qw(parts invoice orderitems)) {
2004       my $query = "SELECT COUNT(*) FROM $table WHERE unit ";
2005
2006       if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) {
2007         $query .= "= " . $dbh->quote($unit->{"name"});
2008       } else {
2009         $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," . join(",", @{$unit->{"DEPENDING_UNITS"}}) . ")";
2010       }
2011
2012       my ($count) = $dbh->selectrow_array($query);
2013       $form->dberror($query) if ($dbh->err);
2014
2015       if ($count) {
2016         $unit->{"in_use"} = 1;
2017         last;
2018       }
2019     }
2020   }
2021
2022   $dbh->disconnect();
2023
2024   $main::lxdebug->leave_sub();
2025 }
2026
2027 sub unit_select_data {
2028   $main::lxdebug->enter_sub();
2029
2030   my ($self, $units, $selected, $empty_entry) = @_;
2031
2032   my $select = [];
2033
2034   if ($empty_entry) {
2035     push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" });
2036   }
2037
2038   foreach my $unit (sort({ $a->{"sortkey"} <=> $b->{"sortkey"} } keys(%{$units}))) {
2039     push(@{$select}, { "name" => $unit,
2040                        "base_unit" => $units->{$unit}->{"base_unit"},
2041                        "factor" => $units->{$unit}->{"factor"},
2042                        "selected" => ($unit eq $selected) ? "selected" : "" });
2043   }
2044
2045   $main::lxdebug->leave_sub();
2046
2047   return $select;
2048 }
2049
2050 sub unit_select_html {
2051   $main::lxdebug->enter_sub();
2052
2053   my ($self, $units, $name, $selected, $convertible_into) = @_;
2054
2055   my $select = "<select name=${name}>";
2056
2057   foreach my $unit (sort({ $a->{"sortkey"} <=> $b->{"sortkey"} } keys(%{$units}))) {
2058     if (!$convertible_into ||
2059         ($units->{$convertible_into} &&
2060          ($units->{$convertible_into}->{"base_unit"} eq $units->{$unit}->{"base_unit"}))) {
2061       $select .= "<option" . (($unit eq $selected) ? " selected" : "") . ">${unit}</option>";
2062     }
2063   }
2064   $select .= "</select>";
2065
2066   $main::lxdebug->leave_sub();
2067
2068   return $select;
2069 }
2070
2071 sub add_unit {
2072   $main::lxdebug->enter_sub();
2073
2074   my ($self, $myconfig, $form, $name, $base_unit, $factor, $type, $languages) = @_;
2075
2076   my $dbh = $form->dbconnect_noauto($myconfig);
2077
2078   my $query = qq|SELECT COALESCE(MAX(sortkey), 0) + 1 FROM units|;
2079   my ($sortkey) = selectrow_query($form, $dbh, $query);
2080
2081   $query = "INSERT INTO units (name, base_unit, factor, type, sortkey) " .
2082     "VALUES (?, ?, ?, ?, ?)";
2083   do_query($form, $dbh, $query, $name, $base_unit, $factor, $type, $sortkey);
2084
2085   if ($languages) {
2086     $query = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
2087     my $sth = $dbh->prepare($query);
2088     foreach my $lang (@{$languages}) {
2089       my @values = ($name, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
2090       $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
2091     }
2092     $sth->finish();
2093   }
2094
2095   $dbh->commit();
2096   $dbh->disconnect();
2097
2098   $main::lxdebug->leave_sub();
2099 }
2100
2101 sub save_units {
2102   $main::lxdebug->enter_sub();
2103
2104   my ($self, $myconfig, $form, $type, $units, $delete_units) = @_;
2105
2106   my $dbh = $form->dbconnect_noauto($myconfig);
2107
2108   my ($base_unit, $unit, $sth, $query);
2109
2110   $query = "DELETE FROM units_language";
2111   $dbh->do($query) || $form->dberror($query);
2112
2113   if ($delete_units && (0 != scalar(@{$delete_units}))) {
2114     $query = "DELETE FROM units WHERE name IN (";
2115     map({ $query .= "?," } @{$delete_units});
2116     substr($query, -1, 1) = ")";
2117     $dbh->do($query, undef, @{$delete_units}) ||
2118       $form->dberror($query . " (" . join(", ", @{$delete_units}) . ")");
2119   }
2120
2121   $query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?";
2122   $sth = $dbh->prepare($query);
2123
2124   my $query_lang = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
2125   my $sth_lang = $dbh->prepare($query_lang);
2126
2127   foreach $unit (values(%{$units})) {
2128     $unit->{"depth"} = 0;
2129     my $base_unit = $unit;
2130     while ($base_unit->{"base_unit"}) {
2131       $unit->{"depth"}++;
2132       $base_unit = $units->{$base_unit->{"base_unit"}};
2133     }
2134   }
2135
2136   foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) {
2137     if ($unit->{"LANGUAGES"}) {
2138       foreach my $lang (@{$unit->{"LANGUAGES"}}) {
2139         next unless ($lang->{"id"} && $lang->{"localized"});
2140         my @values = ($unit->{"name"}, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
2141         $sth_lang->execute(@values) || $form->dberror($query_lang . " (" . join(", ", @values) . ")");
2142       }
2143     }
2144
2145     next if ($unit->{"unchanged_unit"});
2146
2147     my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"});
2148     $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
2149   }
2150
2151   $sth->finish();
2152   $sth_lang->finish();
2153   $dbh->commit();
2154   $dbh->disconnect();
2155
2156   $main::lxdebug->leave_sub();
2157 }
2158
2159 sub swap_units {
2160   $main::lxdebug->enter_sub();
2161
2162   my ($self, $myconfig, $form, $dir, $name_1, $unit_type) = @_;
2163
2164   my $dbh = $form->dbconnect_noauto($myconfig);
2165
2166   my $query;
2167
2168   $query = qq|SELECT sortkey FROM units WHERE name = ?|;
2169   my ($sortkey_1) = selectrow_query($form, $dbh, $query, $name_1);
2170
2171   $query =
2172     qq|SELECT sortkey FROM units | .
2173     qq|WHERE sortkey | . ($dir eq "down" ? ">" : "<") . qq| ? AND type = ? | .
2174     qq|ORDER BY sortkey | . ($dir eq "down" ? "ASC" : "DESC") . qq| LIMIT 1|;
2175   my ($sortkey_2) = selectrow_query($form, $dbh, $query, $sortkey_1, $unit_type);
2176
2177   if (defined($sortkey_1)) {
2178     $query = qq|SELECT name FROM units WHERE sortkey = ${sortkey_2}|;
2179     my ($name_2) = selectrow_query($form, $dbh, $query);
2180
2181     if (defined($name_2)) {
2182       $query = qq|UPDATE units SET sortkey = ? WHERE name = ?|;
2183       my $sth = $dbh->prepare($query);
2184
2185       do_statement($form, $sth, $query, $sortkey_1, $name_2);
2186       do_statement($form, $sth, $query, $sortkey_2, $name_1);
2187     }
2188   }
2189
2190   $dbh->commit();
2191   $dbh->disconnect();
2192
2193   $main::lxdebug->leave_sub();
2194 }
2195
2196 1;