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 SL::DBUpgrade2;
  38
  39 sub new {
  40   $main::lxdebug->enter_sub();
  41
  42   my ($type, $memfile, $login) = @_;
  43   my $self = {};
  44
  45   if ($login ne "") {
  46     &error("", "$memfile locked!") if (-f "${memfile}.LCK");
  47
  48     open(MEMBER, "$memfile") or &error("", "$memfile : $!");
  49
  50     while (<MEMBER>) {
  51       if (/^\[$login\]/) {
  52         while (<MEMBER>) {
  53           last if /^\[/;
  54           next if /^(#|\s)/;
  55
  56           # remove comments
  57           s/\s#.*//g;
  58
  59           # remove any trailing whitespace
  60           s/^\s*(.*?)\s*$/$1/;
  61
  62           ($key, $value) = split(/=/, $_, 2);
  63
  64           if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
  65             $value = "lx-office-erp.css";
  66           }
  67
  68           $self->{$key} = $value;
  69         }
  70
  71         $self->{login} = $login;
  72
  73         last;
  74       }
  75     }
  76     close MEMBER;
  77   }
  78
  79   $main::lxdebug->leave_sub();
  80   bless $self, $type;
  81 }
  82
  83 sub country_codes {
  84   $main::lxdebug->enter_sub();
  85
  86   my %cc       = ();
  87   my @language = ();
  88
  89   # scan the locale directory and read in the LANGUAGE files
  90   opendir DIR, "locale";
  91
  92   my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR;
  93
  94   foreach my $dir (@dir) {
  95     next unless open(FH, "locale/$dir/LANGUAGE");
  96     @language = <FH>;
  97     close FH;
  98
  99     $cc{$dir} = "@language";
 100   }
 101
 102   closedir(DIR);
 103
 104   $main::lxdebug->leave_sub();
 105
 106   return %cc;
 107 }
 108
 109 sub login {
 110   $main::lxdebug->enter_sub();
 111
 112   my ($self, $form, $userspath) = @_;
 113
 114   my $rc = -3;
 115
 116   if ($self->{login}) {
 117
 118     if ($self->{password}) {
 119       if ($form->{hashed_password}) {
 120         $form->{password} = $form->{hashed_password};
 121       } else {
 122         $form->{password} = crypt($form->{password},
 123                                   substr($self->{login}, 0, 2));
 124       }
 125       if ($self->{password} ne $form->{password}) {
 126         $main::lxdebug->leave_sub();
 127         return -1;
 128       }
 129     }
 130
 131     unless (-e "$userspath/$self->{login}.conf") {
 132       $self->create_config("$userspath/$self->{login}.conf");
 133     }
 134
 135     do "$userspath/$self->{login}.conf";
 136     $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
 137
 138     # check if database is down
 139     my $dbh =
 140       DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
 141                    $myconfig{dbpasswd})
 142       or $self->error(DBI::errstr);
 143
 144     # we got a connection, check the version
 145     my $query = qq|SELECT version FROM defaults|;
 146     my $sth   = $dbh->prepare($query);
 147     $sth->execute || $form->dberror($query);
 148
 149     my ($dbversion) = $sth->fetchrow_array;
 150     $sth->finish;
 151
 152     # add login to employee table if it does not exist
 153     # no error check for employee table, ignore if it does not exist
 154     $query = qq|SELECT e.id FROM employee e WHERE e.login = '$self->{login}'|;
 155     $sth   = $dbh->prepare($query);
 156     $sth->execute;
 157
 158     my ($login) = $sth->fetchrow_array;
 159     $sth->finish;
 160
 161     if (!$login) {
 162       $query = qq|INSERT INTO employee (login, name, workphone, role)
 163                   VALUES ('$self->{login}', '$myconfig{name}',
 164                   '$myconfig{tel}', 'user')|;
 165       $dbh->do($query);
 166     }
 167
 168     $self->create_schema_info_table($form, $dbh);
 169
 170     $dbh->disconnect;
 171
 172     $rc = 0;
 173
 174     my $controls =
 175       parse_dbupdate_controls($form, $myconfig{"dbdriver"});
 176
 177     map({ $form->{$_} = $myconfig{$_} }
 178         qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect));
 179
 180     if (update_available($myconfig{"dbdriver"}, $dbversion) ||
 181         update2_available($form, $controls)) {
 182
 183       $form->{"stylesheet"} = "lx-office-erp.css";
 184       $form->{"title"} = $main::locale->text("Dataset upgrade");
 185       $form->header();
 186       print($form->parse_html_template("dbupgrade/header"));
 187
 188       $form->{dbupdate} = "db$myconfig{dbname}";
 189       $form->{ $form->{dbupdate} } = 1;
 190
 191       if ($form->{"show_dbupdate_warning"}) {
 192         print($form->parse_html_template("dbupgrade/warning"));
 193         exit(0);
 194       }
 195
 196       # update the tables
 197       open(FH, ">$userspath/nologin") or die("$!");
 198
 199       # required for Oracle
 200       $form->{dbdefault} = $sid;
 201
 202       # ignore HUP, QUIT in case the webserver times out
 203       $SIG{HUP}  = 'IGNORE';
 204       $SIG{QUIT} = 'IGNORE';
 205
 206       $self->dbupdate($form);
 207       $self->dbupdate2($form, $controls);
 208
 209       # remove lock file
 210       unlink("$userspath/nologin");
 211
 212       my $menufile =
 213         $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
 214         $self->{"menustyle"} eq "neu" ? "menunew.pl" :
 215         "menu.pl";
 216
 217       print($form->parse_html_template("dbupgrade/footer",
 218                                        { "menufile" => $menufile }));
 219
 220       $rc = -2;
 221
 222     }
 223   }
 224
 225   $main::lxdebug->leave_sub();
 226
 227   return $rc;
 228 }
 229
 230 sub dbconnect_vars {
 231   $main::lxdebug->enter_sub();
 232
 233   my ($form, $db) = @_;
 234
 235   my %dboptions = (
 236         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 237                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 238                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 239                   'mm-dd-yy'   => 'set DateStyle to \'POSTGRES, US\'',
 240                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 241                   'dd-mm-yy'   => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 242                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 243         },
 244         'Oracle' => {
 245           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 246           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 247           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 248           'mm-dd-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 249           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
 250           'dd-mm-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
 251           'dd.mm.yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
 252         });
 253
 254   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
 255
 256   if ($form->{dbdriver} eq 'Pg') {
 257     $form->{dbconnect} = "dbi:Pg:dbname=$db";
 258   }
 259
 260   if ($form->{dbdriver} eq 'Oracle') {
 261     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 262   }
 263
 264   if ($form->{dbhost}) {
 265     $form->{dbconnect} .= ";host=$form->{dbhost}";
 266   }
 267   if ($form->{dbport}) {
 268     $form->{dbconnect} .= ";port=$form->{dbport}";
 269   }
 270
 271   $main::lxdebug->leave_sub();
 272 }
 273
 274 sub dbdrivers {
 275   $main::lxdebug->enter_sub();
 276
 277   my @drivers = DBI->available_drivers();
 278
 279   $main::lxdebug->leave_sub();
 280
 281   return (grep { /(Pg|Oracle)/ } @drivers);
 282 }
 283
 284 sub dbsources {
 285   $main::lxdebug->enter_sub();
 286
 287   my ($self, $form) = @_;
 288
 289   my @dbsources = ();
 290   my ($sth, $query);
 291
 292   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 293   $form->{sid} = $form->{dbdefault};
 294   &dbconnect_vars($form, $form->{dbdefault});
 295
 296   my $dbh =
 297     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 298     or $form->dberror;
 299
 300   if ($form->{dbdriver} eq 'Pg') {
 301
 302     $query = qq|SELECT datname FROM pg_database WHERE NOT ((datname = 'template0') OR (datname = 'template1'))|;
 303     $sth   = $dbh->prepare($query);
 304     $sth->execute || $form->dberror($query);
 305
 306     while (my ($db) = $sth->fetchrow_array) {
 307
 308       if ($form->{only_acc_db}) {
 309
 310         next if ($db =~ /^template/);
 311
 312         &dbconnect_vars($form, $db);
 313         my $dbh =
 314           DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 315           or $form->dberror;
 316
 317         $query = qq|SELECT p.tablename FROM pg_tables p
 318                     WHERE p.tablename = 'defaults'
 319                     AND p.tableowner = '$form->{dbuser}'|;
 320         my $sth = $dbh->prepare($query);
 321         $sth->execute || $form->dberror($query);
 322
 323         if ($sth->fetchrow_array) {
 324           push @dbsources, $db;
 325         }
 326         $sth->finish;
 327         $dbh->disconnect;
 328         next;
 329       }
 330       push @dbsources, $db;
 331     }
 332   }
 333
 334   if ($form->{dbdriver} eq 'Oracle') {
 335     if ($form->{only_acc_db}) {
 336       $query = qq|SELECT o.owner FROM dba_objects o
 337                   WHERE o.object_name = 'DEFAULTS'
 338                   AND o.object_type = 'TABLE'|;
 339     } else {
 340       $query = qq|SELECT username FROM dba_users|;
 341     }
 342
 343     $sth = $dbh->prepare($query);
 344     $sth->execute || $form->dberror($query);
 345
 346     while (my ($db) = $sth->fetchrow_array) {
 347       push @dbsources, $db;
 348     }
 349   }
 350
 351   $sth->finish;
 352   $dbh->disconnect;
 353
 354   $main::lxdebug->leave_sub();
 355
 356   return @dbsources;
 357 }
 358
 359 sub dbcreate {
 360   $main::lxdebug->enter_sub();
 361
 362   my ($self, $form) = @_;
 363
 364   $form->{sid} = $form->{dbdefault};
 365   &dbconnect_vars($form, $form->{dbdefault});
 366   my $dbh =
 367     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 368     or $form->dberror;
 369
 370   my %dbcreate = (
 371     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
 372     'Oracle' =>
 373       qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
 374   );
 375
 376   my %dboptions = (
 377     'Pg' => [],
 378   );
 379
 380   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
 381     if ($form->{"encoding"});
 382   if ($form->{"dbdefault"}) {
 383     my $dbdefault = $form->{"dbdefault"};
 384     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 385     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
 386   }
 387
 388   my $query = qq|$dbcreate{$form->{dbdriver}}|;
 389   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
 390
 391   $dbh->do($query) || $form->dberror($query);
 392
 393   if ($form->{dbdriver} eq 'Oracle') {
 394     $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
 395     $dbh->do($query) || $form->dberror($query);
 396   }
 397   $dbh->disconnect;
 398
 399   # setup variables for the new database
 400   if ($form->{dbdriver} eq 'Oracle') {
 401     $form->{dbuser}   = $form->{db};
 402     $form->{dbpasswd} = $form->{db};
 403   }
 404
 405   &dbconnect_vars($form, $form->{db});
 406
 407   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 408     or $form->dberror;
 409
 410   # create the tables
 411   my $filename = qq|sql/lx-office.sql|;
 412   $self->process_query($form, $dbh, $filename);
 413
 414   # load gifi
 415   ($filename) = split /_/, $form->{chart};
 416   $filename =~ s/_//;
 417   $self->process_query($form, $dbh, "sql/${filename}-gifi.sql");
 418
 419   # load chart of accounts
 420   $filename = qq|sql/$form->{chart}-chart.sql|;
 421   $self->process_query($form, $dbh, $filename);
 422
 423   $query = "UPDATE defaults SET coa = " . $dbh->quote($form->{"chart"});
 424   $dbh->do($query) || $form->dberror($query);
 425
 426   $dbh->disconnect;
 427
 428   $main::lxdebug->leave_sub();
 429 }
 430
 431 # Process a Perl script which updates the database.
 432 # If the script returns 1 then the update was successful.
 433 # Return code "2" means "needs more interaction; remove
 434 # users/nologin and exit".
 435 # All other return codes are fatal errors.
 436 sub process_perl_script {
 437   $main::lxdebug->enter_sub();
 438
 439   my ($self, $form, $dbh, $filename, $version_or_control) = @_;
 440
 441   open(FH, "$filename") or $form->error("$filename : $!\n");
 442   my $contents = join("", <FH>);
 443   close(FH);
 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) = @_;
 490
 491   #  return unless (-f $filename);
 492
 493   open(FH, "$filename") or $form->error("$filename : $!\n");
 494   my $query = "";
 495   my $sth;
 496   my @quote_chars;
 497
 498   $dbh->begin_work();
 499
 500   while (<FH>) {
 501
 502     # Remove DOS and Unix style line endings.
 503     chomp;
 504
 505     # remove comments
 506     s/--.*$//;
 507
 508     for (my $i = 0; $i < length($_); $i++) {
 509       my $char = substr($_, $i, 1);
 510
 511       # Are we inside a string?
 512       if (@quote_chars) {
 513         if ($char eq $quote_chars[-1]) {
 514           pop(@quote_chars);
 515         }
 516         $query .= $char;
 517
 518       } else {
 519         if (($char eq "'") || ($char eq "\"")) {
 520           push(@quote_chars, $char);
 521
 522         } elsif ($char eq ";") {
 523
 524           # Query is complete. Send it.
 525
 526           $sth = $dbh->prepare($query);
 527           if (!$sth->execute()) {
 528             my $errstr = $dbh->errstr;
 529             $sth->finish();
 530             $dbh->rollback();
 531             $form->dberror("The database update/creation did not succeed. The file ${filename} containing the following query failed:<br>${query}<br>" .
 532                            "The error message was: ${errstr}<br>" .
 533                            "All changes in that file have been reverted.");
 534           }
 535           $sth->finish();
 536
 537           $char  = "";
 538           $query = "";
 539         }
 540
 541         $query .= $char;
 542       }
 543     }
 544   }
 545
 546   if (ref($version_or_control) eq "HASH") {
 547     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 548              $dbh->quote($version_or_control->{"tag"}) . ", " .
 549              $dbh->quote($form->{"login"}) . ")");
 550   } elsif ($version_or_control) {
 551     $dbh->do("UPDATE defaults SET version = " .
 552              $dbh->quote($version_or_control));
 553   }
 554   $dbh->commit();
 555
 556   close FH;
 557
 558   $main::lxdebug->leave_sub();
 559 }
 560
 561 sub dbdelete {
 562   $main::lxdebug->enter_sub();
 563
 564   my ($self, $form) = @_;
 565
 566   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 567                   'Oracle' => qq|DROP USER $form->{db} CASCADE|);
 568
 569   $form->{sid} = $form->{dbdefault};
 570   &dbconnect_vars($form, $form->{dbdefault});
 571   my $dbh =
 572     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 573     or $form->dberror;
 574   my $query = qq|$dbdelete{$form->{dbdriver}}|;
 575   $dbh->do($query) || $form->dberror($query);
 576
 577   $dbh->disconnect;
 578
 579   $main::lxdebug->leave_sub();
 580 }
 581
 582 sub dbsources_unused {
 583   $main::lxdebug->enter_sub();
 584
 585   my ($self, $form, $memfile) = @_;
 586
 587   my @dbexcl    = ();
 588   my @dbsources = ();
 589
 590   $form->error('File locked!') if (-f "${memfile}.LCK");
 591
 592   # open members file
 593   open(FH, "$memfile") or $form->error("$memfile : $!");
 594
 595   while (<FH>) {
 596     if (/^dbname=/) {
 597       my ($null, $item) = split(/=/);
 598       push @dbexcl, $item;
 599     }
 600   }
 601
 602   close FH;
 603
 604   $form->{only_acc_db} = 1;
 605   my @db = &dbsources("", $form);
 606
 607   push @dbexcl, $form->{dbdefault};
 608
 609   foreach $item (@db) {
 610     unless (grep /$item$/, @dbexcl) {
 611       push @dbsources, $item;
 612     }
 613   }
 614
 615   $main::lxdebug->leave_sub();
 616
 617   return @dbsources;
 618 }
 619
 620 sub dbneedsupdate {
 621   $main::lxdebug->enter_sub();
 622
 623   my ($self, $form) = @_;
 624
 625   my %dbsources = ();
 626   my $query;
 627
 628   $form->{sid} = $form->{dbdefault};
 629   &dbconnect_vars($form, $form->{dbdefault});
 630
 631   my $dbh =
 632     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 633     or $form->dberror;
 634
 635   if ($form->{dbdriver} eq 'Pg') {
 636
 637     $query = qq|SELECT d.datname FROM pg_database d, pg_user u
 638                 WHERE d.datdba = u.usesysid
 639                 AND u.usename = '$form->{dbuser}'|;
 640     my $sth = $dbh->prepare($query);
 641     $sth->execute || $form->dberror($query);
 642
 643     while (my ($db) = $sth->fetchrow_array) {
 644
 645       next if ($db =~ /^template/);
 646
 647       &dbconnect_vars($form, $db);
 648
 649       my $dbh =
 650         DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 651         or $form->dberror;
 652
 653       $query = qq|SELECT t.tablename FROM pg_tables t
 654                   WHERE t.tablename = 'defaults'|;
 655       my $sth = $dbh->prepare($query);
 656       $sth->execute || $form->dberror($query);
 657
 658       if ($sth->fetchrow_array) {
 659         $query = qq|SELECT version FROM defaults|;
 660         my $sth = $dbh->prepare($query);
 661         $sth->execute;
 662
 663         if (my ($version) = $sth->fetchrow_array) {
 664           $dbsources{$db} = $version;
 665         }
 666         $sth->finish;
 667       }
 668       $sth->finish;
 669       $dbh->disconnect;
 670     }
 671     $sth->finish;
 672   }
 673
 674   if ($form->{dbdriver} eq 'Oracle') {
 675     $query = qq|SELECT o.owner FROM dba_objects o
 676                 WHERE o.object_name = 'DEFAULTS'
 677                 AND o.object_type = 'TABLE'|;
 678
 679     $sth = $dbh->prepare($query);
 680     $sth->execute || $form->dberror($query);
 681
 682     while (my ($db) = $sth->fetchrow_array) {
 683
 684       $form->{dbuser} = $db;
 685       &dbconnect_vars($form, $db);
 686
 687       my $dbh =
 688         DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 689         or $form->dberror;
 690
 691       $query = qq|SELECT version FROM defaults|;
 692       my $sth = $dbh->prepare($query);
 693       $sth->execute;
 694
 695       if (my ($version) = $sth->fetchrow_array) {
 696         $dbsources{$db} = $version;
 697       }
 698       $sth->finish;
 699       $dbh->disconnect;
 700     }
 701     $sth->finish;
 702   }
 703
 704   $dbh->disconnect;
 705
 706   $main::lxdebug->leave_sub();
 707
 708   return %dbsources;
 709 }
 710
 711 ## LINET
 712 sub calc_version {
 713   $main::lxdebug->enter_sub(2);
 714
 715   my (@v, $version, $i);
 716
 717   @v = split(/\./, $_[0]);
 718   while (scalar(@v) < 4) {
 719     push(@v, 0);
 720   }
 721   $version = 0;
 722   for ($i = 0; $i < 4; $i++) {
 723     $version *= 1000;
 724     $version += $v[$i];
 725   }
 726
 727   $main::lxdebug->leave_sub(2);
 728   return $version;
 729 }
 730
 731 sub cmp_script_version {
 732   my ($a_from, $a_to, $b_from, $b_to);
 733   my ($i, $res_a, $res_b);
 734   my ($my_a, $my_b) = ($a, $b);
 735
 736   $my_a =~ s/.*-upgrade-//;
 737   $my_a =~ s/.sql$//;
 738   $my_b =~ s/.*-upgrade-//;
 739   $my_b =~ s/.sql$//;
 740   ($my_a_from, $my_a_to) = split(/-/, $my_a);
 741   ($my_b_from, $my_b_to) = split(/-/, $my_b);
 742
 743   $res_a = calc_version($my_a_from);
 744   $res_b = calc_version($my_b_from);
 745
 746   if ($res_a == $res_b) {
 747     $res_a = calc_version($my_a_to);
 748     $res_b = calc_version($my_b_to);
 749   }
 750
 751   return $res_a <=> $res_b;
 752 }
 753 ## /LINET
 754
 755 sub update_available {
 756   my ($dbdriver, $cur_version) = @_;
 757
 758   opendir SQLDIR, "sql/${dbdriver}-upgrade" or &error("", "sql/${dbdriver}-upgrade: $!");
 759   my @upgradescripts =
 760     grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir(SQLDIR));
 761   closedir SQLDIR;
 762
 763   return ($#upgradescripts > -1);
 764 }
 765
 766 sub create_schema_info_table {
 767   $main::lxdebug->enter_sub();
 768
 769   my ($self, $form, $dbh) = @_;
 770
 771   my $query = "SELECT tag FROM schema_info LIMIT 1";
 772   if (!$dbh->do($query)) {
 773     $query =
 774       "CREATE TABLE schema_info (" .
 775       "  tag text, " .
 776       "  login text, " .
 777       "  itime timestamp DEFAULT now(), " .
 778       "  PRIMARY KEY (tag))";
 779     $dbh->do($query) || $form->dberror($query);
 780   }
 781
 782   $main::lxdebug->leave_sub();
 783 }
 784
 785 sub dbupdate {
 786   $main::lxdebug->enter_sub();
 787
 788   my ($self, $form) = @_;
 789
 790   $form->{sid} = $form->{dbdefault};
 791
 792   my @upgradescripts = ();
 793   my $query;
 794   my $rc = -2;
 795
 796   if ($form->{dbupdate}) {
 797
 798     # read update scripts into memory
 799     opendir SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade" or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 800     ## LINET
 801     @upgradescripts =
 802       sort(cmp_script_version
 803            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/, readdir(SQLDIR)));
 804     ## /LINET
 805     closedir SQLDIR;
 806   }
 807
 808   foreach my $db (split / /, $form->{dbupdate}) {
 809
 810     next unless $form->{$db};
 811
 812     # strip db from dataset
 813     $db =~ s/^db//;
 814     &dbconnect_vars($form, $db);
 815
 816     my $dbh =
 817       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 818       or $form->dberror;
 819
 820     # check version
 821     $query = qq|SELECT version FROM defaults|;
 822     my $sth = $dbh->prepare($query);
 823
 824     # no error check, let it fall through
 825     $sth->execute;
 826
 827     my $version = $sth->fetchrow_array;
 828     $sth->finish;
 829
 830     next unless $version;
 831
 832     ## LINET
 833     $version = calc_version($version);
 834     ## /LINET
 835
 836     foreach my $upgradescript (@upgradescripts) {
 837       my $a = $upgradescript;
 838       $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g;
 839       my $file_type = $1;
 840
 841       my ($mindb, $maxdb) = split /-/, $a;
 842       my $str_maxdb = $maxdb;
 843       ## LINET
 844       $mindb = calc_version($mindb);
 845       $maxdb = calc_version($maxdb);
 846       ## /LINET
 847
 848       next if ($version >= $maxdb);
 849
 850       # if there is no upgrade script exit
 851       last if ($version < $mindb);
 852
 853       # apply upgrade
 854       $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
 855       if ($file_type eq "sql") {
 856         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
 857       } else {
 858         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
 859       }
 860
 861       $version = $maxdb;
 862
 863     }
 864
 865     $rc = 0;
 866     $dbh->disconnect;
 867
 868   }
 869
 870   $main::lxdebug->leave_sub();
 871
 872   return $rc;
 873 }
 874
 875 sub dbupdate2 {
 876   $main::lxdebug->enter_sub();
 877
 878   my ($self, $form, $controls) = @_;
 879
 880   $form->{sid} = $form->{dbdefault};
 881
 882   my @upgradescripts = ();
 883   my ($query, $sth, $tag);
 884   my $rc = -2;
 885
 886   @upgradescripts = sort_dbupdate_controls($controls);
 887
 888   foreach my $db (split / /, $form->{dbupdate}) {
 889
 890     next unless $form->{$db};
 891
 892     # strip db from dataset
 893     $db =~ s/^db//;
 894     &dbconnect_vars($form, $db);
 895
 896     my $dbh =
 897       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 898       or $form->dberror;
 899
 900     map({ $_->{"applied"} = 0; } @upgradescripts);
 901
 902     $query = "SELECT tag FROM schema_info";
 903     $sth = $dbh->prepare($query);
 904     $sth->execute() || $form->dberror($query);
 905     while (($tag) = $sth->fetchrow_array()) {
 906       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 907     }
 908     $sth->finish();
 909
 910     my $all_applied = 1;
 911     foreach (@upgradescripts) {
 912       if (!$_->{"applied"}) {
 913         $all_applied = 0;
 914         last;
 915       }
 916     }
 917
 918     next if ($all_applied);
 919
 920     foreach my $control (@upgradescripts) {
 921       next if ($control->{"applied"});
 922
 923       $control->{"file"} =~ /\.(sql|pl)$/;
 924       my $file_type = $1;
 925
 926       # apply upgrade
 927       $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}");
 928       print($form->parse_html_template("dbupgrade/upgrade_message2",
 929                                        $control));
 930
 931       if ($file_type eq "sql") {
 932         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 933                              "-upgrade2/$control->{file}", $control);
 934       } else {
 935         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 936                                    "-upgrade2/$control->{file}", $control);
 937       }
 938     }
 939
 940     $rc = 0;
 941     $dbh->disconnect;
 942
 943   }
 944
 945   $main::lxdebug->leave_sub();
 946
 947   return $rc;
 948 }
 949
 950 sub update2_available {
 951   $main::lxdebug->enter_sub();
 952
 953   my ($form, $controls) = @_;
 954
 955   map({ $_->{"applied"} = 0; } values(%{$controls}));
 956
 957   dbconnect_vars($form, $form->{"dbname"});
 958
 959   my $dbh =
 960     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 961     $form->dberror;
 962
 963   my ($query, $tag, $sth);
 964
 965   $query = "SELECT tag FROM schema_info";
 966   $sth = $dbh->prepare($query);
 967   $sth->execute() || $form->dberror($query);
 968   while (($tag) = $sth->fetchrow_array()) {
 969     $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 970   }
 971   $sth->finish();
 972   $dbh->disconnect();
 973
 974   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
 975       values(%{$controls}));
 976
 977   $main::lxdebug->leave_sub();
 978   return 0;
 979 }
 980
 981 sub create_config {
 982   $main::lxdebug->enter_sub();
 983
 984   my ($self, $filename) = @_;
 985
 986   @config = &config_vars;
 987
 988   open(CONF, ">$filename") or $self->error("$filename : $!");
 989
 990   # create the config file
 991   print CONF qq|# configuration file for $self->{login}
 992
 993 \%myconfig = (
 994 |;
 995
 996   foreach $key (sort @config) {
 997     $self->{$key} =~ s/\'/\\\'/g;
 998     print CONF qq|  $key => '$self->{$key}',\n|;
 999   }
1000
1001   print CONF qq|);\n\n|;
1002
1003   close CONF;
1004
1005   $main::lxdebug->leave_sub();
1006 }
1007
1008 sub save_member {
1009   $main::lxdebug->enter_sub();
1010
1011   my ($self, $memberfile, $userspath) = @_;
1012
1013   my $newmember = 1;
1014
1015   # format dbconnect and dboptions string
1016   &dbconnect_vars($self, $self->{dbname});
1017
1018   $self->error('File locked!') if (-f "${memberfile}.LCK");
1019   open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
1020   close(FH);
1021
1022   open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
1023
1024   @config = <CONF>;
1025
1026   seek(CONF, 0, 0);
1027   truncate(CONF, 0);
1028
1029   while ($line = shift @config) {
1030     if ($line =~ /^\[$self->{login}\]/) {
1031       $newmember = 0;
1032       last;
1033     }
1034     print CONF $line;
1035   }
1036
1037   # remove everything up to next login or EOF
1038   while ($line = shift @config) {
1039     last if ($line =~ /^\[/);
1040   }
1041
1042   # this one is either the next login or EOF
1043   print CONF $line;
1044
1045   while ($line = shift @config) {
1046     print CONF $line;
1047   }
1048
1049   print CONF qq|[$self->{login}]\n|;
1050
1051   if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
1052       && $self->{root}) {
1053     $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
1054     chop $self->{dbpasswd};
1055   }
1056   if (defined($self->{new_password})) {
1057     if ($self->{new_password} ne $self->{old_password}) {
1058       $self->{password} = crypt $self->{new_password},
1059         substr($self->{login}, 0, 2)
1060         if $self->{new_password};
1061     }
1062   } else {
1063     if ($self->{password} ne $self->{old_password}) {
1064       $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
1065         if $self->{password};
1066     }
1067   }
1068
1069   if ($self->{'root login'}) {
1070     @config = ("password");
1071   } else {
1072     @config = &config_vars;
1073   }
1074
1075   # replace \r\n with \n
1076   map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
1077   foreach $key (sort @config) {
1078     print CONF qq|$key=$self->{$key}\n|;
1079   }
1080
1081   print CONF "\n";
1082   close CONF;
1083   unlink "${memberfile}.LCK";
1084
1085   # create conf file
1086   $self->create_config("$userspath/$self->{login}.conf")
1087     unless $self->{'root login'};
1088
1089   $main::lxdebug->leave_sub();
1090 }
1091
1092 sub config_vars {
1093   $main::lxdebug->enter_sub();
1094
1095   my @conf = qw(acs address admin businessnumber charset company countrycode
1096     currency dateformat dbconnect dbdriver dbhost dbport dboptions
1097     dbname dbuser dbpasswd email fax name numberformat password
1098     printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen
1099     anfragen lieferantenbestellungen einkaufsrechnungen taxnumber co_ustid duns menustyle
1100     template_format default_media default_printer_id copies show_form_details);
1101
1102   $main::lxdebug->leave_sub();
1103
1104   return @conf;
1105 }
1106
1107 sub error {
1108   $main::lxdebug->enter_sub();
1109
1110   my ($self, $msg) = @_;
1111
1112   if ($ENV{HTTP_USER_AGENT}) {
1113     print qq|Content-Type: text/html
1114
1115 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1116
1117 <body bgcolor=ffffff>
1118
1119 <h2><font color=red>Error!</font></h2>
1120 <p><b>$msg</b>|;
1121
1122   }
1123
1124   die "Error: $msg\n";
1125
1126   $main::lxdebug->leave_sub();
1127 }
1128
1129 1;
1130