SL/User.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 # user related functions
  32 #
  33 #=====================================================================
  34
  35 package User;
  36
  37 use IO::File;
  38 use Fcntl qw(:seek);
  39
  40 use SL::Auth;
  41 use SL::DBUpgrade2;
  42 use SL::DBUtils;
  43 use SL::Iconv;
  44 use SL::Inifile;
  45
  46 sub new {
  47   $main::lxdebug->enter_sub();
  48
  49   my ($type, $login) = @_;
  50
  51   my $self = {};
  52
  53   if ($login ne "") {
  54     my %user_data = $main::auth->read_user($login);
  55     map { $self->{$_} = $user_data{$_} } keys %user_data;
  56   }
  57
  58   $main::lxdebug->leave_sub();
  59
  60   bless $self, $type;
  61 }
  62
  63 sub country_codes {
  64   $main::lxdebug->enter_sub();
  65
  66   local *DIR;
  67
  68   my %cc       = ();
  69   my @language = ();
  70
  71   # scan the locale directory and read in the LANGUAGE files
  72   opendir(DIR, "locale");
  73
  74   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
  75
  76   foreach my $dir (@dir) {
  77     next unless open(FH, "locale/$dir/LANGUAGE");
  78     @language = <FH>;
  79     close FH;
  80
  81     $cc{$dir} = "@language";
  82   }
  83
  84   closedir(DIR);
  85
  86   $main::lxdebug->leave_sub();
  87
  88   return %cc;
  89 }
  90
  91 sub login {
  92   $main::lxdebug->enter_sub();
  93
  94   my ($self, $form) = @_;
  95
  96   local *FH;
  97
  98   my $rc = -3;
  99
 100   if ($self->{login}) {
 101     my %myconfig = $main::auth->read_user($self->{login});
 102
 103     # check if database is down
 104     my $dbh =
 105       DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
 106                    $myconfig{dbpasswd})
 107       or $self->error(DBI::errstr);
 108
 109     # we got a connection, check the version
 110     my $query = qq|SELECT version FROM defaults|;
 111     my $sth   = $dbh->prepare($query);
 112     $sth->execute || $form->dberror($query);
 113
 114     my ($dbversion) = $sth->fetchrow_array;
 115     $sth->finish;
 116
 117     $self->create_employee_entry($form, $dbh, \%myconfig);
 118
 119     $self->create_schema_info_table($form, $dbh);
 120
 121     $dbh->disconnect;
 122
 123     $rc = 0;
 124
 125     my $controls =
 126       parse_dbupdate_controls($form, $myconfig{"dbdriver"});
 127
 128     map({ $form->{$_} = $myconfig{$_} }
 129         qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
 130
 131     if (update_available($myconfig{"dbdriver"}, $dbversion) ||
 132         update2_available($form, $controls)) {
 133
 134       $form->{"stylesheet"} = "lx-office-erp.css";
 135       $form->{"title"} = $main::locale->text("Dataset upgrade");
 136       $form->header();
 137       print $form->parse_html_template("dbupgrade/header");
 138
 139       $form->{dbupdate} = "db$myconfig{dbname}";
 140       $form->{ $form->{dbupdate} } = 1;
 141
 142       if ($form->{"show_dbupdate_warning"}) {
 143         print $form->parse_html_template("dbupgrade/warning");
 144         exit(0);
 145       }
 146
 147       # update the tables
 148       open(FH, ">$main::userspath/nologin") or die("$!");
 149
 150       # required for Oracle
 151       $form->{dbdefault} = $sid;
 152
 153       # ignore HUP, QUIT in case the webserver times out
 154       $SIG{HUP}  = 'IGNORE';
 155       $SIG{QUIT} = 'IGNORE';
 156
 157       $self->dbupdate($form);
 158       $self->dbupdate2($form, $controls);
 159
 160       close(FH);
 161
 162       # remove lock file
 163       unlink("$main::userspath/nologin");
 164
 165       my $menufile =
 166         $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
 167         $self->{"menustyle"} eq "neu" ? "menunew.pl" :
 168         $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
 169         "menu.pl";
 170
 171       print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
 172
 173       $rc = -2;
 174
 175     }
 176   }
 177
 178   $main::lxdebug->leave_sub();
 179
 180   return $rc;
 181 }
 182
 183 sub dbconnect_vars {
 184   $main::lxdebug->enter_sub();
 185
 186   my ($form, $db) = @_;
 187
 188   my %dboptions = (
 189         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 190                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 191                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 192                   'mm-dd-yy'   => 'set DateStyle to \'POSTGRES, US\'',
 193                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 194                   'dd-mm-yy'   => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 195                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 196         },
 197         'Oracle' => {
 198           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 199           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 200           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 201           'mm-dd-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 202           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
 203           'dd-mm-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
 204           'dd.mm.yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
 205         });
 206
 207   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
 208
 209   if ($form->{dbdriver} eq 'Pg') {
 210     $form->{dbconnect} = "dbi:Pg:dbname=$db";
 211   }
 212
 213   if ($form->{dbdriver} eq 'Oracle') {
 214     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 215   }
 216
 217   if ($form->{dbhost}) {
 218     $form->{dbconnect} .= ";host=$form->{dbhost}";
 219   }
 220   if ($form->{dbport}) {
 221     $form->{dbconnect} .= ";port=$form->{dbport}";
 222   }
 223
 224   $main::lxdebug->leave_sub();
 225 }
 226
 227 sub dbdrivers {
 228   $main::lxdebug->enter_sub();
 229
 230   my @drivers = DBI->available_drivers();
 231
 232   $main::lxdebug->leave_sub();
 233
 234   return (grep { /(Pg|Oracle)/ } @drivers);
 235 }
 236
 237 sub dbsources {
 238   $main::lxdebug->enter_sub();
 239
 240   my ($self, $form) = @_;
 241
 242   my @dbsources = ();
 243   my ($sth, $query);
 244
 245   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 246   $form->{sid} = $form->{dbdefault};
 247   &dbconnect_vars($form, $form->{dbdefault});
 248
 249   my $dbh =
 250     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 251     or $form->dberror;
 252
 253   if ($form->{dbdriver} eq 'Pg') {
 254     $query =
 255       qq|SELECT datname FROM pg_database | .
 256       qq|WHERE NOT datname IN ('template0', 'template1')|;
 257     $sth = $dbh->prepare($query);
 258     $sth->execute() || $form->dberror($query);
 259
 260     while (my ($db) = $sth->fetchrow_array) {
 261
 262       if ($form->{only_acc_db}) {
 263
 264         next if ($db =~ /^template/);
 265
 266         &dbconnect_vars($form, $db);
 267         my $dbh =
 268           DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 269           or $form->dberror;
 270
 271         $query =
 272           qq|SELECT tablename FROM pg_tables | .
 273           qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
 274         my $sth = $dbh->prepare($query);
 275         $sth->execute($form->{dbuser}) ||
 276           $form->dberror($query . " ($form->{dbuser})");
 277
 278         if ($sth->fetchrow_array) {
 279           push(@dbsources, $db);
 280         }
 281         $sth->finish;
 282         $dbh->disconnect;
 283         next;
 284       }
 285       push(@dbsources, $db);
 286     }
 287   }
 288
 289   if ($form->{dbdriver} eq 'Oracle') {
 290     if ($form->{only_acc_db}) {
 291       $query =
 292         qq|SELECT owner FROM dba_objects | .
 293         qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
 294     } else {
 295       $query = qq|SELECT username FROM dba_users|;
 296     }
 297
 298     $sth = $dbh->prepare($query);
 299     $sth->execute || $form->dberror($query);
 300
 301     while (my ($db) = $sth->fetchrow_array) {
 302       push(@dbsources, $db);
 303     }
 304   }
 305
 306   $sth->finish;
 307   $dbh->disconnect;
 308
 309   $main::lxdebug->leave_sub();
 310
 311   return @dbsources;
 312 }
 313
 314 sub dbclusterencoding {
 315   $main::lxdebug->enter_sub();
 316
 317   my ($self, $form) = @_;
 318
 319   $form->{dbdefault} ||= $form->{dbuser};
 320
 321   dbconnect_vars($form, $form->{dbdefault});
 322
 323   my $dbh                = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
 324   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 325   my ($cluster_encoding) = $dbh->selectrow_array($query);
 326   $dbh->disconnect();
 327
 328   $main::lxdebug->leave_sub();
 329
 330   return $cluster_encoding;
 331 }
 332
 333 sub dbcreate {
 334   $main::lxdebug->enter_sub();
 335
 336   my ($self, $form) = @_;
 337
 338   $form->{sid} = $form->{dbdefault};
 339   &dbconnect_vars($form, $form->{dbdefault});
 340   my $dbh =
 341     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 342     or $form->dberror;
 343   $form->{db} =~ s/\"//g;
 344   my %dbcreate = (
 345     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
 346     'Oracle' =>
 347     qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
 348     qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
 349   );
 350
 351   my %dboptions = (
 352     'Pg' => [],
 353   );
 354
 355   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
 356     if ($form->{"encoding"});
 357   if ($form->{"dbdefault"}) {
 358     my $dbdefault = $form->{"dbdefault"};
 359     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 360     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
 361   }
 362
 363   my $query = $dbcreate{$form->{dbdriver}};
 364   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
 365
 366   # Ignore errors if the database exists.
 367   $dbh->do($query);
 368
 369   if ($form->{dbdriver} eq 'Oracle') {
 370     $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
 371     do_query($form, $dbh, $query);
 372   }
 373   $dbh->disconnect;
 374
 375   # setup variables for the new database
 376   if ($form->{dbdriver} eq 'Oracle') {
 377     $form->{dbuser}   = $form->{db};
 378     $form->{dbpasswd} = $form->{db};
 379   }
 380
 381   &dbconnect_vars($form, $form->{db});
 382
 383   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 384     or $form->dberror;
 385
 386   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 387   $db_charset ||= Common::DEFAULT_CHARSET;
 388
 389   # create the tables
 390   $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
 391
 392   # load chart of accounts
 393   $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 394
 395   $query = "UPDATE defaults SET coa = ?";
 396   do_query($form, $dbh, $query, $form->{chart});
 397
 398   $dbh->disconnect;
 399
 400   $main::lxdebug->leave_sub();
 401 }
 402
 403 # Process a Perl script which updates the database.
 404 # If the script returns 1 then the update was successful.
 405 # Return code "2" means "needs more interaction; remove
 406 # users/nologin and exit".
 407 # All other return codes are fatal errors.
 408 sub process_perl_script {
 409   $main::lxdebug->enter_sub();
 410
 411   my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 412
 413   my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
 414
 415   my $file_charset = Common::DEFAULT_CHARSET;
 416
 417   if (ref($version_or_control) eq "HASH") {
 418     $file_charset = $version_or_control->{charset};
 419
 420   } else {
 421     while (<$fh>) {
 422       last if !/^--/;
 423       next if !/^--\s*\@charset:\s*(.+)/;
 424       $file_charset = $1;
 425       last;
 426     }
 427     $fh->seek(0, SEEK_SET);
 428   }
 429
 430   my $contents = join "", <$fh>;
 431   $fh->close();
 432
 433   $db_charset ||= Common::DEFAULT_CHARSET;
 434
 435   my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
 436
 437   $dbh->begin_work();
 438
 439   my %dbup_myconfig = ();
 440   map({ $dbup_myconfig{$_} = $form->{$_}; }
 441       qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
 442
 443   my $nls_file = $filename;
 444   $nls_file =~ s|.*/||;
 445   $nls_file =~ s|.pl$||;
 446   my $dbup_locale = Locale->new($main::language, $nls_file);
 447
 448   my $result = eval($contents);
 449
 450   if (1 != $result) {
 451     $dbh->rollback();
 452     $dbh->disconnect();
 453   }
 454
 455   if (!defined($result)) {
 456     print $form->parse_html_template("dbupgrade/error",
 457                                      { "file"  => $filename,
 458                                        "error" => $@ });
 459     exit(0);
 460   } elsif (1 != $result) {
 461     unlink("users/nologin") if (2 == $result);
 462     exit(0);
 463   }
 464
 465   if (ref($version_or_control) eq "HASH") {
 466     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 467              $dbh->quote($version_or_control->{"tag"}) . ", " .
 468              $dbh->quote($form->{"login"}) . ")");
 469   } elsif ($version_or_control) {
 470     $dbh->do("UPDATE defaults SET version = " .
 471              $dbh->quote($version_or_control));
 472   }
 473   $dbh->commit();
 474
 475   $main::lxdebug->leave_sub();
 476 }
 477
 478 sub process_query {
 479   $main::lxdebug->enter_sub();
 480
 481   my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 482
 483   my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
 484   my $query = "";
 485   my $sth;
 486   my @quote_chars;
 487
 488   my $file_charset = Common::DEFAULT_CHARSET;
 489   while (<$fh>) {
 490     last if !/^--/;
 491     next if !/^--\s*\@charset:\s*(.+)/;
 492     $file_charset = $1;
 493     last;
 494   }
 495   $fh->seek(0, SEEK_SET);
 496
 497   $db_charset ||= Common::DEFAULT_CHARSET;
 498
 499   $dbh->begin_work();
 500
 501   while (<$fh>) {
 502     $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
 503
 504     # Remove DOS and Unix style line endings.
 505     chomp;
 506
 507     # remove comments
 508     s/--.*$//;
 509
 510     for (my $i = 0; $i < length($_); $i++) {
 511       my $char = substr($_, $i, 1);
 512
 513       # Are we inside a string?
 514       if (@quote_chars) {
 515         if ($char eq $quote_chars[-1]) {
 516           pop(@quote_chars);
 517         }
 518         $query .= $char;
 519
 520       } else {
 521         if (($char eq "'") || ($char eq "\"")) {
 522           push(@quote_chars, $char);
 523
 524         } elsif ($char eq ";") {
 525
 526           # Query is complete. Send it.
 527
 528           $sth = $dbh->prepare($query);
 529           if (!$sth->execute()) {
 530             my $errstr = $dbh->errstr;
 531             $sth->finish();
 532             $dbh->rollback();
 533             $form->dberror("The database update/creation did not succeed. " .
 534                            "The file ${filename} containing the following " .
 535                            "query failed:<br>${query}<br>" .
 536                            "The error message was: ${errstr}<br>" .
 537                            "All changes in that file have been reverted.");
 538           }
 539           $sth->finish();
 540
 541           $char  = "";
 542           $query = "";
 543         }
 544
 545         $query .= $char;
 546       }
 547     }
 548   }
 549
 550   if (ref($version_or_control) eq "HASH") {
 551     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 552              $dbh->quote($version_or_control->{"tag"}) . ", " .
 553              $dbh->quote($form->{"login"}) . ")");
 554   } elsif ($version_or_control) {
 555     $dbh->do("UPDATE defaults SET version = " .
 556              $dbh->quote($version_or_control));
 557   }
 558   $dbh->commit();
 559
 560   $fh->close();
 561
 562   $main::lxdebug->leave_sub();
 563 }
 564
 565 sub dbdelete {
 566   $main::lxdebug->enter_sub();
 567
 568   my ($self, $form) = @_;
 569   $form->{db} =~ s/\"//g;
 570   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 571                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 572
 573   $form->{sid} = $form->{dbdefault};
 574   &dbconnect_vars($form, $form->{dbdefault});
 575   my $dbh =
 576     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 577     or $form->dberror;
 578   my $query = $dbdelete{$form->{dbdriver}};
 579   do_query($form, $dbh, $query);
 580
 581   $dbh->disconnect;
 582
 583   $main::lxdebug->leave_sub();
 584 }
 585
 586 sub dbsources_unused {
 587   $main::lxdebug->enter_sub();
 588
 589   my ($self, $form) = @_;
 590
 591   $form->{only_acc_db} = 1;
 592
 593   my %members = $main::auth->read_all_users();
 594   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 595
 596   $dbexcl{$form->{dbdefault}}             = 1;
 597   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 598
 599   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 600
 601   $main::lxdebug->leave_sub();
 602
 603   return @dbunused;
 604 }
 605
 606 sub dbneedsupdate {
 607   $main::lxdebug->enter_sub();
 608
 609   my ($self, $form) = @_;
 610
 611   my %members  = $main::auth->read_all_users();
 612   my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
 613
 614   my ($query, $sth, %dbs_needing_updates);
 615
 616   foreach my $login (grep /[a-z]/, keys %members) {
 617     my $member = $members{$login};
 618
 619     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 620     dbconnect_vars($form, $form->{dbname});
 621
 622     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 623
 624     next unless $dbh;
 625
 626     my $version;
 627
 628     $query = qq|SELECT version FROM defaults|;
 629     $sth = prepare_query($form, $dbh, $query);
 630     if ($sth->execute()) {
 631       ($version) = $sth->fetchrow_array();
 632     }
 633     $sth->finish();
 634     $dbh->disconnect();
 635
 636     next unless $version;
 637
 638     if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
 639       my $dbinfo = {};
 640       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 641       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 642     }
 643   }
 644
 645   $main::lxdebug->leave_sub();
 646
 647   return values %dbs_needing_updates;
 648 }
 649
 650 sub calc_version {
 651   $main::lxdebug->enter_sub(2);
 652
 653   my (@v, $version, $i);
 654
 655   @v = split(/\./, $_[0]);
 656   while (scalar(@v) < 4) {
 657     push(@v, 0);
 658   }
 659   $version = 0;
 660   for ($i = 0; $i < 4; $i++) {
 661     $version *= 1000;
 662     $version += $v[$i];
 663   }
 664
 665   $main::lxdebug->leave_sub(2);
 666   return $version;
 667 }
 668
 669 sub cmp_script_version {
 670   my ($a_from, $a_to, $b_from, $b_to);
 671   my ($i, $res_a, $res_b);
 672   my ($my_a, $my_b) = ($a, $b);
 673
 674   $my_a =~ s/.*-upgrade-//;
 675   $my_a =~ s/.sql$//;
 676   $my_b =~ s/.*-upgrade-//;
 677   $my_b =~ s/.sql$//;
 678   ($my_a_from, $my_a_to) = split(/-/, $my_a);
 679   ($my_b_from, $my_b_to) = split(/-/, $my_b);
 680
 681   $res_a = calc_version($my_a_from);
 682   $res_b = calc_version($my_b_from);
 683
 684   if ($res_a == $res_b) {
 685     $res_a = calc_version($my_a_to);
 686     $res_b = calc_version($my_b_to);
 687   }
 688
 689   return $res_a <=> $res_b;
 690 }
 691
 692 sub update_available {
 693   my ($dbdriver, $cur_version) = @_;
 694
 695   local *SQLDIR;
 696
 697   opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
 698   my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
 699   closedir SQLDIR;
 700
 701   return ($#upgradescripts > -1);
 702 }
 703
 704 sub create_schema_info_table {
 705   $main::lxdebug->enter_sub();
 706
 707   my ($self, $form, $dbh) = @_;
 708
 709   my $query = "SELECT tag FROM schema_info LIMIT 1";
 710   if (!$dbh->do($query)) {
 711     $dbh->rollback();
 712     $query =
 713       qq|CREATE TABLE schema_info (| .
 714       qq|  tag text, | .
 715       qq|  login text, | .
 716       qq|  itime timestamp DEFAULT now(), | .
 717       qq|  PRIMARY KEY (tag))|;
 718     $dbh->do($query) || $form->dberror($query);
 719   }
 720
 721   $main::lxdebug->leave_sub();
 722 }
 723
 724 sub dbupdate {
 725   $main::lxdebug->enter_sub();
 726
 727   my ($self, $form) = @_;
 728
 729   local *SQLDIR;
 730
 731   $form->{sid} = $form->{dbdefault};
 732
 733   my @upgradescripts = ();
 734   my $query;
 735   my $rc = -2;
 736
 737   if ($form->{dbupdate}) {
 738
 739     # read update scripts into memory
 740     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 741       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 742     @upgradescripts =
 743       sort(cmp_script_version
 744            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 745                 readdir(SQLDIR)));
 746     closedir(SQLDIR);
 747   }
 748
 749   my $db_charset = $main::dbcharset;
 750   $db_charset ||= Common::DEFAULT_CHARSET;
 751
 752   foreach my $db (split(/ /, $form->{dbupdate})) {
 753
 754     next unless $form->{$db};
 755
 756     # strip db from dataset
 757     $db =~ s/^db//;
 758     &dbconnect_vars($form, $db);
 759
 760     my $dbh =
 761       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 762       or $form->dberror;
 763
 764     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 765
 766     # check version
 767     $query = qq|SELECT version FROM defaults|;
 768     my ($version) = selectrow_query($form, $dbh, $query);
 769
 770     next unless $version;
 771
 772     $version = calc_version($version);
 773
 774     foreach my $upgradescript (@upgradescripts) {
 775       my $a = $upgradescript;
 776       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 777       my $file_type = $1;
 778
 779       my ($mindb, $maxdb) = split /-/, $a;
 780       my $str_maxdb = $maxdb;
 781       $mindb = calc_version($mindb);
 782       $maxdb = calc_version($maxdb);
 783
 784       next if ($version >= $maxdb);
 785
 786       # if there is no upgrade script exit
 787       last if ($version < $mindb);
 788
 789       # apply upgrade
 790       $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
 791       if ($file_type eq "sql") {
 792         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 793                              "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 794       } else {
 795         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 796                                    "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 797       }
 798
 799       $version = $maxdb;
 800
 801     }
 802
 803     $rc = 0;
 804     $dbh->disconnect;
 805
 806   }
 807
 808   $main::lxdebug->leave_sub();
 809
 810   return $rc;
 811 }
 812
 813 sub dbupdate2 {
 814   $main::lxdebug->enter_sub();
 815
 816   my ($self, $form, $controls) = @_;
 817
 818   $form->{sid} = $form->{dbdefault};
 819
 820   my @upgradescripts = ();
 821   my ($query, $sth, $tag);
 822   my $rc = -2;
 823
 824   @upgradescripts = sort_dbupdate_controls($controls);
 825
 826   my $db_charset = $main::dbcharset;
 827   $db_charset ||= Common::DEFAULT_CHARSET;
 828
 829   foreach my $db (split / /, $form->{dbupdate}) {
 830
 831     next unless $form->{$db};
 832
 833     # strip db from dataset
 834     $db =~ s/^db//;
 835     &dbconnect_vars($form, $db);
 836
 837     my $dbh =
 838       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 839       or $form->dberror;
 840
 841     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 842
 843     map({ $_->{"applied"} = 0; } @upgradescripts);
 844
 845     $self->create_schema_info_table($form, $dbh);
 846
 847     $query = qq|SELECT tag FROM schema_info|;
 848     $sth = $dbh->prepare($query);
 849     $sth->execute() || $form->dberror($query);
 850     while (($tag) = $sth->fetchrow_array()) {
 851       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 852     }
 853     $sth->finish();
 854
 855     my $all_applied = 1;
 856     foreach (@upgradescripts) {
 857       if (!$_->{"applied"}) {
 858         $all_applied = 0;
 859         last;
 860       }
 861     }
 862
 863     next if ($all_applied);
 864
 865     foreach my $control (@upgradescripts) {
 866       next if ($control->{"applied"});
 867
 868       $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
 869
 870       $control->{"file"} =~ /\.(sql|pl)$/;
 871       my $file_type = $1;
 872
 873       # apply upgrade
 874       $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
 875       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 876
 877       if ($file_type eq "sql") {
 878         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 879                              "-upgrade2/$control->{file}", $control, $db_charset);
 880       } else {
 881         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 882                                    "-upgrade2/$control->{file}", $control, $db_charset);
 883       }
 884     }
 885
 886     $rc = 0;
 887     $dbh->disconnect;
 888
 889   }
 890
 891   $main::lxdebug->leave_sub();
 892
 893   return $rc;
 894 }
 895
 896 sub update2_available {
 897   $main::lxdebug->enter_sub();
 898
 899   my ($form, $controls) = @_;
 900
 901   map({ $_->{"applied"} = 0; } values(%{$controls}));
 902
 903   dbconnect_vars($form, $form->{"dbname"});
 904
 905   my $dbh =
 906     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 907     $form->dberror;
 908
 909   my ($query, $tag, $sth);
 910
 911   $query = qq|SELECT tag FROM schema_info|;
 912   $sth = $dbh->prepare($query);
 913   if ($sth->execute()) {
 914     while (($tag) = $sth->fetchrow_array()) {
 915       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 916     }
 917   }
 918   $sth->finish();
 919   $dbh->disconnect();
 920
 921   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
 922       values(%{$controls}));
 923
 924   $main::lxdebug->leave_sub();
 925   return 0;
 926 }
 927
 928 sub save_member {
 929   $main::lxdebug->enter_sub();
 930
 931   my ($self) = @_;
 932
 933   # format dbconnect and dboptions string
 934   dbconnect_vars($self, $self->{dbname});
 935
 936   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 937
 938   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 939
 940   my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 941   if ($dbh) {
 942     $self->create_employee_entry($form, $dbh, $self);
 943     $dbh->disconnect();
 944   }
 945
 946   $main::lxdebug->leave_sub();
 947 }
 948
 949 sub create_employee_entry {
 950   $main::lxdebug->enter_sub();
 951
 952   my $self     = shift;
 953   my $form     = shift;
 954   my $dbh      = shift;
 955   my $myconfig = shift;
 956
 957   # add login to employee table if it does not exist
 958   # no error check for employee table, ignore if it does not exist
 959   my ($login)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 960
 961   if (!$login) {
 962     $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 963     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 964   }
 965
 966   $main::lxdebug->leave_sub();
 967 }
 968
 969 sub config_vars {
 970   $main::lxdebug->enter_sub();
 971
 972   my @conf = qw(acs address admin businessnumber company countrycode
 973     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 974     dbname dbuser dbpasswd email fax name numberformat password
 975     printer role sid signature stylesheet tel templates vclimit angebote
 976     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 977     taxnumber co_ustid duns menustyle template_format default_media
 978     default_printer_id copies show_form_details favorites
 979     pdonumber sdonumber);
 980
 981   $main::lxdebug->leave_sub();
 982
 983   return @conf;
 984 }
 985
 986 sub error {
 987   $main::lxdebug->enter_sub();
 988
 989   my ($self, $msg) = @_;
 990
 991   $main::lxdebug->show_backtrace();
 992
 993   if ($ENV{HTTP_USER_AGENT}) {
 994     print qq|Content-Type: text/html
 995
 996 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 997
 998 <body bgcolor=ffffff>
 999
1000 <h2><font color=red>Error!</font></h2>
1001 <p><b>$msg</b>|;
1002
1003   }
1004
1005   die "Error: $msg\n";
1006
1007   $main::lxdebug->leave_sub();
1008 }
1009
1010 1;
1011