SL/User.pm

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