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