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 strict;
  38
  39 use IO::File;
  40 use Fcntl qw(:seek);
  41
  42 use SL::Auth;
  43 use SL::DBUpgrade2;
  44 use SL::DBUtils;
  45 use SL::Iconv;
  46 use SL::Inifile;
  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   my %dbup_myconfig = ();
 449   map({ $dbup_myconfig{$_} = $form->{$_}; }
 450       qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
 451
 452   my $nls_file = $filename;
 453   $nls_file =~ s|.*/||;
 454   $nls_file =~ s|.pl$||;
 455   my $dbup_locale = Locale->new($main::language, $nls_file);
 456
 457   my $result = eval($contents);
 458
 459   if (1 != $result) {
 460     $dbh->rollback();
 461     $dbh->disconnect();
 462   }
 463
 464   if (!defined($result)) {
 465     print $form->parse_html_template("dbupgrade/error",
 466                                      { "file"  => $filename,
 467                                        "error" => $@ });
 468     exit(0);
 469   } elsif (1 != $result) {
 470     unlink("users/nologin") if (2 == $result);
 471     exit(0);
 472   }
 473
 474   if (ref($version_or_control) eq "HASH") {
 475     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 476              $dbh->quote($version_or_control->{"tag"}) . ", " .
 477              $dbh->quote($form->{"login"}) . ")");
 478   } elsif ($version_or_control) {
 479     $dbh->do("UPDATE defaults SET version = " .
 480              $dbh->quote($version_or_control));
 481   }
 482   $dbh->commit();
 483
 484   $main::lxdebug->leave_sub();
 485 }
 486
 487 sub process_query {
 488   $main::lxdebug->enter_sub();
 489
 490   my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 491
 492   my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
 493   my $query = "";
 494   my $sth;
 495   my @quote_chars;
 496
 497   my $file_charset = Common::DEFAULT_CHARSET;
 498   while (<$fh>) {
 499     last if !/^--/;
 500     next if !/^--\s*\@charset:\s*(.+)/;
 501     $file_charset = $1;
 502     last;
 503   }
 504   $fh->seek(0, SEEK_SET);
 505
 506   $db_charset ||= Common::DEFAULT_CHARSET;
 507
 508   $dbh->begin_work();
 509
 510   while (<$fh>) {
 511     $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
 512
 513     # Remove DOS and Unix style line endings.
 514     chomp;
 515
 516     # remove comments
 517     s/--.*$//;
 518
 519     for (my $i = 0; $i < length($_); $i++) {
 520       my $char = substr($_, $i, 1);
 521
 522       # Are we inside a string?
 523       if (@quote_chars) {
 524         if ($char eq $quote_chars[-1]) {
 525           pop(@quote_chars);
 526         }
 527         $query .= $char;
 528
 529       } else {
 530         if (($char eq "'") || ($char eq "\"")) {
 531           push(@quote_chars, $char);
 532
 533         } elsif ($char eq ";") {
 534
 535           # Query is complete. Send it.
 536
 537           $sth = $dbh->prepare($query);
 538           if (!$sth->execute()) {
 539             my $errstr = $dbh->errstr;
 540             $sth->finish();
 541             $dbh->rollback();
 542             $form->dberror("The database update/creation did not succeed. " .
 543                            "The file ${filename} containing the following " .
 544                            "query failed:<br>${query}<br>" .
 545                            "The error message was: ${errstr}<br>" .
 546                            "All changes in that file have been reverted.");
 547           }
 548           $sth->finish();
 549
 550           $char  = "";
 551           $query = "";
 552         }
 553
 554         $query .= $char;
 555       }
 556     }
 557
 558     # Insert a space at the end of each line so that queries split
 559     # over multiple lines work properly.
 560     if ($query ne '') {
 561       $query .= @quote_chars ? "\n" : ' ';
 562     }
 563   }
 564
 565   if (ref($version_or_control) eq "HASH") {
 566     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 567              $dbh->quote($version_or_control->{"tag"}) . ", " .
 568              $dbh->quote($form->{"login"}) . ")");
 569   } elsif ($version_or_control) {
 570     $dbh->do("UPDATE defaults SET version = " .
 571              $dbh->quote($version_or_control));
 572   }
 573   $dbh->commit();
 574
 575   $fh->close();
 576
 577   $main::lxdebug->leave_sub();
 578 }
 579
 580 sub dbdelete {
 581   $main::lxdebug->enter_sub();
 582
 583   my ($self, $form) = @_;
 584   $form->{db} =~ s/\"//g;
 585   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 586                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 587
 588   $form->{sid} = $form->{dbdefault};
 589   &dbconnect_vars($form, $form->{dbdefault});
 590   my $dbh =
 591     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 592     or $form->dberror;
 593   my $query = $dbdelete{$form->{dbdriver}};
 594   do_query($form, $dbh, $query);
 595
 596   $dbh->disconnect;
 597
 598   $main::lxdebug->leave_sub();
 599 }
 600
 601 sub dbsources_unused {
 602   $main::lxdebug->enter_sub();
 603
 604   my ($self, $form) = @_;
 605
 606   $form->{only_acc_db} = 1;
 607
 608   my %members = $main::auth->read_all_users();
 609   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 610
 611   $dbexcl{$form->{dbdefault}}             = 1;
 612   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 613
 614   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 615
 616   $main::lxdebug->leave_sub();
 617
 618   return @dbunused;
 619 }
 620
 621 sub dbneedsupdate {
 622   $main::lxdebug->enter_sub();
 623
 624   my ($self, $form) = @_;
 625
 626   my %members  = $main::auth->read_all_users();
 627   my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
 628
 629   my ($query, $sth, %dbs_needing_updates);
 630
 631   foreach my $login (grep /[a-z]/, keys %members) {
 632     my $member = $members{$login};
 633
 634     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 635     dbconnect_vars($form, $form->{dbname});
 636
 637     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 638
 639     next unless $dbh;
 640
 641     my $version;
 642
 643     $query = qq|SELECT version FROM defaults|;
 644     $sth = prepare_query($form, $dbh, $query);
 645     if ($sth->execute()) {
 646       ($version) = $sth->fetchrow_array();
 647     }
 648     $sth->finish();
 649     $dbh->disconnect();
 650
 651     next unless $version;
 652
 653     if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
 654       my $dbinfo = {};
 655       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 656       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 657     }
 658   }
 659
 660   $main::lxdebug->leave_sub();
 661
 662   return values %dbs_needing_updates;
 663 }
 664
 665 sub calc_version {
 666   $main::lxdebug->enter_sub(2);
 667
 668   my (@v, $version, $i);
 669
 670   @v = split(/\./, $_[0]);
 671   while (scalar(@v) < 4) {
 672     push(@v, 0);
 673   }
 674   $version = 0;
 675   for ($i = 0; $i < 4; $i++) {
 676     $version *= 1000;
 677     $version += $v[$i];
 678   }
 679
 680   $main::lxdebug->leave_sub(2);
 681   return $version;
 682 }
 683
 684 sub cmp_script_version {
 685   my ($a_from, $a_to, $b_from, $b_to);
 686   my ($i, $res_a, $res_b);
 687   my ($my_a, $my_b) = ($a, $b);
 688
 689   $my_a =~ s/.*-upgrade-//;
 690   $my_a =~ s/.sql$//;
 691   $my_b =~ s/.*-upgrade-//;
 692   $my_b =~ s/.sql$//;
 693   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 694   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 695
 696   $res_a = calc_version($my_a_from);
 697   $res_b = calc_version($my_b_from);
 698
 699   if ($res_a == $res_b) {
 700     $res_a = calc_version($my_a_to);
 701     $res_b = calc_version($my_b_to);
 702   }
 703
 704   return $res_a <=> $res_b;
 705 }
 706
 707 sub update_available {
 708   my ($dbdriver, $cur_version) = @_;
 709
 710   local *SQLDIR;
 711
 712   opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
 713   my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
 714   closedir SQLDIR;
 715
 716   return ($#upgradescripts > -1);
 717 }
 718
 719 sub create_schema_info_table {
 720   $main::lxdebug->enter_sub();
 721
 722   my ($self, $form, $dbh) = @_;
 723
 724   my $query = "SELECT tag FROM schema_info LIMIT 1";
 725   if (!$dbh->do($query)) {
 726     $dbh->rollback();
 727     $query =
 728       qq|CREATE TABLE schema_info (| .
 729       qq|  tag text, | .
 730       qq|  login text, | .
 731       qq|  itime timestamp DEFAULT now(), | .
 732       qq|  PRIMARY KEY (tag))|;
 733     $dbh->do($query) || $form->dberror($query);
 734   }
 735
 736   $main::lxdebug->leave_sub();
 737 }
 738
 739 sub dbupdate {
 740   $main::lxdebug->enter_sub();
 741
 742   my ($self, $form) = @_;
 743
 744   local *SQLDIR;
 745
 746   $form->{sid} = $form->{dbdefault};
 747
 748   my @upgradescripts = ();
 749   my $query;
 750   my $rc = -2;
 751
 752   if ($form->{dbupdate}) {
 753
 754     # read update scripts into memory
 755     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 756       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 757     @upgradescripts =
 758       sort(cmp_script_version
 759            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 760                 readdir(SQLDIR)));
 761     closedir(SQLDIR);
 762   }
 763
 764   my $db_charset = $main::dbcharset;
 765   $db_charset ||= Common::DEFAULT_CHARSET;
 766
 767   foreach my $db (split(/ /, $form->{dbupdate})) {
 768
 769     next unless $form->{$db};
 770
 771     # strip db from dataset
 772     $db =~ s/^db//;
 773     &dbconnect_vars($form, $db);
 774
 775     my $dbh =
 776       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 777       or $form->dberror;
 778
 779     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 780
 781     # check version
 782     $query = qq|SELECT version FROM defaults|;
 783     my ($version) = selectrow_query($form, $dbh, $query);
 784
 785     next unless $version;
 786
 787     $version = calc_version($version);
 788
 789     foreach my $upgradescript (@upgradescripts) {
 790       my $a = $upgradescript;
 791       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 792       my $file_type = $1;
 793
 794       my ($mindb, $maxdb) = split /-/, $a;
 795       my $str_maxdb = $maxdb;
 796       $mindb = calc_version($mindb);
 797       $maxdb = calc_version($maxdb);
 798
 799       next if ($version >= $maxdb);
 800
 801       # if there is no upgrade script exit
 802       last if ($version < $mindb);
 803
 804       # apply upgrade
 805       $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
 806       if ($file_type eq "sql") {
 807         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 808                              "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 809       } else {
 810         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 811                                    "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 812       }
 813
 814       $version = $maxdb;
 815
 816     }
 817
 818     $rc = 0;
 819     $dbh->disconnect;
 820
 821   }
 822
 823   $main::lxdebug->leave_sub();
 824
 825   return $rc;
 826 }
 827
 828 sub dbupdate2 {
 829   $main::lxdebug->enter_sub();
 830
 831   my ($self, $form, $controls) = @_;
 832
 833   $form->{sid} = $form->{dbdefault};
 834
 835   my @upgradescripts = ();
 836   my ($query, $sth, $tag);
 837   my $rc = -2;
 838
 839   @upgradescripts = sort_dbupdate_controls($controls);
 840
 841   my $db_charset = $main::dbcharset;
 842   $db_charset ||= Common::DEFAULT_CHARSET;
 843
 844   foreach my $db (split / /, $form->{dbupdate}) {
 845
 846     next unless $form->{$db};
 847
 848     # strip db from dataset
 849     $db =~ s/^db//;
 850     &dbconnect_vars($form, $db);
 851
 852     my $dbh =
 853       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 854       or $form->dberror;
 855
 856     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 857
 858     map({ $_->{"applied"} = 0; } @upgradescripts);
 859
 860     $self->create_schema_info_table($form, $dbh);
 861
 862     $query = qq|SELECT tag FROM schema_info|;
 863     $sth = $dbh->prepare($query);
 864     $sth->execute() || $form->dberror($query);
 865     while (($tag) = $sth->fetchrow_array()) {
 866       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 867     }
 868     $sth->finish();
 869
 870     my $all_applied = 1;
 871     foreach (@upgradescripts) {
 872       if (!$_->{"applied"}) {
 873         $all_applied = 0;
 874         last;
 875       }
 876     }
 877
 878     next if ($all_applied);
 879
 880     foreach my $control (@upgradescripts) {
 881       next if ($control->{"applied"});
 882
 883       $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
 884
 885       $control->{"file"} =~ /\.(sql|pl)$/;
 886       my $file_type = $1;
 887
 888       # apply upgrade
 889       $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
 890       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 891
 892       if ($file_type eq "sql") {
 893         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 894                              "-upgrade2/$control->{file}", $control, $db_charset);
 895       } else {
 896         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 897                                    "-upgrade2/$control->{file}", $control, $db_charset);
 898       }
 899     }
 900
 901     $rc = 0;
 902     $dbh->disconnect;
 903
 904   }
 905
 906   $main::lxdebug->leave_sub();
 907
 908   return $rc;
 909 }
 910
 911 sub update2_available {
 912   $main::lxdebug->enter_sub();
 913
 914   my ($form, $controls) = @_;
 915
 916   map({ $_->{"applied"} = 0; } values(%{$controls}));
 917
 918   dbconnect_vars($form, $form->{"dbname"});
 919
 920   my $dbh =
 921     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 922     $form->dberror;
 923
 924   my ($query, $tag, $sth);
 925
 926   $query = qq|SELECT tag FROM schema_info|;
 927   $sth = $dbh->prepare($query);
 928   if ($sth->execute()) {
 929     while (($tag) = $sth->fetchrow_array()) {
 930       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 931     }
 932   }
 933   $sth->finish();
 934   $dbh->disconnect();
 935
 936   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
 937       values(%{$controls}));
 938
 939   $main::lxdebug->leave_sub();
 940   return 0;
 941 }
 942
 943 sub save_member {
 944   $main::lxdebug->enter_sub();
 945
 946   my ($self) = @_;
 947   my $form   = \%main::form;
 948
 949   # format dbconnect and dboptions string
 950   dbconnect_vars($self, $self->{dbname});
 951
 952   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 953
 954   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 955
 956   my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 957   if ($dbh) {
 958     $self->create_employee_entry($form, $dbh, $self, 1);
 959     $dbh->disconnect();
 960   }
 961
 962   $main::lxdebug->leave_sub();
 963 }
 964
 965 sub create_employee_entry {
 966   $main::lxdebug->enter_sub();
 967
 968   my $self            = shift;
 969   my $form            = shift;
 970   my $dbh             = shift;
 971   my $myconfig        = shift;
 972   my $update_existing = shift;
 973
 974   if (!does_table_exist($dbh, 'employee')) {
 975     $main::lxdebug->leave_sub();
 976     return;
 977   }
 978
 979   # add login to employee table if it does not exist
 980   # no error check for employee table, ignore if it does not exist
 981   my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 982
 983   if (!$id) {
 984     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 985     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 986
 987   } elsif ($update_existing) {
 988     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
 989     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 990   }
 991
 992   $main::lxdebug->leave_sub();
 993 }
 994
 995 sub config_vars {
 996   $main::lxdebug->enter_sub();
 997
 998   my @conf = qw(address admin businessnumber company countrycode
 999     currency dateformat dbconnect dbdriver dbhost dbport dboptions
1000     dbname dbuser dbpasswd email fax name numberformat password
1001     printer role sid signature stylesheet tel templates vclimit angebote
1002     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
1003     taxnumber co_ustid duns menustyle template_format default_media
1004     default_printer_id copies show_form_details favorites
1005     pdonumber sdonumber);
1006
1007   $main::lxdebug->leave_sub();
1008
1009   return @conf;
1010 }
1011
1012 sub error {
1013   $main::lxdebug->enter_sub();
1014
1015   my ($self, $msg) = @_;
1016
1017   $main::lxdebug->show_backtrace();
1018
1019   if ($ENV{HTTP_USER_AGENT}) {
1020     print qq|Content-Type: text/html
1021
1022 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1023
1024 <body bgcolor=ffffff>
1025
1026 <h2><font color=red>Error!</font></h2>
1027 <p><b>$msg</b>|;
1028
1029   }
1030
1031   die "Error: $msg\n";
1032
1033   $main::lxdebug->leave_sub();
1034 }
1035
1036 1;
1037