summaryrefslogtreecommitdiff
path: root/LedgerSMB/User.pm
blob: f67ad9c44c17440a695801ed593507bc45f85d06 (plain)
  1. =head1 NAME
  2. LedgerSMB::User
  3. =head1 SYNOPSIS
  4. This module provides user support and database management functions.
  5. =head1 STATUS
  6. Deprecated
  7. =head1 COPYRIGHT
  8. #====================================================================
  9. # LedgerSMB
  10. # Small Medium Business Accounting software
  11. # http://www.ledgersmb.org/
  12. #
  13. # Copyright (C) 2006
  14. # This work contains copyrighted information from a number of sources
  15. # all used with permission.
  16. #
  17. # This file contains source code included with or based on SQL-Ledger
  18. # which is Copyright Dieter Simader and DWS Systems Inc. 2000-2005
  19. # and licensed under the GNU General Public License version 2 or, at
  20. # your option, any later version. For a full list including contact
  21. # information of contributors, maintainers, and copyright holders,
  22. # see the CONTRIBUTORS file.
  23. #
  24. # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
  25. # Copyright (C) 2000
  26. #
  27. # Author: DWS Systems Inc.
  28. # Web: http://www.sql-ledger.org
  29. #
  30. # Contributors: Jim Rawlings <jim@your-dba.com>
  31. #
  32. #====================================================================
  33. #
  34. # This file has undergone whitespace cleanup.
  35. #
  36. #====================================================================
  37. #
  38. # user related functions
  39. #
  40. #====================================================================
  41. =head1 METHODS
  42. =over
  43. =cut
  44. # inline documentation
  45. package LedgerSMB::User;
  46. use LedgerSMB::Sysconfig;
  47. use LedgerSMB::Session;
  48. use Data::Dumper;
  49. =item LedgerSMB::User->new($login);
  50. Create a LedgerSMB::User object. If the user $login exists, set the fields
  51. with values retrieved from the database.
  52. =cut
  53. sub new {
  54. my ( $type, $login ) = @_;
  55. my $self = {};
  56. if ( $login ne "" ) {
  57. # use central db
  58. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  59. # for now, this is querying the table directly... ugly
  60. my $fetchUserPrefs = $dbh->prepare(
  61. "SELECT acs, address, businessnumber,
  62. company, countrycode, currency,
  63. dateformat, dbdriver, dbhost, dbname,
  64. dboptions, dbpasswd, dbport, dbuser,
  65. email, fax, menuwidth, name, numberformat,
  66. password, print, printer, role, sid,
  67. signature, stylesheet, tel, templates,
  68. timeout, vclimit, u.username
  69. FROM users_conf as uc, users as u
  70. WHERE u.username = ?
  71. AND u.id = uc.id;"
  72. );
  73. $fetchUserPrefs->execute($login);
  74. my $userHashRef = $fetchUserPrefs->fetchrow_hashref;
  75. while ( my ( $key, $value ) = each( %{$userHashRef} ) ) {
  76. $self->{$key} = $value;
  77. }
  78. chomp( $self->{dbport} );
  79. chomp( $self->{dbname} );
  80. chomp( $self->{dbhost} );
  81. $self->{dbconnect} =
  82. 'dbi:Pg:dbname='
  83. . $self->{dbname}
  84. . ';host='
  85. . $self->{dbhost}
  86. . ';port='
  87. . $self->{dbport};
  88. if ( $self->{username} ) {
  89. $self->{login} = $login;
  90. }
  91. }
  92. bless $self, $type;
  93. }
  94. =item LedgerSMB::User->country_codes();
  95. Returns a hash where the keys are registered locales and the values are the
  96. textual representation of the locale name.
  97. =cut
  98. sub country_codes {
  99. use Locale::Country;
  100. use Locale::Language;
  101. my %cc = ();
  102. # scan the locale directory and read in the LANGUAGE files
  103. opendir DIR, "${LedgerSMB::Sysconfig::localepath}";
  104. my @dir = grep !/^\..*$/, readdir DIR;
  105. foreach my $dir (@dir) {
  106. $dir = substr( $dir, 0, -3 );
  107. $cc{$dir} = code2language( substr( $dir, 0, 2 ) );
  108. $cc{$dir} .= ( "/" . code2country( substr( $dir, 3, 2 ) ) )
  109. if length($dir) > 2;
  110. $cc{$dir} .= ( " " . substr( $dir, 6 ) ) if length($dir) > 5;
  111. }
  112. closedir(DIR);
  113. %cc;
  114. }
  115. =item LedgerSMB::User->fetch_config($login);
  116. Returns a reference to a hash that contains the user config for the user $login.
  117. If that user does not exist, output 'Access denied' if in CGI and die in all
  118. cases.
  119. =cut
  120. sub fetch_config {
  121. #I'm hoping that this function will go and is a temporary bridge
  122. #until we get rid of %myconfig elsewhere in the code
  123. my ( $self, $login ) = @_;
  124. if ( !$login ) {
  125. &error( $self, "Access Denied" );
  126. }
  127. # use central db
  128. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  129. # for now, this is querying the table directly... ugly
  130. my $fetchUserPrefs = $dbh->prepare(
  131. "SELECT acs, address, businessnumber,
  132. company, countrycode, currency,
  133. dateformat, dbdriver, dbhost, dbname,
  134. dboptions, dbpasswd, dbport, dbuser,
  135. email, fax, menuwidth, name, numberformat,
  136. password, print, printer, role, sid,
  137. signature, stylesheet, tel, templates,
  138. timeout, vclimit, u.username
  139. FROM users_conf as uc, users as u
  140. WHERE u.username = ?
  141. AND u.id = uc.id;"
  142. );
  143. $fetchUserPrefs->execute($login);
  144. my $userHashRef = $fetchUserPrefs->fetchrow_hashref;
  145. if ( !$userHashRef ) {
  146. &error( $self, "Access Denied" );
  147. }
  148. while ( my ( $key, $value ) = each( %{$userHashRef} ) ) {
  149. $myconfig{$key} = $value;
  150. }
  151. chomp( $myconfig{'dbport'} );
  152. chomp( $myconfig{'dbname'} );
  153. chomp( $myconfig{'dbhost'} );
  154. $myconfig{'login'} = $login;
  155. $myconfig{'dbconnect'} =
  156. 'dbi:Pg:dbname='
  157. . $myconfig{'dbname'}
  158. . ';host='
  159. . $myconfig{'dbhost'}
  160. . ';port='
  161. . $myconfig{'dbport'};
  162. return \%myconfig;
  163. }
  164. =item $user->login($form);
  165. Disused auth function.
  166. =cut
  167. sub login {
  168. my ( $self, $form ) = @_;
  169. my $rc = -1;
  170. if ( $self->{login} ne "" ) {
  171. if (
  172. !Session::password_check(
  173. $form, $form->{login}, $form->{password}
  174. )
  175. )
  176. {
  177. return -1;
  178. }
  179. #this is really dumb, but %myconfig will have to stay until 1.3
  180. while ( my ( $key, $value ) = each( %{$self} ) ) {
  181. $myconfig{$key} = $value;
  182. }
  183. # check if database is down
  184. my $dbh =
  185. DBI->connect( $myconfig{dbconnect}, $myconfig{dbuser},
  186. $myconfig{dbpasswd} )
  187. or $self->error( __FILE__ . ':' . __LINE__ . ': ' . $DBI::errstr );
  188. $dbh->{pg_enable_utf8} = 1;
  189. # we got a connection, check the version
  190. my $query = qq|
  191. SELECT value FROM defaults
  192. WHERE setting_key = 'version'|;
  193. my $sth = $dbh->prepare($query);
  194. $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  195. my ($dbversion) = $sth->fetchrow_array;
  196. $sth->finish;
  197. # add login to employee table if it does not exist
  198. # no error check for employee table, ignore if it does not exist
  199. my $login = $self->{login};
  200. $login =~ s/@.*//;
  201. $query = qq|SELECT id FROM employee WHERE login = ?|;
  202. $sth = $dbh->prepare($query);
  203. $sth->execute($login);
  204. my ($id) = $sth->fetchrow_array;
  205. $sth->finish;
  206. if ( !$id ) {
  207. my ($employeenumber) =
  208. $form->update_defaults( \%myconfig, "employeenumber", $dbh );
  209. $query = qq|
  210. INSERT INTO employee
  211. (login, employeenumber, name,
  212. workphone, role)
  213. VALUES (?, ?, ?, ?, ?)|;
  214. $sth = $dbh->prepare($query);
  215. $sth->execute(
  216. $login, $employeenumber, $myconfig{name},
  217. $myconfig{tel}, $myconfig{role}
  218. );
  219. }
  220. $dbh->disconnect;
  221. $rc = 0;
  222. if ( $form->{dbversion} ne $dbversion ) {
  223. $rc = -3;
  224. $dbupdate =
  225. ( calc_version($dbversion) < calc_version( $form->{dbversion} ) );
  226. }
  227. if ($dbupdate) {
  228. $rc = -4;
  229. # if DB2 bale out
  230. if ( $myconfig{dbdriver} eq 'DB2' ) {
  231. $rc = -2;
  232. }
  233. }
  234. }
  235. $rc;
  236. }
  237. =item LedgerSMB::User->check_recurring($form);
  238. Disused function to return the number of current recurring events.
  239. =cut
  240. sub check_recurring {
  241. my ( $self, $form ) = @_;
  242. my $dbh =
  243. DBI->connect( $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd} )
  244. or $form->dberror( __FILE__ . ':' . __LINE__ );
  245. $dbh->{pg_encode_utf8} = 1;
  246. my $query = qq|
  247. SELECT count(*) FROM recurring
  248. WHERE enddate >= current_date AND nextdate <= current_date|;
  249. ($_) = $dbh->selectrow_array($query);
  250. $dbh->disconnect;
  251. $_;
  252. }
  253. =item LedgerSMB::User::dbconnect_vars($form, $db);
  254. Converts individual $form values into $form->{dboptions} and $form->{dbconnect}.
  255. =cut
  256. sub dbconnect_vars {
  257. my ( $form, $db ) = @_;
  258. my %dboptions = (
  259. 'Pg' => {
  260. 'yy-mm-dd' => 'set DateStyle to \'ISO\'',
  261. 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'',
  262. 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'',
  263. 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'',
  264. 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
  265. 'dd.mm.yy' => 'set DateStyle to \'GERMAN\''
  266. }
  267. );
  268. $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
  269. $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db";
  270. $form->{dbconnect} .= ";host=$form->{dbhost}";
  271. $form->{dbconnect} .= ";port=$form->{dbport}";
  272. }
  273. =item LedgerSMB::User->dbdrivers();
  274. Returns a list of all drivers set up with DBI whose names end in 'Pg'.
  275. =cut
  276. sub dbdrivers {
  277. my @drivers = DBI->available_drivers();
  278. # return (grep { /(Pg|Oracle|DB2)/ } @drivers);
  279. return ( grep { /Pg$/ } @drivers );
  280. }
  281. =item LedgerSMB::User->dbsources($form);
  282. Returns a list of all databases in the same cluster as the database that $form
  283. is set to. If $form->{only_acc_db} is set, only non-template databases that
  284. have a defaults table owned by $form->{dbuser} are returned.
  285. =cut
  286. sub dbsources {
  287. my ( $self, $form ) = @_;
  288. my @dbsources = ();
  289. my ( $sth, $query );
  290. $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
  291. $form->{sid} = $form->{dbdefault};
  292. &dbconnect_vars( $form, $form->{dbdefault} );
  293. my $dbh =
  294. DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} )
  295. or $form->dberror( __FILE__ . ':' . __LINE__ );
  296. $dbh->{pg_enable_utf8} = 1;
  297. if ( $form->{dbdriver} eq 'Pg' ) {
  298. $query = qq|SELECT datname FROM pg_database|;
  299. $sth = $dbh->prepare($query);
  300. $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  301. while ( my ($db) = $sth->fetchrow_array ) {
  302. if ( $form->{only_acc_db} ) {
  303. next if ( $db =~ /^template/ );
  304. &dbconnect_vars( $form, $db );
  305. my $dbh =
  306. DBI->connect( $form->{dbconnect}, $form->{dbuser},
  307. $form->{dbpasswd} )
  308. or $form->dberror( __FILE__ . ':' . __LINE__ );
  309. $dbh->{pg_enable_utf8} = 1;
  310. $query = qq|
  311. SELECT tablename FROM pg_tables
  312. WHERE tablename = 'defaults'
  313. AND tableowner = ?|;
  314. my $sth = $dbh->prepare($query);
  315. $sth->execute( $form->{dbuser} )
  316. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  317. if ( $sth->fetchrow_array ) {
  318. push @dbsources, $db;
  319. }
  320. $sth->finish;
  321. $dbh->disconnect;
  322. next;
  323. }
  324. push @dbsources, $db;
  325. }
  326. }
  327. $sth->finish;
  328. $dbh->disconnect;
  329. return @dbsources;
  330. }
  331. =item LedgerSMB::User->dbcreate($form);
  332. Create the database indicated by $form->{db} and load Pg-database.sql, the chart
  333. indicated by $form->{chart} and custom tables and functions
  334. (Pg-custom_tables.sql and Pg-custom_functions).
  335. =cut
  336. sub dbcreate {
  337. my ( $self, $form ) = @_;
  338. my %dbcreate =
  339. ( 'Pg' => qq|CREATE DATABASE "$form->{db}" WITH ENCODING = 'UNICODE'| );
  340. $form->{sid} = $form->{dbdefault};
  341. &dbconnect_vars( $form, $form->{dbdefault} );
  342. # The below line connects to Template1 or another template file in order
  343. # to create the db. One must disconnect and reconnect later.
  344. if ( $form->{dbsuperuser} ) {
  345. my $superdbh =
  346. DBI->connect( $form->{dbconnect}, $form->{dbsuperuser},
  347. $form->{dbsuperpasswd} )
  348. or $form->dberror( __FILE__ . ':' . __LINE__ );
  349. $superdbh->{pg_enable_utf8} = 1;
  350. my $query = qq|$dbcreate{$form->{dbdriver}}|;
  351. $superdbh->do($query)
  352. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  353. $superdbh->disconnect;
  354. }
  355. #Reassign for the work below
  356. &dbconnect_vars( $form, $form->{db} );
  357. my $dbh =
  358. DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} )
  359. or $form->dberror( __FILE__ . ':' . __LINE__ );
  360. $dbh->{pg_enable_utf8} = 1;
  361. if ( $form->{dbsuperuser} ) {
  362. my $superdbh =
  363. DBI->connect( $form->{dbconnect}, $form->{dbsuperuser},
  364. $form->{dbsuperpasswd} )
  365. or $form->dberror( __FILE__ . ':' . __LINE__ );
  366. $superdbh->{pg_enable_utf8} = 1;
  367. # JD: We need to check for plpgsql,
  368. # if it isn't there create it, if we can't error
  369. # Good chance I will have to do this twice as I get
  370. # used to the way the code is structured
  371. my %langcreate = ( 'Pg' => qq|CREATE LANGUAGE plpgsql| );
  372. my $query = qq|$langcreate{$form->{dbdriver}}|;
  373. $superdbh->do($query);
  374. $superdbh->disconnect;
  375. }
  376. # create the tables
  377. my $dbdriver =
  378. ( $form->{dbdriver} =~ /Pg/ )
  379. ? 'Pg'
  380. : $form->{dbdriver};
  381. my $filename = qq|sql/Pg-database.sql|;
  382. $self->process_query( $form, $dbh, $filename );
  383. # load gifi
  384. ($filename) = split /_/, $form->{chart};
  385. $filename =~ s/_//;
  386. $self->process_query( $form, $dbh, "sql/${filename}-gifi.sql" );
  387. # load chart of accounts
  388. $filename = qq|sql/$form->{chart}-chart.sql|;
  389. $self->process_query( $form, $dbh, $filename );
  390. # create custom tables and functions
  391. my $item;
  392. foreach $item (qw(tables functions)) {
  393. $filename = "sql/${dbdriver}-custom_${item}.sql";
  394. if ( -f "$filename" ) {
  395. $self->process_query( $form, $dbh, $filename );
  396. }
  397. }
  398. $dbh->disconnect;
  399. }
  400. =item LedgerSMB::User->process_query($form, $dbh, $filename);
  401. Load the file $filename into the database indicated through form using psql.
  402. $dbh is ignored.
  403. =cut
  404. sub process_query {
  405. my ( $self, $form, $dbh, $filename ) = @_;
  406. return unless ( -f $filename );
  407. $ENV{PGPASSWORD} = $form->{dbpasswd};
  408. $ENV{PGUSER} = $form->{dbuser};
  409. $ENV{PGDATABASE} = $form->{db};
  410. $ENV{PGHOST} = $form->{dbhost};
  411. $ENV{PGPORT} = $form->{dbport};
  412. $results = `psql -f $filename 2>&1`;
  413. if ($?) {
  414. $form->error($!);
  415. }
  416. elsif ( $results =~ /error/i ) {
  417. $form->error($results);
  418. }
  419. }
  420. =item LedgerSMB::User->dbdelete($form);
  421. Disused function to drop the database $form->{db}.
  422. =cut
  423. sub dbdelete {
  424. my ( $self, $form ) = @_;
  425. $form->{sid} = $form->{dbdefault};
  426. &dbconnect_vars( $form, $form->{dbdefault} );
  427. my $dbh =
  428. DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} )
  429. or $form->dberror( __FILE__ . ':' . __LINE__ );
  430. $dbh->{pg_enable_utf8} = 1;
  431. my $query = qq|DROP DATABASE "$form->{db}"|;
  432. $dbh->do($query) || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  433. $dbh->disconnect;
  434. }
  435. =item LedgerSMB::User->dbsources_unused($form, $memfile);
  436. Disused function to identify all databases in a cluster with a defaults table
  437. that are not mentioned in the memberfile $memfile.
  438. =cut
  439. sub dbsources_unused {
  440. my ( $self, $form, $memfile ) = @_;
  441. my @dbexcl = ();
  442. my @dbsources = ();
  443. $form->error( __FILE__ . ':' . __LINE__ . ": $memfile locked!" )
  444. if ( -f "${memfile}.LCK" );
  445. # open members file
  446. open( FH, '<', "$memfile" )
  447. or $form->error( __FILE__ . ':' . __LINE__ . ": $memfile : $!" );
  448. while (<FH>) {
  449. if (/^dbname=/) {
  450. my ( $null, $item ) = split /=/;
  451. push @dbexcl, $item;
  452. }
  453. }
  454. close FH;
  455. $form->{only_acc_db} = 1;
  456. my @db = &dbsources( "", $form );
  457. push @dbexcl, $form->{dbdefault};
  458. foreach $item (@db) {
  459. unless ( grep /$item$/, @dbexcl ) {
  460. push @dbsources, $item;
  461. }
  462. }
  463. return @dbsources;
  464. }
  465. =item LedgerSMB::User->dbneedsupdate($form);
  466. Disused function to locate all databases owned by $form->{dbuser} that are not
  467. a template* database which have a defaults table with a version entry.
  468. =cut
  469. sub dbneedsupdate {
  470. my ( $self, $form ) = @_;
  471. my %dbsources = ();
  472. my $query;
  473. $form->{sid} = $form->{dbdefault};
  474. &dbconnect_vars( $form, $form->{dbdefault} );
  475. my $dbh =
  476. DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} )
  477. or $form->dberror( __FILE__ . ':' . __LINE__ );
  478. $dbh->{pg_enable_utf8} = 1;
  479. if ( $form->{dbdriver} =~ /Pg/ ) {
  480. $query = qq|
  481. SELECT d.datname
  482. FROM pg_database d, pg_user u
  483. WHERE d.datdba = u.usesysid
  484. AND u.usename = ?|;
  485. my $sth = $dbh->prepare($query);
  486. $sth->execute( $form->{dbuser} )
  487. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  488. while ( my ($db) = $sth->fetchrow_array ) {
  489. next if ( $db =~ /^template/ );
  490. &dbconnect_vars( $form, $db );
  491. my $dbh =
  492. DBI->connect( $form->{dbconnect}, $form->{dbuser},
  493. $form->{dbpasswd} )
  494. or $form->dberror( __FILE__ . ':' . __LINE__ );
  495. $dbh->{pg_enable_utf8};
  496. $query = qq|
  497. SELECT tablename
  498. FROM pg_tables
  499. WHERE tablename = 'defaults'|;
  500. my $sth = $dbh->prepare($query);
  501. $sth->execute
  502. || $form->dberror( __FILE__ . ':' . __LINE__ . $query );
  503. if ( $sth->fetchrow_array ) {
  504. $query = qq|
  505. SELECT value FROM defaults
  506. WHERE setting_key = 'version'|;
  507. my $sth = $dbh->prepare($query);
  508. $sth->execute;
  509. if ( my ($version) = $sth->fetchrow_array ) {
  510. $dbsources{$db} = $version;
  511. }
  512. $sth->finish;
  513. }
  514. $sth->finish;
  515. $dbh->disconnect;
  516. }
  517. $sth->finish;
  518. }
  519. $dbh->disconnect;
  520. %dbsources;
  521. }
  522. =item LedgerSMB::User->dbupdate($form);
  523. Applies database upgrade scripts to upgrade the database to the current level.
  524. =cut
  525. sub dbupdate {
  526. my ( $self, $form ) = @_;
  527. $form->{sid} = $form->{dbdefault};
  528. my @upgradescripts = ();
  529. my $query;
  530. my $rc = -2;
  531. if ( $form->{dbupdate} ) {
  532. # read update scripts into memory
  533. opendir SQLDIR, "sql/."
  534. or $form->error( __FILE__ . ':' . __LINE__ . ': ' . $! );
  535. @upgradescripts =
  536. sort script_version grep /$form->{dbdriver}-upgrade-.*?\.sql$/,
  537. readdir SQLDIR;
  538. closedir SQLDIR;
  539. }
  540. foreach my $db ( split / /, $form->{dbupdate} ) {
  541. next unless $form->{$db};
  542. # strip db from dataset
  543. $db =~ s/^db//;
  544. &dbconnect_vars( $form, $db );
  545. my $dbh = DBI->connect(
  546. $form->{dbconnect}, $form->{dbuser},
  547. $form->{dbpasswd}, { AutoCommit => 0 }
  548. ) or $form->dberror( __FILE__ . ':' . __LINE__ );
  549. $dbh->{pg_enable_utf8} = 1;
  550. # check version
  551. $query = qq|
  552. SELECT value FROM defaults
  553. WHERE setting_key = 'version'|;
  554. my $sth = $dbh->prepare($query);
  555. # no error check, let it fall through
  556. $sth->execute;
  557. my $version = $sth->fetchrow_array;
  558. $sth->finish;
  559. next unless $version;
  560. $version = calc_version($version);
  561. my $dbversion = calc_version( $form->{dbversion} );
  562. foreach my $upgradescript (@upgradescripts) {
  563. my $a = $upgradescript;
  564. $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g;
  565. my ( $mindb, $maxdb ) = split /-/, $a;
  566. $mindb = calc_version($mindb);
  567. $maxdb = calc_version($maxdb);
  568. next if ( $version >= $maxdb );
  569. # exit if there is no upgrade script or version == mindb
  570. last if ( $version < $mindb || $version >= $dbversion );
  571. # apply upgrade
  572. $self->process_query( $form, $dbh, "sql/$upgradescript" );
  573. $dbh->commit;
  574. $version = $maxdb;
  575. }
  576. $rc = 0;
  577. $dbh->disconnect;
  578. }
  579. $rc;
  580. }
  581. =item calc_version($version);
  582. Returns a numeric form for the version passed in. The numeric form is derived
  583. by converting each dotted portion of the version to a three-digit number and
  584. appending them.
  585. +----------+------------+
  586. | $version | returned |
  587. +----------+------------+
  588. | 1.0.0 | 1000000 |
  589. | 1.2.33 | 1002033 |
  590. | 189.2.33 | 189002033 |
  591. | 1.2.3.4 | 1002003004 |
  592. +----------+------------+
  593. =cut
  594. sub calc_version {
  595. my @v = split /\./, $_[0];
  596. my $version = 0;
  597. my $i;
  598. for ( $i = 0 ; $i <= $#v ; $i++ ) {
  599. $version *= 1000;
  600. $version += $v[$i];
  601. }
  602. return $version;
  603. }
  604. =item script_version
  605. Sorting function for database upgrade scripts.
  606. =cut
  607. sub script_version {
  608. my ( $my_a, $my_b ) = ( $a, $b );
  609. my ( $a_from, $a_to, $b_from, $b_to );
  610. my ( $res_a, $res_b, $i );
  611. $my_a =~ s/.*-upgrade-//;
  612. $my_a =~ s/.sql$//;
  613. $my_b =~ s/.*-upgrade-//;
  614. $my_b =~ s/.sql$//;
  615. ( $a_from, $a_to ) = split( /-/, $my_a );
  616. ( $b_from, $b_to ) = split( /-/, $my_b );
  617. $res_a = calc_version($a_from);
  618. $res_b = calc_version($b_from);
  619. if ( $res_a == $res_b ) {
  620. $res_a = calc_version($a_to);
  621. $res_b = calc_version($b_to);
  622. }
  623. return $res_a <=> $res_b;
  624. }
  625. =item $user->save_member();
  626. Updates the user config in the database for the user $user. If no config for
  627. the user exists, the user to the database.
  628. =cut
  629. sub save_member {
  630. my ($self) = @_;
  631. # replace \r\n with \n
  632. for (qw(address signature)) { $self->{$_} =~ s/\r?\n/\\n/g }
  633. # use central db
  634. my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH};
  635. #check to see if the user exists already
  636. my $userCheck = $dbh->prepare("SELECT id FROM users WHERE username = ?");
  637. $userCheck->execute( $self->{login} );
  638. my ($userID) = $userCheck->fetchrow_array;
  639. if ( !$self->{dbhost} ) {
  640. $self->{dbhost} = 'localhost';
  641. }
  642. if ( !$self->{dbport} ) {
  643. $self->{dbport} = '5432';
  644. }
  645. my $userConfExists = 0;
  646. if ($userID) {
  647. #got an id, check to see if it's in the users_conf table
  648. my $userConfCheck =
  649. $dbh->prepare("SELECT password, 1 FROM users_conf WHERE id = ?");
  650. $userConfCheck->execute($userID);
  651. ( $oldPassword, $userConfExists ) = $userConfCheck->fetchrow_array;
  652. }
  653. else {
  654. my $userConfAdd = $dbh->prepare("SELECT create_user(?);");
  655. $userConfAdd->execute( $self->{login} );
  656. ($userID) = $userConfAdd->fetchrow_array;
  657. }
  658. if ($userConfExists) {
  659. # for now, this is updating the table directly... ugly
  660. my $userConfUpdate = $dbh->prepare(
  661. "UPDATE users_conf
  662. SET acs = ?, address = ?, businessnumber = ?,
  663. company = ?, countrycode = ?, currency = ?,
  664. dateformat = ?, dbdriver = ?,
  665. dbhost = ?, dbname = ?, dboptions = ?,
  666. dbpasswd = ?, dbport = ?, dbuser = ?,
  667. email = ?, fax = ?, menuwidth = ?,
  668. name = ?, numberformat = ?,
  669. print = ?, printer = ?, role = ?,
  670. sid = ?, signature = ?, stylesheet = ?,
  671. tel = ?, templates = ?, timeout = ?,
  672. vclimit = ?
  673. WHERE id = ?;"
  674. );
  675. $userConfUpdate->execute(
  676. $self->{acs}, $self->{address},
  677. $self->{businessnumber}, $self->{company},
  678. $self->{countrycode}, $self->{currency},
  679. $self->{dateformat}, $self->{dbdriver},
  680. $self->{dbhost}, $self->{dbname},
  681. $self->{dboptions}, $self->{dbpasswd},
  682. $self->{dbport}, $self->{dbuser},
  683. $self->{email}, $self->{fax},
  684. $self->{menuwidth}, $self->{name},
  685. $self->{numberformat}, $self->{print},
  686. $self->{printer}, $self->{role},
  687. $self->{sid}, $self->{signature},
  688. $self->{stylesheet}, $self->{tel},
  689. $self->{templates}, $self->{timeout},
  690. $self->{vclimit}, $userID
  691. );
  692. if ( $oldPassword ne $self->{password} ) {
  693. # if they're supplying a 32 char password that matches their old password
  694. # assume they don't want to change passwords
  695. $userConfUpdate = $dbh->prepare(
  696. "UPDATE users_conf
  697. SET password = md5(?)
  698. WHERE id = ?"
  699. );
  700. $userConfUpdate->execute( $self->{password}, $userID );
  701. }
  702. }
  703. else {
  704. my $userConfInsert = $dbh->prepare(
  705. "INSERT INTO users_conf(acs, address, businessnumber,
  706. company, countrycode, currency,
  707. dateformat, dbdriver,
  708. dbhost, dbname, dboptions, dbpasswd,
  709. dbport, dbuser, email, fax, menuwidth,
  710. name, numberformat, print, printer, role,
  711. sid, signature, stylesheet, tel, templates,
  712. timeout, vclimit, id, password)
  713. VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?,
  714. ?, ?, ?, ?, ?, ?, ?, ?, ?, ?,
  715. ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, md5(?));"
  716. );
  717. $userConfInsert->execute(
  718. $self->{acs}, $self->{address},
  719. $self->{businessnumber}, $self->{company},
  720. $self->{countrycode}, $self->{currency},
  721. $self->{dateformat}, $self->{dbdriver},
  722. $self->{dbhost}, $self->{dbname},
  723. $self->{dboptions}, $self->{dbpasswd},
  724. $self->{dbport}, $self->{dbuser},
  725. $self->{email}, $self->{fax},
  726. $self->{menuwidth}, $self->{name},
  727. $self->{numberformat}, $self->{print},
  728. $self->{printer}, $self->{role},
  729. $self->{sid}, $self->{signature},
  730. $self->{stylesheet}, $self->{tel},
  731. $self->{templates}, $self->{timeout},
  732. $self->{vclimit}, $userID,
  733. $self->{password}
  734. );
  735. }
  736. if ( !$self->{'admin'} ) {
  737. $self->{dbpasswd} =~ s/\\'/'/g;
  738. $self->{dbpasswd} =~ s/\\\\/\\/g;
  739. # format dbconnect and dboptions string
  740. &dbconnect_vars( $self, $self->{dbname} );
  741. # check if login is in database
  742. my $dbh = DBI->connect(
  743. $self->{dbconnect}, $self->{dbuser},
  744. $self->{dbpasswd}, { AutoCommit => 0 }
  745. ) or $self->error($DBI::errstr);
  746. $dbh->{pg_enable_utf8} = 1;
  747. # add login to employees table if it does not exist
  748. my $login = $self->{login};
  749. $login =~ s/@.*//;
  750. my $sth = $dbh->prepare("SELECT id FROM employee WHERE login = ?;");
  751. $sth->execute($login);
  752. my ($id) = $sth->fetchrow_array;
  753. $sth->finish;
  754. my $employeenumber;
  755. my @values;
  756. if ($id) {
  757. $query = qq|UPDATE employee SET
  758. role = ?,
  759. email = ?,
  760. name = ?
  761. WHERE login = ?|;
  762. @values = ( $self->{role}, $self->{email}, $self->{name}, $login );
  763. }
  764. else {
  765. my ($employeenumber) =
  766. Form::update_defaults( "", \%$self, "employeenumber", $dbh );
  767. $query = qq|
  768. INSERT INTO employee
  769. (login, employeenumber, name,
  770. workphone, role, email, sales)
  771. VALUES (?, ?, ?, ?, ?, ?, '1')|;
  772. @values = (
  773. $login, $employeenumber, $self->{name},
  774. $self->{tel}, $self->{role}, $self->{email}
  775. );
  776. }
  777. $sth = $dbh->prepare($query);
  778. $sth->execute(@values);
  779. $dbh->commit;
  780. $dbh->disconnect;
  781. }
  782. }
  783. =item LedgerSMB::User->delete_login($form);
  784. Disused function to delete the user $form->{login}.
  785. =cut
  786. sub delete_login {
  787. my ( $self, $form ) = @_;
  788. my $dbh = DBI->connect(
  789. $form->{dbconnect}, $form->{dbuser},
  790. $form->{dbpasswd}, { AutoCommit => 0 }
  791. ) or $form->dberror( __FILE__ . ':' . __LINE__ );
  792. $dbh->{pg_enable_utf8} = 1;
  793. my $login = $form->{login};
  794. $login =~ s/@.*//;
  795. my $query = qq|SELECT id FROM employee WHERE login = ?|;
  796. my $sth = $dbh->prepare($query);
  797. $sth->execute($login)
  798. || $form->dberror( __FILE__ . ':' . __LINE__ . ': ' . $query );
  799. my ($id) = $sth->fetchrow_array;
  800. $sth->finish;
  801. my $query = qq|
  802. UPDATE employee
  803. SET login = NULL,
  804. enddate = current_date
  805. WHERE login = ?|;
  806. $sth = $dbh->prepare($query);
  807. $sth->execute($login);
  808. $dbh->commit;
  809. $dbh->disconnect;
  810. }
  811. =item LedgerSMB::User->config_vars();
  812. Disused function that returns a list of user config variable names.
  813. =cut
  814. sub config_vars {
  815. my @conf = qw(acs address businessnumber company countrycode
  816. currency dateformat dbconnect dbdriver dbhost dbname dboptions
  817. dbpasswd dbport dbuser email fax menuwidth name numberformat
  818. password printer role sid signature stylesheet tel templates
  819. timeout vclimit);
  820. @conf;
  821. }
  822. =item $self->error($msg);
  823. Privately used error function. Used in places where the more typically used
  824. $form->error cannot be used. Always dies.
  825. =cut
  826. sub error {
  827. my ( $self, $msg ) = @_;
  828. if ( $ENV{GATEWAY_INTERFACE} ) {
  829. print qq|Content-Type: text/html\n\n|
  830. . qq|<body bgcolor=ffffff>\n\n|
  831. . qq|<h2><font color=red>Error!</font></h2>\n|
  832. . qq|<p><b>$msg</b>|;
  833. }
  834. die "Error: $msg\n";
  835. }
  836. 1;
  837. =back