1 #=====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #=====================================================================
8 # SQL-Ledger Accounting
11 # Author: Dieter Simader
12 # Email: dsimader@sql-ledger.org
13 # Web: http://www.sql-ledger.org
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.
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 #=====================================================================
31 # user related functions
33 #=====================================================================
38 $main::lxdebug->enter_sub();
40 my ($type, $memfile, $login) = @_;
44 &error("", "$memfile locked!") if (-f "${memfile}.LCK");
46 open(MEMBER, "$memfile") or &error("", "$memfile : $!");
57 # remove any trailing whitespace
60 ($key, $value) = split /=/, $_, 2;
62 if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
63 $value = "lx-office-erp.css";
66 $self->{$key} = $value;
69 $self->{login} = $login;
77 $main::lxdebug->leave_sub();
82 $main::lxdebug->enter_sub();
87 # scan the locale directory and read in the LANGUAGE files
88 opendir DIR, "locale";
90 my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR;
92 foreach my $dir (@dir) {
93 next unless open(FH, "locale/$dir/LANGUAGE");
97 $cc{$dir} = "@language";
102 $main::lxdebug->leave_sub();
108 $main::lxdebug->enter_sub();
110 my ($self, $form, $userspath) = @_;
114 if ($self->{login}) {
116 if ($self->{password}) {
117 $form->{password} = crypt $form->{password},
118 substr($self->{login}, 0, 2);
119 if ($self->{password} ne $form->{password}) {
120 $main::lxdebug->leave_sub();
125 unless (-e "$userspath/$self->{login}.conf") {
126 $self->create_config("$userspath/$self->{login}.conf");
129 do "$userspath/$self->{login}.conf";
130 $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
132 # check if database is down
134 DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
136 or $self->error(DBI::errstr);
138 # we got a connection, check the version
139 my $query = qq|SELECT version FROM defaults|;
140 my $sth = $dbh->prepare($query);
141 $sth->execute || $form->dberror($query);
143 my ($dbversion) = $sth->fetchrow_array;
146 # add login to employee table if it does not exist
147 # no error check for employee table, ignore if it does not exist
148 $query = qq|SELECT e.id FROM employee e WHERE e.login = '$self->{login}'|;
149 $sth = $dbh->prepare($query);
152 my ($login) = $sth->fetchrow_array;
156 $query = qq|INSERT INTO employee (login, name, workphone, role)
157 VALUES ('$self->{login}', '$myconfig{name}',
158 '$myconfig{tel}', 'user')|;
165 if ($form->{dbversion} ne $dbversion) {
168 open FH, ">$userspath/nologin" or die "
171 map { $form->{$_} = $myconfig{$_} }
172 qw(dbname dbhost dbport dbdriver dbuser dbpasswd);
174 $form->{dbupdate} = "db$myconfig{dbname}";
175 $form->{ $form->{dbupdate} } = 1;
177 $form->info("Upgrading Dataset $myconfig{dbname} ...");
179 # required for Oracle
180 $form->{dbdefault} = $sid;
182 # ignore HUP, QUIT in case the webserver times out
183 $SIG{HUP} = 'IGNORE';
184 $SIG{QUIT} = 'IGNORE';
186 $self->dbupdate($form);
189 unlink "$userspath/nologin";
191 $form->info("... done");
198 $main::lxdebug->leave_sub();
204 $main::lxdebug->enter_sub();
206 my ($form, $db) = @_;
209 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
210 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
211 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
212 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
213 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
214 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
215 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
218 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
219 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
220 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
221 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
222 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
223 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
224 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
227 $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
229 if ($form->{dbdriver} eq 'Pg') {
230 $form->{dbconnect} = "dbi:Pg:dbname=$db";
233 if ($form->{dbdriver} eq 'Oracle') {
234 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
237 if ($form->{dbhost}) {
238 $form->{dbconnect} .= ";host=$form->{dbhost}";
240 if ($form->{dbport}) {
241 $form->{dbconnect} .= ";port=$form->{dbport}";
244 $main::lxdebug->leave_sub();
248 $main::lxdebug->enter_sub();
250 my @drivers = DBI->available_drivers();
252 $main::lxdebug->leave_sub();
254 return (grep { /(Pg|Oracle)/ } @drivers);
258 $main::lxdebug->enter_sub();
260 my ($self, $form) = @_;
265 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
266 $form->{sid} = $form->{dbdefault};
267 &dbconnect_vars($form, $form->{dbdefault});
270 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
273 if ($form->{dbdriver} eq 'Pg') {
275 $query = qq|SELECT datname FROM pg_database|;
276 $sth = $dbh->prepare($query);
277 $sth->execute || $form->dberror($query);
279 while (my ($db) = $sth->fetchrow_array) {
281 if ($form->{only_acc_db}) {
283 next if ($db =~ /^template/);
285 &dbconnect_vars($form, $db);
287 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
290 $query = qq|SELECT p.tablename FROM pg_tables p
291 WHERE p.tablename = 'defaults'
292 AND p.tableowner = '$form->{dbuser}'|;
293 my $sth = $dbh->prepare($query);
294 $sth->execute || $form->dberror($query);
296 if ($sth->fetchrow_array) {
297 push @dbsources, $db;
303 push @dbsources, $db;
307 if ($form->{dbdriver} eq 'Oracle') {
308 if ($form->{only_acc_db}) {
309 $query = qq|SELECT o.owner FROM dba_objects o
310 WHERE o.object_name = 'DEFAULTS'
311 AND o.object_type = 'TABLE'|;
313 $query = qq|SELECT username FROM dba_users|;
316 $sth = $dbh->prepare($query);
317 $sth->execute || $form->dberror($query);
319 while (my ($db) = $sth->fetchrow_array) {
320 push @dbsources, $db;
327 $main::lxdebug->leave_sub();
333 $main::lxdebug->enter_sub();
335 my ($self, $form) = @_;
338 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
340 qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
343 $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding};
345 $form->{sid} = $form->{dbdefault};
346 &dbconnect_vars($form, $form->{dbdefault});
348 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
350 my $query = qq|$dbcreate{$form->{dbdriver}}|;
351 $dbh->do($query) || $form->dberror($query);
353 if ($form->{dbdriver} eq 'Oracle') {
354 $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
355 $dbh->do($query) || $form->dberror($query);
359 # setup variables for the new database
360 if ($form->{dbdriver} eq 'Oracle') {
361 $form->{dbuser} = $form->{db};
362 $form->{dbpasswd} = $form->{db};
365 &dbconnect_vars($form, $form->{db});
367 $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
371 my $filename = qq|sql/lx-office.sql|;
372 $self->process_query($form, $dbh, $filename);
375 ($filename) = split /_/, $form->{chart};
377 $self->process_query($form, $dbh, "sql/${filename}-gifi.sql");
379 # load chart of accounts
380 $filename = qq|sql/$form->{chart}-chart.sql|;
381 $self->process_query($form, $dbh, $filename);
384 # Indices sind auch in lx-office.sql
385 # $filename = qq|sql/$form->{dbdriver}-indices.sql|;
386 # $self->process_query($form, $dbh, $filename);
390 $main::lxdebug->leave_sub();
394 $main::lxdebug->enter_sub();
396 my ($self, $form, $dbh, $filename) = @_;
398 # return unless (-f $filename);
400 open(FH, "$filename") or $form->error("$filename : $!\n");
407 # Remove DOS and Unix style line endings.
410 # don't add comments or empty lines
411 next if /^(--.*|\s+)$/;
413 for (my $i = 0; $i < length($_); $i++) {
414 my $char = substr($_, $i, 1);
416 # Are we inside a string?
418 if ($char eq $quote_chars[-1]) {
424 if (($char eq "'") || ($char eq "\"")) {
425 push(@quote_chars, $char);
427 } elsif ($char eq ";") {
429 # Query is complete. Send it.
431 $sth = $dbh->prepare($query);
432 $sth->execute || $form->dberror($query);
446 $main::lxdebug->leave_sub();
450 $main::lxdebug->enter_sub();
452 my ($self, $form) = @_;
454 my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
455 'Oracle' => qq|DROP USER $form->{db} CASCADE|);
457 $form->{sid} = $form->{dbdefault};
458 &dbconnect_vars($form, $form->{dbdefault});
460 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
462 my $query = qq|$dbdelete{$form->{dbdriver}}|;
463 $dbh->do($query) || $form->dberror($query);
467 $main::lxdebug->leave_sub();
470 sub dbsources_unused {
471 $main::lxdebug->enter_sub();
473 my ($self, $form, $memfile) = @_;
478 $form->error('File locked!') if (-f "${memfile}.LCK");
481 open(FH, "$memfile") or $form->error("$memfile : $!");
485 my ($null, $item) = split /=/;
492 $form->{only_acc_db} = 1;
493 my @db = &dbsources("", $form);
495 push @dbexcl, $form->{dbdefault};
497 foreach $item (@db) {
498 unless (grep /$item$/, @dbexcl) {
499 push @dbsources, $item;
503 $main::lxdebug->leave_sub();
509 $main::lxdebug->enter_sub();
511 my ($self, $form) = @_;
516 $form->{sid} = $form->{dbdefault};
517 &dbconnect_vars($form, $form->{dbdefault});
520 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
523 if ($form->{dbdriver} eq 'Pg') {
525 $query = qq|SELECT d.datname FROM pg_database d, pg_user u
526 WHERE d.datdba = u.usesysid
527 AND u.usename = '$form->{dbuser}'|;
528 my $sth = $dbh->prepare($query);
529 $sth->execute || $form->dberror($query);
531 while (my ($db) = $sth->fetchrow_array) {
533 next if ($db =~ /^template/);
535 &dbconnect_vars($form, $db);
538 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
541 $query = qq|SELECT t.tablename FROM pg_tables t
542 WHERE t.tablename = 'defaults'|;
543 my $sth = $dbh->prepare($query);
544 $sth->execute || $form->dberror($query);
546 if ($sth->fetchrow_array) {
547 $query = qq|SELECT version FROM defaults|;
548 my $sth = $dbh->prepare($query);
551 if (my ($version) = $sth->fetchrow_array) {
552 $dbsources{$db} = $version;
562 if ($form->{dbdriver} eq 'Oracle') {
563 $query = qq|SELECT o.owner FROM dba_objects o
564 WHERE o.object_name = 'DEFAULTS'
565 AND o.object_type = 'TABLE'|;
567 $sth = $dbh->prepare($query);
568 $sth->execute || $form->dberror($query);
570 while (my ($db) = $sth->fetchrow_array) {
572 $form->{dbuser} = $db;
573 &dbconnect_vars($form, $db);
576 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
579 $query = qq|SELECT version FROM defaults|;
580 my $sth = $dbh->prepare($query);
583 if (my ($version) = $sth->fetchrow_array) {
584 $dbsources{$db} = $version;
594 $main::lxdebug->leave_sub();
601 $main::lxdebug->enter_sub();
603 my (@v, $version, $i);
605 @v = split(/\./, $_[0]);
606 while (scalar(@v) < 4) {
610 for ($i = 0; $i < 4; $i++) {
615 $main::lxdebug->leave_sub();
619 sub cmp_script_version {
620 my ($a_from, $a_to, $b_from, $b_to);
621 my ($i, $res_a, $res_b);
622 my ($my_a, $my_b) = ($a, $b);
624 $my_a =~ s/.*-upgrade-//;
626 $my_b =~ s/.*-upgrade-//;
628 ($my_a_from, $my_a_to) = split(/-/, $my_a);
629 ($my_b_from, $my_b_to) = split(/-/, $my_b);
631 $res_a = calc_version($my_a_from);
632 $res_b = calc_version($my_b_from);
634 if ($res_a == $res_b) {
635 $res_a = calc_version($my_a_to);
636 $res_b = calc_version($my_b_to);
639 return $res_a <=> $res_b;
644 $main::lxdebug->enter_sub();
646 my ($self, $form) = @_;
648 $form->{sid} = $form->{dbdefault};
650 my @upgradescripts = ();
654 if ($form->{dbupdate}) {
656 # read update scripts into memory
657 opendir SQLDIR, "sql/." or $form - error($!);
660 sort(cmp_script_version
661 grep(/$form->{dbdriver}-upgrade-.*?\.sql$/, readdir(SQLDIR)));
666 foreach my $db (split / /, $form->{dbupdate}) {
668 next unless $form->{$db};
670 # strip db from dataset
672 &dbconnect_vars($form, $db);
675 DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
679 $query = qq|SELECT version FROM defaults|;
680 my $sth = $dbh->prepare($query);
682 # no error check, let it fall through
685 my $version = $sth->fetchrow_array;
688 next unless $version;
691 $version = calc_version($version);
694 foreach my $upgradescript (@upgradescripts) {
695 my $a = $upgradescript;
696 $a =~ s/^$form->{dbdriver}-upgrade-|\.sql$//g;
698 my ($mindb, $maxdb) = split /-/, $a;
700 $mindb = calc_version($mindb);
701 $maxdb = calc_version($maxdb);
704 next if ($version >= $maxdb);
706 # if there is no upgrade script exit
707 last if ($version < $mindb);
710 $self->process_query($form, $dbh, "sql/$upgradescript");
721 $main::lxdebug->leave_sub();
727 $main::lxdebug->enter_sub();
729 my ($self, $filename) = @_;
731 @config = &config_vars;
733 open(CONF, ">$filename") or $self->error("$filename : $!");
735 # create the config file
736 print CONF qq|# configuration file for $self->{login}
741 foreach $key (sort @config) {
742 $self->{$key} =~ s/\'/\\\'/g;
743 print CONF qq| $key => '$self->{$key}',\n|;
746 print CONF qq|);\n\n|;
750 $main::lxdebug->leave_sub();
754 $main::lxdebug->enter_sub();
756 my ($self, $memberfile, $userspath) = @_;
760 # format dbconnect and dboptions string
761 &dbconnect_vars($self, $self->{dbname});
763 $self->error('File locked!') if (-f "${memberfile}.LCK");
764 open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
767 open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
774 while ($line = shift @config) {
775 if ($line =~ /^\[$self->{login}\]/) {
782 # remove everything up to next login or EOF
783 while ($line = shift @config) {
784 last if ($line =~ /^\[/);
787 # this one is either the next login or EOF
790 while ($line = shift @config) {
794 print CONF qq|[$self->{login}]\n|;
796 if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
798 $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
799 chop $self->{dbpasswd};
801 if (defined($self->{new_password})) {
802 if ($self->{new_password} ne $self->{old_password}) {
803 $self->{password} = crypt $self->{new_password},
804 substr($self->{login}, 0, 2)
805 if $self->{new_password};
808 if ($self->{password} ne $self->{old_password}) {
809 $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
810 if $self->{password};
814 if ($self->{'root login'}) {
815 @config = ("password");
817 @config = &config_vars;
820 # replace \r\n with \n
821 map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
822 foreach $key (sort @config) {
823 print CONF qq|$key=$self->{$key}\n|;
828 unlink "${memberfile}.LCK";
831 $self->create_config("$userspath/$self->{login}.conf")
832 unless $self->{'root login'};
834 $main::lxdebug->leave_sub();
838 $main::lxdebug->enter_sub();
840 my @conf = qw(acs address admin businessnumber charset company countrycode
841 currency dateformat dbconnect dbdriver dbhost dbport dboptions
842 dbname dbuser dbpasswd email fax name numberformat password
843 printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen
844 anfragen lieferantenbestellungen einkaufsrechnungen steuernummer ustid duns menustyle);
846 $main::lxdebug->leave_sub();
852 $main::lxdebug->enter_sub();
854 my ($self, $msg) = @_;
856 if ($ENV{HTTP_USER_AGENT}) {
857 print qq|Content-Type: text/html
859 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
861 <body bgcolor=ffffff>
863 <h2><font color=red>Error!</font></h2>
870 $main::lxdebug->leave_sub();