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