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