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