typo
[freeside.git] / sql-ledger / SL / User.pm
1 #=====================================================================
2 # SQL-Ledger Accounting
3 # Copyright (C) 2001
4 #
5 #  Author: Dieter Simader
6 #   Email: dsimader@sql-ledger.org
7 #     Web: http://www.sql-ledger.org
8 #
9 #  Contributors:
10 #
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.
15
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 #=====================================================================
24 #
25 # user related functions
26 #
27 #=====================================================================
28
29 package User;
30
31
32 sub new {
33   my ($type, $memfile, $login) = @_;
34   my $self = {};
35
36   if ($login ne "") {
37     # check if the file is locked
38     &error("", "$memfile locked!") if (-f "${memfile}.LCK");
39     
40     open(MEMBER, "$memfile") or &error("", "$memfile : $!");
41     
42     while (<MEMBER>) {
43       if (/^\[$login\]/) {
44         while (<MEMBER>) {
45           last if /^\[/;
46           next if /^(#|\s)/;
47           
48           # remove comments
49           s/\s#.*//g;
50
51           # remove any trailing whitespace
52           s/^\s*(.*?)\s*$/$1/;
53
54           ($key, $value) = split /=/, $_, 2;
55           
56           $self->{$key} = $value;
57         }
58         
59         $self->{login} = $login;
60
61         last;
62       }
63     }
64     close MEMBER;
65   }
66   
67   bless $self, $type;
68 }
69
70
71 sub country_codes {
72
73   my %cc = ();
74   my @language = ();
75   
76   # scan the locale directory and read in the LANGUAGE files
77   opendir DIR, "locale";
78
79   my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR;
80   
81   foreach my $dir (@dir) {
82     next unless open(FH, "locale/$dir/LANGUAGE");
83     @language = <FH>;
84     close FH;
85
86     $cc{$dir} = "@language";
87   }
88
89   closedir(DIR);
90   
91   %cc;
92
93 }
94
95
96 sub login {
97   my ($self, $form, $userspath) = @_;
98
99
100   if ($self->{login}) {
101     
102     if ($self->{password}) {
103       $form->{password} = crypt $form->{password}, substr($self->{login}, 0, 2);
104       if ($self->{password} ne $form->{password}) {
105         return -1;
106       }
107     }
108     
109     unless (-e "$userspath/$self->{login}.conf") {
110       $self->create_config("$userspath/$self->{login}.conf");
111     }
112     
113     do "$userspath/$self->{login}.conf";
114     $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
115   
116     # check if database is down
117     my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}) or $self->error(DBI::errstr);
118
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);
123
124     my ($dbversion) = $sth->fetchrow_array;
125     $sth->finish;
126
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     $query = qq|SELECT id FROM employee WHERE login = '$self->{login}'|;
130     $sth = $dbh->prepare($query);
131     $sth->execute;
132
133     my ($login) = $sth->fetchrow_array;
134     $sth->finish;
135
136     if (!$login) {
137       $query = qq|INSERT INTO employee (login, name, workphone)
138                   VALUES ('$self->{login}', '$myconfig{name}', '$myconfig{tel}')|;
139       $dbh->do($query);
140     }
141     $dbh->disconnect;
142
143     if ($form->{dbversion} ne $dbversion) {
144       return -2;
145     }
146
147   } else {
148     return -3;
149   }
150
151 }
152
153
154
155 sub dbconnect_vars {
156   my ($form, $db) = @_;
157   
158   my %dboptions = (
159      'Pg' => {
160         'yy-mm-dd' => 'set DateStyle to \'ISO\'',
161         'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
162         'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
163         'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
164         'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
165         'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
166              },
167      'Oracle' => {
168         'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
169         'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
170         'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
171         'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
172         'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
173         'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
174                  }
175      );
176                              
177   $form->{dboptions} = $dboptions{$form->{dbdriver}}{$form->{dateformat}};
178
179   if ($form->{dbdriver} eq 'Pg') {
180     $form->{dbconnect} = "dbi:Pg:dbname=$db";
181   }
182
183   if ($form->{dbdriver} eq 'Oracle') {
184     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
185   }
186
187   if ($form->{dbhost}) {
188     $form->{dbconnect} .= ";host=$form->{dbhost}";
189   }
190   if ($form->{dbport}) {
191     $form->{dbconnect} .= ";port=$form->{dbport}";
192   }
193   
194 }
195
196
197 sub dbdrivers {
198
199   my @drivers = DBI->available_drivers();
200
201   return (grep { /(Pg|Oracle)$/ } @drivers);
202
203 }
204
205
206 sub dbsources {
207   my ($self, $form) = @_;
208
209   my @dbsources = ();
210   my ($sth, $query);
211   
212   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
213   $form->{sid} = $form->{dbdefault};
214   &dbconnect_vars($form, $form->{dbdefault});
215
216   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
217
218
219   if ($form->{dbdriver} eq 'Pg') {
220
221     $query = qq|SELECT datname FROM pg_database|;
222     $sth = $dbh->prepare($query);
223     $sth->execute || $form->dberror($query);
224     
225     while (my ($db) = $sth->fetchrow_array) {
226
227       if ($form->{only_acc_db}) {
228         
229         next if ($db =~ /^template/);
230
231         &dbconnect_vars($form, $db);
232         my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
233
234         $query = qq|SELECT tablename FROM pg_tables
235                     WHERE tablename = 'defaults'
236                     AND tableowner = '$form->{dbuser}'|;
237         my $sth = $dbh->prepare($query);
238         $sth->execute || $form->dberror($query);
239
240         if ($sth->fetchrow_array) {
241           push @dbsources, $db;
242         }
243         $sth->finish;
244         $dbh->disconnect;
245         next;
246       }
247       push @dbsources, $db;
248     }
249   }
250
251   if ($form->{dbdriver} eq 'Oracle') {
252     if ($form->{only_acc_db}) {
253       $query = qq|SELECT owner FROM dba_objects
254                   WHERE object_name = 'DEFAULTS'
255                   AND object_type = 'TABLE'|;
256     } else {
257       $query = qq|SELECT username FROM dba_users|;
258     }
259
260     $sth = $dbh->prepare($query);
261     $sth->execute || $form->dberror($query);
262
263     while (my ($db) = $sth->fetchrow_array) {
264       push @dbsources, $db;
265     }
266   }
267
268   $sth->finish;
269   $dbh->disconnect;
270   
271   return @dbsources;
272
273 }
274
275
276 sub dbcreate {
277   my ($self, $form) = @_;
278
279   my %dbcreate = ( 'Pg' => qq|CREATE DATABASE "$form->{db}"|,
280                'Oracle' => qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|);
281
282   $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding};
283   
284   $form->{sid} = $form->{dbdefault};
285   &dbconnect_vars($form, $form->{dbdefault});
286   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
287   my $query = qq|$dbcreate{$form->{dbdriver}}|;
288   $dbh->do($query) || $form->dberror($query);
289
290   if ($form->{dbdriver} eq 'Oracle') {
291     $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
292     $dbh->do($query) || $form->dberror($query);
293   }
294   $dbh->disconnect;
295
296
297   # setup variables for the new database
298   if ($form->{dbdriver} eq 'Oracle') {
299     $form->{dbuser} = $form->{db};
300     $form->{dbpasswd} = $form->{db};
301   }
302   
303   
304   &dbconnect_vars($form, $form->{db});
305   
306   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
307   
308   # create the tables
309   my $filename = qq|sql/$form->{dbdriver}-tables.sql|;
310   $self->processquery($form, $dbh, $filename);
311
312   # load gifi
313   ($filename) = split /_/, $form->{chart};
314   $filename =~ s/_//;
315   $self->processquery($form, $dbh, "sql/${filename}-gifi.sql");
316
317   # load chart of accounts
318   $filename = qq|sql/$form->{chart}-chart.sql|;
319   $self->processquery($form, $dbh, $filename);
320
321   # create indices
322   $filename = qq|sql/$form->{dbdriver}-indices.sql|;
323   $self->processquery($form, $dbh, $filename);
324   
325   $dbh->disconnect;
326
327 }
328
329
330
331 sub processquery {
332   my ($self, $form, $dbh, $filename) = @_;
333   
334   return unless (-f $filename);
335   
336   open(FH, "$filename") or $form->error("$filename : $!\n");
337   my $query = "";
338   
339   while (<FH>) {
340     $query .= $_;
341
342     if (/;\s*$/) {
343       # strip ;... Oracle doesn't like it
344       $query =~ s/;\s*$//;
345       $dbh->do($query) || $form->dberror($query);
346       $query = "";
347     }
348   }
349   close FH;
350
351 }
352   
353
354
355 sub dbdelete {
356   my ($self, $form) = @_;
357
358   my %dbdelete = ( 'Pg' => qq|DROP DATABASE "$form->{db}"|,
359                'Oracle' => qq|DROP USER $form->{db} CASCADE|
360                  );
361   
362   $form->{sid} = $form->{dbdefault};
363   &dbconnect_vars($form, $form->{dbdefault});
364   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
365   my $query = qq|$dbdelete{$form->{dbdriver}}|;
366   $dbh->do($query) || $form->dberror($query);
367
368   $dbh->disconnect;
369
370 }
371   
372
373
374 sub dbsources_unused {
375   my ($self, $form, $memfile) = @_;
376
377   my @dbexcl = ();
378   my @dbsources = ();
379   
380   $form->error('File locked!') if (-f "${memfile}.LCK");
381   
382   # open members file
383   open(FH, "$memfile") or $form->error("$memfile : $!");
384
385   while (<FH>) {
386     if (/^dbname=/) {
387       my ($null,$item) = split /=/;
388       push @dbexcl, $item;
389     }
390   }
391
392   close FH;
393
394   $form->{only_acc_db} = 1;
395   my @db = &dbsources("", $form);
396
397   push @dbexcl, $form->{dbdefault};
398
399   foreach $item (@db) {
400     unless (grep /$item$/, @dbexcl) {
401       push @dbsources, $item;
402     }
403   }
404
405   return @dbsources;
406
407 }
408
409
410 sub dbneedsupdate {
411   my ($self, $form) = @_;
412
413   my %dbsources = ();
414   my $query;
415   
416   $form->{sid} = $form->{dbdefault};
417   &dbconnect_vars($form, $form->{dbdefault});
418
419   my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
420
421   if ($form->{dbdriver} eq 'Pg') {
422
423     $query = qq|SELECT d.datname FROM pg_database d, pg_user u
424                 WHERE d.datdba = u.usesysid
425                 AND u.usename = '$form->{dbuser}'|;
426     my $sth = $dbh->prepare($query);
427     $sth->execute || $form->dberror($query);
428     
429     while (my ($db) = $sth->fetchrow_array) {
430
431       next if ($db =~ /^template/);
432
433       &dbconnect_vars($form, $db);
434       
435       my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
436
437       $query = qq|SELECT tablename FROM pg_tables
438                   WHERE tablename = 'defaults'|;
439       my $sth = $dbh->prepare($query);
440       $sth->execute || $form->dberror($query);
441
442       if ($sth->fetchrow_array) {
443         $query = qq|SELECT version FROM defaults|;
444         my $sth = $dbh->prepare($query);
445         $sth->execute;
446         
447         if (my ($version) = $sth->fetchrow_array) {
448           $dbsources{$db} = $version;
449         }
450         $sth->finish;
451       }
452       $sth->finish;
453       $dbh->disconnect;
454     }
455     $sth->finish;
456   }
457
458
459   if ($form->{dbdriver} eq 'Oracle') {
460     $query = qq|SELECT owner FROM dba_objects
461                 WHERE object_name = 'DEFAULTS'
462                 AND object_type = 'TABLE'|;
463
464     $sth = $dbh->prepare($query);
465     $sth->execute || $form->dberror($query);
466
467     while (my ($db) = $sth->fetchrow_array) {
468       
469       $form->{dbuser} = $db;
470       &dbconnect_vars($form, $db);
471       
472       my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
473
474       $query = qq|SELECT version FROM defaults|;
475       my $sth = $dbh->prepare($query);
476       $sth->execute;
477       
478       if (my ($version) = $sth->fetchrow_array) {
479         $dbsources{$db} = $version;
480       }
481       $sth->finish;
482       $dbh->disconnect;
483     }
484     $sth->finish;
485   }
486   
487   $dbh->disconnect;
488   
489   %dbsources;
490
491 }
492
493
494 sub dbupdate {
495   my ($self, $form) = @_;
496
497   $form->{sid} = $form->{dbdefault};
498   
499   my @upgradescripts = ();
500   my $query;
501   
502   if ($form->{dbupdate}) {
503     # read update scripts into memory
504     opendir SQLDIR, "sql/." or $form-error($!);
505     @upgradescripts = sort grep /$form->{dbdriver}-upgrade-.*?\.sql/, readdir SQLDIR;
506     closedir SQLDIR;
507   }
508
509   
510   foreach my $db (split / /, $form->{dbupdate}) {
511
512     next unless $form->{$db};
513
514     # strip db from dataset
515     $db =~ s/^db//;
516     &dbconnect_vars($form, $db);
517
518     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
519
520     # check version
521     $query = qq|SELECT version FROM defaults|;
522     my $sth = $dbh->prepare($query);
523     # no error check, let it fall through
524     $sth->execute;
525
526     my $version = $sth->fetchrow_array;
527     $sth->finish;
528     
529     next unless $version;
530
531     foreach my $upgradescript (@upgradescripts) {
532       my $a = $upgradescript;
533       $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g;
534       
535       my ($mindb, $maxdb) = split /-/, $a;
536
537       next if ($version ge $maxdb);
538
539       # if there is no upgrade script exit
540       last if ($version lt $mindb);
541
542       # apply upgrade
543       $self->processquery($form, $dbh, "sql/$upgradescript");
544
545       $version = $maxdb;
546  
547     }
548     
549     $dbh->disconnect;
550     
551   }
552 }
553   
554
555
556 sub create_config {
557   my ($self, $filename) = @_;
558
559
560   @config = &config_vars;
561   
562   open(CONF, ">$filename") or $self->error("$filename : $!");
563   
564   # create the config file
565   print CONF qq|# configuration file for $self->{login}
566
567 \%myconfig = (
568 |;
569
570   foreach $key (sort @config) {
571     $self->{$key} =~ s/'/\\'/g;
572     print CONF qq|  $key => '$self->{$key}',\n|;
573   }
574
575    
576   print CONF qq|);\n\n|;
577
578   close CONF;
579
580 }
581
582
583 sub save_member {
584   my ($self, $memberfile, $userspath) = @_;
585
586   my $newmember = 1;
587   
588   # format dbconnect and dboptions string
589   map { $self->{$_} = lc $self->{$_} } qw(dbname host);
590   &dbconnect_vars($self, $self->{dbname});
591   
592   $self->error('File locked!') if (-f "${memberfile}.LCK");
593   open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
594   close(FH);
595   
596   open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
597   
598   @config = <CONF>;
599   
600   seek(CONF, 0, 0);
601   truncate(CONF, 0);
602   
603   while ($line = shift @config) {
604     if ($line =~ /^\[$self->{login}\]/) {
605       $newmember = 0;
606       last;
607     }
608     print CONF $line;
609   }
610
611   # remove everything up to next login or EOF
612   while ($line = shift @config) {
613     last if ($line =~ /^\[/);
614   }
615
616   # this one is either the next login or EOF
617   print CONF $line;
618
619   while ($line = shift @config) {
620     print CONF $line;
621   }
622
623   print CONF qq|[$self->{login}]\n|;
624   
625   if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember) && $self->{root}) {
626     $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
627     chop $self->{dbpasswd};
628   }
629   
630   if ($self->{password} ne $self->{old_password}) {
631     $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2) if $self->{password};
632   }
633   
634   if ($self->{'root login'}) {
635     @config = ("password");
636   } else {
637     @config = &config_vars;
638   }
639   
640   # replace \r\n with \n
641   $self->{address} =~ s/\r\n/\\n/g if $self->{address};
642   $self->{signature} =~ s/\r\n/\\n/g if $self->{signature};
643
644   foreach $key (sort @config) {
645     print CONF qq|$key=$self->{$key}\n|;
646   }
647
648   print CONF "\n";
649   close CONF;
650   unlink "${memberfile}.LCK";
651   
652   # create conf file
653   $self->create_config("$userspath/$self->{login}.conf") unless $self->{'root login'};
654  
655 }
656
657
658 sub config_vars {
659   
660   my @conf = qw(acs address admin businessnumber charset company countrycode
661              currency dateformat dbconnect dbdriver dbhost dbport dboptions
662              dbname dbuser dbpasswd email fax name numberformat password
663              printer sid shippingpoint signature stylesheet tel templates
664              vclimit);
665
666   @conf;
667
668 }
669
670
671 sub error {
672   my ($self, $msg) = @_;
673
674   if ($ENV{HTTP_USER_AGENT}) {
675     print qq|Content-Type: text/html
676
677 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
678
679 <body bgcolor=ffffff>
680
681 <h2><font color=red>Error!</font></h2>
682 <p><b>$msg</b>|;
683
684   }
685   
686   die "Error: $msg\n";
687   
688 }
689
690
691 1;
692