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
 558   if (ref($version_or_control) eq "HASH") {
 559     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 560              $dbh->quote($version_or_control->{"tag"}) . ", " .
 561              $dbh->quote($form->{"login"}) . ")");
 562   } elsif ($version_or_control) {
 563     $dbh->do("UPDATE defaults SET version = " .
 564              $dbh->quote($version_or_control));
 565   }
 566   $dbh->commit();
 567
 568   $fh->close();
 569
 570   $main::lxdebug->leave_sub();
 571 }
 572
 573 sub dbdelete {
 574   $main::lxdebug->enter_sub();
 575
 576   my ($self, $form) = @_;
 577   $form->{db} =~ s/\"//g;
 578   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 579                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 580
 581   $form->{sid} = $form->{dbdefault};
 582   &dbconnect_vars($form, $form->{dbdefault});
 583   my $dbh =
 584     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 585     or $form->dberror;
 586   my $query = $dbdelete{$form->{dbdriver}};
 587   do_query($form, $dbh, $query);
 588
 589   $dbh->disconnect;
 590
 591   $main::lxdebug->leave_sub();
 592 }
 593
 594 sub dbsources_unused {
 595   $main::lxdebug->enter_sub();
 596
 597   my ($self, $form) = @_;
 598
 599   $form->{only_acc_db} = 1;
 600
 601   my %members = $main::auth->read_all_users();
 602   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 603
 604   $dbexcl{$form->{dbdefault}}             = 1;
 605   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 606
 607   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 608
 609   $main::lxdebug->leave_sub();
 610
 611   return @dbunused;
 612 }
 613
 614 sub dbneedsupdate {
 615   $main::lxdebug->enter_sub();
 616
 617   my ($self, $form) = @_;
 618
 619   my %members  = $main::auth->read_all_users();
 620   my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
 621
 622   my ($query, $sth, %dbs_needing_updates);
 623
 624   foreach my $login (grep /[a-z]/, keys %members) {
 625     my $member = $members{$login};
 626
 627     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 628     dbconnect_vars($form, $form->{dbname});
 629
 630     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 631
 632     next unless $dbh;
 633
 634     my $version;
 635
 636     $query = qq|SELECT version FROM defaults|;
 637     $sth = prepare_query($form, $dbh, $query);
 638     if ($sth->execute()) {
 639       ($version) = $sth->fetchrow_array();
 640     }
 641     $sth->finish();
 642     $dbh->disconnect();
 643
 644     next unless $version;
 645
 646     if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
 647       my $dbinfo = {};
 648       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 649       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 650     }
 651   }
 652
 653   $main::lxdebug->leave_sub();
 654
 655   return values %dbs_needing_updates;
 656 }
 657
 658 sub calc_version {
 659   $main::lxdebug->enter_sub(2);
 660
 661   my (@v, $version, $i);
 662
 663   @v = split(/\./, $_[0]);
 664   while (scalar(@v) < 4) {
 665     push(@v, 0);
 666   }
 667   $version = 0;
 668   for ($i = 0; $i < 4; $i++) {
 669     $version *= 1000;
 670     $version += $v[$i];
 671   }
 672
 673   $main::lxdebug->leave_sub(2);
 674   return $version;
 675 }
 676
 677 sub cmp_script_version {
 678   my ($a_from, $a_to, $b_from, $b_to);
 679   my ($i, $res_a, $res_b);
 680   my ($my_a, $my_b) = ($a, $b);
 681
 682   $my_a =~ s/.*-upgrade-//;
 683   $my_a =~ s/.sql$//;
 684   $my_b =~ s/.*-upgrade-//;
 685   $my_b =~ s/.sql$//;
 686   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 687   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 688
 689   $res_a = calc_version($my_a_from);
 690   $res_b = calc_version($my_b_from);
 691
 692   if ($res_a == $res_b) {
 693     $res_a = calc_version($my_a_to);
 694     $res_b = calc_version($my_b_to);
 695   }
 696
 697   return $res_a <=> $res_b;
 698 }
 699
 700 sub update_available {
 701   my ($dbdriver, $cur_version) = @_;
 702
 703   local *SQLDIR;
 704
 705   opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
 706   my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
 707   closedir SQLDIR;
 708
 709   return ($#upgradescripts > -1);
 710 }
 711
 712 sub create_schema_info_table {
 713   $main::lxdebug->enter_sub();
 714
 715   my ($self, $form, $dbh) = @_;
 716
 717   my $query = "SELECT tag FROM schema_info LIMIT 1";
 718   if (!$dbh->do($query)) {
 719     $dbh->rollback();
 720     $query =
 721       qq|CREATE TABLE schema_info (| .
 722       qq|  tag text, | .
 723       qq|  login text, | .
 724       qq|  itime timestamp DEFAULT now(), | .
 725       qq|  PRIMARY KEY (tag))|;
 726     $dbh->do($query) || $form->dberror($query);
 727   }
 728
 729   $main::lxdebug->leave_sub();
 730 }
 731
 732 sub dbupdate {
 733   $main::lxdebug->enter_sub();
 734
 735   my ($self, $form) = @_;
 736
 737   local *SQLDIR;
 738
 739   $form->{sid} = $form->{dbdefault};
 740
 741   my @upgradescripts = ();
 742   my $query;
 743   my $rc = -2;
 744
 745   if ($form->{dbupdate}) {
 746
 747     # read update scripts into memory
 748     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 749       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 750     @upgradescripts =
 751       sort(cmp_script_version
 752            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 753                 readdir(SQLDIR)));
 754     closedir(SQLDIR);
 755   }
 756
 757   my $db_charset = $main::dbcharset;
 758   $db_charset ||= Common::DEFAULT_CHARSET;
 759
 760   foreach my $db (split(/ /, $form->{dbupdate})) {
 761
 762     next unless $form->{$db};
 763
 764     # strip db from dataset
 765     $db =~ s/^db//;
 766     &dbconnect_vars($form, $db);
 767
 768     my $dbh =
 769       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 770       or $form->dberror;
 771
 772     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 773
 774     # check version
 775     $query = qq|SELECT version FROM defaults|;
 776     my ($version) = selectrow_query($form, $dbh, $query);
 777
 778     next unless $version;
 779
 780     $version = calc_version($version);
 781
 782     foreach my $upgradescript (@upgradescripts) {
 783       my $a = $upgradescript;
 784       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 785       my $file_type = $1;
 786
 787       my ($mindb, $maxdb) = split /-/, $a;
 788       my $str_maxdb = $maxdb;
 789       $mindb = calc_version($mindb);
 790       $maxdb = calc_version($maxdb);
 791
 792       next if ($version >= $maxdb);
 793
 794       # if there is no upgrade script exit
 795       last if ($version < $mindb);
 796
 797       # apply upgrade
 798       $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
 799       if ($file_type eq "sql") {
 800         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 801                              "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 802       } else {
 803         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 804                                    "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 805       }
 806
 807       $version = $maxdb;
 808
 809     }
 810
 811     $rc = 0;
 812     $dbh->disconnect;
 813
 814   }
 815
 816   $main::lxdebug->leave_sub();
 817
 818   return $rc;
 819 }
 820
 821 sub dbupdate2 {
 822   $main::lxdebug->enter_sub();
 823
 824   my ($self, $form, $controls) = @_;
 825
 826   $form->{sid} = $form->{dbdefault};
 827
 828   my @upgradescripts = ();
 829   my ($query, $sth, $tag);
 830   my $rc = -2;
 831
 832   @upgradescripts = sort_dbupdate_controls($controls);
 833
 834   my $db_charset = $main::dbcharset;
 835   $db_charset ||= Common::DEFAULT_CHARSET;
 836
 837   foreach my $db (split / /, $form->{dbupdate}) {
 838
 839     next unless $form->{$db};
 840
 841     # strip db from dataset
 842     $db =~ s/^db//;
 843     &dbconnect_vars($form, $db);
 844
 845     my $dbh =
 846       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 847       or $form->dberror;
 848
 849     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 850
 851     map({ $_->{"applied"} = 0; } @upgradescripts);
 852
 853     $self->create_schema_info_table($form, $dbh);
 854
 855     $query = qq|SELECT tag FROM schema_info|;
 856     $sth = $dbh->prepare($query);
 857     $sth->execute() || $form->dberror($query);
 858     while (($tag) = $sth->fetchrow_array()) {
 859       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 860     }
 861     $sth->finish();
 862
 863     my $all_applied = 1;
 864     foreach (@upgradescripts) {
 865       if (!$_->{"applied"}) {
 866         $all_applied = 0;
 867         last;
 868       }
 869     }
 870
 871     next if ($all_applied);
 872
 873     foreach my $control (@upgradescripts) {
 874       next if ($control->{"applied"});
 875
 876       $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
 877
 878       $control->{"file"} =~ /\.(sql|pl)$/;
 879       my $file_type = $1;
 880
 881       # apply upgrade
 882       $main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
 883       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 884
 885       if ($file_type eq "sql") {
 886         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 887                              "-upgrade2/$control->{file}", $control, $db_charset);
 888       } else {
 889         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 890                                    "-upgrade2/$control->{file}", $control, $db_charset);
 891       }
 892     }
 893
 894     $rc = 0;
 895     $dbh->disconnect;
 896
 897   }
 898
 899   $main::lxdebug->leave_sub();
 900
 901   return $rc;
 902 }
 903
 904 sub update2_available {
 905   $main::lxdebug->enter_sub();
 906
 907   my ($form, $controls) = @_;
 908
 909   map({ $_->{"applied"} = 0; } values(%{$controls}));
 910
 911   dbconnect_vars($form, $form->{"dbname"});
 912
 913   my $dbh =
 914     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 915     $form->dberror;
 916
 917   my ($query, $tag, $sth);
 918
 919   $query = qq|SELECT tag FROM schema_info|;
 920   $sth = $dbh->prepare($query);
 921   if ($sth->execute()) {
 922     while (($tag) = $sth->fetchrow_array()) {
 923       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 924     }
 925   }
 926   $sth->finish();
 927   $dbh->disconnect();
 928
 929   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
 930       values(%{$controls}));
 931
 932   $main::lxdebug->leave_sub();
 933   return 0;
 934 }
 935
 936 sub save_member {
 937   $main::lxdebug->enter_sub();
 938
 939   my ($self) = @_;
 940   my $form   = \%main::form;
 941
 942   # format dbconnect and dboptions string
 943   dbconnect_vars($self, $self->{dbname});
 944
 945   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 946
 947   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 948
 949   my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 950   if ($dbh) {
 951     $self->create_employee_entry($form, $dbh, $self);
 952     $dbh->disconnect();
 953   }
 954
 955   $main::lxdebug->leave_sub();
 956 }
 957
 958 sub create_employee_entry {
 959   $main::lxdebug->enter_sub();
 960
 961   my $self     = shift;
 962   my $form     = shift;
 963   my $dbh      = shift;
 964   my $myconfig = shift;
 965
 966   # add login to employee table if it does not exist
 967   # no error check for employee table, ignore if it does not exist
 968   my ($login)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 969
 970   if (!$login) {
 971     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 972     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 973   }
 974
 975   $main::lxdebug->leave_sub();
 976 }
 977
 978 sub config_vars {
 979   $main::lxdebug->enter_sub();
 980
 981   my @conf = qw(address admin businessnumber company countrycode
 982     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 983     dbname dbuser dbpasswd email fax name numberformat password
 984     printer role sid signature stylesheet tel templates vclimit angebote
 985     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 986     taxnumber co_ustid duns menustyle template_format default_media
 987     default_printer_id copies show_form_details favorites
 988     pdonumber sdonumber);
 989
 990   $main::lxdebug->leave_sub();
 991
 992   return @conf;
 993 }
 994
 995 sub error {
 996   $main::lxdebug->enter_sub();
 997
 998   my ($self, $msg) = @_;
 999
1000   $main::lxdebug->show_backtrace();
1001
1002   if ($ENV{HTTP_USER_AGENT}) {
1003     print qq|Content-Type: text/html
1004
1005 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1006
1007 <body bgcolor=ffffff>
1008
1009 <h2><font color=red>Error!</font></h2>
1010 <p><b>$msg</b>|;
1011
1012   }
1013
1014   die "Error: $msg\n";
1015
1016   $main::lxdebug->leave_sub();
1017 }
1018
1019 1;
1020