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