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