sql-ledger/SL/User.pm

   1 #=====================================================================
   2 # SQL-Ledger Accounting
   3 # Copyright (C) 2000
   4 #
   5 #  Author: Dieter Simader
   6 #   Email: dsimader@sql-ledger.org
   7 #     Web: http://www.sql-ledger.org
   8 #
   9 #  Contributors: Jim Rawlings <jim@your-dba.com>
  10 #
  11 # This program is free software; you can redistribute it and/or modify
  12 # it under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 2 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # This program is distributed in the hope that it will be useful,
  17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 # GNU General Public License for more details.
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program; if not, write to the Free Software
  22 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23 #=====================================================================
  24 #
  25 # user related functions
  26 #
  27 #=====================================================================
  28
  29 package User;
  30
  31
  32 sub new {
  33   my ($type, $memfile, $login) = @_;
  34   my $self = {};
  35
  36   if ($login ne "") {
  37     &error("", "$memfile locked!") if (-f "${memfile}.LCK");
  38
  39     open(MEMBER, "$memfile") or &error("", "$memfile : $!");
  40
  41     while (<MEMBER>) {
  42       if (/^\[$login\]/) {
  43         while (<MEMBER>) {
  44           last if /^\[/;
  45           next if /^(#|\s)/;
  46
  47           # remove comments
  48           s/^\s*#.*//g;
  49
  50           # remove any trailing whitespace
  51           s/^\s*(.*?)\s*$/$1/;
  52
  53           ($key, $value) = split /=/, $_, 2;
  54
  55           $self->{$key} = $value;
  56         }
  57
  58         $self->{login} = $login;
  59
  60         last;
  61       }
  62     }
  63     close MEMBER;
  64   }
  65
  66   bless $self, $type;
  67 }
  68
  69
  70 sub country_codes {
  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(FH, "locale/$dir/LANGUAGE");
  82     @language = <FH>;
  83     close FH;
  84
  85     $cc{$dir} = "@language";
  86   }
  87
  88   closedir(DIR);
  89
  90   %cc;
  91
  92 }
  93
  94
  95 sub login {
  96   my ($self, $form, $userspath) = @_;
  97
  98   my $rc = -3;
  99
 100   if ($self->{login}) {
 101
 102     if ($self->{password}) {
 103       my $password = crypt $form->{password}, substr($self->{login}, 0, 2);
 104       if ($self->{password} ne $password) {
 105         return -1;
 106       }
 107     }
 108
 109     unless (-f "$userspath/$self->{login}.conf") {
 110       $self->create_config("$userspath/$self->{login}.conf");
 111     }
 112
 113     do "$userspath/$self->{login}.conf";
 114     $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
 115
 116     # check if database is down
 117     my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}) or $self->error($DBI::errstr);
 118
 119     # we got a connection, check the version
 120     my $query = qq|SELECT version FROM defaults|;
 121     my $sth = $dbh->prepare($query);
 122     $sth->execute || $form->dberror($query);
 123
 124     my ($dbversion) = $sth->fetchrow_array;
 125     $sth->finish;
 126
 127     # add login to employee table if it does not exist
 128     # no error check for employee table, ignore if it does not exist
 129     my $login = $self->{login};
 130     $login =~ s/@.*//;
 131     $query = qq|SELECT id FROM employee WHERE login = '$login'|;
 132     $sth = $dbh->prepare($query);
 133     $sth->execute;
 134
 135     my ($id) = $sth->fetchrow_array;
 136     $sth->finish;
 137
 138     if (! $id) {
 139       my ($employeenumber) = $form->update_defaults(\%myconfig, "employeenumber", $dbh);
 140
 141       $query = qq|INSERT INTO employee (login, employeenumber, name, workphone,
 142                   role)
 143                   VALUES ('$login', '$employeenumber', '$myconfig{name}',
 144                   '$myconfig{tel}', '$myconfig{role}')|;
 145       $dbh->do($query);
 146     }
 147     $dbh->disconnect;
 148
 149     $rc = 0;
 150
 151
 152     if ($form->{dbversion} ne $dbversion) {
 153       $rc = -4;
 154       $dbupdate = (calc_version($dbversion) < calc_version($form->{dbversion}));
 155     }
 156
 157     if ($dbupdate) {
 158       $rc = -5;
 159
 160       # if DB2 bale out
 161       if ($myconfig{dbdriver} eq 'DB2') {
 162         $rc = -2;
 163       }
 164     }
 165   }
 166
 167   $rc;
 168
 169 }
 170
 171
 172
 173 sub dbconnect_vars {
 174   my ($form, $db) = @_;
 175
 176   my %dboptions = (
 177      'Pg' => {
 178         'yy-mm-dd' => 'set DateStyle to \'ISO\'',
 179         'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
 180         'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
 181         'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
 182         'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 183         'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
 184              },
 185      'Oracle' => {
 186         'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 187         'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 188         'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 189         'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
 190         'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
 191         'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
 192                  }
 193      );
 194
 195
 196   $form->{dboptions} = $dboptions{$form->{dbdriver}}{$form->{dateformat}};
 197
 198   if ($form->{dbdriver} =~ /Pg/) {
 199     $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db";
 200   }
 201
 202   if ($form->{dbdriver} eq 'Oracle') {
 203     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 204   }
 205
 206   if ($form->{dbhost}) {
 207     $form->{dbconnect} .= ";host=$form->{dbhost}";
 208   }
 209   if ($form->{dbport}) {
 210     $form->{dbconnect} .= ";port=$form->{dbport}";
 211   }
 212
 213 }
 214
 215
 216 sub dbdrivers {
 217
 218   my @drivers = DBI->available_drivers();
 219
 220 #  return (grep { /(Pg|Oracle|DB2)/ } @drivers);
 221   return (grep { /Pg$/ } @drivers);
 222
 223 }
 224
 225
 226 sub dbsources {
 227   my ($self, $form) = @_;
 228
 229   my @dbsources = ();
 230   my ($sth, $query);
 231
 232   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 233   $form->{sid} = $form->{dbdefault};
 234   &dbconnect_vars($form, $form->{dbdefault});
 235
 236   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 237
 238
 239   if ($form->{dbdriver} eq 'Pg') {
 240
 241     $query = qq|SELECT datname FROM pg_database|;
 242     $sth = $dbh->prepare($query);
 243     $sth->execute || $form->dberror($query);
 244
 245     while (my ($db) = $sth->fetchrow_array) {
 246
 247       if ($form->{only_acc_db}) {
 248
 249         next if ($db =~ /^template/);
 250
 251         &dbconnect_vars($form, $db);
 252         my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 253
 254         $query = qq|SELECT tablename FROM pg_tables
 255                     WHERE tablename = 'defaults'
 256                     AND tableowner = '$form->{dbuser}'|;
 257         my $sth = $dbh->prepare($query);
 258         $sth->execute || $form->dberror($query);
 259
 260         if ($sth->fetchrow_array) {
 261           push @dbsources, $db;
 262         }
 263         $sth->finish;
 264         $dbh->disconnect;
 265         next;
 266       }
 267       push @dbsources, $db;
 268     }
 269   }
 270
 271   if ($form->{dbdriver} eq 'Oracle') {
 272     if ($form->{only_acc_db}) {
 273       $query = qq|SELECT owner FROM dba_objects
 274                   WHERE object_name = 'DEFAULTS'
 275                   AND object_type = 'TABLE'|;
 276     } else {
 277       $query = qq|SELECT username FROM dba_users|;
 278     }
 279
 280     $sth = $dbh->prepare($query);
 281     $sth->execute || $form->dberror($query);
 282
 283     while (my ($db) = $sth->fetchrow_array) {
 284       push @dbsources, $db;
 285     }
 286   }
 287
 288
 289 # JJR
 290   if ($form->{dbdriver} eq 'DB2') {
 291     if ($form->{only_acc_db}) {
 292       $query = qq|SELECT tabschema FROM syscat.tables WHERE tabname = 'DEFAULTS'|;
 293     } else {
 294       $query = qq|SELECT DISTINCT schemaname FROM syscat.schemata WHERE definer != 'SYSIBM' AND schemaname != 'NULLID'|;
 295     }
 296
 297     $sth = $dbh->prepare($query);
 298     $sth->execute || $form->dberror($query);
 299
 300     while (my ($db) = $sth->fetchrow_array) {
 301       push @dbsources, $db;
 302     }
 303   }
 304 # End JJR
 305
 306 # the above is not used but leave it in for future reference
 307 # DS, Oct. 28, 2003
 308
 309
 310   $sth->finish;
 311   $dbh->disconnect;
 312
 313   return @dbsources;
 314
 315 }
 316
 317
 318 sub dbcreate {
 319   my ($self, $form) = @_;
 320
 321   my %dbcreate = ( 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
 322                'Oracle' => qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|);
 323
 324   $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding};
 325
 326   $form->{sid} = $form->{dbdefault};
 327   &dbconnect_vars($form, $form->{dbdefault});
 328   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 329   my $query = qq|$dbcreate{$form->{dbdriver}}|;
 330   $dbh->do($query) || $form->dberror($query);
 331
 332   if ($form->{dbdriver} eq 'Oracle') {
 333     $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
 334     $dbh->do($query) || $form->dberror($query);
 335   }
 336   $dbh->disconnect;
 337
 338
 339   # setup variables for the new database
 340   if ($form->{dbdriver} eq 'Oracle') {
 341     $form->{dbuser} = $form->{db};
 342     $form->{dbpasswd} = $form->{db};
 343   }
 344
 345
 346   &dbconnect_vars($form, $form->{db});
 347
 348   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 349
 350   # create the tables
 351   my $dbdriver = ($form->{dbdriver} =~ /Pg/) ? 'Pg' : $form->{dbdriver};
 352
 353   my $filename = qq|sql/${dbdriver}-tables.sql|;
 354   $self->process_query($form, $dbh, $filename);
 355
 356   # create functions
 357   $filename = qq|sql/${dbdriver}-functions.sql|;
 358   $self->process_query($form, $dbh, $filename);
 359
 360   # load gifi
 361   ($filename) = split /_/, $form->{chart};
 362   $filename =~ s/_//;
 363   $self->process_query($form, $dbh, "sql/${filename}-gifi.sql");
 364
 365   # load chart of accounts
 366   $filename = qq|sql/$form->{chart}-chart.sql|;
 367   $self->process_query($form, $dbh, $filename);
 368
 369   # create indices
 370   $filename = qq|sql/${dbdriver}-indices.sql|;
 371   $self->process_query($form, $dbh, $filename);
 372
 373   # create custom tables and functions
 374   my $item;
 375   foreach $item (qw(tables functions)) {
 376     $filename = "sql/${dbdriver}-custom_${item}.sql";
 377     if (-f "$filename") {
 378       $self->process_query($form, $dbh, $filename);
 379     }
 380   }
 381
 382   $dbh->disconnect;
 383
 384 }
 385
 386
 387
 388 sub process_query {
 389   my ($self, $form, $dbh, $filename) = @_;
 390
 391   return unless (-f $filename);
 392
 393   open(FH, "$filename") or $form->error("$filename : $!\n");
 394   my $query = "";
 395   my $loop = 0;
 396   my $sth;
 397
 398
 399   while (<FH>) {
 400
 401     if ($loop && /^--\s*end\s*(procedure|function|trigger)/i) {
 402       $loop = 0;
 403
 404       $sth = $dbh->prepare($query);
 405       $sth->execute || $form->dberror($query);
 406       $sth->finish;
 407
 408       $query = "";
 409       next;
 410     }
 411
 412     if ($loop || /^create *(or replace)? *(procedure|function|trigger)/i) {
 413       $loop = 1;
 414       next if /^(--.*|\s+)$/;
 415
 416       $query .= $_;
 417       next;
 418     }
 419
 420     # don't add comments or empty lines
 421     next if /^(--.*|\s+)$/;
 422
 423     # anything else, add to query
 424     $query .= $_;
 425
 426     if (/;\s*$/) {
 427       # strip ;... Oracle doesn't like it
 428       $query =~ s/;\s*$//;
 429       $query =~ s/\\'/''/g;
 430
 431       $sth = $dbh->prepare($query);
 432       $sth->execute || $form->dberror($query);
 433       $sth->finish;
 434
 435       $query = "";
 436     }
 437
 438   }
 439   close FH;
 440
 441 }
 442
 443
 444
 445 sub dbdelete {
 446   my ($self, $form) = @_;
 447
 448   my %dbdelete = ( 'Pg' => qq|DROP DATABASE "$form->{db}"|,
 449                'Oracle' => qq|DROP USER $form->{db} CASCADE|
 450                  );
 451
 452   $form->{sid} = $form->{dbdefault};
 453   &dbconnect_vars($form, $form->{dbdefault});
 454   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 455   my $query = qq|$dbdelete{$form->{dbdriver}}|;
 456   $dbh->do($query) || $form->dberror($query);
 457
 458   $dbh->disconnect;
 459
 460 }
 461
 462
 463
 464 sub dbsources_unused {
 465   my ($self, $form, $memfile) = @_;
 466
 467   my @dbexcl = ();
 468   my @dbsources = ();
 469
 470   $form->error("$memfile locked!") if (-f "${memfile}.LCK");
 471
 472   # open members file
 473   open(FH, "$memfile") or $form->error("$memfile : $!");
 474
 475   while (<FH>) {
 476     if (/^dbname=/) {
 477       my ($null,$item) = split /=/;
 478       push @dbexcl, $item;
 479     }
 480   }
 481
 482   close FH;
 483
 484   $form->{only_acc_db} = 1;
 485   my @db = &dbsources("", $form);
 486
 487   push @dbexcl, $form->{dbdefault};
 488
 489   foreach $item (@db) {
 490     unless (grep /$item$/, @dbexcl) {
 491       push @dbsources, $item;
 492     }
 493   }
 494
 495   return @dbsources;
 496
 497 }
 498
 499
 500 sub dbneedsupdate {
 501   my ($self, $form) = @_;
 502
 503   my %dbsources = ();
 504   my $query;
 505
 506   $form->{sid} = $form->{dbdefault};
 507   &dbconnect_vars($form, $form->{dbdefault});
 508
 509   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 510
 511   if ($form->{dbdriver} =~ /Pg/) {
 512
 513     $query = qq|SELECT d.datname FROM pg_database d, pg_user u
 514                 WHERE d.datdba = u.usesysid
 515                 AND u.usename = '$form->{dbuser}'|;
 516     my $sth = $dbh->prepare($query);
 517     $sth->execute || $form->dberror($query);
 518
 519     while (my ($db) = $sth->fetchrow_array) {
 520
 521       next if ($db =~ /^template/);
 522
 523       &dbconnect_vars($form, $db);
 524
 525       my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 526
 527       $query = qq|SELECT tablename FROM pg_tables
 528                   WHERE tablename = 'defaults'|;
 529       my $sth = $dbh->prepare($query);
 530       $sth->execute || $form->dberror($query);
 531
 532       if ($sth->fetchrow_array) {
 533         $query = qq|SELECT version FROM defaults|;
 534         my $sth = $dbh->prepare($query);
 535         $sth->execute;
 536
 537         if (my ($version) = $sth->fetchrow_array) {
 538           $dbsources{$db} = $version;
 539         }
 540         $sth->finish;
 541       }
 542       $sth->finish;
 543       $dbh->disconnect;
 544     }
 545     $sth->finish;
 546   }
 547
 548
 549   if ($form->{dbdriver} eq 'Oracle') {
 550     $query = qq|SELECT owner FROM dba_objects
 551                 WHERE object_name = 'DEFAULTS'
 552                 AND object_type = 'TABLE'|;
 553
 554     $sth = $dbh->prepare($query);
 555     $sth->execute || $form->dberror($query);
 556
 557     while (my ($db) = $sth->fetchrow_array) {
 558
 559       $form->{dbuser} = $db;
 560       &dbconnect_vars($form, $db);
 561
 562       my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 563
 564       $query = qq|SELECT version FROM defaults|;
 565       my $sth = $dbh->prepare($query);
 566       $sth->execute;
 567
 568       if (my ($version) = $sth->fetchrow_array) {
 569         $dbsources{$db} = $version;
 570       }
 571       $sth->finish;
 572       $dbh->disconnect;
 573     }
 574     $sth->finish;
 575   }
 576
 577
 578 # JJR
 579   if ($form->{dbdriver} eq 'DB2') {
 580     $query = qq|SELECT tabschema FROM syscat.tables WHERE tabname = 'DEFAULTS'|;
 581
 582     $sth = $dbh->prepare($query);
 583     $sth->execute || $form->dberror($query);
 584
 585     while (my ($db) = $sth->fetchrow_array) {
 586
 587       &dbconnect_vars($form, $db);
 588
 589       my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 590
 591       $query = qq|SELECT version FROM defaults|;
 592       my $sth = $dbh->prepare($query);
 593       $sth->execute;
 594
 595       if (my ($version) = $sth->fetchrow_array) {
 596         $dbsources{$db} = $version;
 597       }
 598       $sth->finish;
 599       $dbh->disconnect;
 600     }
 601     $sth->finish;
 602   }
 603 # End JJR
 604
 605 # code for DB2 is not used, keep for future reference
 606 # DS, Oct. 28, 2003
 607
 608   $dbh->disconnect;
 609
 610   %dbsources;
 611
 612 }
 613
 614
 615 sub dbupdate {
 616   my ($self, $form) = @_;
 617
 618   $form->{sid} = $form->{dbdefault};
 619
 620   my @upgradescripts = ();
 621   my $query;
 622   my $rc = -2;
 623
 624   if ($form->{dbupdate}) {
 625     # read update scripts into memory
 626     opendir SQLDIR, "sql/." or $form->error($!);
 627     @upgradescripts = sort script_version grep /$form->{dbdriver}-upgrade-.*?\.sql$/, readdir SQLDIR;
 628     closedir SQLDIR;
 629   }
 630
 631
 632   foreach my $db (split / /, $form->{dbupdate}) {
 633
 634     next unless $form->{$db};
 635
 636     # strip db from dataset
 637     $db =~ s/^db//;
 638     &dbconnect_vars($form, $db);
 639
 640     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 641
 642     # check version
 643     $query = qq|SELECT version FROM defaults|;
 644     my $sth = $dbh->prepare($query);
 645     # no error check, let it fall through
 646     $sth->execute;
 647
 648     my $version = $sth->fetchrow_array;
 649     $sth->finish;
 650
 651     next unless $version;
 652
 653     $version = calc_version($version);
 654     my $dbversion = calc_version($form->{dbversion});
 655
 656     foreach my $upgradescript (@upgradescripts) {
 657       my $a = $upgradescript;
 658       $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g;
 659
 660       my ($mindb, $maxdb) = split /-/, $a;
 661       $mindb = calc_version($mindb);
 662       $maxdb = calc_version($maxdb);
 663
 664       next if ($version >= $maxdb);
 665
 666       # exit if there is no upgrade script or version == mindb
 667       last if ($version < $mindb || $version >= $dbversion);
 668
 669       # apply upgrade
 670       $self->process_query($form, $dbh, "sql/$upgradescript");
 671
 672       $version = $maxdb;
 673
 674     }
 675
 676     $rc = 0;
 677     $dbh->disconnect;
 678
 679   }
 680
 681   $rc;
 682
 683 }
 684
 685
 686 sub calc_version {
 687
 688   my @v = split /\./, $_[0];
 689   my $version = 0;
 690   my $i;
 691
 692   for ($i = 0; $i <= $#v; $i++) {
 693     $version *= 1000;
 694     $version += $v[$i];
 695   }
 696
 697   return $version;
 698
 699 }
 700
 701
 702 sub script_version {
 703   my ($my_a, $my_b) = ($a, $b);
 704
 705   my ($a_from, $a_to, $b_from, $b_to);
 706   my ($res_a, $res_b, $i);
 707
 708   $my_a =~ s/.*-upgrade-//;
 709   $my_a =~ s/.sql$//;
 710   $my_b =~ s/.*-upgrade-//;
 711   $my_b =~ s/.sql$//;
 712   ($a_from, $a_to) = split(/-/, $my_a);
 713   ($b_from, $b_to) = split(/-/, $my_b);
 714
 715   $res_a = calc_version($a_from);
 716   $res_b = calc_version($b_from);
 717
 718   if ($res_a == $res_b) {
 719     $res_a = calc_version($a_to);
 720     $res_b = calc_version($b_to);
 721   }
 722
 723   return $res_a <=> $res_b;
 724
 725 }
 726
 727
 728 sub create_config {
 729   my ($self, $filename) = @_;
 730
 731
 732   @config = &config_vars;
 733
 734   open(CONF, ">$filename") or $self->error("$filename : $!");
 735
 736   # create the config file
 737   print CONF qq|# configuration file for $self->{login}
 738
 739 \%myconfig = (
 740 |;
 741
 742   foreach $key (sort @config) {
 743     $self->{$key} =~ s/\\/\\\\/g;
 744     $self->{$key} =~ s/'/\\'/g;
 745     print CONF qq|  $key => '$self->{$key}',\n|;
 746   }
 747
 748
 749   print CONF qq|);\n\n|;
 750
 751   close CONF;
 752
 753 }
 754
 755
 756 sub save_member {
 757   my ($self, $memberfile, $userspath) = @_;
 758
 759   # format dbconnect and dboptions string
 760   &dbconnect_vars($self, $self->{dbname});
 761
 762   $self->error("$memberfile locked!") if (-f "${memberfile}.LCK");
 763   open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
 764   close(FH);
 765
 766   if (! open(CONF, "+<$memberfile")) {
 767     unlink "${memberfile}.LCK";
 768     $self->error("$memberfile : $!");
 769   }
 770
 771   @config = <CONF>;
 772
 773   seek(CONF, 0, 0);
 774   truncate(CONF, 0);
 775
 776   while ($line = shift @config) {
 777     last if ($line =~ /^\[$self->{login}\]/);
 778     print CONF $line;
 779   }
 780
 781   # remove everything up to next login or EOF
 782   while ($line = shift @config) {
 783     last if ($line =~ /^\[/);
 784   }
 785
 786   # this one is either the next login or EOF
 787   print CONF $line;
 788
 789   while ($line = shift @config) {
 790     print CONF $line;
 791   }
 792
 793   print CONF qq|[$self->{login}]\n|;
 794
 795   if ($self->{root}) {
 796     $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
 797     chop $self->{dbpasswd};
 798   }
 799
 800   if ($self->{password} ne $self->{old_password}) {
 801     $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2) if $self->{password};
 802   }
 803
 804   if ($self->{'root login'}) {
 805     @config = ("password");
 806   } else {
 807     @config = &config_vars;
 808   }
 809
 810   # replace \r\n with \n
 811   map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
 812
 813   foreach $key (sort @config) {
 814     print CONF qq|$key=$self->{$key}\n|;
 815   }
 816
 817   print CONF "\n";
 818   close CONF;
 819   unlink "${memberfile}.LCK";
 820
 821   # create conf file
 822   if (! $self->{'root login'}) {
 823     $self->create_config("$userspath/$self->{login}.conf");
 824
 825     $self->{dbpasswd} =~ s/\\'/'/g;
 826     $self->{dbpasswd} =~ s/\\\\/\\/g;
 827     $self->{dbpasswd} = unpack 'u', $self->{dbpasswd};
 828
 829     # check if login is in database
 830     my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}, {AutoCommit => 0}) or $self->error($DBI::errstr);
 831
 832     # add login to employee table if it does not exist
 833     # no error check for employee table, ignore if it does not exist
 834     my $login = $self->{login};
 835     $login =~ s/@.*//;
 836     my $query = qq|SELECT id FROM employee WHERE login = '$login'|;
 837     my $sth = $dbh->prepare($query);
 838     $sth->execute;
 839
 840     my ($id) = $sth->fetchrow_array;
 841     $sth->finish;
 842
 843     if ($id) {
 844       $query = qq|UPDATE employee SET
 845                   role = '$self->{role}',
 846                   email = '$self->{email}',
 847                   name = '$self->{name}'
 848                   WHERE login = '$login'|;
 849
 850     } else {
 851       my ($employeenumber) = Form::update_defaults("", \%$self, "employeenumber", $dbh);
 852       $query = qq|INSERT INTO employee (login, employeenumber, name, workphone,
 853                   role, email)
 854                   VALUES ('$login', '$employeenumber', '$self->{name}',
 855                   '$self->{tel}', '$self->{role}', '$self->{email}')|;
 856     }
 857
 858     $dbh->do($query);
 859     $dbh->commit;
 860     $dbh->disconnect;
 861
 862   }
 863
 864 }
 865
 866
 867 sub delete_login {
 868   my ($self, $form) = @_;
 869
 870   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, {AutoCommit} => 0) or $form->dberror;
 871
 872   my $login = $form->{login};
 873   $login =~ s/@.*//;
 874   my $query = qq|SELECT id FROM employee
 875                  WHERE login = '$login'|;
 876   my $sth = $dbh->prepare($query);
 877   $sth->execute || $form->dberror($query);
 878
 879   my ($id) = $sth->fetchrow_array;
 880   $sth->finish;
 881
 882   my $query = qq|UPDATE employee
 883                  login = NULL
 884                  WHERE login = '$login'|;
 885   $dbh->do($query);
 886
 887   $dbh->commit;
 888   $dbh->disconnect;
 889
 890 }
 891
 892
 893 sub config_vars {
 894
 895   my @conf = qw(acs address businessnumber charset company countrycode
 896              currency dateformat dbconnect dbdriver dbhost dbport dboptions
 897              dbname dbuser dbpasswd email fax name numberformat password
 898              printer role sid signature stylesheet tel templates vclimit
 899              menuwidth timeout);
 900
 901   @conf;
 902
 903 }
 904
 905
 906 sub error {
 907   my ($self, $msg) = @_;
 908
 909   if ($ENV{HTTP_USER_AGENT}) {
 910     print qq|Content-Type: text/html
 911
 912 <body bgcolor=ffffff>
 913
 914 <h2><font color=red>Error!</font></h2>
 915 <p><b>$msg</b>|;
 916
 917   }
 918
 919   die "Error: $msg\n";
 920
 921 }
 922
 923
 924 1;
 925