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