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