Nicht mehr benötigte Felder beim Speichern von Usern weglassen
[kivitendo-erp.git] / 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
47 use strict;
48
49 sub new {
50   $main::lxdebug->enter_sub();
51
52   my ($type, %params) = @_;
53
54   my $self = {};
55
56   if ($params{id} || $params{login}) {
57     my %user_data = $main::auth->read_user(%params);
58     map { $self->{$_} = $user_data{$_} } keys %user_data;
59   }
60
61   $main::lxdebug->leave_sub();
62
63   bless $self, $type;
64 }
65
66 sub country_codes {
67   $main::lxdebug->enter_sub();
68
69   local *DIR;
70
71   my %cc       = ();
72   my @language = ();
73
74   # scan the locale directory and read in the LANGUAGE files
75   opendir(DIR, "locale");
76
77   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
78
79   foreach my $dir (@dir) {
80     next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
81     @language = <$fh>;
82     close $fh;
83
84     $cc{$dir} = "@language";
85   }
86
87   closedir(DIR);
88
89   $main::lxdebug->leave_sub();
90
91   return %cc;
92 }
93
94 sub login {
95   $main::lxdebug->enter_sub();
96
97   my ($self, $form) = @_;
98   our $sid;
99
100   local *FH;
101
102   my $rc = -3;
103
104   if ($self->{login}) {
105     my %myconfig = $main::auth->read_user(login => $self->{login});
106
107     # check if database is down
108     my $dbh = SL::DBConnect->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}, SL::DBConnect->get_options)
109       or $self->error($DBI::errstr);
110
111     # we got a connection, check the version
112     my $query = qq|SELECT version FROM defaults|;
113     my $sth   = $dbh->prepare($query);
114     $sth->execute || $form->dberror($query);
115
116     my ($dbversion) = $sth->fetchrow_array;
117     $sth->finish;
118
119     $self->create_employee_entry($form, $dbh, \%myconfig);
120
121     $self->create_schema_info_table($form, $dbh);
122
123     my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, dbdriver => 'Pg', auth => 1)->parse_dbupdate_controls;
124     if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
125       $::lxdebug->leave_sub;
126       return -3;
127     }
128
129     $rc = 0;
130
131     my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
132
133     map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
134     dbconnect_vars($form, $form->{dbname});
135     my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
136     $dbh->disconnect;
137
138     if ($update_available) {
139       $form->{"title"} = $main::locale->text("Dataset upgrade");
140       $form->header(no_layout => $form->{no_layout});
141       print $form->parse_html_template("dbupgrade/header");
142
143       $form->{dbupdate} = "db$myconfig{dbname}";
144       $form->{ $form->{dbupdate} } = 1;
145
146       if ($form->{"show_dbupdate_warning"}) {
147         print $form->parse_html_template("dbupgrade/warning");
148         ::end_of_request();
149       }
150
151       # update the tables
152       if (!$::lx_office_conf{debug}->{keep_installation_unlocked} && !open(FH, ">", $::lx_office_conf{paths}->{userspath} . "/nologin")) {
153         $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
154                                                       'Please verify that the directory "#1" is writeable by the webserver.',
155                                                       $::lx_office_conf{paths}->{userspath}),
156                                   'back_button' => 1);
157       }
158
159       # required for Oracle
160       $form->{dbdefault} = $sid;
161
162       # ignore HUP, QUIT in case the webserver times out
163       $SIG{HUP}  = 'IGNORE';
164       $SIG{QUIT} = 'IGNORE';
165
166       $self->dbupdate($form);
167       $self->dbupdate2($form, $dbupdater);
168       SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
169
170       close(FH);
171
172       # remove lock file
173       unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
174
175       print $form->parse_html_template("dbupgrade/footer");
176
177       $rc = -2;
178     }
179   }
180
181   $main::lxdebug->leave_sub();
182
183   return $rc;
184 }
185
186 sub dbconnect_vars {
187   $main::lxdebug->enter_sub();
188
189   my ($form, $db) = @_;
190
191   my %dboptions = (
192         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
193                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
194                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
195                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
196                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
197         },
198         'Oracle' => {
199           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
200           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
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         });
205
206   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
207
208   if ($form->{dbdriver} eq 'Pg') {
209     $form->{dbconnect} = "dbi:Pg:dbname=$db";
210   }
211
212   if ($form->{dbdriver} eq 'Oracle') {
213     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
214   }
215
216   if ($form->{dbhost}) {
217     $form->{dbconnect} .= ";host=$form->{dbhost}";
218   }
219   if ($form->{dbport}) {
220     $form->{dbconnect} .= ";port=$form->{dbport}";
221   }
222
223   $main::lxdebug->leave_sub();
224 }
225
226 sub dbdrivers {
227   $main::lxdebug->enter_sub();
228
229   my @drivers = DBI->available_drivers();
230
231   $main::lxdebug->leave_sub();
232
233   return (grep { /(Pg|Oracle)/ } @drivers);
234 }
235
236 sub dbsources {
237   $main::lxdebug->enter_sub();
238
239   my ($self, $form) = @_;
240
241   my @dbsources = ();
242   my ($sth, $query);
243
244   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
245   $form->{sid} = $form->{dbdefault};
246   &dbconnect_vars($form, $form->{dbdefault});
247
248   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
249     or $form->dberror;
250
251   if ($form->{dbdriver} eq 'Pg') {
252     $query =
253       qq|SELECT datname FROM pg_database | .
254       qq|WHERE NOT datname IN ('template0', 'template1')|;
255     $sth = $dbh->prepare($query);
256     $sth->execute() || $form->dberror($query);
257
258     while (my ($db) = $sth->fetchrow_array) {
259
260       if ($form->{only_acc_db}) {
261
262         next if ($db =~ /^template/);
263
264         &dbconnect_vars($form, $db);
265         my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
266           or $form->dberror;
267
268         $query =
269           qq|SELECT tablename FROM pg_tables | .
270           qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
271         my $sth = $dbh->prepare($query);
272         $sth->execute($form->{dbuser}) ||
273           $form->dberror($query . " ($form->{dbuser})");
274
275         if ($sth->fetchrow_array) {
276           push(@dbsources, $db);
277         }
278         $sth->finish;
279         $dbh->disconnect;
280         next;
281       }
282       push(@dbsources, $db);
283     }
284   }
285
286   if ($form->{dbdriver} eq 'Oracle') {
287     if ($form->{only_acc_db}) {
288       $query =
289         qq|SELECT owner FROM dba_objects | .
290         qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
291     } else {
292       $query = qq|SELECT username FROM dba_users|;
293     }
294
295     $sth = $dbh->prepare($query);
296     $sth->execute || $form->dberror($query);
297
298     while (my ($db) = $sth->fetchrow_array) {
299       push(@dbsources, $db);
300     }
301   }
302
303   $sth->finish;
304   $dbh->disconnect;
305
306   $main::lxdebug->leave_sub();
307
308   return @dbsources;
309 }
310
311 sub dbclusterencoding {
312   $main::lxdebug->enter_sub();
313
314   my ($self, $form) = @_;
315
316   $form->{dbdefault} ||= $form->{dbuser};
317
318   dbconnect_vars($form, $form->{dbdefault});
319
320   my $dbh                = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) || $form->dberror();
321   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
322   my ($cluster_encoding) = $dbh->selectrow_array($query);
323   $dbh->disconnect();
324
325   $main::lxdebug->leave_sub();
326
327   return $cluster_encoding;
328 }
329
330 sub dbcreate {
331   $main::lxdebug->enter_sub();
332
333   my ($self, $form) = @_;
334
335   $form->{sid} = $form->{dbdefault};
336   &dbconnect_vars($form, $form->{dbdefault});
337   my $dbh =
338     SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
339     or $form->dberror;
340   $form->{db} =~ s/\"//g;
341   my %dbcreate = (
342     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
343     'Oracle' =>
344     qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
345     qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
346   );
347
348   my %dboptions = (
349     'Pg' => [],
350   );
351
352   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
353     if ($form->{"encoding"});
354   if ($form->{"dbdefault"}) {
355     my $dbdefault = $form->{"dbdefault"};
356     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
357     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
358   }
359
360   my $query = $dbcreate{$form->{dbdriver}};
361   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
362
363   # Ignore errors if the database exists.
364   $dbh->do($query);
365
366   if ($form->{dbdriver} eq 'Oracle') {
367     $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
368     do_query($form, $dbh, $query);
369   }
370   $dbh->disconnect;
371
372   # setup variables for the new database
373   if ($form->{dbdriver} eq 'Oracle') {
374     $form->{dbuser}   = $form->{db};
375     $form->{dbpasswd} = $form->{db};
376   }
377
378   &dbconnect_vars($form, $form->{db});
379
380   $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
381     or $form->dberror;
382
383   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
384   $db_charset ||= Common::DEFAULT_CHARSET;
385
386   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
387   # create the tables
388   $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
389
390   # load chart of accounts
391   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
392
393   $query = "UPDATE defaults SET coa = ?";
394   do_query($form, $dbh, $query, $form->{chart});
395   $query = "UPDATE defaults SET accounting_method = ?";
396   do_query($form, $dbh, $query, $form->{accounting_method});
397   $query = "UPDATE defaults SET profit_determination = ?";
398   do_query($form, $dbh, $query, $form->{profit_determination});
399   $query = "UPDATE defaults SET inventory_system = ?";
400   do_query($form, $dbh, $query, $form->{inventory_system});
401   $query = "UPDATE defaults SET curr = ?";
402   do_query($form, $dbh, $query, $form->{defaultcurrency});
403
404   $dbh->disconnect;
405
406   $main::lxdebug->leave_sub();
407 }
408
409 sub dbdelete {
410   $main::lxdebug->enter_sub();
411
412   my ($self, $form) = @_;
413   $form->{db} =~ s/\"//g;
414   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
415                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
416
417   $form->{sid} = $form->{dbdefault};
418   &dbconnect_vars($form, $form->{dbdefault});
419   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
420     or $form->dberror;
421   my $query = $dbdelete{$form->{dbdriver}};
422   do_query($form, $dbh, $query);
423
424   $dbh->disconnect;
425
426   $main::lxdebug->leave_sub();
427 }
428
429 sub dbsources_unused {
430   $main::lxdebug->enter_sub();
431
432   my ($self, $form) = @_;
433
434   $form->{only_acc_db} = 1;
435
436   my %members = $main::auth->read_all_users();
437   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
438
439   $dbexcl{$form->{dbdefault}}             = 1;
440   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
441
442   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
443
444   $main::lxdebug->leave_sub();
445
446   return @dbunused;
447 }
448
449 sub dbneedsupdate {
450   $main::lxdebug->enter_sub();
451
452   my ($self, $form) = @_;
453
454   my %members   = $main::auth->read_all_users();
455   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
456
457   my ($query, $sth, %dbs_needing_updates);
458
459   foreach my $login (grep /[a-z]/, keys %members) {
460     my $member = $members{$login};
461
462     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
463     dbconnect_vars($form, $form->{dbname});
464
465     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options);
466
467     next unless $dbh;
468
469     my $version;
470
471     $query = qq|SELECT version FROM defaults|;
472     $sth = prepare_query($form, $dbh, $query);
473     if ($sth->execute()) {
474       ($version) = $sth->fetchrow_array();
475     }
476     $sth->finish();
477
478     $dbh->disconnect and next unless $version;
479
480     my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
481     $dbh->disconnect;
482
483    if ($update_available) {
484       my $dbinfo = {};
485       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
486       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
487     }
488   }
489
490   $main::lxdebug->leave_sub();
491
492   return values %dbs_needing_updates;
493 }
494
495 sub calc_version {
496   $main::lxdebug->enter_sub(2);
497
498   my (@v, $version, $i);
499
500   @v = split(/\./, $_[0]);
501   while (scalar(@v) < 4) {
502     push(@v, 0);
503   }
504   $version = 0;
505   for ($i = 0; $i < 4; $i++) {
506     $version *= 1000;
507     $version += $v[$i];
508   }
509
510   $main::lxdebug->leave_sub(2);
511   return $version;
512 }
513
514 sub cmp_script_version {
515   my ($a_from, $a_to, $b_from, $b_to);
516   my ($i, $res_a, $res_b);
517   my ($my_a, $my_b) = ($a, $b);
518
519   $my_a =~ s/.*-upgrade-//;
520   $my_a =~ s/.sql$//;
521   $my_b =~ s/.*-upgrade-//;
522   $my_b =~ s/.sql$//;
523   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
524   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
525
526   $res_a = calc_version($my_a_from);
527   $res_b = calc_version($my_b_from);
528
529   if ($res_a == $res_b) {
530     $res_a = calc_version($my_a_to);
531     $res_b = calc_version($my_b_to);
532   }
533
534   return $res_a <=> $res_b;
535 }
536
537 sub create_schema_info_table {
538   $main::lxdebug->enter_sub();
539
540   my ($self, $form, $dbh) = @_;
541
542   my $query = "SELECT tag FROM schema_info LIMIT 1";
543   if (!$dbh->do($query)) {
544     $dbh->rollback();
545     $query =
546       qq|CREATE TABLE schema_info (| .
547       qq|  tag text, | .
548       qq|  login text, | .
549       qq|  itime timestamp DEFAULT now(), | .
550       qq|  PRIMARY KEY (tag))|;
551     $dbh->do($query) || $form->dberror($query);
552   }
553
554   $main::lxdebug->leave_sub();
555 }
556
557 sub dbupdate {
558   $main::lxdebug->enter_sub();
559
560   my ($self, $form) = @_;
561
562   local *SQLDIR;
563
564   $form->{sid} = $form->{dbdefault};
565
566   my @upgradescripts = ();
567   my $query;
568   my $rc = -2;
569
570   if ($form->{dbupdate}) {
571
572     # read update scripts into memory
573     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
574       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
575     @upgradescripts =
576       sort(cmp_script_version
577            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
578                 readdir(SQLDIR)));
579     closedir(SQLDIR);
580   }
581
582   my $db_charset = $::lx_office_conf{system}->{dbcharset};
583   $db_charset ||= Common::DEFAULT_CHARSET;
584
585   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
586
587   foreach my $db (split(/ /, $form->{dbupdate})) {
588
589     next unless $form->{$db};
590
591     # strip db from dataset
592     $db =~ s/^db//;
593     &dbconnect_vars($form, $db);
594
595     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
596       or $form->dberror;
597
598     $dbh->do($form->{dboptions}) if ($form->{dboptions});
599
600     # check version
601     $query = qq|SELECT version FROM defaults|;
602     my ($version) = selectrow_query($form, $dbh, $query);
603
604     next unless $version;
605
606     $version = calc_version($version);
607
608     foreach my $upgradescript (@upgradescripts) {
609       my $a = $upgradescript;
610       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
611
612       my ($mindb, $maxdb) = split /-/, $a;
613       my $str_maxdb = $maxdb;
614       $mindb = calc_version($mindb);
615       $maxdb = calc_version($maxdb);
616
617       next if ($version >= $maxdb);
618
619       # if there is no upgrade script exit
620       last if ($version < $mindb);
621
622       # apply upgrade
623       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
624       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
625
626       $version = $maxdb;
627
628     }
629
630     $rc = 0;
631     $dbh->disconnect;
632
633   }
634
635   $main::lxdebug->leave_sub();
636
637   return $rc;
638 }
639
640 sub dbupdate2 {
641   $main::lxdebug->enter_sub();
642
643   my ($self, $form, $dbupdater) = @_;
644
645   $form->{sid} = $form->{dbdefault};
646
647   my $rc         = -2;
648   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
649
650   map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
651
652   foreach my $db (split / /, $form->{dbupdate}) {
653     next unless $form->{$db};
654
655     # strip db from dataset
656     $db =~ s/^db//;
657     &dbconnect_vars($form, $db);
658
659     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror;
660
661     $dbh->do($form->{dboptions}) if ($form->{dboptions});
662
663     $self->create_schema_info_table($form, $dbh);
664
665     my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
666
667     $dbh->disconnect and next if !@upgradescripts;
668
669     foreach my $control (@upgradescripts) {
670       # apply upgrade
671       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
672       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
673
674       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
675     }
676
677     $rc = 0;
678     $dbh->disconnect;
679
680   }
681
682   $main::lxdebug->leave_sub();
683
684   return $rc;
685 }
686
687 sub save_member {
688   $main::lxdebug->enter_sub();
689
690   my ($self) = @_;
691
692   # format dbconnect and dboptions string
693   dbconnect_vars($self, $self->{dbname});
694
695   map { $self->{$_} =~ s/\r//g; } qw(address signature);
696
697   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
698
699   my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}, SL::DBConnect->get_options);
700   if ($dbh) {
701     $self->create_employee_entry($::form, $dbh, $self, 1);
702     $dbh->disconnect();
703   }
704
705   $main::lxdebug->leave_sub();
706 }
707
708 sub create_employee_entry {
709   $main::lxdebug->enter_sub();
710
711   my $self            = shift;
712   my $form            = shift;
713   my $dbh             = shift;
714   my $myconfig        = shift;
715   my $update_existing = shift;
716
717   if (!does_table_exist($dbh, 'employee')) {
718     $main::lxdebug->leave_sub();
719     return;
720   }
721
722   # add login to employee table if it does not exist
723   # no error check for employee table, ignore if it does not exist
724   my ($id)         = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
725   my ($good_db)    = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
726   my  $can_delete;
727      ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
728
729   if (!$id) {
730     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
731     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
732
733   } elsif ($update_existing && $can_delete) {
734     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
735     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
736   }
737
738   $main::lxdebug->leave_sub();
739 }
740
741 sub config_vars {
742   $main::lxdebug->enter_sub();
743
744   my @conf = qw(copies countrycode dateformat default_media default_printer_id email favorites fax hide_cvar_search_options mandatory_departments menustyle name
745                 numberformat show_form_details signature stylesheet taxincluded_checked tel template_format vclimit);
746
747   $main::lxdebug->leave_sub();
748
749   return @conf;
750 }
751
752 sub error {
753   $main::lxdebug->enter_sub();
754
755   my ($self, $msg) = @_;
756
757   $main::lxdebug->show_backtrace();
758
759   if ($ENV{HTTP_USER_AGENT}) {
760     print qq|Content-Type: text/html
761
762 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
763
764 <body bgcolor=ffffff>
765
766 <h2><font color=red>Error!</font></h2>
767 <p><b>$msg</b>|;
768
769   }
770
771   die "Error: $msg\n";
772
773   $main::lxdebug->leave_sub();
774 }
775
776 sub data {
777   +{ %{ $_[0] } }
778 }
779
780 1;