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