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