summaryrefslogtreecommitdiff
path: root/LedgerSMB/User.pm
blob: fabcde51264b40765652aded6d3ca9387e8b670c (plain)
  1. #=====================================================================
  2. # LedgerSMB
  3. # Small Medium Business Accounting software
  4. # http://www.ledgersmb.org/
  5. #
  6. # Copyright (C) 2006
  7. # This work contains copyrighted information from a number of sources all used
  8. # with permission.
  9. #
  10. # This file contains source code included with or based on SQL-Ledger which
  11. # is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed
  12. # under the GNU General Public License version 2 or, at your option, any later
  13. # version. For a full list including contact information of contributors,
  14. # maintainers, and copyright holders, see the CONTRIBUTORS file.
  15. #
  16. # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
  17. # Copyright (C) 2000
  18. #
  19. # Author: DWS Systems Inc.
  20. # Web: http://www.sql-ledger.org
  21. #
  22. # Contributors: Jim Rawlings <jim@your-dba.com>
  23. #
  24. #======================================================================
  25. #
  26. # This file has undergone whitespace cleanup.
  27. #
  28. #======================================================================
  29. #
  30. # user related functions
  31. #
  32. #=====================================================================
  33. package User;
  34. use LedgerSMB::Sysconfig;
  35. sub new {
  36. my ($type, $memfile, $login) = @_;
  37. my $self = {};
  38. if ($login ne "") {
  39. &error("", "$memfile locked!") if (-f "${memfile}.LCK");
  40. open(MEMBER, "$memfile") or &error("", "$memfile : $!");
  41. while (<MEMBER>) {
  42. if (/^\[$login\]/) {
  43. while (<MEMBER>) {
  44. last if /^\[/;
  45. next if /^(#|\s)/;
  46. # remove comments
  47. s/^\s*#.*//g;
  48. # remove any trailing whitespace
  49. s/^\s*(.*?)\s*$/$1/;
  50. ($key, $value) = split /=/, $_, 2;
  51. $self->{$key} = $value;
  52. }
  53. $self->{login} = $login;
  54. last;
  55. }
  56. }
  57. close MEMBER;
  58. }
  59. bless $self, $type;
  60. }
  61. sub country_codes {
  62. use Locale::Country;
  63. use Locale::Language;
  64. my %cc = ();
  65. # scan the locale directory and read in the LANGUAGE files
  66. opendir DIR, "${LedgerSMB::Sysconfig::localepath}";
  67. my @dir = grep !/^\..*$/, readdir DIR;
  68. foreach my $dir (@dir) {
  69. $dir = substr($dir, 0, -3);
  70. $cc{$dir} = code2language(substr($dir, 0, 2));
  71. $cc{$dir} .= ("/" . code2country(substr($dir, 3, 2)))
  72. if length($dir) > 2;
  73. $cc{$dir} .= (" " . substr($dir, 6)) if length($dir) > 5;
  74. }
  75. closedir(DIR);
  76. %cc;
  77. }
  78. sub login {
  79. my ($self, $form) = @_;
  80. my $rc = -1;
  81. if ($self->{login} ne "") {
  82. if ($self->{password} ne "") {
  83. my $password =
  84. crypt $form->{password},
  85. substr($self->{login}, 0, 2);
  86. if ($self->{password} ne $password) {
  87. return -1;
  88. }
  89. }
  90. #there shouldn't be any harm in always doing this.
  91. #It might even un-bork things.
  92. $self->create_config(
  93. "${LedgerSMB::Sysconfig::userspath}/$self->{login}.conf");
  94. do "${LedgerSMB::Sysconfig::userspath}/$self->{login}.conf";
  95. $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
  96. # check if database is down
  97. my $dbh = DBI->connect(
  98. $myconfig{dbconnect}, $myconfig{dbuser},
  99. $myconfig{dbpasswd})
  100. or $self->error($DBI::errstr);
  101. # we got a connection, check the version
  102. my $query = qq|SELECT version FROM defaults|;
  103. my $sth = $dbh->prepare($query);
  104. $sth->execute || $form->dberror($query);
  105. my ($dbversion) = $sth->fetchrow_array;
  106. $sth->finish;
  107. # add login to employee table if it does not exist
  108. # no error check for employee table, ignore if it does not exist
  109. my $login = $self->{login};
  110. $login =~ s/@.*//;
  111. $query = qq|SELECT id FROM employee WHERE login = ?|;
  112. $sth = $dbh->prepare($query);
  113. $sth->execute($login);
  114. my ($id) = $sth->fetchrow_array;
  115. $sth->finish;
  116. if (! $id) {
  117. my ($employeenumber) =
  118. $form->update_defaults(
  119. \%myconfig, "employeenumber", $dbh);
  120. $query = qq|
  121. INSERT INTO employee
  122. (login, employeenumber, name,
  123. workphone, role)
  124. VALUES (?, ?, ?, ?, ?)|;
  125. $sth = $dbh->prepare($query);
  126. $sth->execute(
  127. $login, $employeenumber, $myconfig{name},
  128. $myconfig{tel}, $myconfig{role});
  129. }
  130. $dbh->disconnect;
  131. $rc = 0;
  132. if ($form->{dbversion} ne $dbversion) {
  133. $rc = -3;
  134. $dbupdate = (calc_version($dbversion)
  135. < calc_version($form->{dbversion}));
  136. }
  137. if ($dbupdate) {
  138. $rc = -4;
  139. # if DB2 bale out
  140. if ($myconfig{dbdriver} eq 'DB2') {
  141. $rc = -2;
  142. }
  143. }
  144. }
  145. $rc;
  146. }
  147. sub check_recurring {
  148. my ($self, $form) = @_;
  149. $self->{dbpasswd} = unpack 'u', $self->{dbpasswd};
  150. my $dbh = DBI->connect(
  151. $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd})
  152. or $form->dberror;
  153. my $query = qq|
  154. SELECT count(*) FROM recurring
  155. WHERE enddate >= current_date AND nextdate <= current_date|;
  156. ($_) = $dbh->selectrow_array($query);
  157. $dbh->disconnect;
  158. $_;
  159. }
  160. sub dbconnect_vars {
  161. my ($form, $db) = @_;
  162. my %dboptions = (
  163. 'Pg' => {
  164. 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
  165. 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
  166. 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
  167. 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
  168. 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
  169. 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
  170. }
  171. );
  172. $form->{dboptions} = $dboptions{$form->{dbdriver}}{$form->{dateformat}};
  173. if ($form->{dbdriver} =~ /Pg/) {
  174. $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db";
  175. }
  176. if ($form->{dbdriver} eq 'Oracle') {
  177. $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
  178. }
  179. if ($form->{dbhost}) {
  180. $form->{dbconnect} .= ";host=$form->{dbhost}";
  181. }
  182. if ($form->{dbport}) {
  183. $form->{dbconnect} .= ";port=$form->{dbport}";
  184. }
  185. }
  186. sub dbdrivers {
  187. my @drivers = DBI->available_drivers();
  188. # return (grep { /(Pg|Oracle|DB2)/ } @drivers);
  189. return (grep { /Pg$/ } @drivers);
  190. }
  191. sub dbsources {
  192. my ($self, $form) = @_;
  193. my @dbsources = ();
  194. my ($sth, $query);
  195. $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
  196. $form->{sid} = $form->{dbdefault};
  197. &dbconnect_vars($form, $form->{dbdefault});
  198. my $dbh = DBI->connect(
  199. $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
  200. or $form->dberror;
  201. if ($form->{dbdriver} eq 'Pg') {
  202. $query = qq|SELECT datname FROM pg_database|;
  203. $sth = $dbh->prepare($query);
  204. $sth->execute || $form->dberror($query);
  205. while (my ($db) = $sth->fetchrow_array) {
  206. if ($form->{only_acc_db}) {
  207. next if ($db =~ /^template/);
  208. &dbconnect_vars($form, $db);
  209. my $dbh = DBI->connect(
  210. $form->{dbconnect}, $form->{dbuser},
  211. $form->{dbpasswd})
  212. or $form->dberror;
  213. $query = qq|
  214. SELECT tablename FROM pg_tables
  215. WHERE tablename = 'defaults'
  216. AND tableowner = ?|;
  217. my $sth = $dbh->prepare($query);
  218. $sth->execute($form->{dbuser})
  219. || $form->dberror($query);
  220. if ($sth->fetchrow_array) {
  221. push @dbsources, $db;
  222. }
  223. $sth->finish;
  224. $dbh->disconnect;
  225. next;
  226. }
  227. push @dbsources, $db;
  228. }
  229. }
  230. $sth->finish;
  231. $dbh->disconnect;
  232. return @dbsources;
  233. }
  234. sub dbcreate {
  235. my ($self, $form) = @_;
  236. my %dbcreate = ( 'Pg' => qq|CREATE DATABASE "$form->{db}"| );
  237. $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'"
  238. if $form->{encoding};
  239. $form->{sid} = $form->{dbdefault};
  240. &dbconnect_vars($form, $form->{dbdefault});
  241. # The below line connects to Template1 or another template file in order
  242. # to create the db. One must disconnect and reconnect later.
  243. if ($form->{dbsuperuser}){
  244. my $superdbh = DBI->connect(
  245. $form->{dbconnect},
  246. $form->{dbsuperuser},
  247. $form->{dbsuperpasswd})
  248. or $form->dberror;
  249. my $query = qq|$dbcreate{$form->{dbdriver}}|;
  250. $superdbh->do($query) || $form->dberror($query);
  251. $superdbh->disconnect;
  252. }
  253. #Reassign for the work below
  254. &dbconnect_vars($form, $form->{db});
  255. my $dbh = DBI->connect(
  256. $form->{dbconnect},
  257. $form->{dbuser},
  258. $form->{dbpasswd})
  259. or $form->dberror;
  260. if ($form->{dbsuperuser}){
  261. my $superdbh = DBI->connect(
  262. $form->{dbconnect},
  263. $form->{dbsuperuser},
  264. $form->{dbsuperpasswd})
  265. or $form->dberror;
  266. # JD: We need to check for plpgsql,
  267. # if it isn't there create it, if we can't error
  268. # Good chance I will have to do this twice as I get
  269. # used to the way the code is structured
  270. my %langcreate = ( 'Pg' => qq|CREATE LANGUAGE plpgsql|);
  271. my $query = qq|$langcreate{$form->{dbdriver}}|;
  272. $superdbh->do($query);
  273. $superdbh->disconnect;
  274. }
  275. # create the tables
  276. my $dbdriver =
  277. ($form->{dbdriver} =~ /Pg/)
  278. ? 'Pg'
  279. : $form->{dbdriver};
  280. my $filename = qq|sql/${dbdriver}-tables.sql|;
  281. $self->process_query($form, $dbh, $filename);
  282. # create functions
  283. $filename = qq|sql/${dbdriver}-functions.sql|;
  284. $self->process_query($form, $dbh, $filename);
  285. # load gifi
  286. ($filename) = split /_/, $form->{chart};
  287. $filename =~ s/_//;
  288. $self->process_query($form, $dbh, "sql/${filename}-gifi.sql");
  289. # load chart of accounts
  290. $filename = qq|sql/$form->{chart}-chart.sql|;
  291. $self->process_query($form, $dbh, $filename);
  292. # create indices
  293. $filename = qq|sql/${dbdriver}-indices.sql|;
  294. $self->process_query($form, $dbh, $filename);
  295. # create custom tables and functions
  296. my $item;
  297. foreach $item (qw(tables functions)) {
  298. $filename = "sql/${dbdriver}-custom_${item}.sql";
  299. if (-f "$filename") {
  300. $self->process_query($form, $dbh, $filename);
  301. }
  302. }
  303. $dbh->disconnect;
  304. }
  305. sub process_query {
  306. my ($self, $form, $dbh, $filename) = @_;
  307. return unless (-f $filename);
  308. open(FH, "$filename") or $form->error("$filename : $!\n");
  309. open(PSQL, "| psql") or $form->error("psql : $! \n");
  310. while (<FH>){
  311. print PSQL $_;
  312. }
  313. close FH;
  314. }
  315. sub dbdelete {
  316. my ($self, $form) = @_;
  317. $form->{sid} = $form->{dbdefault};
  318. &dbconnect_vars($form, $form->{dbdefault});
  319. my $dbh = DBI->connect(
  320. $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
  321. or $form->dberror;
  322. my $query = qq|DROP DATABASE "$form->{db}"|;
  323. $dbh->do($query) || $form->dberror($query);
  324. $dbh->disconnect;
  325. }
  326. sub dbsources_unused {
  327. my ($self, $form, $memfile) = @_;
  328. my @dbexcl = ();
  329. my @dbsources = ();
  330. $form->error("$memfile locked!") if (-f "${memfile}.LCK");
  331. # open members file
  332. open(FH, "$memfile") or $form->error("$memfile : $!");
  333. while (<FH>) {
  334. if (/^dbname=/) {
  335. my ($null,$item) = split /=/;
  336. push @dbexcl, $item;
  337. }
  338. }
  339. close FH;
  340. $form->{only_acc_db} = 1;
  341. my @db = &dbsources("", $form);
  342. push @dbexcl, $form->{dbdefault};
  343. foreach $item (@db) {
  344. unless (grep /$item$/, @dbexcl) {
  345. push @dbsources, $item;
  346. }
  347. }
  348. return @dbsources;
  349. }
  350. sub dbneedsupdate {
  351. my ($self, $form) = @_;
  352. my %dbsources = ();
  353. my $query;
  354. $form->{sid} = $form->{dbdefault};
  355. &dbconnect_vars($form, $form->{dbdefault});
  356. my $dbh = DBI->connect(
  357. $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
  358. or $form->dberror;
  359. if ($form->{dbdriver} =~ /Pg/) {
  360. $query = qq|
  361. SELECT d.datname
  362. FROM pg_database d, pg_user u
  363. WHERE d.datdba = u.usesysid
  364. AND u.usename = ?|;
  365. my $sth = $dbh->prepare($query);
  366. $sth->execute($form->{dbuser}) || $form->dberror($query);
  367. while (my ($db) = $sth->fetchrow_array) {
  368. next if ($db =~ /^template/);
  369. &dbconnect_vars($form, $db);
  370. my $dbh = DBI->connect(
  371. $form->{dbconnect}, $form->{dbuser},
  372. $form->{dbpasswd})
  373. or $form->dberror;
  374. $query = qq|
  375. SELECT tablename
  376. FROM pg_tables
  377. WHERE tablename = 'defaults'|;
  378. my $sth = $dbh->prepare($query);
  379. $sth->execute || $form->dberror($query);
  380. if ($sth->fetchrow_array) {
  381. $query = qq|SELECT version FROM defaults|;
  382. my $sth = $dbh->prepare($query);
  383. $sth->execute;
  384. if (my ($version) = $sth->fetchrow_array) {
  385. $dbsources{$db} = $version;
  386. }
  387. $sth->finish;
  388. }
  389. $sth->finish;
  390. $dbh->disconnect;
  391. }
  392. $sth->finish;
  393. }
  394. $dbh->disconnect;
  395. %dbsources;
  396. }
  397. sub dbupdate {
  398. my ($self, $form) = @_;
  399. $form->{sid} = $form->{dbdefault};
  400. my @upgradescripts = ();
  401. my $query;
  402. my $rc = -2;
  403. if ($form->{dbupdate}) {
  404. # read update scripts into memory
  405. opendir SQLDIR, "sql/." or $form->error($!);
  406. @upgradescripts =
  407. sort script_version
  408. grep /$form->{dbdriver}-upgrade-.*?\.sql$/,
  409. readdir SQLDIR;
  410. closedir SQLDIR;
  411. }
  412. foreach my $db (split / /, $form->{dbupdate}) {
  413. next unless $form->{$db};
  414. # strip db from dataset
  415. $db =~ s/^db//;
  416. &dbconnect_vars($form, $db);
  417. my $dbh = DBI->connect(
  418. $form->{dbconnect}, $form->{dbuser},
  419. $form->{dbpasswd}, {AutoCommit => 0})
  420. or $form->dberror;
  421. # check version
  422. $query = qq|SELECT version FROM defaults|;
  423. my $sth = $dbh->prepare($query);
  424. # no error check, let it fall through
  425. $sth->execute;
  426. my $version = $sth->fetchrow_array;
  427. $sth->finish;
  428. next unless $version;
  429. $version = calc_version($version);
  430. my $dbversion = calc_version($form->{dbversion});
  431. foreach my $upgradescript (@upgradescripts) {
  432. my $a = $upgradescript;
  433. $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g;
  434. my ($mindb, $maxdb) = split /-/, $a;
  435. $mindb = calc_version($mindb);
  436. $maxdb = calc_version($maxdb);
  437. next if ($version >= $maxdb);
  438. # exit if there is no upgrade script or version == mindb
  439. last if ($version < $mindb || $version >= $dbversion);
  440. # apply upgrade
  441. $self->process_query($form, $dbh, "sql/$upgradescript");
  442. $dbh->commit;
  443. $version = $maxdb;
  444. }
  445. $rc = 0;
  446. $dbh->disconnect;
  447. }
  448. $rc;
  449. }
  450. sub calc_version {
  451. my @v = split /\./, $_[0];
  452. my $version = 0;
  453. my $i;
  454. for ($i = 0; $i <= $#v; $i++) {
  455. $version *= 1000;
  456. $version += $v[$i];
  457. }
  458. return $version;
  459. }
  460. sub script_version {
  461. my ($my_a, $my_b) = ($a, $b);
  462. my ($a_from, $a_to, $b_from, $b_to);
  463. my ($res_a, $res_b, $i);
  464. $my_a =~ s/.*-upgrade-//;
  465. $my_a =~ s/.sql$//;
  466. $my_b =~ s/.*-upgrade-//;
  467. $my_b =~ s/.sql$//;
  468. ($a_from, $a_to) = split(/-/, $my_a);
  469. ($b_from, $b_to) = split(/-/, $my_b);
  470. $res_a = calc_version($a_from);
  471. $res_b = calc_version($b_from);
  472. if ($res_a == $res_b) {
  473. $res_a = calc_version($a_to);
  474. $res_b = calc_version($b_to);
  475. }
  476. return $res_a <=> $res_b;
  477. }
  478. sub create_config {
  479. my ($self, $filename) = @_;
  480. @config = &config_vars;
  481. open(CONF, ">$filename") or $self->error("$filename : $!");
  482. # create the config file
  483. print CONF qq|# configuration file for $self->{login}
  484. \%myconfig = (
  485. |;
  486. foreach $key (sort @config) {
  487. $self->{$key} =~ s/\\/\\\\/g;
  488. $self->{$key} =~ s/'/\\'/g;
  489. #remaining conversion from SL
  490. $self->{$key} =~ s/sql-ledger([^.]*)\.css/ledger-smb$1.css/g;
  491. print CONF qq| $key => '$self->{$key}',\n|;
  492. }
  493. print CONF qq|);\n\n|;
  494. close CONF;
  495. }
  496. sub save_member {
  497. my ($self) = @_;
  498. # format dbconnect and dboptions string
  499. &dbconnect_vars($self, $self->{dbname});
  500. $self->error("${LedgerSMB::Sysconfig::memberfile} locked!")
  501. if (-f "${LedgerSMB::Sysconfig::memberfile}.LCK");
  502. open(FH, ">${LedgerSMB::Sysconfig::memberfile}.LCK")
  503. or $self->error("${LedgerSMB::Sysconfig::memberfile}.LCK : $!");
  504. close(FH);
  505. if (! open(CONF, "+<${LedgerSMB::Sysconfig::memberfile}")) {
  506. unlink "${LedgerSMB::Sysconfig::memberfile}.LCK";
  507. $self->error("${LedgerSMB::Sysconfig::memberfile} : $!");
  508. }
  509. @config = <CONF>;
  510. seek(CONF, 0, 0);
  511. truncate(CONF, 0);
  512. while ($line = shift @config) {
  513. last if ($line =~ /^\[$self->{login}\]/);
  514. #remaining conversion from SL
  515. $line =~ s/sql-ledger([^.]*)\.css/ledger-smb$1.css/g;
  516. print CONF $line;
  517. }
  518. # remove everything up to next login or EOF
  519. while ($line = shift @config) {
  520. last if ($line =~ /^\[/);
  521. }
  522. # this one is either the next login or EOF
  523. print CONF $line;
  524. while ($line = shift @config) {
  525. print CONF $line;
  526. }
  527. print CONF qq|[$self->{login}]\n|;
  528. if ($self->{packpw}) {
  529. $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
  530. chop $self->{dbpasswd};
  531. }
  532. if ($self->{password} ne $self->{old_password}) {
  533. $self->{password} = crypt $self->{password},
  534. substr($self->{login}, 0, 2) if $self->{password};
  535. }
  536. if ($self->{'root login'}) {
  537. @config = qw(password);
  538. } else {
  539. @config = &config_vars;
  540. }
  541. # replace \r\n with \n
  542. for (qw(address signature)) { $self->{$_} =~ s/\r?\n/\\n/g }
  543. for (sort @config) {
  544. print CONF qq|$_=$self->{$_}\n|
  545. }
  546. print CONF "\n";
  547. close CONF;
  548. unlink "${LedgerSMB::Sysconfig::memberfile}.LCK";
  549. # create conf file
  550. if (! $self->{'root login'}) {
  551. $self->create_config("${LedgerSMB::Sysconfig::userspath}/$self->{login}.conf");
  552. $self->{dbpasswd} =~ s/\\'/'/g;
  553. $self->{dbpasswd} =~ s/\\\\/\\/g;
  554. $self->{dbpasswd} = unpack 'u', $self->{dbpasswd};
  555. # check if login is in database
  556. my $dbh = DBI->connect(
  557. $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd},
  558. {AutoCommit => 0})
  559. or $self->error($DBI::errstr);
  560. # add login to employee table if it does not exist
  561. my $login = $self->{login};
  562. $login =~ s/@.*//;
  563. my $query = qq|SELECT id FROM employee WHERE login = '$login'|;
  564. my $sth = $dbh->prepare($query);
  565. $sth->execute;
  566. my ($id) = $sth->fetchrow_array;
  567. $sth->finish;
  568. if ($id) {
  569. $query = qq|UPDATE employee SET
  570. role = '$self->{role}',
  571. email = '$self->{email}',
  572. name = '$self->{name}'
  573. WHERE login = '$login'|;
  574. } else {
  575. my ($employeenumber) = Form::update_defaults(
  576. "", \%$self, "employeenumber", $dbh);
  577. $query = qq|
  578. INSERT INTO employee
  579. (login, employeenumber, name,
  580. workphone, role, email, sales)
  581. VALUES (?, ?, ?, ?, ?, ?, '1')|;
  582. }
  583. $sth = $dbh->prepare($query);
  584. $sth->execute(
  585. $login, $employeenumber, $self->{name}, $self->{tel},
  586. $self->{role}, $self->{email});
  587. $dbh->commit;
  588. $dbh->disconnect;
  589. }
  590. }
  591. sub delete_login {
  592. my ($self, $form) = @_;
  593. my $dbh = DBI->connect(
  594. $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd},
  595. {AutoCommit => 0})
  596. or $form->dberror;
  597. my $login = $form->{login};
  598. $login =~ s/@.*//;
  599. my $query = qq|SELECT id FROM employee WHERE login = ?|;
  600. my $sth = $dbh->prepare($query);
  601. $sth->execute($login) || $form->dberror($query);
  602. my ($id) = $sth->fetchrow_array;
  603. $sth->finish;
  604. my $query = qq|
  605. UPDATE employee
  606. SET login = NULL,
  607. enddate = current_date
  608. WHERE login = ?|;
  609. $sth = $dbh->prepare($query);
  610. $sth->execute($login);
  611. $dbh->commit;
  612. $dbh->disconnect;
  613. }
  614. sub config_vars {
  615. my @conf =
  616. qw(acs address businessnumber company countrycode
  617. currency dateformat dbconnect dbdriver dbhost dbname dboptions
  618. dbpasswd dbport dbuser email fax menuwidth name numberformat
  619. password printer role sid signature stylesheet tel templates
  620. timeout vclimit);
  621. @conf;
  622. }
  623. sub error {
  624. my ($self, $msg) = @_;
  625. if ($ENV{HTTP_USER_AGENT}) {
  626. print qq|Content-Type: text/html\n\n|.
  627. qq|<body bgcolor=ffffff>\n\n|.
  628. qq|<h2><font color=red>Error!</font></h2>\n|.
  629. qq|<p><b>$msg</b>|;
  630. }
  631. die "Error: $msg\n";
  632. }
  633. 1;