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