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 Carp;
  41 use Data::Dumper;
  42 use Encode;
  43 use List::MoreUtils qw(any);
  44 use SL::DBUtils;
  45 use SL::DB::AuthUser;
  46 use SL::DB::Default;
  47 use SL::DB::Employee;
  48 use SL::DB::Chart;
  49 use SL::GenericTranslations;
  50
  51 use strict;
  52
  53 sub get_account {
  54   $main::lxdebug->enter_sub();
  55
  56   my ($self, $myconfig, $form) = @_;
  57
  58
  59   my $chart_obj = SL::DB::Manager::Chart->find_by(id => $form->{id}) || die "Can't open chart";
  60
  61   # connect to database
  62   my $dbh = $form->dbconnect($myconfig);
  63   my $query = qq{
  64     SELECT c.accno, c.description, c.charttype, c.category,
  65       c.link, c.pos_bilanz, c.pos_eur, c.pos_er, c.new_chart_id, c.valid_from,
  66       c.pos_bwa, datevautomatik,
  67       tk.taxkey_id, tk.pos_ustva, tk.tax_id,
  68       tk.tax_id || '--' || tk.taxkey_id AS tax, tk.startdate
  69     FROM chart c
  70     LEFT JOIN taxkeys tk
  71     ON (c.id=tk.chart_id AND tk.id =
  72       (SELECT id FROM taxkeys
  73        WHERE taxkeys.chart_id = c.id AND startdate <= current_date
  74        ORDER BY startdate DESC LIMIT 1))
  75     WHERE c.id = ?
  76     };
  77
  78
  79   $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
  80   my $sth = $dbh->prepare($query);
  81   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
  82
  83   my $ref = $sth->fetchrow_hashref("NAME_lc");
  84
  85   foreach my $key (keys %$ref) {
  86     $form->{"$key"} = $ref->{"$key"};
  87   }
  88
  89   $sth->finish;
  90
  91   # get default accounts
  92   $query = qq|SELECT inventory_accno_id, income_accno_id, expense_accno_id
  93               FROM defaults|;
  94   $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
  95   $sth = $dbh->prepare($query);
  96   $sth->execute || $form->dberror($query);
  97
  98   $ref = $sth->fetchrow_hashref("NAME_lc");
  99
 100   map { $form->{$_} = $ref->{$_} } keys %{ $ref };
 101
 102   $sth->finish;
 103
 104
 105
 106   # get taxkeys and description
 107   $query = qq{
 108     SELECT
 109       id,
 110       (SELECT accno FROM chart WHERE id=tax.chart_id) AS chart_accno,
 111       taxkey,
 112       id||'--'||taxkey AS tax,
 113       taxdescription,
 114       rate
 115     FROM tax ORDER BY taxkey
 116   };
 117   $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
 118   $sth = $dbh->prepare($query);
 119   $sth->execute || $form->dberror($query);
 120
 121   $form->{TAXKEY} = [];
 122
 123   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 124     push @{ $form->{TAXKEY} }, $ref;
 125   }
 126
 127   $sth->finish;
 128   if ($form->{id}) {
 129     # get new accounts
 130     $query = qq|SELECT id, accno,description
 131                 FROM chart
 132                 WHERE link = ?
 133                 ORDER BY accno|;
 134     $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
 135     $sth = $dbh->prepare($query);
 136     $sth->execute($form->{link}) || $form->dberror($query . " ($form->{link})");
 137
 138     $form->{NEWACCOUNT} = [];
 139     while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 140       push @{ $form->{NEWACCOUNT} }, $ref;
 141     }
 142
 143     $sth->finish;
 144
 145     # get the taxkeys of account
 146
 147     $query = qq{
 148       SELECT
 149         tk.id,
 150         tk.chart_id,
 151         c.accno,
 152         tk.tax_id,
 153         t.taxdescription,
 154         t.rate,
 155         tk.taxkey_id,
 156         tk.pos_ustva,
 157         tk.startdate
 158       FROM taxkeys tk
 159       LEFT JOIN   tax t ON (t.id = tk.tax_id)
 160       LEFT JOIN chart c ON (c.id = t.chart_id)
 161
 162       WHERE tk.chart_id = ?
 163       ORDER BY startdate DESC
 164     };
 165     $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
 166     $sth = $dbh->prepare($query);
 167
 168     $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 169
 170     $form->{ACCOUNT_TAXKEYS} = [];
 171
 172     while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 173       push @{ $form->{ACCOUNT_TAXKEYS} }, $ref;
 174     }
 175
 176     $sth->finish;
 177
 178   }
 179
 180   # check if there any transactions for this chart
 181   $form->{orphaned} = $chart_obj->has_transaction ? 0 : 1;
 182
 183   # check if new account is active
 184   $form->{new_chart_valid} = 0;
 185   if ($form->{new_chart_id}) {
 186     $query = qq|SELECT current_date-valid_from FROM chart
 187                 WHERE id = ?|;
 188     $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
 189     my ($count) = selectrow_query($form, $dbh, $query, $form->{id});
 190     if ($count >=0) {
 191       $form->{new_chart_valid} = 1;
 192     }
 193     $sth->finish;
 194   }
 195
 196   $dbh->disconnect;
 197
 198   $main::lxdebug->leave_sub();
 199 }
 200
 201 sub save_account {
 202   $main::lxdebug->enter_sub();
 203
 204   # TODO: it should be forbidden to change an account to a heading if there
 205   # have been bookings to this account in the past
 206
 207   my ($self, $myconfig, $form) = @_;
 208
 209   # connect to database, turn off AutoCommit
 210   my $dbh = $form->dbconnect_noauto($myconfig);
 211
 212   for (qw(AR_include_in_dropdown AP_include_in_dropdown summary_account)) {
 213     $form->{$form->{$_}} = $form->{$_} if $form->{$_};
 214   }
 215
 216   # sanity check, can't have AR with AR_...
 217   if ($form->{AR} || $form->{AP} || $form->{IC}) {
 218     if (any { $form->{$_} } 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)) {
 219       $form->error($::locale->text('It is not allowed that a summary account occurs in a drop-down menu!'));
 220     }
 221   }
 222
 223   $form->{link} = "";
 224   foreach my $item ($form->{AR},            $form->{AR_amount},
 225                     $form->{AR_tax},        $form->{AR_paid},
 226                     $form->{AP},            $form->{AP_amount},
 227                     $form->{AP_tax},        $form->{AP_paid},
 228                     $form->{IC},            $form->{IC_sale},
 229                     $form->{IC_cogs},       $form->{IC_taxpart},
 230                     $form->{IC_income},     $form->{IC_expense},
 231                     $form->{IC_taxservice}
 232     ) {
 233     $form->{link} .= "${item}:" if ($item);
 234   }
 235   chop $form->{link};
 236
 237   # strip blanks from accno
 238   map { $form->{$_} =~ s/ //g; } qw(accno);
 239
 240   my ($query, $sth);
 241
 242   if ($form->{id} eq "NULL") {
 243     $form->{id} = "";
 244   }
 245
 246   $query = '
 247     SELECT accno
 248     FROM chart
 249     WHERE accno = ?';
 250
 251   my @values = ($form->{accno});
 252
 253   if ( $form->{id} ) {
 254     $query .= ' AND NOT id = ?';
 255     push(@values, $form->{id});
 256   }
 257
 258   my ($accno) = selectrow_query($form, $dbh, $query, @values);
 259
 260   if ($accno) {
 261     $form->error($::locale->text('Account number not unique!'));
 262   }
 263
 264
 265   if (!$form->{id} || $form->{id} eq "") {
 266     $query = qq|SELECT nextval('id')|;
 267     ($form->{"id"}) = selectrow_query($form, $dbh, $query);
 268     $query = qq|INSERT INTO chart (id, accno, link) VALUES (?, ?, ?)|;
 269     do_query($form, $dbh, $query, $form->{"id"}, $form->{"accno"}, '');
 270   }
 271
 272   @values = ();
 273
 274
 275   if ($form->{id}) {
 276
 277     # if charttype is heading make sure certain values are empty
 278     # specifically, if charttype is changed from an existing account, empty the
 279     # fields unnecessary for headings, so that e.g. heading doesn't appear in
 280     # drop-down menues due to still having a valid "link" entry
 281
 282     if ( $form->{charttype} eq 'H' ) {
 283       $form->{link} = '';
 284       $form->{pos_bwa} = '';
 285       $form->{pos_bilanz} = '';
 286       $form->{pos_eur} = '';
 287       $form->{new_chart_id} = '';
 288       $form->{valid_from} = '';
 289     };
 290
 291     $query = qq|UPDATE chart SET
 292                   accno = ?,
 293                   description = ?,
 294                   charttype = ?,
 295                   category = ?,
 296                   link = ?,
 297                   pos_bwa   = ?,
 298                   pos_bilanz = ?,
 299                   pos_eur = ?,
 300                   pos_er = ?,
 301                   new_chart_id = ?,
 302                   valid_from = ?,
 303                   datevautomatik = ?
 304                 WHERE id = ?|;
 305
 306     @values = (
 307                   $form->{accno},
 308                   $form->{description},
 309                   $form->{charttype},
 310                   $form->{category},
 311                   $form->{link},
 312                   conv_i($form->{pos_bwa}),
 313                   conv_i($form->{pos_bilanz}),
 314                   conv_i($form->{pos_eur}),
 315                   conv_i($form->{pos_er}),
 316                   conv_i($form->{new_chart_id}),
 317                   conv_date($form->{valid_from}),
 318                   ($form->{datevautomatik} eq 'T') ? 'true':'false',
 319                 $form->{id},
 320     );
 321
 322
 323   }
 324
 325   do_query($form, $dbh, $query, @values);
 326
 327   #Save Taxkeys
 328
 329   my @taxkeys = ();
 330
 331   my $MAX_TRIES = 10; # Maximum count of taxkeys in form
 332   my $tk_count;
 333
 334   READTAXKEYS:
 335   for $tk_count (0 .. $MAX_TRIES) {
 336
 337     # Loop control
 338
 339     # Check if the account already exists, else cancel
 340
 341     print(STDERR "Keine Taxkeys weil ID =: $form->{id}\n");
 342
 343     last READTAXKEYS if ( $form->{'id'} == 0);
 344
 345     # check if there is a startdate
 346     if ( $form->{"taxkey_startdate_$tk_count"} eq '' ) {
 347       $tk_count++;
 348       next READTAXKEYS;
 349     }
 350
 351     # Add valid taxkeys into the array
 352     push @taxkeys ,
 353       {
 354         id        => ($form->{"taxkey_id_$tk_count"} eq 'NEW') ? conv_i('') : conv_i($form->{"taxkey_id_$tk_count"}),
 355         tax_id    => conv_i($form->{"taxkey_tax_$tk_count"}),
 356         startdate => conv_date($form->{"taxkey_startdate_$tk_count"}),
 357         chart_id  => conv_i($form->{"id"}),
 358         pos_ustva => conv_i($form->{"taxkey_pos_ustva_$tk_count"}),
 359         delete    => ( $form->{"taxkey_del_$tk_count"} eq 'delete' ) ? '1' : '',
 360       };
 361
 362     $tk_count++;
 363   }
 364
 365   TAXKEY:
 366   for my $j (0 .. $#taxkeys){
 367     if ( defined $taxkeys[$j]{'id'} ){
 368       # delete Taxkey?
 369
 370       if ($taxkeys[$j]{'delete'}){
 371         $query = qq{
 372           DELETE FROM taxkeys WHERE id = ?
 373         };
 374
 375         @values = ($taxkeys[$j]{'id'});
 376
 377         do_query($form, $dbh, $query, @values);
 378
 379         next TAXKEY;
 380       }
 381
 382       # UPDATE Taxkey
 383
 384       $query = qq{
 385         UPDATE taxkeys
 386         SET taxkey_id = (SELECT taxkey FROM tax WHERE tax.id = ?),
 387             chart_id  = ?,
 388             tax_id    = ?,
 389             pos_ustva = ?,
 390             startdate = ?
 391         WHERE id = ?
 392       };
 393       @values = (
 394         $taxkeys[$j]{'tax_id'},
 395         $taxkeys[$j]{'chart_id'},
 396         $taxkeys[$j]{'tax_id'},
 397         $taxkeys[$j]{'pos_ustva'},
 398         $taxkeys[$j]{'startdate'},
 399         $taxkeys[$j]{'id'},
 400       );
 401       do_query($form, $dbh, $query, @values);
 402     }
 403     else {
 404       # INSERT Taxkey
 405
 406       $query = qq{
 407         INSERT INTO taxkeys (
 408           taxkey_id,
 409           chart_id,
 410           tax_id,
 411           pos_ustva,
 412           startdate
 413         )
 414         VALUES ((SELECT taxkey FROM tax WHERE tax.id = ?), ?, ?, ?, ?)
 415       };
 416       @values = (
 417         $taxkeys[$j]{'tax_id'},
 418         $taxkeys[$j]{'chart_id'},
 419         $taxkeys[$j]{'tax_id'},
 420         $taxkeys[$j]{'pos_ustva'},
 421         $taxkeys[$j]{'startdate'},
 422       );
 423
 424       do_query($form, $dbh, $query, @values);
 425     }
 426
 427   }
 428
 429   # Update chart.taxkey_id to the latest from taxkeys for this chart.
 430   $query = <<SQL;
 431     UPDATE chart
 432     SET taxkey_id = (
 433       SELECT taxkey_id
 434       FROM taxkeys
 435       WHERE taxkeys.chart_id = chart.id
 436       ORDER BY startdate DESC
 437       LIMIT 1
 438     )
 439     WHERE id = ?
 440 SQL
 441
 442   do_query($form, $dbh, $query, $form->{id});
 443
 444   # commit
 445   my $rc = $dbh->commit;
 446   $dbh->disconnect;
 447
 448   $main::lxdebug->leave_sub();
 449
 450   return $rc;
 451 }
 452
 453 sub delete_account {
 454   $main::lxdebug->enter_sub();
 455
 456   my ($self, $myconfig, $form) = @_;
 457
 458   # connect to database, turn off AutoCommit
 459   my $dbh = $form->dbconnect_noauto($myconfig);
 460
 461   my $query = qq|SELECT count(*) FROM acc_trans a
 462                  WHERE a.chart_id = ?|;
 463   my ($count) = selectrow_query($form, $dbh, $query, $form->{id});
 464
 465   if ($count) {
 466     $dbh->disconnect;
 467     $main::lxdebug->leave_sub();
 468     return;
 469   }
 470
 471   # set inventory_accno_id, income_accno_id, expense_accno_id to defaults
 472   foreach my $type (qw(inventory income expense)) {
 473     $query =
 474       qq|UPDATE parts | .
 475       qq|SET ${type}_accno_id = (SELECT ${type}_accno_id FROM defaults) | .
 476       qq|WHERE ${type}_accno_id = ?|;
 477     do_query($form, $dbh, $query, $form->{id});
 478   }
 479
 480   $query = qq|DELETE FROM tax
 481               WHERE chart_id = ?|;
 482   do_query($form, $dbh, $query, $form->{id});
 483
 484   # delete account taxkeys
 485   $query = qq|DELETE FROM taxkeys
 486               WHERE chart_id = ?|;
 487   do_query($form, $dbh, $query, $form->{id});
 488
 489   # delete chart of account record
 490   # last step delete chart, because we have a constraint
 491   # to taxkeys
 492   $query = qq|DELETE FROM chart
 493               WHERE id = ?|;
 494   do_query($form, $dbh, $query, $form->{id});
 495
 496   # commit and redirect
 497   my $rc = $dbh->commit;
 498   $dbh->disconnect;
 499
 500   $main::lxdebug->leave_sub();
 501
 502   return $rc;
 503 }
 504
 505 sub lead {
 506   $main::lxdebug->enter_sub();
 507
 508   my ($self, $myconfig, $form) = @_;
 509
 510   # connect to database
 511   my $dbh = $form->dbconnect($myconfig);
 512
 513   my $query = qq|SELECT id, lead
 514                  FROM leads
 515                  ORDER BY 2|;
 516
 517   my $sth = $dbh->prepare($query);
 518   $sth->execute || $form->dberror($query);
 519
 520   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 521     push @{ $form->{ALL} }, $ref;
 522   }
 523
 524   $sth->finish;
 525   $dbh->disconnect;
 526
 527   $main::lxdebug->leave_sub();
 528 }
 529
 530 sub get_lead {
 531   $main::lxdebug->enter_sub();
 532
 533   my ($self, $myconfig, $form) = @_;
 534
 535   # connect to database
 536   my $dbh = $form->dbconnect($myconfig);
 537
 538   my $query =
 539     qq|SELECT l.id, l.lead | .
 540     qq|FROM leads l | .
 541     qq|WHERE l.id = ?|;
 542   my $sth = $dbh->prepare($query);
 543   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
 544
 545   my $ref = $sth->fetchrow_hashref("NAME_lc");
 546
 547   map { $form->{$_} = $ref->{$_} } keys %$ref;
 548
 549   $sth->finish;
 550
 551   $dbh->disconnect;
 552
 553   $main::lxdebug->leave_sub();
 554 }
 555
 556 sub save_lead {
 557   $main::lxdebug->enter_sub();
 558
 559   my ($self, $myconfig, $form) = @_;
 560   my ($query);
 561
 562   # connect to database
 563   my $dbh = $form->dbconnect($myconfig);
 564
 565   my @values = ($form->{description});
 566   # id is the old record
 567   if ($form->{id}) {
 568     $query = qq|UPDATE leads SET
 569                 lead = ?
 570                 WHERE id = ?|;
 571     push(@values, $form->{id});
 572   } else {
 573     $query = qq|INSERT INTO leads
 574                 (lead)
 575                 VALUES (?)|;
 576   }
 577   do_query($form, $dbh, $query, @values);
 578
 579   $dbh->disconnect;
 580
 581   $main::lxdebug->leave_sub();
 582 }
 583
 584 sub delete_lead {
 585   $main::lxdebug->enter_sub();
 586
 587   my ($self, $myconfig, $form) = @_;
 588   my ($query);
 589
 590   # connect to database
 591   my $dbh = $form->dbconnect($myconfig);
 592
 593   $query = qq|DELETE FROM leads
 594               WHERE id = ?|;
 595   do_query($form, $dbh, $query, $form->{id});
 596
 597   $dbh->disconnect;
 598
 599   $main::lxdebug->leave_sub();
 600 }
 601
 602 sub language {
 603   $main::lxdebug->enter_sub();
 604
 605   my ($self, $myconfig, $form, $return_list) = @_;
 606
 607   # connect to database
 608   my $dbh = $form->dbconnect($myconfig);
 609
 610   my $query =
 611     "SELECT id, description, template_code, article_code, " .
 612     "  output_numberformat, output_dateformat, output_longdates " .
 613     "FROM language ORDER BY description";
 614
 615   my $sth = $dbh->prepare($query);
 616   $sth->execute || $form->dberror($query);
 617
 618   my $ary = [];
 619
 620   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
 621     push(@{ $ary }, $ref);
 622   }
 623
 624   $sth->finish;
 625   $dbh->disconnect;
 626
 627   $main::lxdebug->leave_sub();
 628
 629   if ($return_list) {
 630     return @{$ary};
 631   } else {
 632     $form->{ALL} = $ary;
 633   }
 634 }
 635
 636 sub get_language {
 637   $main::lxdebug->enter_sub();
 638
 639   my ($self, $myconfig, $form) = @_;
 640
 641   # connect to database
 642   my $dbh = $form->dbconnect($myconfig);
 643
 644   my $query =
 645     "SELECT description, template_code, article_code, " .
 646     "  output_numberformat, output_dateformat, output_longdates " .
 647     "FROM language WHERE id = ?";
 648   my $sth = $dbh->prepare($query);
 649   $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
 650
 651   my $ref = $sth->fetchrow_hashref("NAME_lc");
 652
 653   map { $form->{$_} = $ref->{$_} } keys %$ref;
 654
 655   $sth->finish;
 656
 657   $dbh->disconnect;
 658
 659   $main::lxdebug->leave_sub();
 660 }
 661
 662 sub get_language_details {
 663   $main::lxdebug->enter_sub();
 664
 665   my ($self, $myconfig, $form, $id) = @_;
 666
 667   # connect to database
 668   my $dbh = $form->dbconnect($myconfig);
 669
 670   my $query =
 671     "SELECT template_code, " .
 672     "  output_numberformat, output_dateformat, output_longdates " .
 673     "FROM language WHERE id = ?";
 674   my @res = selectrow_query($form, $dbh, $query, $id);
 675   $dbh->disconnect;
 676
 677   $main::lxdebug->leave_sub();
 678
 679   return @res;
 680 }
 681
 682 sub save_language {
 683   $main::lxdebug->enter_sub();
 684
 685   my ($self, $myconfig, $form) = @_;
 686
 687   # connect to database
 688   my $dbh = $form->dbconnect($myconfig);
 689   my (@values, $query);
 690
 691   map({ push(@values, $form->{$_}); }
 692       qw(description template_code article_code
 693          output_numberformat output_dateformat output_longdates));
 694
 695   # id is the old record
 696   if ($form->{id}) {
 697     $query =
 698       "UPDATE language SET " .
 699       "  description = ?, template_code = ?, article_code = ?, " .
 700       "  output_numberformat = ?, output_dateformat = ?, " .
 701       "  output_longdates = ? " .
 702       "WHERE id = ?";
 703     push(@values, $form->{id});
 704   } else {
 705     $query =
 706       "INSERT INTO language (" .
 707       "  description, template_code, article_code, " .
 708       "  output_numberformat, output_dateformat, output_longdates" .
 709       ") VALUES (?, ?, ?, ?, ?, ?)";
 710   }
 711   do_query($form, $dbh, $query, @values);
 712
 713   $dbh->disconnect;
 714
 715   $main::lxdebug->leave_sub();
 716 }
 717
 718 sub delete_language {
 719   $main::lxdebug->enter_sub();
 720
 721   my ($self, $myconfig, $form) = @_;
 722   my $query;
 723
 724   # connect to database
 725   my $dbh = $form->dbconnect_noauto($myconfig);
 726
 727   foreach my $table (qw(generic_translations units_language)) {
 728     $query = qq|DELETE FROM $table WHERE language_id = ?|;
 729     do_query($form, $dbh, $query, $form->{"id"});
 730   }
 731
 732   $query = "DELETE FROM language WHERE id = ?";
 733   do_query($form, $dbh, $query, $form->{"id"});
 734
 735   $dbh->commit();
 736   $dbh->disconnect;
 737
 738   $main::lxdebug->leave_sub();
 739 }
 740
 741 sub prepare_template_filename {
 742   $main::lxdebug->enter_sub();
 743
 744   my ($self, $myconfig, $form) = @_;
 745
 746   my ($filename, $display_filename);
 747
 748   if ($form->{type} eq "stylesheet") {
 749     $filename = "css/$myconfig->{stylesheet}";
 750     $display_filename = $myconfig->{stylesheet};
 751
 752   } else {
 753     $filename = $form->{formname};
 754
 755     if ($form->{language}) {
 756       my ($id, $template_code) = split(/--/, $form->{language});
 757       $filename .= "_${template_code}";
 758     }
 759
 760     if ($form->{printer}) {
 761       my ($id, $template_code) = split(/--/, $form->{printer});
 762       $filename .= "_${template_code}";
 763     }
 764
 765     $filename .= "." . ($form->{format} eq "html" ? "html" : "tex");
 766     if ($form->{"formname"} =~ m|\.\.| || $form->{"formname"} =~ m|^/|) {
 767       $filename =~ s|.*/||;
 768     }
 769     $display_filename = $filename;
 770     $filename = SL::DB::Default->get->templates . "/$filename";
 771   }
 772
 773   $main::lxdebug->leave_sub();
 774
 775   return ($filename, $display_filename);
 776 }
 777
 778
 779 sub load_template {
 780   $main::lxdebug->enter_sub();
 781
 782   my ($self, $filename) = @_;
 783
 784   my ($content, $lines) = ("", 0);
 785
 786   local *TEMPLATE;
 787
 788   if (open(TEMPLATE, $filename)) {
 789     while (<TEMPLATE>) {
 790       $content .= $_;
 791       $lines++;
 792     }
 793     close(TEMPLATE);
 794   }
 795
 796   $content = Encode::decode('utf-8-strict', $content);
 797
 798   $main::lxdebug->leave_sub();
 799
 800   return ($content, $lines);
 801 }
 802
 803 sub save_template {
 804   $main::lxdebug->enter_sub();
 805
 806   my ($self, $filename, $content) = @_;
 807
 808   local *TEMPLATE;
 809
 810   my $error = "";
 811
 812   if (open(TEMPLATE, ">", $filename)) {
 813     $content = Encode::encode('utf-8-strict', $content);
 814     $content =~ s/\r\n/\n/g;
 815     print(TEMPLATE $content);
 816     close(TEMPLATE);
 817   } else {
 818     $error = $!;
 819   }
 820
 821   $main::lxdebug->leave_sub();
 822
 823   return $error;
 824 }
 825
 826 sub save_preferences {
 827   $main::lxdebug->enter_sub();
 828
 829   my ($self, $form) = @_;
 830
 831   my $employee = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
 832   $employee->update_attributes(name => $form->{name});
 833
 834   my $user = SL::DB::Manager::AuthUser->find_by(login => $::myconfig{login});
 835   $user->update_attributes(
 836     config_values => {
 837       %{ $user->config_values },
 838       map { ($_ => $form->{$_}) } SL::DB::AuthUser::CONFIG_VARS(),
 839     });
 840
 841   $main::lxdebug->leave_sub();
 842
 843   return 1;
 844 }
 845
 846 sub get_defaults {
 847   $main::lxdebug->enter_sub();
 848
 849   my $self     = shift;
 850   my %params   = @_;
 851
 852   my $myconfig = \%main::myconfig;
 853   my $form     = $main::form;
 854
 855   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
 856
 857   my $defaults = selectfirst_hashref_query($form, $dbh, qq|SELECT * FROM defaults|) || {};
 858
 859   $defaults->{weightunit} ||= 'kg';
 860
 861   $main::lxdebug->leave_sub();
 862
 863   return $defaults;
 864 }
 865
 866 sub closedto {
 867   $main::lxdebug->enter_sub();
 868
 869   my ($self, $myconfig, $form) = @_;
 870
 871   my $dbh = $form->dbconnect($myconfig);
 872
 873   my $query = qq|SELECT closedto, max_future_booking_interval, revtrans FROM defaults|;
 874   my $sth   = $dbh->prepare($query);
 875   $sth->execute || $form->dberror($query);
 876
 877   ($form->{closedto}, $form->{max_future_booking_interval}, $form->{revtrans}) = $sth->fetchrow_array;
 878
 879   $sth->finish;
 880
 881   $dbh->disconnect;
 882
 883   $main::lxdebug->leave_sub();
 884 }
 885
 886 sub closebooks {
 887   $main::lxdebug->enter_sub();
 888
 889   my ($self, $myconfig, $form) = @_;
 890
 891   my $dbh = $form->dbconnect($myconfig);
 892
 893   my ($query, @values);
 894
 895   # is currently NEVER trueish (no more hidden revtrans in $form)
 896   # if ($form->{revtrans}) {
 897   #   $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '1'|;
 898   # -> therefore you can only set this to false (which is already the default)
 899   # and this flag is currently only checked in gl.pl. TOOD Can probably be removed
 900
 901     $query = qq|UPDATE defaults SET closedto = ?, max_future_booking_interval = ?, revtrans = '0'|;
 902     @values = (conv_date($form->{closedto}), conv_i($form->{max_future_booking_interval}));
 903
 904   # set close in defaults
 905   do_query($form, $dbh, $query, @values);
 906
 907   $dbh->disconnect;
 908
 909   $main::lxdebug->leave_sub();
 910 }
 911
 912 sub get_base_unit {
 913   my ($self, $units, $unit_name, $factor) = @_;
 914
 915   $factor = 1 unless ($factor);
 916
 917   my $unit = $units->{$unit_name};
 918
 919   if (!defined($unit) || !$unit->{"base_unit"} ||
 920       ($unit_name eq $unit->{"base_unit"})) {
 921     return ($unit_name, $factor);
 922   }
 923
 924   return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"});
 925 }
 926
 927 sub retrieve_units {
 928   $main::lxdebug->enter_sub();
 929
 930   my ($self, $myconfig, $form, $prefix) = @_;
 931   $prefix ||= '';
 932
 933   my $dbh = $form->get_standard_dbh;
 934
 935   my $query = "SELECT *, base_unit AS original_base_unit FROM units";
 936
 937   my $sth = prepare_execute_query($form, $dbh, $query);
 938
 939   my $units = {};
 940   while (my $ref = $sth->fetchrow_hashref()) {
 941     $units->{$ref->{"name"}} = $ref;
 942   }
 943   $sth->finish();
 944
 945   my $query_lang = "SELECT id, template_code FROM language ORDER BY description";
 946   $sth = $dbh->prepare($query_lang);
 947   $sth->execute() || $form->dberror($query_lang);
 948   my @languages;
 949   while (my $ref = $sth->fetchrow_hashref()) {
 950     push(@languages, $ref);
 951   }
 952   $sth->finish();
 953
 954   $query_lang = "SELECT ul.localized, ul.localized_plural, l.id, l.template_code " .
 955     "FROM units_language ul " .
 956     "LEFT JOIN language l ON ul.language_id = l.id " .
 957     "WHERE ul.unit = ?";
 958   $sth = $dbh->prepare($query_lang);
 959
 960   foreach my $unit (values(%{$units})) {
 961     ($unit->{"${prefix}base_unit"}, $unit->{"${prefix}factor"}) = AM->get_base_unit($units, $unit->{"name"});
 962
 963     $unit->{"LANGUAGES"} = {};
 964     foreach my $lang (@languages) {
 965       $unit->{"LANGUAGES"}->{$lang->{"template_code"}} = { "template_code" => $lang->{"template_code"} };
 966     }
 967
 968     $sth->execute($unit->{"name"}) || $form->dberror($query_lang . " (" . $unit->{"name"} . ")");
 969     while (my $ref = $sth->fetchrow_hashref()) {
 970       map({ $unit->{"LANGUAGES"}->{$ref->{"template_code"}}->{$_} = $ref->{$_} } keys(%{$ref}));
 971     }
 972   }
 973   $sth->finish;
 974
 975   $main::lxdebug->leave_sub();
 976
 977   return $units;
 978 }
 979
 980 sub retrieve_all_units {
 981   $main::lxdebug->enter_sub();
 982
 983   my $self = shift;
 984
 985   if (!$::request->{cache}{all_units}) {
 986     $::request->{cache}{all_units} = $self->retrieve_units(\%main::myconfig, $main::form);
 987   }
 988
 989   $main::lxdebug->leave_sub();
 990
 991   return $::request->{cache}{all_units};
 992 }
 993
 994
 995 sub translate_units {
 996   $main::lxdebug->enter_sub();
 997
 998   my ($self, $form, $template_code, $unit, $amount) = @_;
 999
1000   my $units = $self->retrieve_units(\%main::myconfig, $form);
1001
1002   my $h = $units->{$unit}->{"LANGUAGES"}->{$template_code};
1003   my $new_unit = $unit;
1004   if ($h) {
1005     if (($amount != 1) && $h->{"localized_plural"}) {
1006       $new_unit = $h->{"localized_plural"};
1007     } elsif ($h->{"localized"}) {
1008       $new_unit = $h->{"localized"};
1009     }
1010   }
1011
1012   $main::lxdebug->leave_sub();
1013
1014   return $new_unit;
1015 }
1016
1017 sub units_in_use {
1018   $main::lxdebug->enter_sub();
1019
1020   my ($self, $myconfig, $form, $units) = @_;
1021
1022   my $dbh = $form->dbconnect($myconfig);
1023
1024   map({ $_->{"in_use"} = 0; } values(%{$units}));
1025
1026   foreach my $unit (values(%{$units})) {
1027     my $base_unit = $unit->{"original_base_unit"};
1028     while ($base_unit) {
1029       $units->{$base_unit}->{"in_use"} = 1;
1030       $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"});
1031       push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"});
1032       $base_unit = $units->{$base_unit}->{"original_base_unit"};
1033     }
1034   }
1035
1036   foreach my $unit (values(%{$units})) {
1037     map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}});
1038
1039     foreach my $table (qw(parts invoice orderitems)) {
1040       my $query = "SELECT COUNT(*) FROM $table WHERE unit ";
1041
1042       if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) {
1043         $query .= "= " . $dbh->quote($unit->{"name"});
1044       } else {
1045         $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," .
1046           join(",", map({ $dbh->quote($_) } @{$unit->{"DEPENDING_UNITS"}})) . ")";
1047       }
1048
1049       my ($count) = $dbh->selectrow_array($query);
1050       $form->dberror($query) if ($dbh->err);
1051
1052       if ($count) {
1053         $unit->{"in_use"} = 1;
1054         last;
1055       }
1056     }
1057   }
1058
1059   $dbh->disconnect();
1060
1061   $main::lxdebug->leave_sub();
1062 }
1063
1064 sub convertible_units {
1065   $main::lxdebug->enter_sub();
1066
1067   my $self        = shift;
1068   my $units       = shift;
1069   my $filter_unit = shift;
1070   my $not_smaller = shift;
1071
1072   my $conv_units = [];
1073
1074   $filter_unit = $units->{$filter_unit};
1075
1076   foreach my $name (sort { lc $a cmp lc $b } keys %{ $units }) {
1077     my $unit = $units->{$name};
1078
1079     if (($unit->{base_unit} eq $filter_unit->{base_unit}) &&
1080         (!$not_smaller || ($unit->{factor} >= $filter_unit->{factor}))) {
1081       push @{$conv_units}, $unit;
1082     }
1083   }
1084
1085   my @sorted = sort { $b->{factor} <=> $a->{factor} } @{ $conv_units };
1086
1087   $main::lxdebug->leave_sub();
1088
1089   return \@sorted;
1090 }
1091
1092 # if $a is translatable to $b, return the factor between them.
1093 # else return 1
1094 sub convert_unit {
1095   $main::lxdebug->enter_sub(2);
1096   my ($this, $a, $b, $all_units) = @_;
1097
1098   if (!$all_units) {
1099     $all_units = $this->retrieve_all_units;
1100   }
1101
1102   $main::lxdebug->leave_sub(2) and return 0 unless $a && $b;
1103   $main::lxdebug->leave_sub(2) and return 0 unless $all_units->{$a} && $all_units->{$b};
1104   $main::lxdebug->leave_sub(2) and return 0 unless $all_units->{$a}{base_unit} eq $all_units->{$b}{base_unit};
1105   $main::lxdebug->leave_sub(2) and return $all_units->{$a}{factor} / $all_units->{$b}{factor};
1106 }
1107
1108 sub unit_select_data {
1109   $main::lxdebug->enter_sub();
1110
1111   my ($self, $units, $selected, $empty_entry, $convertible_into) = @_;
1112
1113   my $select = [];
1114
1115   if ($empty_entry) {
1116     push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" });
1117   }
1118
1119   foreach my $unit (sort({ $units->{$a}->{"sortkey"} <=> $units->{$b}->{"sortkey"} } keys(%{$units}))) {
1120     if (!$convertible_into ||
1121         ($units->{$convertible_into} &&
1122          ($units->{$convertible_into}->{base_unit} eq $units->{$unit}->{base_unit}))) {
1123       push @{$select}, { "name"      => $unit,
1124                          "base_unit" => $units->{$unit}->{"base_unit"},
1125                          "factor"    => $units->{$unit}->{"factor"},
1126                          "selected"  => ($unit eq $selected) ? "selected" : "" };
1127     }
1128   }
1129
1130   $main::lxdebug->leave_sub();
1131
1132   return $select;
1133 }
1134
1135 sub unit_select_html {
1136   $main::lxdebug->enter_sub();
1137
1138   my ($self, $units, $name, $selected, $convertible_into) = @_;
1139
1140   my $select = "<select name=${name}>";
1141
1142   foreach my $unit (sort({ $units->{$a}->{"sortkey"} <=> $units->{$b}->{"sortkey"} } keys(%{$units}))) {
1143     if (!$convertible_into ||
1144         ($units->{$convertible_into} &&
1145          ($units->{$convertible_into}->{"base_unit"} eq $units->{$unit}->{"base_unit"}))) {
1146       $select .= "<option" . (($unit eq $selected) ? " selected" : "") . ">${unit}</option>";
1147     }
1148   }
1149   $select .= "</select>";
1150
1151   $main::lxdebug->leave_sub();
1152
1153   return $select;
1154 }
1155
1156 sub sum_with_unit {
1157   $main::lxdebug->enter_sub();
1158
1159   my $self  = shift;
1160
1161   my $units = $self->retrieve_all_units();
1162
1163   my $sum   = 0;
1164   my $base_unit;
1165
1166   while (2 <= scalar(@_)) {
1167     my $qty  = shift(@_);
1168     my $unit = $units->{shift(@_)};
1169
1170     croak "No unit defined with name $unit" if (!defined $unit);
1171
1172     if (!$base_unit) {
1173       $base_unit = $unit->{base_unit};
1174     } elsif ($base_unit ne $unit->{base_unit}) {
1175       croak "Adding values with incompatible base units $base_unit/$unit->{base_unit}";
1176     }
1177
1178     $sum += $qty * $unit->{factor};
1179   }
1180
1181   $main::lxdebug->leave_sub();
1182
1183   return $sum;
1184 }
1185
1186 sub add_unit {
1187   $main::lxdebug->enter_sub();
1188
1189   my ($self, $myconfig, $form, $name, $base_unit, $factor, $languages) = @_;
1190
1191   my $dbh = $form->dbconnect_noauto($myconfig);
1192
1193   my $query = qq|SELECT COALESCE(MAX(sortkey), 0) + 1 FROM units|;
1194   my ($sortkey) = selectrow_query($form, $dbh, $query);
1195
1196   $query = "INSERT INTO units (name, base_unit, factor, sortkey) " .
1197     "VALUES (?, ?, ?, ?)";
1198   do_query($form, $dbh, $query, $name, $base_unit, $factor, $sortkey);
1199
1200   if ($languages) {
1201     $query = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
1202     my $sth = $dbh->prepare($query);
1203     foreach my $lang (@{$languages}) {
1204       my @values = ($name, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
1205       $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
1206     }
1207     $sth->finish();
1208   }
1209
1210   $dbh->commit();
1211   $dbh->disconnect();
1212
1213   $main::lxdebug->leave_sub();
1214 }
1215
1216 sub save_units {
1217   $main::lxdebug->enter_sub();
1218
1219   my ($self, $myconfig, $form, $units, $delete_units) = @_;
1220
1221   my $dbh = $form->dbconnect_noauto($myconfig);
1222
1223   my ($base_unit, $unit, $sth, $query);
1224
1225   $query = "DELETE FROM units_language";
1226   $dbh->do($query) || $form->dberror($query);
1227
1228   if ($delete_units && (0 != scalar(@{$delete_units}))) {
1229     $query = "DELETE FROM units WHERE name IN (";
1230     map({ $query .= "?," } @{$delete_units});
1231     substr($query, -1, 1) = ")";
1232     $dbh->do($query, undef, @{$delete_units}) ||
1233       $form->dberror($query . " (" . join(", ", @{$delete_units}) . ")");
1234   }
1235
1236   $query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?";
1237   $sth = $dbh->prepare($query);
1238
1239   my $query_lang = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
1240   my $sth_lang = $dbh->prepare($query_lang);
1241
1242   foreach $unit (values(%{$units})) {
1243     $unit->{"depth"} = 0;
1244     my $base_unit = $unit;
1245     while ($base_unit->{"base_unit"}) {
1246       $unit->{"depth"}++;
1247       $base_unit = $units->{$base_unit->{"base_unit"}};
1248     }
1249   }
1250
1251   foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) {
1252     if ($unit->{"LANGUAGES"}) {
1253       foreach my $lang (@{$unit->{"LANGUAGES"}}) {
1254         next unless ($lang->{"id"} && $lang->{"localized"});
1255         my @values = ($unit->{"name"}, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
1256         $sth_lang->execute(@values) || $form->dberror($query_lang . " (" . join(", ", @values) . ")");
1257       }
1258     }
1259
1260     next if ($unit->{"unchanged_unit"});
1261
1262     my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"});
1263     $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
1264   }
1265
1266   $sth->finish();
1267   $sth_lang->finish();
1268   $dbh->commit();
1269   $dbh->disconnect();
1270
1271   $main::lxdebug->leave_sub();
1272 }
1273
1274 sub taxes {
1275   $main::lxdebug->enter_sub();
1276
1277   my ($self, $myconfig, $form) = @_;
1278
1279   # connect to database
1280   my $dbh = $form->dbconnect($myconfig);
1281
1282   my $query = qq|SELECT
1283                    t.id,
1284                    t.taxkey,
1285                    t.taxdescription,
1286                    round(t.rate * 100, 2) AS rate,
1287                    (SELECT accno FROM chart WHERE id = chart_id) AS taxnumber,
1288                    (SELECT description FROM chart WHERE id = chart_id) AS account_description,
1289                    (SELECT accno FROM chart WHERE id = skonto_sales_chart_id) AS skonto_chart_accno,
1290                    (SELECT description FROM chart WHERE id = skonto_sales_chart_id) AS skonto_chart_description,
1291                    (SELECT accno FROM chart WHERE id = skonto_purchase_chart_id) AS skonto_chart_purchase_accno,
1292                    (SELECT description FROM chart WHERE id = skonto_purchase_chart_id) AS skonto_chart_purchase_description
1293                  FROM tax t
1294                  ORDER BY taxkey, rate|;
1295
1296   my $sth = $dbh->prepare($query);
1297   $sth->execute || $form->dberror($query);
1298
1299   $form->{TAX} = [];
1300   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1301     push @{ $form->{TAX} }, $ref;
1302   }
1303
1304   $sth->finish;
1305   $dbh->disconnect;
1306
1307   $main::lxdebug->leave_sub();
1308 }
1309
1310 sub get_tax_accounts {
1311   $main::lxdebug->enter_sub();
1312
1313   my ($self, $myconfig, $form) = @_;
1314
1315   my $dbh = $form->dbconnect($myconfig);
1316
1317   # get Accounts from chart
1318   my $query = qq{ SELECT
1319                  id,
1320                  accno || ' - ' || description AS taxaccount
1321                FROM chart
1322                WHERE link LIKE '%_tax%'
1323                ORDER BY accno
1324              };
1325
1326   my $sth = $dbh->prepare($query);
1327   $sth->execute || $form->dberror($query);
1328
1329   $form->{ACCOUNTS} = [];
1330   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1331     push @{ $form->{ACCOUNTS} }, $ref;
1332   }
1333
1334   $form->{AR_PAID} = SL::DB::Manager::Chart->get_all(where => [ link => { like => '%AR_paid%' } ], sort_by => 'accno ASC');
1335   $form->{AP_PAID} = SL::DB::Manager::Chart->get_all(where => [ link => { like => '%AP_paid%' } ], sort_by => 'accno ASC');
1336
1337   $form->{skontochart_value_title_sub} = sub {
1338     my $item = shift;
1339     return [
1340       $item->{id},
1341       $item->{accno} .' '. $item->{description},
1342     ];
1343   };
1344
1345   $sth->finish;
1346
1347   $dbh->disconnect;
1348
1349   $main::lxdebug->leave_sub();
1350 }
1351
1352 sub get_tax {
1353   $main::lxdebug->enter_sub();
1354
1355   my ($self, $myconfig, $form) = @_;
1356
1357   # connect to database
1358   my $dbh = $form->dbconnect($myconfig);
1359
1360   my $query = qq|SELECT
1361                    taxkey,
1362                    taxdescription,
1363                    round(rate * 100, 2) AS rate,
1364                    chart_id,
1365                    chart_categories,
1366                    (id IN (SELECT tax_id
1367                            FROM acc_trans)) AS tax_already_used,
1368                    skonto_sales_chart_id,
1369                    skonto_purchase_chart_id
1370                  FROM tax
1371                  WHERE id = ? |;
1372
1373   my $sth = $dbh->prepare($query);
1374   $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
1375
1376   my $ref = $sth->fetchrow_hashref("NAME_lc");
1377
1378   map { $form->{$_} = $ref->{$_} } keys %$ref;
1379
1380   $sth->finish;
1381
1382   # see if it is used by a taxkey
1383   $query = qq|SELECT count(*) FROM taxkeys
1384               WHERE tax_id = ? AND chart_id >0|;
1385
1386   ($form->{orphaned}) = selectrow_query($form, $dbh, $query, $form->{id});
1387
1388   $form->{orphaned} = !$form->{orphaned};
1389   $sth->finish;
1390
1391   if (!$form->{orphaned} ) {
1392     $query = qq|SELECT DISTINCT c.id, c.accno
1393                 FROM taxkeys tk
1394                 JOIN   tax t ON (t.id = tk.tax_id)
1395                 JOIN chart c ON (c.id = tk.chart_id)
1396                 WHERE tk.tax_id = ?|;
1397
1398     $sth = $dbh->prepare($query);
1399     $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
1400
1401     $form->{TAXINUSE} = [];
1402     while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
1403       push @{ $form->{TAXINUSE} }, $ref;
1404     }
1405
1406     $sth->finish;
1407   }
1408
1409   $dbh->disconnect;
1410
1411   $main::lxdebug->leave_sub();
1412 }
1413
1414 sub save_tax {
1415   $main::lxdebug->enter_sub();
1416
1417   my ($self, $myconfig, $form) = @_;
1418   my $query;
1419
1420   # connect to database
1421   my $dbh = $form->get_standard_dbh($myconfig);
1422
1423   $form->{rate} = $form->{rate} / 100;
1424
1425   my $chart_categories = '';
1426   $chart_categories .= 'A' if $form->{asset};
1427   $chart_categories .= 'L' if $form->{liability};
1428   $chart_categories .= 'Q' if $form->{equity};
1429   $chart_categories .= 'I' if $form->{revenue};
1430   $chart_categories .= 'E' if $form->{expense};
1431   $chart_categories .= 'C' if $form->{costs};
1432
1433   my @values = ($form->{taxkey}, $form->{taxdescription}, $form->{rate}, conv_i($form->{chart_id}), conv_i($form->{chart_id}), conv_i($form->{skonto_sales_chart_id}), conv_i($form->{skonto_purchase_chart_id}), $chart_categories);
1434   if ($form->{id} ne "") {
1435     $query = qq|UPDATE tax SET
1436                   taxkey                   = ?,
1437                   taxdescription           = ?,
1438                   rate                     = ?,
1439                   chart_id                 = ?,
1440                   taxnumber                = (SELECT accno FROM chart WHERE id = ? ),
1441                   skonto_sales_chart_id    = ?,
1442                   skonto_purchase_chart_id = ?,
1443                   chart_categories         = ?
1444                 WHERE id = ?|;
1445
1446   } else {
1447     #ok
1448     ($form->{id}) = selectfirst_array_query($form, $dbh, qq|SELECT nextval('id')|);
1449     $query = qq|INSERT INTO tax (
1450                   taxkey,
1451                   taxdescription,
1452                   rate,
1453                   chart_id,
1454                   taxnumber,
1455                   skonto_sales_chart_id,
1456                   skonto_purchase_chart_id,
1457                   chart_categories,
1458                   id
1459                 )
1460                 VALUES (?, ?, ?, ?, (SELECT accno FROM chart WHERE id = ?), ?, ?,  ?, ?)|;
1461   }
1462   push(@values, $form->{id});
1463   do_query($form, $dbh, $query, @values);
1464
1465   foreach my $language_id (keys %{ $form->{translations} }) {
1466     GenericTranslations->save('dbh'              => $dbh,
1467                               'translation_type' => 'SL::DB::Tax/taxdescription',
1468                               'translation_id'   => $form->{id},
1469                               'language_id'      => $language_id,
1470                               'translation'      => $form->{translations}->{$language_id});
1471   }
1472
1473   $dbh->commit();
1474
1475   $main::lxdebug->leave_sub();
1476 }
1477
1478 sub delete_tax {
1479   $main::lxdebug->enter_sub();
1480
1481   my ($self, $myconfig, $form) = @_;
1482   my $query;
1483
1484   # connect to database
1485   my $dbh = $form->get_standard_dbh($myconfig);
1486
1487   $query = qq|DELETE FROM tax
1488               WHERE id = ?|;
1489   do_query($form, $dbh, $query, $form->{id});
1490
1491   $dbh->commit();
1492
1493   $main::lxdebug->leave_sub();
1494 }
1495
1496 sub save_price_factor {
1497   $main::lxdebug->enter_sub();
1498
1499   my ($self, $myconfig, $form) = @_;
1500
1501   # connect to database
1502   my $dbh = $form->get_standard_dbh($myconfig);
1503
1504   my $query;
1505   my @values = ($form->{description}, conv_i($form->{factor}));
1506
1507   if ($form->{id}) {
1508     $query = qq|UPDATE price_factors SET description = ?, factor = ? WHERE id = ?|;
1509     push @values, conv_i($form->{id});
1510
1511   } else {
1512     $query = qq|INSERT INTO price_factors (description, factor, sortkey) VALUES (?, ?, (SELECT COALESCE(MAX(sortkey), 0) + 1 FROM price_factors))|;
1513   }
1514
1515   do_query($form, $dbh, $query, @values);
1516
1517   $dbh->commit();
1518
1519   $main::lxdebug->leave_sub();
1520 }
1521
1522 sub get_all_price_factors {
1523   $main::lxdebug->enter_sub();
1524
1525   my ($self, $myconfig, $form) = @_;
1526
1527   # connect to database
1528   my $dbh = $form->get_standard_dbh($myconfig);
1529
1530   $form->{PRICE_FACTORS} = selectall_hashref_query($form, $dbh, qq|SELECT * FROM price_factors ORDER BY sortkey|);
1531
1532   $main::lxdebug->leave_sub();
1533 }
1534
1535 sub get_price_factor {
1536   $main::lxdebug->enter_sub();
1537
1538   my ($self, $myconfig, $form) = @_;
1539
1540   # connect to database
1541   my $dbh = $form->get_standard_dbh($myconfig);
1542
1543   my $query = qq|SELECT description, factor,
1544                    ((SELECT COUNT(*) FROM parts      WHERE price_factor_id = ?) +
1545                     (SELECT COUNT(*) FROM invoice    WHERE price_factor_id = ?) +
1546                     (SELECT COUNT(*) FROM orderitems WHERE price_factor_id = ?)) = 0 AS orphaned
1547                  FROM price_factors WHERE id = ?|;
1548
1549   ($form->{description}, $form->{factor}, $form->{orphaned}) = selectrow_query($form, $dbh, $query, (conv_i($form->{id})) x 4);
1550
1551   $main::lxdebug->leave_sub();
1552 }
1553
1554 sub delete_price_factor {
1555   $main::lxdebug->enter_sub();
1556
1557   my ($self, $myconfig, $form) = @_;
1558
1559   # connect to database
1560   my $dbh = $form->get_standard_dbh($myconfig);
1561
1562   do_query($form, $dbh, qq|DELETE FROM price_factors WHERE id = ?|, conv_i($form->{id}));
1563   $dbh->commit();
1564
1565   $main::lxdebug->leave_sub();
1566 }
1567
1568 sub save_warehouse {
1569   $main::lxdebug->enter_sub();
1570
1571   my ($self, $myconfig, $form) = @_;
1572
1573   # connect to database
1574   my $dbh = $form->get_standard_dbh($myconfig);
1575
1576   my ($query, @values, $sth);
1577
1578   if (!$form->{id}) {
1579     $query        = qq|SELECT nextval('id')|;
1580     ($form->{id}) = selectrow_query($form, $dbh, $query);
1581
1582     $query        = qq|INSERT INTO warehouse (id, sortkey) VALUES (?, (SELECT COALESCE(MAX(sortkey), 0) + 1 FROM warehouse))|;
1583     do_query($form, $dbh, $query, $form->{id});
1584   }
1585
1586   do_query($form, $dbh, qq|UPDATE warehouse SET description = ?, invalid = ? WHERE id = ?|,
1587            $form->{description}, $form->{invalid} ? 't' : 'f', conv_i($form->{id}));
1588
1589   if (0 < $form->{number_of_new_bins}) {
1590     my ($num_existing_bins) = selectfirst_array_query($form, $dbh, qq|SELECT COUNT(*) FROM bin WHERE warehouse_id = ?|, $form->{id});
1591     $query = qq|INSERT INTO bin (warehouse_id, description) VALUES (?, ?)|;
1592     $sth   = prepare_query($form, $dbh, $query);
1593
1594     foreach my $i (1..$form->{number_of_new_bins}) {
1595       do_statement($form, $sth, $query, conv_i($form->{id}), "$form->{prefix}" . ($i + $num_existing_bins));
1596     }
1597
1598     $sth->finish();
1599   }
1600
1601   $dbh->commit();
1602
1603   $main::lxdebug->leave_sub();
1604 }
1605
1606 sub save_bins {
1607   $main::lxdebug->enter_sub();
1608
1609   my ($self, $myconfig, $form) = @_;
1610
1611   # connect to database
1612   my $dbh = $form->get_standard_dbh($myconfig);
1613
1614   my ($query, @values, $commit_necessary, $sth);
1615
1616   @values = map { $form->{"id_${_}"} } grep { $form->{"delete_${_}"} } (1..$form->{rowcount});
1617
1618   if (@values) {
1619     $query = qq|DELETE FROM bin WHERE id IN (| . join(', ', ('?') x scalar(@values)) . qq|)|;
1620     do_query($form, $dbh, $query, @values);
1621
1622     $commit_necessary = 1;
1623   }
1624
1625   $query = qq|UPDATE bin SET description = ? WHERE id = ?|;
1626   $sth   = prepare_query($form, $dbh, $query);
1627
1628   foreach my $row (1..$form->{rowcount}) {
1629     next if ($form->{"delete_${row}"});
1630
1631     do_statement($form, $sth, $query, $form->{"description_${row}"}, conv_i($form->{"id_${row}"}));
1632
1633     $commit_necessary = 1;
1634   }
1635
1636   $sth->finish();
1637
1638   $dbh->commit() if ($commit_necessary);
1639
1640   $main::lxdebug->leave_sub();
1641 }
1642
1643 sub delete_warehouse {
1644   $main::lxdebug->enter_sub();
1645
1646   my ($self, $myconfig, $form) = @_;
1647
1648   # connect to database
1649   my $dbh = $form->get_standard_dbh($myconfig);
1650
1651   my $id      = conv_i($form->{id});
1652   my $query   = qq|SELECT i.bin_id FROM inventory i WHERE i.bin_id IN (SELECT b.id FROM bin b WHERE b.warehouse_id = ?) LIMIT 1|;
1653   my ($count) = selectrow_query($form, $dbh, $query, $id);
1654
1655   if ($count) {
1656     $main::lxdebug->leave_sub();
1657     return 0;
1658   }
1659
1660   do_query($form, $dbh, qq|DELETE FROM bin       WHERE warehouse_id = ?|, conv_i($form->{id}));
1661   do_query($form, $dbh, qq|DELETE FROM warehouse WHERE id           = ?|, conv_i($form->{id}));
1662
1663   $dbh->commit();
1664
1665   $main::lxdebug->leave_sub();
1666
1667   return 1;
1668 }
1669
1670 sub get_all_warehouses {
1671   $main::lxdebug->enter_sub();
1672
1673   my ($self, $myconfig, $form) = @_;
1674
1675   # connect to database
1676   my $dbh = $form->get_standard_dbh($myconfig);
1677
1678   my $query = qq|SELECT w.id, w.description, w.invalid,
1679                    (SELECT COUNT(b.description) FROM bin b WHERE b.warehouse_id = w.id) AS number_of_bins
1680                  FROM warehouse w
1681                  ORDER BY w.sortkey|;
1682
1683   $form->{WAREHOUSES} = selectall_hashref_query($form, $dbh, $query);
1684
1685   $main::lxdebug->leave_sub();
1686 }
1687
1688 sub get_warehouse {
1689   $main::lxdebug->enter_sub();
1690
1691   my ($self, $myconfig, $form) = @_;
1692
1693   # connect to database
1694   my $dbh = $form->get_standard_dbh($myconfig);
1695
1696   my $id    = conv_i($form->{id});
1697   my $query = qq|SELECT w.description, w.invalid
1698                  FROM warehouse w
1699                  WHERE w.id = ?|;
1700
1701   my $ref   = selectfirst_hashref_query($form, $dbh, $query, $id);
1702
1703   map { $form->{$_} = $ref->{$_} } keys %{ $ref };
1704
1705   $query = <<SQL;
1706     SELECT b.*,
1707       (   EXISTS(SELECT i.bin_id FROM inventory i WHERE i.bin_id = b.id LIMIT 1)
1708        OR EXISTS(SELECT p.bin_id FROM parts     p WHERE p.bin_id = b.id LIMIT 1))
1709       AS in_use
1710     FROM bin b
1711     WHERE b.warehouse_id = ?
1712 SQL
1713
1714   $form->{BINS} = selectall_hashref_query($form, $dbh, $query, conv_i($form->{id}));
1715
1716   $main::lxdebug->leave_sub();
1717 }
1718
1719 1;