1 #=====================================================================
2 # SQL-Ledger Accounting
5 # Author: Dieter Simader
6 # Email: dsimader@sql-ledger.org
7 # Web: http://www.sql-ledger.org
9 # Contributors: Jim Rawlings <jim@your-dba.com>
11 # This program is free software; you can redistribute it and/or modify
12 # it under the terms of the GNU General Public License as published by
13 # the Free Software Foundation; either version 2 of the License, or
14 # (at your option) any later version.
16 # This program is distributed in the hope that it will be useful,
17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 # GNU General Public License for more details.
20 # You should have received a copy of the GNU General Public License
21 # along with this program; if not, write to the Free Software
22 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 #=====================================================================
25 # user related functions
27 #=====================================================================
33 my ($type, $memfile, $login) = @_;
37 &error("", "$memfile locked!") if (-f "${memfile}.LCK");
39 open(MEMBER, "$memfile") or &error("", "$memfile : $!");
50 # remove any trailing whitespace
53 ($key, $value) = split /=/, $_, 2;
55 $self->{$key} = $value;
58 $self->{login} = $login;
75 # scan the locale directory and read in the LANGUAGE files
76 opendir DIR, "locale";
78 my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR;
80 foreach my $dir (@dir) {
81 next unless open(FH, "locale/$dir/LANGUAGE");
85 $cc{$dir} = "@language";
96 my ($self, $form, $userspath) = @_;
100 if ($self->{login}) {
102 if ($self->{password}) {
103 my $password = crypt $form->{password}, substr($self->{login}, 0, 2);
104 if ($self->{password} ne $password) {
109 unless (-f "$userspath/$self->{login}.conf") {
110 $self->create_config("$userspath/$self->{login}.conf");
113 do "$userspath/$self->{login}.conf";
114 $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
116 # check if database is down
117 my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}) or $self->error($DBI::errstr);
119 # we got a connection, check the version
120 my $query = qq|SELECT version FROM defaults|;
121 my $sth = $dbh->prepare($query);
122 $sth->execute || $form->dberror($query);
124 my ($dbversion) = $sth->fetchrow_array;
127 # add login to employee table if it does not exist
128 # no error check for employee table, ignore if it does not exist
129 my $login = $self->{login};
131 $query = qq|SELECT id FROM employee WHERE login = '$login'|;
132 $sth = $dbh->prepare($query);
135 my ($id) = $sth->fetchrow_array;
139 my ($employeenumber) = $form->update_defaults(\%myconfig, "employeenumber", $dbh);
141 $query = qq|INSERT INTO employee (login, employeenumber, name, workphone,
143 VALUES ('$login', '$employeenumber', '$myconfig{name}',
144 '$myconfig{tel}', '$myconfig{role}')|;
152 if ($form->{dbversion} ne $dbversion) {
154 $dbupdate = (calc_version($dbversion) < calc_version($form->{dbversion}));
161 if ($myconfig{dbdriver} eq 'DB2') {
174 my ($form, $db) = @_;
178 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
179 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
180 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
181 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
182 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
183 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
186 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
187 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
188 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
189 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
190 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
191 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
196 $form->{dboptions} = $dboptions{$form->{dbdriver}}{$form->{dateformat}};
198 if ($form->{dbdriver} =~ /Pg/) {
199 $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db";
202 if ($form->{dbdriver} eq 'Oracle') {
203 $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
206 if ($form->{dbhost}) {
207 $form->{dbconnect} .= ";host=$form->{dbhost}";
209 if ($form->{dbport}) {
210 $form->{dbconnect} .= ";port=$form->{dbport}";
218 my @drivers = DBI->available_drivers();
220 # return (grep { /(Pg|Oracle|DB2)/ } @drivers);
221 return (grep { /Pg$/ } @drivers);
227 my ($self, $form) = @_;
232 $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
233 $form->{sid} = $form->{dbdefault};
234 &dbconnect_vars($form, $form->{dbdefault});
236 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
239 if ($form->{dbdriver} eq 'Pg') {
241 $query = qq|SELECT datname FROM pg_database|;
242 $sth = $dbh->prepare($query);
243 $sth->execute || $form->dberror($query);
245 while (my ($db) = $sth->fetchrow_array) {
247 if ($form->{only_acc_db}) {
249 next if ($db =~ /^template/);
251 &dbconnect_vars($form, $db);
252 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
254 $query = qq|SELECT tablename FROM pg_tables
255 WHERE tablename = 'defaults'
256 AND tableowner = '$form->{dbuser}'|;
257 my $sth = $dbh->prepare($query);
258 $sth->execute || $form->dberror($query);
260 if ($sth->fetchrow_array) {
261 push @dbsources, $db;
267 push @dbsources, $db;
271 if ($form->{dbdriver} eq 'Oracle') {
272 if ($form->{only_acc_db}) {
273 $query = qq|SELECT owner FROM dba_objects
274 WHERE object_name = 'DEFAULTS'
275 AND object_type = 'TABLE'|;
277 $query = qq|SELECT username FROM dba_users|;
280 $sth = $dbh->prepare($query);
281 $sth->execute || $form->dberror($query);
283 while (my ($db) = $sth->fetchrow_array) {
284 push @dbsources, $db;
290 if ($form->{dbdriver} eq 'DB2') {
291 if ($form->{only_acc_db}) {
292 $query = qq|SELECT tabschema FROM syscat.tables WHERE tabname = 'DEFAULTS'|;
294 $query = qq|SELECT DISTINCT schemaname FROM syscat.schemata WHERE definer != 'SYSIBM' AND schemaname != 'NULLID'|;
297 $sth = $dbh->prepare($query);
298 $sth->execute || $form->dberror($query);
300 while (my ($db) = $sth->fetchrow_array) {
301 push @dbsources, $db;
306 # the above is not used but leave it in for future reference
319 my ($self, $form) = @_;
321 my %dbcreate = ( 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
322 'Oracle' => qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|);
324 $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding};
326 $form->{sid} = $form->{dbdefault};
327 &dbconnect_vars($form, $form->{dbdefault});
328 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
329 my $query = qq|$dbcreate{$form->{dbdriver}}|;
330 $dbh->do($query) || $form->dberror($query);
332 if ($form->{dbdriver} eq 'Oracle') {
333 $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
334 $dbh->do($query) || $form->dberror($query);
339 # setup variables for the new database
340 if ($form->{dbdriver} eq 'Oracle') {
341 $form->{dbuser} = $form->{db};
342 $form->{dbpasswd} = $form->{db};
346 &dbconnect_vars($form, $form->{db});
348 $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
351 my $dbdriver = ($form->{dbdriver} =~ /Pg/) ? 'Pg' : $form->{dbdriver};
353 my $filename = qq|sql/${dbdriver}-tables.sql|;
354 $self->process_query($form, $dbh, $filename);
357 $filename = qq|sql/${dbdriver}-functions.sql|;
358 $self->process_query($form, $dbh, $filename);
361 ($filename) = split /_/, $form->{chart};
363 $self->process_query($form, $dbh, "sql/${filename}-gifi.sql");
365 # load chart of accounts
366 $filename = qq|sql/$form->{chart}-chart.sql|;
367 $self->process_query($form, $dbh, $filename);
370 $filename = qq|sql/${dbdriver}-indices.sql|;
371 $self->process_query($form, $dbh, $filename);
373 # create custom tables and functions
375 foreach $item (qw(tables functions)) {
376 $filename = "sql/${dbdriver}-custom_${item}.sql";
377 if (-f "$filename") {
378 $self->process_query($form, $dbh, $filename);
389 my ($self, $form, $dbh, $filename) = @_;
391 return unless (-f $filename);
393 open(FH, "$filename") or $form->error("$filename : $!\n");
401 if ($loop && /^--\s*end\s*(procedure|function|trigger)/i) {
404 $sth = $dbh->prepare($query);
405 $sth->execute || $form->dberror($query);
412 if ($loop || /^create *(or replace)? *(procedure|function|trigger)/i) {
414 next if /^(--.*|\s+)$/;
420 # don't add comments or empty lines
421 next if /^(--.*|\s+)$/;
423 # anything else, add to query
427 # strip ;... Oracle doesn't like it
429 $query =~ s/\\'/''/g;
431 $sth = $dbh->prepare($query);
432 $sth->execute || $form->dberror($query);
446 my ($self, $form) = @_;
448 my %dbdelete = ( 'Pg' => qq|DROP DATABASE "$form->{db}"|,
449 'Oracle' => qq|DROP USER $form->{db} CASCADE|
452 $form->{sid} = $form->{dbdefault};
453 &dbconnect_vars($form, $form->{dbdefault});
454 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
455 my $query = qq|$dbdelete{$form->{dbdriver}}|;
456 $dbh->do($query) || $form->dberror($query);
464 sub dbsources_unused {
465 my ($self, $form, $memfile) = @_;
470 $form->error("$memfile locked!") if (-f "${memfile}.LCK");
473 open(FH, "$memfile") or $form->error("$memfile : $!");
477 my ($null,$item) = split /=/;
484 $form->{only_acc_db} = 1;
485 my @db = &dbsources("", $form);
487 push @dbexcl, $form->{dbdefault};
489 foreach $item (@db) {
490 unless (grep /$item$/, @dbexcl) {
491 push @dbsources, $item;
501 my ($self, $form) = @_;
506 $form->{sid} = $form->{dbdefault};
507 &dbconnect_vars($form, $form->{dbdefault});
509 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
511 if ($form->{dbdriver} =~ /Pg/) {
513 $query = qq|SELECT d.datname FROM pg_database d, pg_user u
514 WHERE d.datdba = u.usesysid
515 AND u.usename = '$form->{dbuser}'|;
516 my $sth = $dbh->prepare($query);
517 $sth->execute || $form->dberror($query);
519 while (my ($db) = $sth->fetchrow_array) {
521 next if ($db =~ /^template/);
523 &dbconnect_vars($form, $db);
525 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
527 $query = qq|SELECT tablename FROM pg_tables
528 WHERE tablename = 'defaults'|;
529 my $sth = $dbh->prepare($query);
530 $sth->execute || $form->dberror($query);
532 if ($sth->fetchrow_array) {
533 $query = qq|SELECT version FROM defaults|;
534 my $sth = $dbh->prepare($query);
537 if (my ($version) = $sth->fetchrow_array) {
538 $dbsources{$db} = $version;
549 if ($form->{dbdriver} eq 'Oracle') {
550 $query = qq|SELECT owner FROM dba_objects
551 WHERE object_name = 'DEFAULTS'
552 AND object_type = 'TABLE'|;
554 $sth = $dbh->prepare($query);
555 $sth->execute || $form->dberror($query);
557 while (my ($db) = $sth->fetchrow_array) {
559 $form->{dbuser} = $db;
560 &dbconnect_vars($form, $db);
562 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
564 $query = qq|SELECT version FROM defaults|;
565 my $sth = $dbh->prepare($query);
568 if (my ($version) = $sth->fetchrow_array) {
569 $dbsources{$db} = $version;
579 if ($form->{dbdriver} eq 'DB2') {
580 $query = qq|SELECT tabschema FROM syscat.tables WHERE tabname = 'DEFAULTS'|;
582 $sth = $dbh->prepare($query);
583 $sth->execute || $form->dberror($query);
585 while (my ($db) = $sth->fetchrow_array) {
587 &dbconnect_vars($form, $db);
589 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
591 $query = qq|SELECT version FROM defaults|;
592 my $sth = $dbh->prepare($query);
595 if (my ($version) = $sth->fetchrow_array) {
596 $dbsources{$db} = $version;
605 # code for DB2 is not used, keep for future reference
616 my ($self, $form) = @_;
618 $form->{sid} = $form->{dbdefault};
620 my @upgradescripts = ();
624 if ($form->{dbupdate}) {
625 # read update scripts into memory
626 opendir SQLDIR, "sql/." or $form->error($!);
627 @upgradescripts = sort script_version grep /$form->{dbdriver}-upgrade-.*?\.sql$/, readdir SQLDIR;
632 foreach my $db (split / /, $form->{dbupdate}) {
634 next unless $form->{$db};
636 # strip db from dataset
638 &dbconnect_vars($form, $db);
640 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
643 $query = qq|SELECT version FROM defaults|;
644 my $sth = $dbh->prepare($query);
645 # no error check, let it fall through
648 my $version = $sth->fetchrow_array;
651 next unless $version;
653 $version = calc_version($version);
654 my $dbversion = calc_version($form->{dbversion});
656 foreach my $upgradescript (@upgradescripts) {
657 my $a = $upgradescript;
658 $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g;
660 my ($mindb, $maxdb) = split /-/, $a;
661 $mindb = calc_version($mindb);
662 $maxdb = calc_version($maxdb);
664 next if ($version >= $maxdb);
666 # exit if there is no upgrade script or version == mindb
667 last if ($version < $mindb || $version >= $dbversion);
670 $self->process_query($form, $dbh, "sql/$upgradescript");
688 my @v = split /\./, $_[0];
692 for ($i = 0; $i <= $#v; $i++) {
703 my ($my_a, $my_b) = ($a, $b);
705 my ($a_from, $a_to, $b_from, $b_to);
706 my ($res_a, $res_b, $i);
708 $my_a =~ s/.*-upgrade-//;
710 $my_b =~ s/.*-upgrade-//;
712 ($a_from, $a_to) = split(/-/, $my_a);
713 ($b_from, $b_to) = split(/-/, $my_b);
715 $res_a = calc_version($a_from);
716 $res_b = calc_version($b_from);
718 if ($res_a == $res_b) {
719 $res_a = calc_version($a_to);
720 $res_b = calc_version($b_to);
723 return $res_a <=> $res_b;
729 my ($self, $filename) = @_;
732 @config = &config_vars;
734 open(CONF, ">$filename") or $self->error("$filename : $!");
736 # create the config file
737 print CONF qq|# configuration file for $self->{login}
742 foreach $key (sort @config) {
743 $self->{$key} =~ s/\\/\\\\/g;
744 $self->{$key} =~ s/'/\\'/g;
745 print CONF qq| $key => '$self->{$key}',\n|;
749 print CONF qq|);\n\n|;
757 my ($self, $memberfile, $userspath) = @_;
759 # format dbconnect and dboptions string
760 &dbconnect_vars($self, $self->{dbname});
762 $self->error("$memberfile locked!") if (-f "${memberfile}.LCK");
763 open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
766 if (! open(CONF, "+<$memberfile")) {
767 unlink "${memberfile}.LCK";
768 $self->error("$memberfile : $!");
776 while ($line = shift @config) {
777 last if ($line =~ /^\[$self->{login}\]/);
781 # remove everything up to next login or EOF
782 while ($line = shift @config) {
783 last if ($line =~ /^\[/);
786 # this one is either the next login or EOF
789 while ($line = shift @config) {
793 print CONF qq|[$self->{login}]\n|;
796 $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
797 chop $self->{dbpasswd};
800 if ($self->{password} ne $self->{old_password}) {
801 $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2) if $self->{password};
804 if ($self->{'root login'}) {
805 @config = ("password");
807 @config = &config_vars;
810 # replace \r\n with \n
811 map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
813 foreach $key (sort @config) {
814 print CONF qq|$key=$self->{$key}\n|;
819 unlink "${memberfile}.LCK";
822 if (! $self->{'root login'}) {
823 $self->create_config("$userspath/$self->{login}.conf");
825 $self->{dbpasswd} =~ s/\\'/'/g;
826 $self->{dbpasswd} =~ s/\\\\/\\/g;
827 $self->{dbpasswd} = unpack 'u', $self->{dbpasswd};
829 # check if login is in database
830 my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}, {AutoCommit => 0}) or $self->error($DBI::errstr);
832 # add login to employee table if it does not exist
833 # no error check for employee table, ignore if it does not exist
834 my $login = $self->{login};
836 my $query = qq|SELECT id FROM employee WHERE login = '$login'|;
837 my $sth = $dbh->prepare($query);
840 my ($id) = $sth->fetchrow_array;
844 $query = qq|UPDATE employee SET
845 role = '$self->{role}',
846 email = '$self->{email}',
847 name = '$self->{name}'
848 WHERE login = '$login'|;
851 my ($employeenumber) = Form::update_defaults("", \%$self, "employeenumber", $dbh);
852 $query = qq|INSERT INTO employee (login, employeenumber, name, workphone,
854 VALUES ('$login', '$employeenumber', '$self->{name}',
855 '$self->{tel}', '$self->{role}', '$self->{email}')|;
868 my ($self, $form) = @_;
870 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, {AutoCommit} => 0) or $form->dberror;
872 my $login = $form->{login};
874 my $query = qq|SELECT id FROM employee
875 WHERE login = '$login'|;
876 my $sth = $dbh->prepare($query);
877 $sth->execute || $form->dberror($query);
879 my ($id) = $sth->fetchrow_array;
882 my $query = qq|UPDATE employee
884 WHERE login = '$login'|;
895 my @conf = qw(acs address businessnumber charset company countrycode
896 currency dateformat dbconnect dbdriver dbhost dbport dboptions
897 dbname dbuser dbpasswd email fax name numberformat password
898 printer role sid signature stylesheet tel templates vclimit
907 my ($self, $msg) = @_;
909 if ($ENV{HTTP_USER_AGENT}) {
910 print qq|Content-Type: text/html
912 <body bgcolor=ffffff>
914 <h2><font color=red>Error!</font></h2>