summaryrefslogtreecommitdiff
path: root/LedgerSMB/User.pm
blob: e935583df45d4004c2d89f3532f34a938b39ee55 (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 undergone whitespace cleanup.
  27. #
  28. #======================================================================
  29. #
  30. # user related functions
  31. #
  32. #=====================================================================
  33. package LedgerSMB::User;
  34. use LedgerSMB::Sysconfig;
  35. use LedgerSMB::Session;
  36. use Data::Dumper;
  37. use LedgerSMB::Form;
  38. sub new {
  39. my ( $type, $login ) = @_;
  40. my $self = {};
  41. if ( $login ne "" ) {
  42. # use central db
  43. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  44. # for now, this is querying the table directly... ugly
  45. my $fetchUserPrefs = $dbh->prepare(
  46. "SELECT acs, address, businessnumber,
  47. company, countrycode, currency,
  48. dateformat, dbdriver, dbhost, dbname,
  49. dboptions, dbpasswd, dbport, dbuser,
  50. email, fax, menuwidth, name, numberformat,
  51. password, print, printer, role, sid,
  52. signature, stylesheet, tel, templates,
  53. timeout, vclimit, u.username
  54. FROM users_conf as uc, users as u
  55. WHERE u.username = ?
  56. AND u.id = uc.id;"
  57. );
  58. $fetchUserPrefs->execute($login);
  59. my $userHashRef = $fetchUserPrefs->fetchrow_hashref;
  60. while ( my ( $key, $value ) = each( %{$userHashRef} ) ) {
  61. $self->{$key} = $value;
  62. }
  63. chomp( $self->{dbport} );
  64. chomp( $self->{dbname} );
  65. chomp( $self->{dbhost} );
  66. $self->{dbconnect} =
  67. 'dbi:Pg:dbname='
  68. . $self->{dbname}
  69. . ';host='
  70. . $self->{dbhost}
  71. . ';port='
  72. . $self->{dbport};
  73. if ( $self->{username} ) {
  74. $self->{login} = $login;
  75. }
  76. }
  77. bless $self, $type;
  78. }
  79. sub country_codes {
  80. use Locale::Country;
  81. use Locale::Language;
  82. my %cc = ();
  83. # scan the locale directory and read in the LANGUAGE files
  84. opendir DIR, "${LedgerSMB::Sysconfig::localepath}";
  85. my @dir = grep !/^\..*$/, readdir DIR;
  86. foreach my $dir (@dir) {
  87. $dir = substr( $dir, 0, -3 );
  88. $cc{$dir} = code2language( substr( $dir, 0, 2 ) );
  89. $cc{$dir} .= ( "/" . code2country( substr( $dir, 3, 2 ) ) )
  90. if length($dir) > 2;
  91. $cc{$dir} .= ( " " . substr( $dir, 6 ) ) if length($dir) > 5;
  92. }
  93. closedir(DIR);
  94. %cc;
  95. }
  96. sub fetch_config {
  97. #I'm hoping that this function will go and is a temporary bridge
  98. #until we get rid of %myconfig elsewhere in the code
  99. my ( $self, $login ) = @_;
  100. if ( !$login ) {
  101. &error( $self, "Access Denied" );
  102. }
  103. # use central db
  104. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  105. # for now, this is querying the table directly... ugly
  106. my $fetchUserPrefs = $dbh->prepare(
  107. "SELECT acs, address, businessnumber,
  108. company, countrycode, currency,
  109. dateformat, dbdriver, dbhost, dbname,
  110. dboptions, dbpasswd, dbport, dbuser,
  111. email, fax, menuwidth, name, numberformat,
  112. password, print, printer, role, sid,
  113. signature, stylesheet, tel, templates,
  114. timeout, vclimit, u.username
  115. FROM users_conf as uc, users as u
  116. WHERE u.username = ?
  117. AND u.id = uc.id;"
  118. );
  119. $fetchUserPrefs->execute($login);
  120. my $userHashRef = $fetchUserPrefs->fetchrow_hashref;
  121. if ( !$userHashRef ) {
  122. &error( $self, "Access Denied" );
  123. }
  124. while ( my ( $key, $value ) = each( %{$userHashRef} ) ) {
  125. $myconfig{$key} = $value;
  126. }
  127. chomp( $myconfig{'dbport'} );
  128. chomp( $myconfig{'dbname'} );
  129. chomp( $myconfig{'dbhost'} );
  130. $myconfig{'login'} = $login;
  131. $myconfig{'dbconnect'} =
  132. 'dbi:Pg:dbname='
  133. . $myconfig{'dbname'}
  134. . ';host='
  135. . $myconfig{'dbhost'}
  136. . ';port='
  137. . $myconfig{'dbport'};
  138. return \%myconfig;
  139. }
  140. sub login {
  141. my ( $self, $form ) = @_;
  142. my $rc = -1;
  143. if ( $self->{login} ne "" ) {
  144. if (
  145. !Session::password_check(
  146. $form, $form->{login}, $form->{password}
  147. )
  148. )
  149. {
  150. return -1;
  151. }
  152. #this is really dumb, but %myconfig will have to stay until 1.3
  153. while ( my ( $key, $value ) = each( %{$self} ) ) {
  154. $myconfig{$key} = $value;
  155. }
  156. # check if database is down
  157. my $dbh =
  158. DBI->connect( $myconfig{dbconnect}, $myconfig{dbuser},
  159. $myconfig{dbpasswd} )
  160. or $self->error( __FILE__ . ':' . __LINE__ . ': ' . $DBI::errstr );
  161. $dbh->{pg_enable_utf8} = 1;
  162. # we got a connection, check the version
  163. my $query = qq|
  164. SELECT value FROM defaults
  165. WHERE setting_key = 'version'|;
  166. my $sth = $dbh->prepare($query);
  167. $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  168. my ($dbversion) = $sth->fetchrow_array;
  169. $sth->finish;
  170. # add login to employee table if it does not exist
  171. # no error check for employee table, ignore if it does not exist
  172. my $login = $self->{login};
  173. $login =~ s/@.*//;
  174. $query = qq|SELECT id FROM employee WHERE login = ?|;
  175. $sth = $dbh->prepare($query);
  176. $sth->execute($login);
  177. my ($id) = $sth->fetchrow_array;
  178. $sth->finish;
  179. if ( !$id ) {
  180. my ($employeenumber) =
  181. $form->update_defaults( \%myconfig, "employeenumber", $dbh );
  182. $query = qq|
  183. INSERT INTO employee
  184. (login, employeenumber, name,
  185. workphone, role)
  186. VALUES (?, ?, ?, ?, ?)|;
  187. $sth = $dbh->prepare($query);
  188. $sth->execute(
  189. $login, $employeenumber, $myconfig{name},
  190. $myconfig{tel}, $myconfig{role}
  191. );
  192. }
  193. $dbh->disconnect;
  194. $rc = 0;
  195. if ( $form->{dbversion} ne $dbversion ) {
  196. $rc = -3;
  197. $dbupdate =
  198. ( calc_version($dbversion) < calc_version( $form->{dbversion} ) );
  199. }
  200. if ($dbupdate) {
  201. $rc = -4;
  202. # if DB2 bale out
  203. if ( $myconfig{dbdriver} eq 'DB2' ) {
  204. $rc = -2;
  205. }
  206. }
  207. }
  208. $rc;
  209. }
  210. sub check_recurring {
  211. my ( $self, $form ) = @_;
  212. my $dbh =
  213. DBI->connect( $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd} )
  214. or $form->dberror( __FILE__ . ':' . __LINE__ );
  215. $dbh->{pg_enable_utf8} = 1;
  216. my $query = qq|
  217. SELECT count(*) FROM recurring
  218. WHERE enddate >= current_date AND nextdate <= current_date|;
  219. ($_) = $dbh->selectrow_array($query);
  220. $dbh->disconnect;
  221. $_;
  222. }
  223. sub dbconnect_vars {
  224. my ( $form, $db ) = @_;
  225. my %dboptions = (
  226. 'Pg' => {
  227. 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
  228. 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
  229. 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
  230. 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
  231. 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
  232. 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
  233. }
  234. );
  235. $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
  236. $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db";
  237. $form->{dbconnect} .= ";host=$form->{dbhost}";
  238. $form->{dbconnect} .= ";port=$form->{dbport}";
  239. }
  240. sub dbdrivers {
  241. my @drivers = DBI->available_drivers();
  242. # return (grep { /(Pg|Oracle|DB2)/ } @drivers);
  243. return ( grep { /Pg$/ } @drivers );
  244. }
  245. sub dbsources {
  246. my ( $self, $form ) = @_;
  247. my @dbsources = ();
  248. my ( $sth, $query );
  249. $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
  250. $form->{sid} = $form->{dbdefault};
  251. &dbconnect_vars( $form, $form->{dbdefault} );
  252. my $dbh =
  253. DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} )
  254. or $form->dberror( __FILE__ . ':' . __LINE__ );
  255. $dbh->{pg_enable_utf8} = 1;
  256. if ( $form->{dbdriver} eq 'Pg' ) {
  257. $query = qq|SELECT datname FROM pg_database|;
  258. $sth = $dbh->prepare($query);
  259. $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  260. while ( my ($db) = $sth->fetchrow_array ) {
  261. if ( $form->{only_acc_db} ) {
  262. next if ( $db =~ /^template/ );
  263. &dbconnect_vars( $form, $db );
  264. my $dbh =
  265. DBI->connect( $form->{dbconnect}, $form->{dbuser},
  266. $form->{dbpasswd} )
  267. or $form->dberror( __FILE__ . ':' . __LINE__ );
  268. $dbh->{pg_enable_utf8} = 1;
  269. $query = qq|
  270. SELECT tablename FROM pg_tables
  271. WHERE tablename = 'defaults'
  272. AND tableowner = ?|;
  273. my $sth = $dbh->prepare($query);
  274. $sth->execute( $form->{dbuser} )
  275. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  276. if ( $sth->fetchrow_array ) {
  277. push @dbsources, $db;
  278. }
  279. $sth->finish;
  280. $dbh->disconnect;
  281. next;
  282. }
  283. push @dbsources, $db;
  284. }
  285. }
  286. $sth->finish;
  287. $dbh->disconnect;
  288. return @dbsources;
  289. }
  290. sub dbcreate {
  291. my ( $self, $form ) = @_;
  292. my %dbcreate =
  293. ( 'Pg' => qq|CREATE DATABASE "$form->{db}" WITH ENCODING = 'UNICODE'| );
  294. $form->{sid} = $form->{dbdefault};
  295. &dbconnect_vars( $form, $form->{dbdefault} );
  296. # The below line connects to Template1 or another template file in order
  297. # to create the db. One must disconnect and reconnect later.
  298. if ( $form->{dbsuperuser} ) {
  299. my $superdbh =
  300. DBI->connect( $form->{dbconnect}, $form->{dbsuperuser},
  301. $form->{dbsuperpasswd} )
  302. or $form->dberror( __FILE__ . ':' . __LINE__ );
  303. $superdbh->{pg_enable_utf8} = 1;
  304. my $query = qq|$dbcreate{$form->{dbdriver}}|;
  305. $superdbh->do($query)
  306. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  307. $superdbh->disconnect;
  308. }
  309. #Reassign for the work below
  310. &dbconnect_vars( $form, $form->{db} );
  311. my $dbh =
  312. DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} )
  313. or $form->dberror( __FILE__ . ':' . __LINE__ );
  314. $dbh->{pg_enable_utf8} = 1;
  315. if ( $form->{dbsuperuser} ) {
  316. my $superdbh =
  317. DBI->connect( $form->{dbconnect}, $form->{dbsuperuser},
  318. $form->{dbsuperpasswd} )
  319. or $form->dberror( __FILE__ . ':' . __LINE__ );
  320. $superdbh->{pg_enable_utf8} = 1;
  321. # JD: We need to check for plpgsql,
  322. # if it isn't there create it, if we can't error
  323. # Good chance I will have to do this twice as I get
  324. # used to the way the code is structured
  325. my %langcreate = ( 'Pg' => qq|CREATE LANGUAGE plpgsql| );
  326. my $query = qq|$langcreate{$form->{dbdriver}}|;
  327. $superdbh->do($query);
  328. $superdbh->disconnect;
  329. }
  330. # create the tables
  331. my $dbdriver =
  332. ( $form->{dbdriver} =~ /Pg/ )
  333. ? 'Pg'
  334. : $form->{dbdriver};
  335. my $filename = qq|sql/Pg-database.sql|;
  336. $self->process_query( $form, $dbh, $filename );
  337. # load gifi
  338. ($filename) = split /_/, $form->{chart};
  339. $filename =~ s/_//;
  340. $self->process_query( $form, $dbh, "sql/${filename}-gifi.sql" );
  341. # load chart of accounts
  342. $filename = qq|sql/$form->{chart}-chart.sql|;
  343. $self->process_query( $form, $dbh, $filename );
  344. # create custom tables and functions
  345. my $item;
  346. foreach $item (qw(tables functions)) {
  347. $filename = "sql/${dbdriver}-custom_${item}.sql";
  348. if ( -f "$filename" ) {
  349. $self->process_query( $form, $dbh, $filename );
  350. }
  351. }
  352. $dbh->disconnect;
  353. }
  354. sub process_query {
  355. my ( $self, $form, $dbh, $filename ) = @_;
  356. return unless ( -f $filename );
  357. $ENV{PGPASSWORD} = $form->{dbpasswd};
  358. $ENV{PGUSER} = $form->{dbuser};
  359. $ENV{PGDATABASE} = $form->{db};
  360. $ENV{PGHOST} = $form->{dbhost};
  361. $ENV{PGPORT} = $form->{dbport};
  362. $results = `psql -f $filename 2>&1`;
  363. if ($?) {
  364. $form->error($!);
  365. }
  366. elsif ( $results =~ /error/i ) {
  367. $form->error($results);
  368. }
  369. }
  370. sub dbneedsupdate {
  371. my ( $self, $form ) = @_;
  372. my %dbsources = ();
  373. my $query;
  374. $form->{sid} = $form->{dbdefault};
  375. &dbconnect_vars( $form, $form->{dbdefault} );
  376. my $dbh =
  377. DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} )
  378. or $form->dberror( __FILE__ . ':' . __LINE__ );
  379. $dbh->{pg_enable_utf8} = 1;
  380. if ( $form->{dbdriver} =~ /Pg/ ) {
  381. $query = qq|
  382. SELECT d.datname
  383. FROM pg_database d, pg_user u
  384. WHERE d.datdba = u.usesysid
  385. AND u.usename = ?|;
  386. my $sth = $dbh->prepare($query);
  387. $sth->execute( $form->{dbuser} )
  388. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  389. while ( my ($db) = $sth->fetchrow_array ) {
  390. next if ( $db =~ /^template/ );
  391. &dbconnect_vars( $form, $db );
  392. my $dbh =
  393. DBI->connect( $form->{dbconnect}, $form->{dbuser},
  394. $form->{dbpasswd} )
  395. or $form->dberror( __FILE__ . ':' . __LINE__ );
  396. $dbh->{pg_enable_utf8} = 1;
  397. $query = qq|
  398. SELECT tablename
  399. FROM pg_tables
  400. WHERE tablename = 'defaults'|;
  401. my $sth = $dbh->prepare($query);
  402. $sth->execute
  403. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  404. if ( $sth->fetchrow_array ) {
  405. $query = qq|
  406. SELECT value FROM defaults
  407. WHERE setting_key = 'version'|;
  408. my $sth = $dbh->prepare($query);
  409. $sth->execute;
  410. if ( my ($version) = $sth->fetchrow_array ) {
  411. $dbsources{$db} = $version;
  412. }
  413. $sth->finish;
  414. }
  415. $sth->finish;
  416. $dbh->disconnect;
  417. }
  418. $sth->finish;
  419. }
  420. $dbh->disconnect;
  421. %dbsources;
  422. }
  423. sub dbupdate {
  424. my ( $self, $form ) = @_;
  425. $form->{sid} = $form->{dbdefault};
  426. my @upgradescripts = ();
  427. my $query;
  428. my $rc = -2;
  429. if ( $form->{dbupdate} ) {
  430. # read update scripts into memory
  431. opendir SQLDIR, "sql/."
  432. or $form->error( __FILE__ . ':' . __LINE__ . ': ' . $! );
  433. @upgradescripts =
  434. sort script_version grep /$form->{dbdriver}-upgrade-.*?\.sql$/,
  435. readdir SQLDIR;
  436. closedir SQLDIR;
  437. }
  438. foreach my $db ( split / /, $form->{dbupdate} ) {
  439. next unless $form->{$db};
  440. # strip db from dataset
  441. $db =~ s/^db//;
  442. &dbconnect_vars( $form, $db );
  443. my $dbh = DBI->connect(
  444. $form->{dbconnect}, $form->{dbuser},
  445. $form->{dbpasswd}, { AutoCommit => 0 }
  446. ) or $form->dberror( __FILE__ . ':' . __LINE__ );
  447. $dbh->{pg_enable_utf8} = 1;
  448. # check version
  449. $query = qq|
  450. SELECT value FROM defaults
  451. WHERE setting_key = 'version'|;
  452. my $sth = $dbh->prepare($query);
  453. # no error check, let it fall through
  454. $sth->execute;
  455. my $version = $sth->fetchrow_array;
  456. $sth->finish;
  457. next unless $version;
  458. $version = calc_version($version);
  459. my $dbversion = calc_version( $form->{dbversion} );
  460. foreach my $upgradescript (@upgradescripts) {
  461. my $a = $upgradescript;
  462. $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g;
  463. my ( $mindb, $maxdb ) = split /-/, $a;
  464. $mindb = calc_version($mindb);
  465. $maxdb = calc_version($maxdb);
  466. next if ( $version >= $maxdb );
  467. # exit if there is no upgrade script or version == mindb
  468. last if ( $version < $mindb || $version >= $dbversion );
  469. # apply upgrade
  470. $self->process_query( $form, $dbh, "sql/$upgradescript" );
  471. $dbh->commit;
  472. $version = $maxdb;
  473. }
  474. $rc = 0;
  475. $dbh->disconnect;
  476. }
  477. $rc;
  478. }
  479. sub calc_version {
  480. my @v = split /\./, $_[0];
  481. my $version = 0;
  482. my $i;
  483. for ( $i = 0 ; $i <= $#v ; $i++ ) {
  484. $version *= 1000;
  485. $version += $v[$i];
  486. }
  487. return $version;
  488. }
  489. sub script_version {
  490. my ( $my_a, $my_b ) = ( $a, $b );
  491. my ( $a_from, $a_to, $b_from, $b_to );
  492. my ( $res_a, $res_b, $i );
  493. $my_a =~ s/.*-upgrade-//;
  494. $my_a =~ s/.sql$//;
  495. $my_b =~ s/.*-upgrade-//;
  496. $my_b =~ s/.sql$//;
  497. ( $a_from, $a_to ) = split( /-/, $my_a );
  498. ( $b_from, $b_to ) = split( /-/, $my_b );
  499. $res_a = calc_version($a_from);
  500. $res_b = calc_version($b_from);
  501. if ( $res_a == $res_b ) {
  502. $res_a = calc_version($a_to);
  503. $res_b = calc_version($b_to);
  504. }
  505. return $res_a <=> $res_b;
  506. }
  507. sub save_member {
  508. my ($self) = @_;
  509. # replace \r\n with \n
  510. for (qw(address signature)) { $self->{$_} =~ s/\r?\n/\\n/g }
  511. # use central db
  512. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  513. #check to see if the user exists already
  514. my $userCheck = $dbh->prepare("SELECT id FROM users WHERE username = ?");
  515. $userCheck->execute( $self->{login} );
  516. my ($userID) = $userCheck->fetchrow_array;
  517. if ( !$self->{dbhost} ) {
  518. $self->{dbhost} = 'localhost';
  519. }
  520. if ( !$self->{dbport} ) {
  521. $self->{dbport} = '5432';
  522. }
  523. my $userConfExists = 0;
  524. if ($userID) {
  525. #got an id, check to see if it's in the users_conf table
  526. my $userConfCheck =
  527. $dbh->prepare("SELECT password, 1 FROM users_conf WHERE id = ?");
  528. $userConfCheck->execute($userID);
  529. ( $oldPassword, $userConfExists ) = $userConfCheck->fetchrow_array;
  530. }
  531. else {
  532. my $userConfAdd = $dbh->prepare("SELECT create_user(?);");
  533. $userConfAdd->execute( $self->{login} );
  534. ($userID) = $userConfAdd->fetchrow_array;
  535. }
  536. if ($userConfExists) {
  537. # for now, this is updating the table directly... ugly
  538. my $userConfUpdate = $dbh->prepare(
  539. "UPDATE users_conf
  540. SET acs = ?, address = ?, businessnumber = ?,
  541. company = ?, countrycode = ?, currency = ?,
  542. dateformat = ?, dbdriver = ?,
  543. dbhost = ?, dbname = ?, dboptions = ?,
  544. dbpasswd = ?, dbport = ?, dbuser = ?,
  545. email = ?, fax = ?, menuwidth = ?,
  546. name = ?, numberformat = ?,
  547. print = ?, printer = ?, role = ?,
  548. sid = ?, signature = ?, stylesheet = ?,
  549. tel = ?, templates = ?, timeout = ?,
  550. vclimit = ?
  551. WHERE id = ?;"
  552. );
  553. $userConfUpdate->execute(
  554. $self->{acs}, $self->{address},
  555. $self->{businessnumber}, $self->{company},
  556. $self->{countrycode}, $self->{currency},
  557. $self->{dateformat}, $self->{dbdriver},
  558. $self->{dbhost}, $self->{dbname},
  559. $self->{dboptions}, $self->{dbpasswd},
  560. $self->{dbport}, $self->{dbuser},
  561. $self->{email}, $self->{fax},
  562. $self->{menuwidth}, $self->{name},
  563. $self->{numberformat}, $self->{print},
  564. $self->{printer}, $self->{role},
  565. $self->{sid}, $self->{signature},
  566. $self->{stylesheet}, $self->{tel},
  567. $self->{templates}, $self->{timeout},
  568. $self->{vclimit}, $userID
  569. );
  570. if ( $oldPassword ne $self->{password} ) {
  571. # if they're supplying a 32 char password that matches their old password
  572. # assume they don't want to change passwords
  573. $userConfUpdate = $dbh->prepare(
  574. "UPDATE users_conf
  575. SET password = md5(?)
  576. WHERE id = ?"
  577. );
  578. $userConfUpdate->execute( $self->{password}, $userID );
  579. }
  580. }
  581. else {
  582. my $userConfInsert = $dbh->prepare(
  583. "INSERT INTO users_conf(acs, address, businessnumber,
  584. company, countrycode, currency,
  585. dateformat, dbdriver,
  586. dbhost, dbname, dboptions, dbpasswd,
  587. dbport, dbuser, email, fax, menuwidth,
  588. name, numberformat, print, printer, role,
  589. sid, signature, stylesheet, tel, templates,
  590. timeout, vclimit, id, password)
  591. VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?,
  592. ?, ?, ?, ?, ?, ?, ?, ?, ?, ?,
  593. ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, md5(?));"
  594. );
  595. $userConfInsert->execute(
  596. $self->{acs}, $self->{address},
  597. $self->{businessnumber}, $self->{company},
  598. $self->{countrycode}, $self->{currency},
  599. $self->{dateformat}, $self->{dbdriver},
  600. $self->{dbhost}, $self->{dbname},
  601. $self->{dboptions}, $self->{dbpasswd},
  602. $self->{dbport}, $self->{dbuser},
  603. $self->{email}, $self->{fax},
  604. $self->{menuwidth}, $self->{name},
  605. $self->{numberformat}, $self->{print},
  606. $self->{printer}, $self->{role},
  607. $self->{sid}, $self->{signature},
  608. $self->{stylesheet}, $self->{tel},
  609. $self->{templates}, $self->{timeout},
  610. $self->{vclimit}, $userID,
  611. $self->{password}
  612. );
  613. }
  614. if ( !$self->{'admin'} ) {
  615. $self->{dbpasswd} =~ s/\\'/'/g;
  616. $self->{dbpasswd} =~ s/\\\\/\\/g;
  617. # format dbconnect and dboptions string
  618. &dbconnect_vars( $self, $self->{dbname} );
  619. # check if login is in database
  620. my $dbh = DBI->connect(
  621. $self->{dbconnect}, $self->{dbuser},
  622. $self->{dbpasswd}, { AutoCommit => 0 }
  623. ) or $self->error($DBI::errstr);
  624. $dbh->{pg_enable_utf8} = 1;
  625. # add login to employee table if it does not exist
  626. my $login = $self->{login};
  627. $login =~ s/@.*//;
  628. my $sth = $dbh->prepare("SELECT id FROM employee WHERE login = ?;");
  629. $sth->execute($login);
  630. my ($id) = $sth->fetchrow_array;
  631. $sth->finish;
  632. my $employeenumber;
  633. my @values;
  634. if ($id) {
  635. $query = qq|UPDATE employee SET
  636. role = ?,
  637. email = ?,
  638. name = ?
  639. WHERE login = ?|;
  640. @values = ( $self->{role}, $self->{email}, $self->{name}, $login );
  641. }
  642. else {
  643. my $form = {dbh => $dbh};
  644. bless($form, 'Form');
  645. my ($employeenumber) = $form->update_defaults(\%$self, "employeenumber");
  646. $query = qq|
  647. INSERT INTO employee
  648. (login, employeenumber, name,
  649. workphone, role, email, sales)
  650. VALUES (?, ?, ?, ?, ?, ?, '1')|;
  651. @values = (
  652. $login, $employeenumber, $self->{name},
  653. $self->{tel}, $self->{role}, $self->{email}
  654. );
  655. }
  656. $sth = $dbh->prepare($query);
  657. $sth->execute(@values);
  658. $dbh->commit;
  659. $dbh->disconnect;
  660. }
  661. }
  662. sub delete_login {
  663. my ( $self, $form ) = @_;
  664. my $dbh = DBI->connect(
  665. $form->{dbconnect}, $form->{dbuser},
  666. $form->{dbpasswd}, { AutoCommit => 0 }
  667. ) or $form->dberror( __FILE__ . ':' . __LINE__ );
  668. $dbh->{pg_enable_utf8} = 1;
  669. my $login = $form->{login};
  670. $login =~ s/@.*//;
  671. my $query = qq|SELECT id FROM employee WHERE login = ?|;
  672. my $sth = $dbh->prepare($query);
  673. $sth->execute($login)
  674. || $form->dberror( __FILE__ . ':' . __LINE__ . ': ' . $query );
  675. my ($id) = $sth->fetchrow_array;
  676. $sth->finish;
  677. my $query = qq|
  678. UPDATE employee
  679. SET login = NULL,
  680. enddate = current_date
  681. WHERE login = ?|;
  682. $sth = $dbh->prepare($query);
  683. $sth->execute($login);
  684. $dbh->commit;
  685. $dbh->disconnect;
  686. }
  687. sub config_vars {
  688. my @conf = qw(acs address businessnumber company countrycode
  689. currency dateformat dbconnect dbdriver dbhost dbname dboptions
  690. dbpasswd dbport dbuser email fax menuwidth name numberformat
  691. password printer role sid signature stylesheet tel templates
  692. timeout vclimit);
  693. @conf;
  694. }
  695. sub error {
  696. my ( $self, $msg ) = @_;
  697. if ( $ENV{GATEWAY_INTERFACE} ) {
  698. print qq|Content-Type: text/html\n\n|
  699. . qq|<body bgcolor=ffffff>\n\n|
  700. . qq|<h2><font color=red>Error!</font></h2>\n|
  701. . qq|<p><b>$msg</b>|;
  702. }
  703. die "Error: $msg\n";
  704. }
  705. 1;