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::DBConnect;
  42 use SL::DBUpgrade2;
  43 use SL::DBUtils;
  44 use SL::Iconv;
  45 use SL::Inifile;
  46 use SL::System::InstallationLock;
  47
  48 use strict;
  49
  50 sub new {
  51   $main::lxdebug->enter_sub();
  52
  53   my ($type, %params) = @_;
  54
  55   my $self = {};
  56
  57   if ($params{id} || $params{login}) {
  58     my %user_data = $main::auth->read_user(%params);
  59     map { $self->{$_} = $user_data{$_} } keys %user_data;
  60   }
  61
  62   $main::lxdebug->leave_sub();
  63
  64   bless $self, $type;
  65 }
  66
  67 sub country_codes {
  68   $main::lxdebug->enter_sub();
  69
  70   local *DIR;
  71
  72   my %cc       = ();
  73   my @language = ();
  74
  75   # scan the locale directory and read in the LANGUAGE files
  76   opendir(DIR, "locale");
  77
  78   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
  79
  80   foreach my $dir (@dir) {
  81     next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
  82     @language = <$fh>;
  83     close $fh;
  84
  85     $cc{$dir} = "@language";
  86   }
  87
  88   closedir(DIR);
  89
  90   $main::lxdebug->leave_sub();
  91
  92   return %cc;
  93 }
  94
  95 sub login {
  96   my ($self, $form) = @_;
  97
  98   return -3 if !$self->{login} || !$::auth->client;
  99
 100   my %myconfig = $main::auth->read_user(login => $self->{login});
 101
 102   # check if database is down
 103   my $dbh = $form->dbconnect_noauto;
 104
 105   # we got a connection, check the version
 106   my ($dbversion) = $dbh->selectrow_array(qq|SELECT version FROM defaults|);
 107
 108   $self->create_employee_entry($form, $dbh, \%myconfig);
 109
 110   $self->create_schema_info_table($form, $dbh);
 111
 112   # Auth DB upgrades available?
 113   my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, auth => 1)->parse_dbupdate_controls;
 114   return -3 if $dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect);
 115
 116   my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls;
 117
 118   $form->{$_} = $::auth->client->{$_} for qw(dbname dbhost dbport dbuser dbpasswd);
 119   $form->{$_} = $myconfig{$_}         for qw(dateformat);
 120
 121   dbconnect_vars($form, $form->{dbname});
 122
 123   my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
 124   $dbh->disconnect;
 125
 126   return 0 if !$update_available;
 127   $form->{"title"} = $main::locale->text("Dataset upgrade");
 128   $form->header(no_layout => $form->{no_layout});
 129   print $form->parse_html_template("dbupgrade/header");
 130
 131   $form->{dbupdate} = "db" . $form->{dbname};
 132
 133   if ($form->{"show_dbupdate_warning"}) {
 134     print $form->parse_html_template("dbupgrade/warning");
 135     ::end_of_request();
 136   }
 137
 138   # update the tables
 139   SL::System::InstallationLock->lock;
 140
 141   # ignore HUP, QUIT in case the webserver times out
 142   $SIG{HUP}  = 'IGNORE';
 143   $SIG{QUIT} = 'IGNORE';
 144
 145   $self->dbupdate($form);
 146   $self->dbupdate2($form, $dbupdater);
 147   SL::DBUpgrade2->new(form => $::form, auth => 1)->apply_admin_dbupgrade_scripts(0);
 148
 149   SL::System::InstallationLock->unlock;
 150
 151   print $form->parse_html_template("dbupgrade/footer");
 152
 153   return -2;
 154 }
 155
 156 sub dbconnect_vars {
 157   $main::lxdebug->enter_sub();
 158
 159   my ($form, $db) = @_;
 160
 161   my %dboptions = (
 162     'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 163     'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 164     'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 165     'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 166     'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 167   );
 168
 169   $form->{dboptions} = $dboptions{ $form->{dateformat} };
 170   $form->{dbconnect} = "dbi:Pg:dbname=${db};host=" . ($form->{dbhost} || 'localhost') . ";port=" . ($form->{dbport} || 5432);
 171
 172   $main::lxdebug->leave_sub();
 173 }
 174
 175 sub dbsources {
 176   $main::lxdebug->enter_sub();
 177
 178   my ($self, $form) = @_;
 179
 180   my @dbsources = ();
 181   my ($sth, $query);
 182
 183   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 184   &dbconnect_vars($form, $form->{dbdefault});
 185
 186   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 187     or $form->dberror;
 188
 189   $query =
 190     qq|SELECT datname FROM pg_database | .
 191     qq|WHERE NOT datname IN ('template0', 'template1')|;
 192   $sth = $dbh->prepare($query);
 193   $sth->execute() || $form->dberror($query);
 194
 195   while (my ($db) = $sth->fetchrow_array) {
 196
 197     if ($form->{only_acc_db}) {
 198
 199       next if ($db =~ /^template/);
 200
 201       &dbconnect_vars($form, $db);
 202       my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 203         or $form->dberror;
 204
 205       $query =
 206         qq|SELECT tablename FROM pg_tables | .
 207         qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
 208       my $sth = $dbh->prepare($query);
 209       $sth->execute($form->{dbuser}) ||
 210         $form->dberror($query . " ($form->{dbuser})");
 211
 212       if ($sth->fetchrow_array) {
 213         push(@dbsources, $db);
 214       }
 215       $sth->finish;
 216       $dbh->disconnect;
 217       next;
 218     }
 219     push(@dbsources, $db);
 220   }
 221
 222   $sth->finish;
 223   $dbh->disconnect;
 224
 225   $main::lxdebug->leave_sub();
 226
 227   return @dbsources;
 228 }
 229
 230 sub dbclusterencoding {
 231   $main::lxdebug->enter_sub();
 232
 233   my ($self, $form) = @_;
 234
 235   $form->{dbdefault} ||= $form->{dbuser};
 236
 237   dbconnect_vars($form, $form->{dbdefault});
 238
 239   my $dbh                = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) || $form->dberror();
 240   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 241   my ($cluster_encoding) = $dbh->selectrow_array($query);
 242   $dbh->disconnect();
 243
 244   $main::lxdebug->leave_sub();
 245
 246   return $cluster_encoding;
 247 }
 248
 249 sub dbcreate {
 250   $main::lxdebug->enter_sub();
 251
 252   my ($self, $form) = @_;
 253
 254   &dbconnect_vars($form, $form->{dbdefault});
 255   my $dbh =
 256     SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 257     or $form->dberror;
 258   $form->{db} =~ s/\"//g;
 259
 260   my @dboptions;
 261
 262   push @dboptions, "ENCODING = " . $dbh->quote($form->{"encoding"}) if $form->{"encoding"};
 263   if ($form->{"dbdefault"}) {
 264     my $dbdefault = $form->{"dbdefault"};
 265     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 266     push @dboptions, "TEMPLATE = $dbdefault";
 267   }
 268
 269   my $query = qq|CREATE DATABASE "$form->{db}"|;
 270   $query   .= " WITH " . join(" ", @dboptions) if @dboptions;
 271
 272   # Ignore errors if the database exists.
 273   $dbh->do($query);
 274
 275   $dbh->disconnect;
 276
 277   &dbconnect_vars($form, $form->{db});
 278
 279   $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 280     or $form->dberror;
 281
 282   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 283   $db_charset ||= Common::DEFAULT_CHARSET;
 284
 285   my $dbupdater = SL::DBUpgrade2->new(form => $form);
 286   # create the tables
 287   $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
 288
 289   # load chart of accounts
 290   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 291
 292   $query = "UPDATE defaults SET coa = ?";
 293   do_query($form, $dbh, $query, $form->{chart});
 294   $query = "UPDATE defaults SET accounting_method = ?";
 295   do_query($form, $dbh, $query, $form->{accounting_method});
 296   $query = "UPDATE defaults SET profit_determination = ?";
 297   do_query($form, $dbh, $query, $form->{profit_determination});
 298   $query = "UPDATE defaults SET inventory_system = ?";
 299   do_query($form, $dbh, $query, $form->{inventory_system});
 300   $query = "UPDATE defaults SET curr = ?";
 301   do_query($form, $dbh, $query, $form->{defaultcurrency});
 302
 303   $dbh->disconnect;
 304
 305   $main::lxdebug->leave_sub();
 306 }
 307
 308 sub dbdelete {
 309   $main::lxdebug->enter_sub();
 310
 311   my ($self, $form) = @_;
 312   $form->{db} =~ s/\"//g;
 313
 314   &dbconnect_vars($form, $form->{dbdefault});
 315   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 316     or $form->dberror;
 317   my $query = qq|DROP DATABASE "$form->{db}"|;
 318   do_query($form, $dbh, $query);
 319
 320   $dbh->disconnect;
 321
 322   $main::lxdebug->leave_sub();
 323 }
 324
 325 sub dbsources_unused {
 326   $main::lxdebug->enter_sub();
 327
 328   my ($self, $form) = @_;
 329
 330   $form->{only_acc_db} = 1;
 331
 332   my %members = $main::auth->read_all_users();
 333   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 334
 335   $dbexcl{$form->{dbdefault}}             = 1;
 336   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 337
 338   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 339
 340   $main::lxdebug->leave_sub();
 341
 342   return @dbunused;
 343 }
 344
 345 sub dbneedsupdate {
 346   $main::lxdebug->enter_sub();
 347
 348   my ($self, $form) = @_;
 349
 350   my %members   = $main::auth->read_all_users();
 351   my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls;
 352
 353   my ($query, $sth, %dbs_needing_updates);
 354
 355   foreach my $login (grep /[a-z]/, keys %members) {
 356     my $member = $members{$login};
 357
 358     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 359     dbconnect_vars($form, $form->{dbname});
 360
 361     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options);
 362
 363     next unless $dbh;
 364
 365     my $version;
 366
 367     $query = qq|SELECT version FROM defaults|;
 368     $sth = prepare_query($form, $dbh, $query);
 369     if ($sth->execute()) {
 370       ($version) = $sth->fetchrow_array();
 371     }
 372     $sth->finish();
 373
 374     $dbh->disconnect and next unless $version;
 375
 376     my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
 377     $dbh->disconnect;
 378
 379    if ($update_available) {
 380       my $dbinfo = {};
 381       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 382       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 383     }
 384   }
 385
 386   $main::lxdebug->leave_sub();
 387
 388   return values %dbs_needing_updates;
 389 }
 390
 391 sub calc_version {
 392   $main::lxdebug->enter_sub(2);
 393
 394   my (@v, $version, $i);
 395
 396   @v = split(/\./, $_[0]);
 397   while (scalar(@v) < 4) {
 398     push(@v, 0);
 399   }
 400   $version = 0;
 401   for ($i = 0; $i < 4; $i++) {
 402     $version *= 1000;
 403     $version += $v[$i];
 404   }
 405
 406   $main::lxdebug->leave_sub(2);
 407   return $version;
 408 }
 409
 410 sub cmp_script_version {
 411   my ($a_from, $a_to, $b_from, $b_to);
 412   my ($i, $res_a, $res_b);
 413   my ($my_a, $my_b) = ($a, $b);
 414
 415   $my_a =~ s/.*-upgrade-//;
 416   $my_a =~ s/.sql$//;
 417   $my_b =~ s/.*-upgrade-//;
 418   $my_b =~ s/.sql$//;
 419   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 420   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 421
 422   $res_a = calc_version($my_a_from);
 423   $res_b = calc_version($my_b_from);
 424
 425   if ($res_a == $res_b) {
 426     $res_a = calc_version($my_a_to);
 427     $res_b = calc_version($my_b_to);
 428   }
 429
 430   return $res_a <=> $res_b;
 431 }
 432
 433 sub create_schema_info_table {
 434   $main::lxdebug->enter_sub();
 435
 436   my ($self, $form, $dbh) = @_;
 437
 438   my $query = "SELECT tag FROM schema_info LIMIT 1";
 439   if (!$dbh->do($query)) {
 440     $dbh->rollback();
 441     $query =
 442       qq|CREATE TABLE schema_info (| .
 443       qq|  tag text, | .
 444       qq|  login text, | .
 445       qq|  itime timestamp DEFAULT now(), | .
 446       qq|  PRIMARY KEY (tag))|;
 447     $dbh->do($query) || $form->dberror($query);
 448   }
 449
 450   $main::lxdebug->leave_sub();
 451 }
 452
 453 sub dbupdate {
 454   $main::lxdebug->enter_sub();
 455
 456   my ($self, $form) = @_;
 457
 458   local *SQLDIR;
 459
 460   my @upgradescripts = ();
 461   my $query;
 462   my $rc = -2;
 463
 464   if ($form->{dbupdate}) {
 465
 466     # read update scripts into memory
 467     opendir(SQLDIR, "sql/Pg-upgrade")
 468       or &error("", "sql/Pg-upgrade : $!");
 469     @upgradescripts =
 470       sort(cmp_script_version
 471            grep(/Pg-upgrade-.*?\.(sql|pl)$/,
 472                 readdir(SQLDIR)));
 473     closedir(SQLDIR);
 474   }
 475
 476   my $db_charset = $::lx_office_conf{system}->{dbcharset};
 477   $db_charset ||= Common::DEFAULT_CHARSET;
 478
 479   my $dbupdater = SL::DBUpgrade2->new(form => $form);
 480
 481   foreach my $db (split(/ /, $form->{dbupdate})) {
 482
 483     next unless $form->{$db};
 484
 485     # strip db from dataset
 486     $db =~ s/^db//;
 487     &dbconnect_vars($form, $db);
 488
 489     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 490       or $form->dberror;
 491
 492     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 493
 494     # check version
 495     $query = qq|SELECT version FROM defaults|;
 496     my ($version) = selectrow_query($form, $dbh, $query);
 497
 498     next unless $version;
 499
 500     $version = calc_version($version);
 501
 502     foreach my $upgradescript (@upgradescripts) {
 503       my $a = $upgradescript;
 504       $a =~ s/^Pg-upgrade-|\.(sql|pl)$//g;
 505
 506       my ($mindb, $maxdb) = split /-/, $a;
 507       my $str_maxdb = $maxdb;
 508       $mindb = calc_version($mindb);
 509       $maxdb = calc_version($maxdb);
 510
 511       next if ($version >= $maxdb);
 512
 513       # if there is no upgrade script exit
 514       last if ($version < $mindb);
 515
 516       # apply upgrade
 517       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 518       $dbupdater->process_file($dbh, "sql/Pg-upgrade/$upgradescript", $str_maxdb, $db_charset);
 519
 520       $version = $maxdb;
 521
 522     }
 523
 524     $rc = 0;
 525     $dbh->disconnect;
 526
 527   }
 528
 529   $main::lxdebug->leave_sub();
 530
 531   return $rc;
 532 }
 533
 534 sub dbupdate2 {
 535   $main::lxdebug->enter_sub();
 536
 537   my ($self, $form, $dbupdater) = @_;
 538
 539   my $rc         = -2;
 540   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
 541
 542   map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
 543
 544   foreach my $db (split / /, $form->{dbupdate}) {
 545     next unless $form->{$db};
 546
 547     # strip db from dataset
 548     $db =~ s/^db//;
 549     &dbconnect_vars($form, $db);
 550
 551     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror;
 552
 553     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 554
 555     $self->create_schema_info_table($form, $dbh);
 556
 557     my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
 558
 559     $dbh->disconnect and next if !@upgradescripts;
 560
 561     foreach my $control (@upgradescripts) {
 562       # apply upgrade
 563       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 564       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 565
 566       $dbupdater->process_file($dbh, "sql/Pg-upgrade2/$control->{file}", $control, $db_charset);
 567     }
 568
 569     $rc = 0;
 570     $dbh->disconnect;
 571
 572   }
 573
 574   $main::lxdebug->leave_sub();
 575
 576   return $rc;
 577 }
 578
 579 sub save_member {
 580   $main::lxdebug->enter_sub();
 581
 582   my ($self) = @_;
 583
 584   # format dbconnect and dboptions string
 585   dbconnect_vars($self, $self->{dbname});
 586
 587   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 588
 589   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 590
 591   my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}, SL::DBConnect->get_options);
 592   if ($dbh) {
 593     $self->create_employee_entry($::form, $dbh, $self, 1);
 594     $dbh->disconnect();
 595   }
 596
 597   $main::lxdebug->leave_sub();
 598 }
 599
 600 sub create_employee_entry {
 601   $main::lxdebug->enter_sub();
 602
 603   my $self            = shift;
 604   my $form            = shift;
 605   my $dbh             = shift;
 606   my $myconfig        = shift;
 607   my $update_existing = shift;
 608
 609   if (!does_table_exist($dbh, 'employee')) {
 610     $main::lxdebug->leave_sub();
 611     return;
 612   }
 613
 614   # add login to employee table if it does not exist
 615   # no error check for employee table, ignore if it does not exist
 616   my ($id)         = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 617   my ($good_db)    = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
 618   my  $can_delete;
 619      ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
 620
 621   if (!$id) {
 622     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 623     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 624
 625   } elsif ($update_existing && $can_delete) {
 626     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
 627     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 628   }
 629
 630   $main::lxdebug->leave_sub();
 631 }
 632
 633 sub config_vars {
 634   $main::lxdebug->enter_sub();
 635
 636   my @conf = qw(copies countrycode dateformat default_media default_printer_id email favorites fax hide_cvar_search_options mandatory_departments menustyle name
 637                 numberformat show_form_details signature stylesheet taxincluded_checked tel template_format vclimit);
 638
 639   $main::lxdebug->leave_sub();
 640
 641   return @conf;
 642 }
 643
 644 sub data {
 645   +{ %{ $_[0] } }
 646 }
 647
 648 1;