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