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