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