summaryrefslogtreecommitdiff
path: root/LedgerSMB/AM.pm
blob: e1ff4043de346a562f744dc50f253a99f511f2ad (plain)
  1. =head1 NAME
  2. AM
  3. =head1 SYNOPSIS
  4. This module provides some administrative functions
  5. =head1 COPYRIGHT
  6. #====================================================================
  7. # LedgerSMB
  8. # Small Medium Business Accounting software
  9. # http://www.ledgersmb.org/
  10. #
  11. # Copyright (C) 2006
  12. # This work contains copyrighted information from a number of sources
  13. # all used with permission.
  14. #
  15. # This file contains source code included with or based on SQL-Ledger
  16. # which is Copyright Dieter Simader and DWS Systems Inc. 2000-2005
  17. # and licensed under the GNU General Public License version 2 or, at
  18. # your option, any later version. For a full list including contact
  19. # information of contributors, maintainers, and copyright holders,
  20. # see the CONTRIBUTORS file.
  21. #
  22. # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
  23. # Copyright (C) 2000
  24. #
  25. # Author: DWS Systems Inc.
  26. # Web: http://www.sql-ledger.org
  27. #
  28. # Contributors: Jim Rawlings <jim@your-dba.com>
  29. #
  30. #====================================================================
  31. #
  32. # This file has undergone whitespace cleanup.
  33. #
  34. #====================================================================
  35. #
  36. # Administration module
  37. # Chart of Accounts
  38. # template routines
  39. # preferences
  40. #
  41. #====================================================================
  42. =head1 METHODS
  43. =over
  44. =cut
  45. package AM;
  46. use LedgerSMB::Tax;
  47. use LedgerSMB::Sysconfig;
  48. =item AM->get_account($myconfig, $form);
  49. Populates the $form attributes accno, description, charttype, gifi_accno,
  50. category, link, and contra with details about the account that has the id
  51. $form->{id}. If there are no acc_trans entries that refer to that account,
  52. $form->{orphaned} is made true, otherwise $form->{orphaned} is set to false.
  53. Also populates 'inventory_accno_id', 'income_accno_id', 'expense_accno_id',
  54. 'fxgain_accno_id', and 'fxloss_accno_id' with the values from defaults.
  55. $myconfig is unused.
  56. =cut
  57. sub get_account {
  58. my ( $self, $myconfig, $form ) = @_;
  59. my $dbh = $form->{dbh};
  60. my $query = qq|
  61. SELECT accno, description, charttype, gifi_accno,
  62. category, link, contra
  63. FROM chart
  64. WHERE id = ?|;
  65. my $sth = $dbh->prepare($query);
  66. $sth->execute( $form->{id} ) || $form->dberror($query);
  67. my $ref = $sth->fetchrow_hashref(NAME_lc);
  68. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  69. $sth->finish;
  70. # get default accounts
  71. $query = qq|
  72. SELECT (SELECT value FROM defaults
  73. WHERE setting_key = 'inventory_accno_id')
  74. AS inventory_accno_id,
  75. (SELECT value FROM defaults
  76. WHERE setting_key = 'income_accno_id')
  77. AS income_accno_id,
  78. (SELECT value FROM defaults
  79. WHERE setting_key = 'expense_accno_id')
  80. AS expense_accno_id,
  81. (SELECT value FROM defaults
  82. WHERE setting_key = 'fxgain_accno_id')
  83. AS fxgain_accno_id,
  84. (SELECT value FROM defaults
  85. WHERE setting_key = 'fxloss_accno_id')
  86. AS fxloss_accno_id|;
  87. $sth = $dbh->prepare($query);
  88. $sth->execute || $form->dberror($query);
  89. $ref = $sth->fetchrow_hashref(NAME_lc);
  90. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  91. $sth->finish;
  92. # check if we have any transactions
  93. $query = qq|
  94. SELECT trans_id
  95. FROM acc_trans
  96. WHERE chart_id = ?
  97. LIMIT 1|;
  98. $sth = $dbh->prepare($query);
  99. $sth->execute( $form->{id} );
  100. ( $form->{orphaned} ) = $sth->fetchrow_array();
  101. $form->{orphaned} = !$form->{orphaned};
  102. $dbh->commit;
  103. }
  104. =item AM->save_account($myconfig, $form);
  105. Adds or updates an account in the chart of accounts. If $form->{id} is set,
  106. the existing account with an id of $form->{id} is updated, otherwise a new
  107. account is created. The values for accno, description, charttype, gifi_accno,
  108. category, and contra are taken directly from the $form attributes of the same
  109. name. The link value is generated in $form->{link} as a colon seperated list of
  110. non-empty values from the $form attributes 'AR', 'AR_amount', 'AR_tax',
  111. 'AR_paid', 'AP', 'AP_amount', 'AP_tax', 'AP_paid', 'IC', 'IC_income', 'IC_sale',
  112. 'IC_expense', 'IC_cogs', 'IC_taxpart', and 'IC_taxservice'.
  113. If the account is a tax account, indicated by any of IC_taxpart, IC_taxservice,
  114. AR_tax, and AP_tax being true, and there is no entry in the tax table for the
  115. account, a tax entry is added for the account. If none of those tax flags are
  116. set and this function is updating an existing account, all entries in the tax
  117. table for the account are deleted.
  118. $myconfig is unused.
  119. =cut
  120. sub save_account {
  121. my ( $self, $myconfig, $form ) = @_;
  122. # connect to database, turn off AutoCommit
  123. my $dbh = $form->{dbh};
  124. $form->{link} = "";
  125. foreach my $item (
  126. $form->{AR}, $form->{AR_amount}, $form->{AR_tax}, $form->{AR_overpayment},
  127. $form->{AR_paid}, $form->{AP}, $form->{AP_amount}, $form->{AP_overpayment},
  128. $form->{AP_tax}, $form->{AP_paid}, $form->{IC},
  129. $form->{IC_income}, $form->{IC_sale}, $form->{IC_expense},
  130. $form->{IC_cogs}, $form->{IC_taxpart}, $form->{IC_taxservice}
  131. )
  132. {
  133. $form->{link} .= "${item}:" if ($item);
  134. }
  135. chop $form->{link};
  136. # strip blanks from accno
  137. for (qw(accno gifi_accno)) { $form->{$_} =~ s/( |')//g }
  138. foreach my $item (qw(accno gifi_accno description)) {
  139. $form->{$item} =~ s/-(-+)/-/g;
  140. $form->{$item} =~ s/ ( )+/ /g;
  141. }
  142. my $query;
  143. my $sth;
  144. $form->{contra} *= 1;
  145. my @queryargs;
  146. @queryargs = (
  147. $form->{accno}, $form->{description}, $form->{charttype},
  148. $form->{gifi_accno}, $form->{category}, $form->{"link"},
  149. $form->{contra}
  150. );
  151. # if we have an id then replace the old record
  152. if ( $form->{id} ) {
  153. $query = qq|
  154. UPDATE chart SET accno = ?,
  155. description = ?,
  156. charttype = ?,
  157. gifi_accno = ?,
  158. category = ?,
  159. link = ?,
  160. contra = ?
  161. WHERE id = ?|;
  162. push @queryargs, $form->{id};
  163. }
  164. else {
  165. $query = qq|
  166. INSERT INTO chart
  167. (accno, description, charttype,
  168. gifi_accno, category, link, contra)
  169. VALUES (?, ?, ?, ?, ?, ?, ?)|;
  170. }
  171. $sth = $dbh->prepare($query);
  172. $sth->execute(@queryargs) || $form->dberror($query);
  173. $sth->finish;
  174. $chart_id = $dbh->quote( $form->{id} );
  175. if ( !$form->{id} ) {
  176. # get id from chart
  177. $query = qq|
  178. SELECT id
  179. FROM chart
  180. WHERE accno = ?|;
  181. $sth = $dbh->prepare($query);
  182. $sth->execute( $form->{accno} );
  183. ($chart_id) = $sth->fetchrow_array();
  184. $sth->finish;
  185. }
  186. if ( $form->{IC_taxpart}
  187. || $form->{IC_taxservice}
  188. || $form->{AR_tax}
  189. || $form->{AP_tax} )
  190. {
  191. # add account if it doesn't exist in tax
  192. $query = qq|SELECT chart_id
  193. FROM tax
  194. WHERE chart_id = $chart_id|;
  195. my ($tax_id) = $dbh->selectrow_array($query);
  196. # add tax if it doesn't exist
  197. unless ($tax_id) {
  198. $query = qq|INSERT INTO tax (chart_id, rate)
  199. VALUES ($chart_id, 0)|;
  200. $dbh->do($query) || $form->dberror($query);
  201. }
  202. }
  203. else {
  204. # remove tax
  205. if ( $form->{id} ) {
  206. $query = qq|DELETE FROM tax
  207. WHERE chart_id = $form->{id}|;
  208. $dbh->do($query) || $form->dberror($query);
  209. }
  210. }
  211. # commit
  212. my $rc = $dbh->commit;
  213. $rc;
  214. }
  215. =item AM->delete_account($myconfig, $form);
  216. Deletes the account with the id $form->{id}. Calls $form->error if there are
  217. any acc_trans entries that reference it. If any parts have that account for
  218. an inventory, income, or COGS (expense) account, switch the part to using the
  219. default account for that type. Also deletes all tax, partstax, customertax, and
  220. vendortax table entries for the account.
  221. $myconfig is unused.
  222. =cut
  223. sub delete_account {
  224. my ( $self, $myconfig, $form ) = @_;
  225. # connect to database, turn off AutoCommit
  226. my $dbh = $form->{dbh};
  227. my $sth;
  228. my $query = qq|
  229. SELECT count(*)
  230. FROM acc_trans
  231. WHERE chart_id = ?|;
  232. $sth = $dbh->prepare($query);
  233. $sth->execute( $form->{id} );
  234. my ($rowcount) = $sth->fetchrow_array();
  235. if ($rowcount) {
  236. $form->error( "Cannot delete accounts with associated transactions!" );
  237. }
  238. # delete chart of account record
  239. $query = qq|
  240. DELETE FROM chart
  241. WHERE id = ?|;
  242. $sth = $dbh->prepare($query);
  243. $sth->execute( $form->{id} ) || $form->dberror($query);
  244. # set inventory_accno_id, income_accno_id, expense_accno_id to defaults
  245. $query = qq|
  246. UPDATE parts
  247. SET inventory_accno_id = (SELECT value::int
  248. FROM defaults
  249. WHERE setting_key =
  250. 'inventory_accno_id')
  251. WHERE inventory_accno_id = ?|;
  252. $sth = $dbh->prepare($query);
  253. $sth->execute( $form->{id} ) || $form->dberror($query);
  254. for (qw(income_accno_id expense_accno_id)) {
  255. $query = qq|
  256. UPDATE parts
  257. SET $_ = (SELECT value::int
  258. FROM defaults
  259. WHERE setting_key = '$_')
  260. WHERE $_ = ?|;
  261. $sth = $dbh->prepare($query);
  262. $sth->execute( $form->{id} ) || $form->dberror($query);
  263. $sth->finish;
  264. }
  265. foreach my $table (qw(partstax customertax vendortax tax)) {
  266. $query = qq|
  267. DELETE FROM $table
  268. WHERE chart_id = ?|;
  269. $sth = $dbh->prepare($query);
  270. $sth->execute( $form->{id} ) || $form->dberror($query);
  271. $sth->finish;
  272. }
  273. # commit and redirect
  274. my $rc = $dbh->commit;
  275. $rc;
  276. }
  277. =item AM->gifi_accounts($myconfig, $form);
  278. Populates the list referred to as $form->{ALL} with hashes of gifi numbers and
  279. descriptions in order of the GIFI number. The GIFI number referred to as
  280. 'accno'.
  281. $myconfig is not used.
  282. =cut
  283. sub gifi_accounts {
  284. my ( $self, $myconfig, $form ) = @_;
  285. # connect to database
  286. my $dbh = $form->{dbh};
  287. my $query = qq|
  288. SELECT accno, description
  289. FROM gifi
  290. ORDER BY accno|;
  291. $sth = $dbh->prepare($query);
  292. $sth->execute || $form->dberror($query);
  293. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  294. push @{ $form->{ALL} }, $ref;
  295. }
  296. $sth->finish;
  297. $dbh->commit;
  298. }
  299. =item AM->get_gifi($myconfig, $form);
  300. Sets $form->{description} to the description of the GIFI number $form->{accno}.
  301. Sets $form->{orphaned} to true if there are no entries in acc_trans that refer
  302. to this GIFI and to false otherwise.
  303. $myconfig is not used.
  304. =cut
  305. sub get_gifi {
  306. my ( $self, $myconfig, $form ) = @_;
  307. # connect to database
  308. my $dbh = $form->{dbh};
  309. my $sth;
  310. my $query = qq|
  311. SELECT accno, description
  312. FROM gifi
  313. WHERE accno = ?|;
  314. $sth = $dbh->prepare($query);
  315. $sth->execute( $form->{accno} ) || $form->dberror($query);
  316. ( $form->{accno}, $form->{description} ) = $sth->fetchrow_array();
  317. $sth->finish;
  318. # check for transactions
  319. $query = qq|
  320. SELECT count(*)
  321. FROM acc_trans a
  322. JOIN chart c ON (a.chart_id = c.id)
  323. JOIN gifi g ON (c.gifi_accno = g.accno)
  324. WHERE g.accno = ?|;
  325. $sth = $dbh->prepare($query);
  326. $sth->execute( $form->{accno} ) || $form->dberror($query);
  327. ($numrows) = $sth->fetchrow_array;
  328. if ( ( $numrows * 1 ) == 0 ) {
  329. $form->{orphaned} = 1;
  330. }
  331. else {
  332. $form->{orphaned} = 0;
  333. }
  334. $dbh->commit;
  335. }
  336. =item AM->save_gifi($myconfig, $form);
  337. Adds or updates a GIFI record. If $form->{id} is set, update the gifi record
  338. that has that as an account number. The new values for an added or updated
  339. record are stored in $form->{accno} and $form->{description}.
  340. $myconfig is not used.
  341. =cut
  342. sub save_gifi {
  343. my ( $self, $myconfig, $form ) = @_;
  344. my $dbh = $form->{dbh};
  345. $form->{accno} =~ s/( |')//g;
  346. foreach my $item (qw(accno description)) {
  347. $form->{$item} =~ s/-(-+)/-/g;
  348. $form->{$item} =~ s/ ( )+/ /g;
  349. }
  350. my @queryargs = ( $form->{accno}, $form->{description} );
  351. # id is the old account number!
  352. if ( $form->{id} ) {
  353. $query = qq|
  354. UPDATE gifi
  355. SET accno = ?,
  356. description = ?
  357. WHERE accno = ?|;
  358. push @queryargs, $form->{id};
  359. }
  360. else {
  361. $query = qq|
  362. INSERT INTO gifi (accno, description)
  363. VALUES (?, ?)|;
  364. }
  365. $sth = $dbh->prepare($query);
  366. $sth->execute(@queryargs) || $form->dberror($query);
  367. $sth->finish;
  368. $dbh->commit;
  369. }
  370. =item AM->delete_gifi($myconfig, $form);
  371. Deletes the gifi record with the GIFI number $form->{id}.
  372. $myconfig is not used.
  373. =cut
  374. sub delete_gifi {
  375. my ( $self, $myconfig, $form ) = @_;
  376. # connect to database
  377. my $dbh = $form->{dbh};
  378. # id is the old account number!
  379. $query = qq|
  380. DELETE FROM gifi
  381. WHERE accno = ?|;
  382. $sth = $dbh->prepare($query);
  383. $sth->execute( $form->{id} ) || $form->dberror($query);
  384. $sth->finish;
  385. $dbh->commit;
  386. }
  387. =item AM->warehouses($myconfig, $form);
  388. Populates the list referred to as $form->{ALL} with hashes describing
  389. warehouses, ordered according to the logic of $form->sort_order. Each hash has
  390. an id and a description element.
  391. $myconfig is not used.
  392. =cut
  393. sub warehouses {
  394. my ( $self, $myconfig, $form ) = @_;
  395. # connect to database
  396. my $dbh = $form->{dbh};
  397. $form->sort_order();
  398. my $query = qq|
  399. SELECT id, description
  400. FROM warehouse
  401. ORDER BY description $form->{direction}|;
  402. $sth = $dbh->prepare($query);
  403. $sth->execute || $form->dberror($query);
  404. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  405. push @{ $form->{ALL} }, $ref;
  406. }
  407. $sth->finish;
  408. $dbh->commit;
  409. }
  410. =item AM->get_warehouse($myconfig, $form);
  411. Sets $form->{description} to the name of the warehouse $form->{id}. If no
  412. inventory is currently linked to the warehouse, set $form->{orphaned} to true,
  413. otherwise $form->{orphaned} is false.
  414. $myconfig is not used.
  415. =cut
  416. sub get_warehouse {
  417. my ( $self, $myconfig, $form ) = @_;
  418. # connect to database
  419. my $dbh = $form->{dbh};
  420. my $sth;
  421. my $query = qq|
  422. SELECT description
  423. FROM warehouse
  424. WHERE id = ?|;
  425. $sth = $dbh->prepare($query);
  426. $sth->execute( $form->{id} ) || $form->dberror($query);
  427. ( $form->{description} ) = $sth->fetchrow_array;
  428. $sth->finish;
  429. # see if it is in use
  430. $query = qq|
  431. SELECT count(*)
  432. FROM inventory
  433. WHERE warehouse_id = ?|;
  434. $sth = $dbh->prepare($query);
  435. $sth->execute( $form->{id} );
  436. ( $form->{orphaned} ) = $sth->fetchrow_array;
  437. if ( ( $form->{orphaned} * 1 ) == 0 ) {
  438. $form->{orphaned} = 1;
  439. }
  440. else {
  441. $form->{orphaned} = 0;
  442. }
  443. $dbh->commit;
  444. }
  445. =item AM->save_warehouse($myconfig, $form);
  446. Add or update a warehouse. If $form->{id} is set, that warehouse is updated
  447. instead of adding a new warehouse. In both cases, the description of the
  448. warehouse is set to $form->{description}.
  449. $myconfig is not used.
  450. =cut
  451. sub save_warehouse {
  452. my ( $self, $myconfig, $form ) = @_;
  453. # connect to database
  454. my $dbh = $form->{dbh};
  455. my $sth;
  456. my @queryargs = ( $form->{description} );
  457. $form->{description} =~ s/-(-)+/-/g;
  458. $form->{description} =~ s/ ( )+/ /g;
  459. if ( $form->{id} ) {
  460. $query = qq|
  461. UPDATE warehouse
  462. SET description = ?
  463. WHERE id = ?|;
  464. push @queryargs, $form->{id};
  465. }
  466. else {
  467. $query = qq|
  468. INSERT INTO warehouse (description)
  469. VALUES (?)|;
  470. }
  471. $sth = $dbh->prepare($query);
  472. $sth->execute(@queryargs) || $form->dberror($query);
  473. $sth->finish;
  474. $dbh->commit;
  475. }
  476. =item AM->delete_warehouse($myconfig, $form);
  477. Deletes the warehouse with the id $form->{id}.
  478. $myconfig is not used.
  479. =cut
  480. sub delete_warehouse {
  481. my ( $self, $myconfig, $form ) = @_;
  482. # connect to database
  483. my $dbh = $form->{dbh};
  484. $query = qq|
  485. DELETE FROM warehouse
  486. WHERE id = ?|;
  487. $dbh->prepare($query)->execute( $form->{id} ) || $form->dberror($query);
  488. $dbh->commit;
  489. }
  490. =item AM->departments($myconfig, $form);
  491. Populate the list referred to as $form->{ALL} with hashes of details about
  492. departments. The hashes all contain the id, description, and role of the
  493. department and are ordered by the description.
  494. $myconfig is unused.
  495. =cut
  496. sub departments {
  497. my ( $self, $myconfig, $form ) = @_;
  498. # connect to database
  499. my $dbh = $form->{dbh};
  500. $form->sort_order();
  501. my $query = qq|SELECT id, description, role
  502. FROM department
  503. ORDER BY description $form->{direction}|;
  504. $sth = $dbh->prepare($query);
  505. $sth->execute || $form->dberror($query);
  506. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  507. push @{ $form->{ALL} }, $ref;
  508. }
  509. $sth->finish;
  510. $dbh->commit;
  511. }
  512. =item AM->get_department($myconfig, $form);
  513. Fills $form->{description} and $form->{role} with details about the department
  514. with the id value of $form->{id}. If the department has not been used as part
  515. of a transaction referred to in dpt_trans, set $form->{orphaned} to true,
  516. otherwise it is set to false.
  517. $myconfig is unused.
  518. =cut
  519. sub get_department {
  520. my ( $self, $myconfig, $form ) = @_;
  521. # connect to database
  522. my $dbh = $form->{dbh};
  523. my $sth;
  524. my $query = qq|
  525. SELECT description, role
  526. FROM department
  527. WHERE id = ?|;
  528. $sth = $dbh->prepare($query);
  529. $sth->execute( $form->{id} );
  530. ( $form->{description}, $form->{role} ) = $sth->fetchrow_array;
  531. $sth->finish;
  532. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  533. # see if it is in use
  534. $query = qq|
  535. SELECT count(*)
  536. FROM dpt_trans
  537. WHERE department_id = ? |;
  538. $sth = $dbh->prepare($query);
  539. $sth->execute( $form->{id} );
  540. ( $form->{orphaned} ) = $sth->fetchrow_array;
  541. if ( ( $form->{orphaned} * 1 ) == 0 ) {
  542. $form->{orphaned} = 1;
  543. }
  544. else {
  545. $form->{orphaned} = 0;
  546. }
  547. $dbh->commit;
  548. }
  549. =item AM->save_department($myconfig, $form);
  550. Add or update a department record. If $form->{id} is set, the department with
  551. that id is updated, otherwise a new department is added. The department role
  552. (either 'C' for cost centres or 'P' for profit centres) and description is
  553. taken from the $form attributes 'role' and 'description'.
  554. $myconfig is unused.
  555. =cut
  556. sub save_department {
  557. my ( $self, $myconfig, $form ) = @_;
  558. # connect to database
  559. my $dbh = $form->{dbh};
  560. $form->{description} =~ s/-(-)+/-/g;
  561. $form->{description} =~ s/ ( )+/ /g;
  562. my $sth;
  563. my @queryargs = ( $form->{description}, $form->{role} );
  564. if ( $form->{id} ) {
  565. $query = qq|
  566. UPDATE department
  567. SET description = ?,
  568. role = ?
  569. WHERE id = ?|;
  570. push @queryargs, $form->{id};
  571. }
  572. else {
  573. $query = qq|
  574. INSERT INTO department (description, role)
  575. VALUES (?, ?)|;
  576. }
  577. $sth = $dbh->prepare($query);
  578. $sth->execute(@queryargs) || $form->dberror($query);
  579. $dbh->commit;
  580. }
  581. =item AM->delete_department($myconfig, $form)
  582. Deletes the department with an id of $form->{id}.
  583. $myconfig is unused.
  584. =cut
  585. sub delete_department {
  586. my ( $self, $myconfig, $form ) = @_;
  587. # connect to database
  588. my $dbh = $form->{dbh};
  589. $query = qq|
  590. DELETE FROM department
  591. WHERE id = ?|;
  592. $dbh->prepare($query)->execute( $form->{id} );
  593. $dbh->commit;
  594. }
  595. =item AM->business($myconfig, $form);
  596. Populates the list referred to as $form->{ALL} with hashes containing details
  597. about all known types of business. Each hash contains the id, description, and
  598. discount for businesses of this type. The discount is represented in numeric
  599. form, such that a 10% discount is stored and retrieved as 0.1. The hashes are
  600. sorted by the business description.
  601. $myconfig is unused.
  602. =cut
  603. sub business {
  604. my ( $self, $myconfig, $form ) = @_;
  605. # connect to database
  606. my $dbh = $form->{dbh};
  607. $form->sort_order();
  608. my $query = qq|
  609. SELECT id, description, discount
  610. FROM business
  611. ORDER BY description $form->{direction}|;
  612. $sth = $dbh->prepare($query);
  613. $sth->execute || $form->dberror($query);
  614. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  615. push @{ $form->{ALL} }, $ref;
  616. }
  617. $sth->finish;
  618. $dbh->commit;
  619. }
  620. =item AM->get_business($myconfig, $form);
  621. Places the description and discount for the business with an id of $form->{id}
  622. into $form->{description} and $form->{discount}.
  623. $myconfig is unused.
  624. =cut
  625. sub get_business {
  626. my ( $self, $myconfig, $form ) = @_;
  627. # connect to database
  628. my $dbh = $form->{dbh};
  629. my $query = qq|
  630. SELECT description, discount
  631. FROM business
  632. WHERE id = ?|;
  633. $sth = $dbh->prepare($query);
  634. $sth->execute( $form->{id} );
  635. ( $form->{description}, $form->{discount} ) = $sth->fetchrow_array();
  636. $dbh->commit;
  637. }
  638. =item AM->save_business($myconfig, $form);
  639. Adds or updates a type of business. If $form->{id} is set, the business type
  640. with a corresponding id is updated, otherwise a new type is added. The new
  641. description is $form->{description}. The discount taken as a percentage stored
  642. in $form->{discount}, which then value is divided by 100 in place and the
  643. multiplier is stored. As an example, if $form->{discount} is 10 when this
  644. function is called, it is changed to 0.1 and stored as 0.1.
  645. $myconfig is unused.
  646. =cut
  647. sub save_business {
  648. my ( $self, $myconfig, $form ) = @_;
  649. # connect to database
  650. my $dbh = $form->{dbh};
  651. $form->{description} =~ s/-(-)+/-/g;
  652. $form->{description} =~ s/ ( )+/ /g;
  653. $form->{discount} /= 100;
  654. my $sth;
  655. my @queryargs = ( $form->{description}, $form->{discount} );
  656. if ( $form->{id} ) {
  657. $query = qq|
  658. UPDATE business
  659. SET description = ?,
  660. discount = ?
  661. WHERE id = ?|;
  662. push @queryargs, $form->{id};
  663. }
  664. else {
  665. $query = qq|INSERT INTO business (description, discount)
  666. VALUES (?, ?)|;
  667. }
  668. $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query);
  669. $dbh->commit;
  670. }
  671. =item AM->delete_business($myconfig, $form);
  672. Deletes the business type with the id $form->{id}.
  673. $myconfig is unused.
  674. =cut
  675. sub delete_business {
  676. my ( $self, $myconfig, $form ) = @_;
  677. # connect to database
  678. my $dbh = $form->{dbh};
  679. $query = qq|
  680. DELETE FROM business
  681. WHERE id = ?|;
  682. $dbh->prepare($query)->execute( $form->{id} ) || $form->dberror($query);
  683. $dbh->commit;
  684. }
  685. =item AM->sic($myconfig, $form);
  686. Populate the list referred to as $form->{ALL} with hashes containing SIC (some
  687. well known systems of which are NAICS and ISIC) data from the sic table. code
  688. is the actual SIC code, description is a textual description of the code, and
  689. sictype is an indicator of whether or not the entry refers to a header. The
  690. hashes will be sorted by either the code or description.
  691. $myconfig is unused.
  692. =cut
  693. sub sic {
  694. my ( $self, $myconfig, $form ) = @_;
  695. # connect to database
  696. my $dbh = $form->{dbh};
  697. $form->{sort} = "code" unless $form->{sort};
  698. my @a = qw(code description);
  699. my %ordinal = (
  700. code => 1,
  701. description => 3
  702. );
  703. my $sortorder = $form->sort_order( \@a, \%ordinal );
  704. my $query = qq|SELECT code, sictype, description
  705. FROM sic
  706. ORDER BY $sortorder|;
  707. $sth = $dbh->prepare($query);
  708. $sth->execute || $form->dberror($query);
  709. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  710. push @{ $form->{ALL} }, $ref;
  711. }
  712. $sth->finish;
  713. $dbh->commit;
  714. }
  715. =item AM->get_sic($myconfig, $form);
  716. Retrieves the sictype and description for the SIC indicated by
  717. $form->{code} and places the retrieved values into $form->{sictype} and
  718. $form->{description}.
  719. $myconfig is unused
  720. =cut
  721. sub get_sic {
  722. my ( $self, $myconfig, $form ) = @_;
  723. # connect to database
  724. my $dbh = $form->{dbh};
  725. my $query = qq|
  726. SELECT code, sictype, description
  727. FROM sic
  728. WHERE code = | . $dbh->quote( $form->{code} );
  729. my $sth = $dbh->prepare($query);
  730. $sth->execute || $form->dberror($query);
  731. my $ref = $sth->fetchrow_hashref(NAME_lc);
  732. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  733. $sth->finish;
  734. $dbh->commit;
  735. }
  736. =item AM->save_sic($myconfig, $form);
  737. Add or update a SIC entry. If $form->{id} is set, take it as the original code
  738. to identify the entry update, otherwise treat it as a new entry. $form->{code},
  739. $form->{description}, and $form->{sictype} contain the new values. sictype is
  740. a single character to flag whether or not the entry is for a header ('H').
  741. $myconfig is unused.
  742. =cut
  743. sub save_sic {
  744. my ( $self, $myconfig, $form ) = @_;
  745. my $dbh = $form->{dbh};
  746. foreach my $item (qw(code description)) {
  747. $form->{$item} =~ s/-(-)+/-/g;
  748. }
  749. my $sth;
  750. @queryargs = ( $form->{code}, $form->{sictype}, $form->{description} );
  751. # if there is an id
  752. if ( $form->{id} ) {
  753. $query = qq|
  754. UPDATE sic
  755. SET code = ?,
  756. sictype = ?,
  757. description = ?
  758. WHERE code = ?)|;
  759. push @queryargs, $form->{id};
  760. }
  761. else {
  762. $query = qq|
  763. INSERT INTO sic (code, sictype, description)
  764. VALUES (?, ?, ?)|;
  765. }
  766. $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query);
  767. $dbh->commit;
  768. }
  769. =item AM->delete_sic($myconfig, $form);
  770. Deletes the SIC entry with the code $form->{code}.
  771. $myconfig is unused.
  772. =cut
  773. sub delete_sic {
  774. my ( $self, $myconfig, $form ) = @_;
  775. my $dbh = $form->{dbh};
  776. $query = qq|
  777. DELETE FROM sic
  778. WHERE code = ?|;
  779. $dbh->prepare($query)->execute( $form->{code} );
  780. $dbh->commit;
  781. }
  782. =item AM->language($myconfig, $form);
  783. Populates the list referred to as $form->{ALL} with hashes containing the code
  784. and description of all languages entered in the language table. The usual set
  785. of $form attributes affect the order in which the hashes are entered in the
  786. list.
  787. These language functions are unrelated to LedgerSMB::Locale, although these
  788. language codes are also used for non-UI templates and by LedgerSMB::PE.
  789. $myconfig is unused.
  790. =cut
  791. sub language {
  792. my ( $self, $myconfig, $form ) = @_;
  793. # connect to database
  794. my $dbh = $form->{dbh};
  795. $form->{sort} = "code" unless $form->{sort};
  796. my @a = qw(code description);
  797. my %ordinal = (
  798. code => 1,
  799. description => 2
  800. );
  801. my $sortorder = $form->sort_order( \@a, \%ordinal );
  802. my $query = qq|
  803. SELECT code, description
  804. FROM language
  805. ORDER BY $sortorder|;
  806. $sth = $dbh->prepare($query);
  807. $sth->execute || $form->dberror($query);
  808. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  809. push @{ $form->{ALL} }, $ref;
  810. }
  811. $sth->finish;
  812. $dbh->commit;
  813. }
  814. =item AM->get_language($myconfig, $form);
  815. Sets $form->{description} to the description of the language that has the code
  816. $form->{code}.
  817. $myconfig is unused.
  818. =cut
  819. sub get_language {
  820. my ( $self, $myconfig, $form ) = @_;
  821. # connect to database
  822. my $dbh = $form->{dbh};
  823. my $query = qq|
  824. SELECT code, description
  825. FROM language
  826. WHERE code = ?|;
  827. my $sth = $dbh->prepare($query);
  828. $sth->execute( $form->{code} ) || $form->dberror($query);
  829. my $ref = $sth->fetchrow_hashref(NAME_lc);
  830. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  831. $sth->finish;
  832. $dbh->commit;
  833. }
  834. =item AM->save_language($myconfig, $form);
  835. Add or update a language entry. If $form->{id} is set, the language entry that
  836. has that as a code is updated, otherwise a new entry is added. $form->{code}
  837. and $form->{description} contain the new values for the entry.
  838. $myconfig is unused.
  839. =cut
  840. sub save_language {
  841. my ( $self, $myconfig, $form ) = @_;
  842. # connect to database
  843. my $dbh = $form->{dbh};
  844. $form->{code} =~ s/ //g;
  845. foreach my $item (qw(code description)) {
  846. $form->{$item} =~ s/-(-)+/-/g;
  847. $form->{$item} =~ s/ ( )+/-/g;
  848. }
  849. my $sth;
  850. my @queryargs = ( $form->{code}, $form->{description} );
  851. # if there is an id
  852. if ( $form->{id} ) {
  853. $query = qq|
  854. UPDATE language
  855. SET code = ?,
  856. description = ?
  857. WHERE code = ?|;
  858. push @queryargs, $form->{id};
  859. }
  860. else {
  861. $query = qq|
  862. INSERT INTO language (code, description)
  863. VALUES (?, ?)|;
  864. }
  865. $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query);
  866. $dbh->commit;
  867. }
  868. =item AM->delete_language($myconfig, $form);
  869. Deletes the language entry with the code $form->{code}.
  870. $myconfig is unused.
  871. =cut
  872. sub delete_language {
  873. my ( $self, $myconfig, $form ) = @_;
  874. # connect to database
  875. my $dbh = $form->{dbh};
  876. $query = qq|
  877. DELETE FROM language
  878. WHERE code = | . $dbh->quote( $form->{code} );
  879. $dbh->do($query) || $form->dberror($query);
  880. }
  881. =item AM->recurring_transactions($myconfig, $form);
  882. Populates lists referred to in the form of $form->{transactions}{$type}, where
  883. the possible values for $type are 'ar', 'ap', 'gl', 'so', and 'po', with hashes
  884. containing details about recurring transactions of the $type variety. These
  885. hashes have the fields module (the frontend script that governs the transaction
  886. type), transaction (the transaction type), invoice (true if the transaction is
  887. an invoice), description (a field that is a customer, vendor, or in the case of
  888. a GL transaction, an arbitrary text field), amount (the cash value of the
  889. transaction), id (the id of the recurring transaction), reference (the
  890. reference value for the transaction), startdate (the date the recurring
  891. sequence started), nextdate (the date of the next occurrence of the event),
  892. enddate (the date the sequence ends), repeat (the number of units involved in
  893. the recurrence frequency), unit (the base recurrence unit), howmany (how many
  894. times the event occurs), payment (whether or not the event involves a payment),
  895. recurringemail (a colon separated list of forms to email as part of the event),
  896. recurringprint (a colon separated list of forms to print as part of the event),
  897. overdue (how many days until the next repetition of the event), vc (vendor,
  898. customer, or empty), exchangerate (the exchangerate involved on the day of the
  899. original transaction), curr (the currency of the event), and expired (if there
  900. will be no more recurrences).
  901. By default, these lists are sorted in order of the date of the next occurrence
  902. of the transaction. This order can be affected by the usual attributes used
  903. by $form->sort_order.
  904. $myconfig is unused.
  905. =cut
  906. sub recurring_transactions {
  907. my ( $self, $myconfig, $form ) = @_;
  908. my $dbh = $form->{dbh};
  909. my $query = qq|SELECT value FROM defaults where setting_key = 'curr'|;
  910. my ($defaultcurrency) = $dbh->selectrow_array($query);
  911. $defaultcurrency = $dbh->quote( $defaultcurrency =~ s/:.*//g );
  912. $form->{sort} ||= "nextdate";
  913. my @a = ( $form->{sort} );
  914. my $sortorder = $form->sort_order( \@a );
  915. $query = qq|
  916. SELECT 'ar' AS module, 'ar' AS transaction, a.invoice,
  917. e.name AS description, a.amount,
  918. s.*, se.formname AS recurringemail,
  919. sp.formname AS recurringprint,
  920. s.nextdate - current_date AS overdue,
  921. 'customer' AS vc,
  922. ex.buy AS exchangerate, a.curr,
  923. (s.nextdate IS NULL OR s.nextdate > s.enddate)
  924. AS expired
  925. FROM recurring s
  926. JOIN ar a ON (a.id = s.id)
  927. JOIN entity e ON (a.entity_id = e.id)
  928. LEFT JOIN recurringemail se ON (se.id = s.id)
  929. LEFT JOIN recurringprint sp ON (sp.id = s.id)
  930. LEFT JOIN exchangerate ex
  931. ON (ex.curr = a.curr AND a.transdate = ex.transdate)
  932. UNION
  933. SELECT 'ap' AS module, 'ap' AS transaction, a.invoice,
  934. e.name AS description, a.amount,
  935. s.*, se.formname AS recurringemail,
  936. sp.formname AS recurringprint,
  937. s.nextdate - current_date AS overdue, 'vendor' AS vc,
  938. ex.sell AS exchangerate, a.curr,
  939. (s.nextdate IS NULL OR s.nextdate > s.enddate)
  940. AS expired
  941. FROM recurring s
  942. JOIN ap a ON (a.id = s.id)
  943. JOIN entity e ON (a.entity_id = e.id)
  944. LEFT JOIN recurringemail se ON (se.id = s.id)
  945. LEFT JOIN recurringprint sp ON (sp.id = s.id)
  946. LEFT JOIN exchangerate ex ON
  947. (ex.curr = a.curr AND a.transdate = ex.transdate)
  948. UNION
  949. SELECT 'gl' AS module, 'gl' AS transaction, FALSE AS invoice,
  950. a.description, (SELECT SUM(ac.amount)
  951. FROM acc_trans ac
  952. WHERE ac.trans_id = a.id
  953. AND ac.amount > 0) AS amount,
  954. s.*, se.formname AS recurringemail,
  955. sp.formname AS recurringprint,
  956. s.nextdate - current_date AS overdue, '' AS vc,
  957. '1' AS exchangerate, $defaultcurrency AS curr,
  958. (s.nextdate IS NULL OR s.nextdate > s.enddate)
  959. AS expired
  960. FROM recurring s
  961. JOIN gl a ON (a.id = s.id)
  962. LEFT JOIN recurringemail se ON (se.id = s.id)
  963. LEFT JOIN recurringprint sp ON (sp.id = s.id)
  964. UNION
  965. SELECT 'oe' AS module, 'so' AS transaction, FALSE AS invoice,
  966. e.name AS description, a.amount,
  967. s.*, se.formname AS recurringemail,
  968. sp.formname AS recurringprint,
  969. s.nextdate - current_date AS overdue,
  970. 'customer' AS vc,
  971. ex.buy AS exchangerate, a.curr,
  972. (s.nextdate IS NULL OR s.nextdate > s.enddate)
  973. AS expired
  974. FROM recurring s
  975. JOIN oe a ON (a.id = s.id)
  976. JOIN entity e ON (a.entity_id = e.id)
  977. LEFT JOIN recurringemail se ON (se.id = s.id)
  978. LEFT JOIN recurringprint sp ON (sp.id = s.id)
  979. LEFT JOIN exchangerate ex ON
  980. (ex.curr = a.curr AND a.transdate = ex.transdate)
  981. WHERE a.quotation = '0'
  982. UNION
  983. SELECT 'oe' AS module, 'po' AS transaction, FALSE AS invoice,
  984. e.name AS description, a.amount,
  985. s.*, se.formname AS recurringemail,
  986. sp.formname AS recurringprint,
  987. s.nextdate - current_date AS overdue, 'vendor' AS vc,
  988. ex.sell AS exchangerate, a.curr,
  989. (s.nextdate IS NULL OR s.nextdate > s.enddate)
  990. AS expired
  991. FROM recurring s
  992. JOIN oe a ON (a.id = s.id)
  993. JOIN entity e ON (a.entity_id = e.id)
  994. LEFT JOIN recurringemail se ON (se.id = s.id)
  995. LEFT JOIN recurringprint sp ON (sp.id = s.id)
  996. LEFT JOIN exchangerate ex ON
  997. (ex.curr = a.curr AND a.transdate = ex.transdate)
  998. WHERE a.quotation = '0'
  999. ORDER BY $sortorder|;
  1000. my $sth = $dbh->prepare($query);
  1001. $sth->execute || $form->dberror($query);
  1002. my $id;
  1003. my $transaction;
  1004. my %e = ();
  1005. my %p = ();
  1006. while ( my $ref = $sth->fetchrow_hashref('NAME_lc') ) {
  1007. $ref->{exchangerate} ||= 1;
  1008. $form->db_parse_numeric(sth => $sth, hashref => $ref);
  1009. if ( $ref->{id} != $id ) {
  1010. if (%e) {
  1011. $form->{transactions}{$transaction}->[$i]->{recurringemail} =
  1012. "";
  1013. for ( keys %e ) {
  1014. $form->{transactions}{$transaction}->[$i]
  1015. ->{recurringemail} .= "${_}:";
  1016. }
  1017. chop $form->{transactions}{$transaction}->[$i]
  1018. ->{recurringemail};
  1019. }
  1020. if (%p) {
  1021. $form->{transactions}{$transaction}->[$i]->{recurringprint} =
  1022. "";
  1023. for ( keys %p ) {
  1024. $form->{transactions}{$transaction}->[$i]
  1025. ->{recurringprint} .= "${_}:";
  1026. }
  1027. chop $form->{transactions}{$transaction}->[$i]
  1028. ->{recurringprint};
  1029. }
  1030. %e = ();
  1031. %p = ();
  1032. push @{ $form->{transactions}{ $ref->{transaction} } }, $ref;
  1033. $id = $ref->{id};
  1034. $i = $#{ $form->{transactions}{ $ref->{transaction} } };
  1035. }
  1036. $transaction = $ref->{transaction};
  1037. $e{ $ref->{recurringemail} } = 1 if $ref->{recurringemail};
  1038. $p{ $ref->{recurringprint} } = 1 if $ref->{recurringprint};
  1039. }
  1040. $sth->finish;
  1041. # this is for the last row
  1042. if (%e) {
  1043. $form->{transactions}{$transaction}->[$i]->{recurringemail} = "";
  1044. for ( keys %e ) {
  1045. $form->{transactions}{$transaction}->[$i]->{recurringemail} .=
  1046. "${_}:";
  1047. }
  1048. chop $form->{transactions}{$transaction}->[$i]->{recurringemail};
  1049. }
  1050. if (%p) {
  1051. $form->{transactions}{$transaction}->[$i]->{recurringprint} = "";
  1052. for ( keys %p ) {
  1053. $form->{transactions}{$transaction}->[$i]->{recurringprint} .=
  1054. "${_}:";
  1055. }
  1056. chop $form->{transactions}{$transaction}->[$i]->{recurringprint};
  1057. }
  1058. $dbh->commit;
  1059. }
  1060. =item AM->recurring_details($myconfig, $form, $id);
  1061. Retrieves details about the recurring transaction $id and places them into
  1062. attributes of $form. Sets id (the transaction id passed in, $id), reference
  1063. (a reference string for the recurring transaction), startdate (the date the
  1064. recurrence series started on), nextdate (the date of the next occurrence of the
  1065. event), enddate (the date of the final occurrence of the event), repeat (the
  1066. number of units involved in a recurrence period), unit (the recurrence unit),
  1067. howmany (the total number of recurrences in the recurrence series), payment
  1068. (whether or not the transaction is associated with a payment), arid (true if an
  1069. ar event), apid (true if an ap event), overdue (number of days an ar event was
  1070. to the duedate), paid (number of days after an ar event it was paid), req (days
  1071. until the requirement date from the transdate of an oe event), oeid (true if an
  1072. oe event), customer_id (vendor id if sales order), vendor_id (vendor id if
  1073. puchase order), vc ('customer' if customer_id set, 'vendor' if vendor_id set),
  1074. invoice (true if both arid and arinvoice set or if both apid and apinvoice set),
  1075. recurringemail (colon separated list of forms and formats to be emailed),
  1076. message (the non-attachement message body for the emails), and recurringprint
  1077. (colon separated list of form names, formats, and printer names).
  1078. $myconfig is unused.
  1079. =cut
  1080. sub recurring_details {
  1081. my ( $self, $myconfig, $form, $id ) = @_;
  1082. my $dbh = $form->{dbh};
  1083. my $query = qq|
  1084. SELECT s.*, ar.id AS arid, ar.invoice AS arinvoice,
  1085. ap.id AS apid, ap.invoice AS apinvoice,
  1086. ar.duedate - ar.transdate AS overdue,
  1087. ar.datepaid - ar.transdate AS paid,
  1088. oe.reqdate - oe.transdate AS req,
  1089. oe.id AS oeid, oe.customer_id, oe.vendor_id
  1090. FROM recurring s
  1091. LEFT JOIN ar ON (ar.id = s.id)
  1092. LEFT JOIN ap ON (ap.id = s.id)
  1093. LEFT JOIN oe ON (oe.id = s.id)
  1094. WHERE s.id = ?|;
  1095. my $sth = $dbh->prepare($query);
  1096. $sth->execute($id) || $form->dberror($query);
  1097. my $ref = $sth->fetchrow_hashref(NAME_lc);
  1098. $form->{vc} = "customer" if $ref->{customer_id};
  1099. $form->{vc} = "vendor" if $ref->{vendor_id};
  1100. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  1101. $sth->finish;
  1102. $form->{invoice} = ( $form->{arid} && $form->{arinvoice} );
  1103. $form->{invoice} = ( $form->{apid} && $form->{apinvoice} )
  1104. unless $form->{invoice};
  1105. $query = qq|
  1106. SELECT *
  1107. FROM recurringemail
  1108. WHERE id = ?|;
  1109. $sth = $dbh->prepare($query);
  1110. $sth->execute($id) || $form->dberror($query);
  1111. $form->{recurringemail} = "";
  1112. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1113. $form->{recurringemail} .= "$ref->{formname}:$ref->{format}:";
  1114. $form->{message} = $ref->{message};
  1115. }
  1116. $sth->finish;
  1117. $query = qq|
  1118. SELECT *
  1119. FROM recurringprint
  1120. WHERE id = ?|;
  1121. $sth = $dbh->prepare($query);
  1122. $sth->execute($id) || $form->dberror($query);
  1123. $form->{recurringprint} = "";
  1124. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1125. $form->{recurringprint} .=
  1126. "$ref->{formname}:$ref->{format}:$ref->{printer}:";
  1127. }
  1128. $sth->finish;
  1129. chop $form->{recurringemail};
  1130. chop $form->{recurringprint};
  1131. for (qw(arinvoice apinvoice)) { delete $form->{$_} }
  1132. $dbh->commit;
  1133. }
  1134. =item AM->update_recurring($myconfig, $form, $id)
  1135. Updates nextdate for the recurring transaction $id to the next date of the
  1136. sequence. If the new value for nextdate is after enddate, nextdate is set to
  1137. NULL.
  1138. $myconfig is unused.
  1139. =cut
  1140. sub update_recurring {
  1141. my ( $self, $myconfig, $form, $id ) = @_;
  1142. my $dbh = $form->{dbh};
  1143. $id = $dbh->quote($id);
  1144. my $query = qq|
  1145. SELECT nextdate, repeat, unit
  1146. FROM recurring
  1147. WHERE id = $id|;
  1148. my ( $nextdate, $repeat, $unit ) = $dbh->selectrow_array($query);
  1149. $nextdate = $dbh->quote($nextdate);
  1150. my $interval = $dbh->quote("$repeat $unit");
  1151. # check if it is the last date
  1152. $query = qq|
  1153. SELECT (date $nextdate + interval $interval) > enddate
  1154. FROM recurring
  1155. WHERE id = $id|;
  1156. my ($last_repeat) = $dbh->selectrow_array($query);
  1157. if ($last_repeat) {
  1158. $query = qq|
  1159. UPDATE recurring
  1160. SET nextdate = NULL
  1161. WHERE id = $id|;
  1162. } else {
  1163. $query = qq|
  1164. UPDATE recurring
  1165. SET nextdate = (date $nextdate + interval $interval)
  1166. WHERE id = $id|;
  1167. }
  1168. $dbh->do($query) || $form->dberror($query);
  1169. $dbh->commit;
  1170. }
  1171. =item AM->check_template_name($myconfig, $form);
  1172. Performs some sanity checking on the filename $form->{file} and calls
  1173. $form->error if the filename is disallowed.
  1174. =cut
  1175. sub check_template_name {
  1176. my ( $self, $myconfig, $form ) = @_;
  1177. my @allowedsuff = qw(css tex txt html xml);
  1178. if ( $form->{file} =~ /^(.:)*?\/|:|\.\.\/|^\// ) {
  1179. $form->error("Directory transversal not allowed.");
  1180. }
  1181. if ( $form->{file} =~ /^${LedgerSMB::Sysconfig::backuppath}\// ) {
  1182. $form->error(
  1183. "Not allowed to access ${LedgerSMB::Sysconfig::backuppath}/ with this method"
  1184. );
  1185. }
  1186. my $whitelisted = 0;
  1187. for (@allowedsuff) {
  1188. if ( $form->{file} =~ /$_$/ ) {
  1189. $whitelisted = 1;
  1190. }
  1191. }
  1192. if ( !$whitelisted ) {
  1193. $form->error("Error: File is of type that is not allowed.");
  1194. }
  1195. if ( $form->{file} !~ /^$myconfig->{templates}\// ) {
  1196. $form->error("Not in a whitelisted directory: $form->{file}")
  1197. unless $form->{file} =~ /^css\//;
  1198. }
  1199. }
  1200. =item AM->load_template($myconfig, $form);
  1201. Populates $form->{body} with the contents of the file $form->{file}.
  1202. =cut
  1203. sub load_template {
  1204. my ( $self, $myconfig, $form ) = @_;
  1205. $form->{file} ||= lc "$myconfig->{templates}/$form->{template}.$form->{format}";
  1206. $self->check_template_name( \%$myconfig, \%$form );
  1207. open( TEMPLATE, '<', "$form->{file}" )
  1208. or $form->error("$form->{file} : $!");
  1209. while (<TEMPLATE>) {
  1210. $form->{body} .= $_;
  1211. }
  1212. close(TEMPLATE);
  1213. }
  1214. =item AM->save_template($myconfig, $form);
  1215. Overwrites the file $form->{file} with the contents of $form->{body}, excluding
  1216. carriage returns.
  1217. =cut
  1218. sub save_template {
  1219. my ( $self, $myconfig, $form ) = @_;
  1220. $form->{file} ||= lc "$myconfig->{templates}/$form->{template}.$form->{format}";
  1221. $self->check_template_name( \%$myconfig, \%$form );
  1222. open( TEMPLATE, '>', "$form->{file}" )
  1223. or $form->error("$form->{file} : $!");
  1224. # strip
  1225. $form->{body} =~ s/\r//g;
  1226. print TEMPLATE $form->{body};
  1227. close(TEMPLATE);
  1228. }
  1229. =item AM->save_preferences($myconfig, $form);
  1230. Saves the preferences for the current user. New values are taken from the $form
  1231. attributes name, email, dateformat, signature, numberformat, vclimit, tel, fax,
  1232. company, menuwidth, countrycode, address, timeout, stylesheet, printer,
  1233. password, new_password, and old_password. Password updates occur when
  1234. new_password and old_password differ.
  1235. =cut
  1236. sub save_preferences {
  1237. my ( $self, $myconfig, $form ) = @_;
  1238. # connect to database
  1239. my $dbh = $form->{dbh};
  1240. # get username, is same as requested?
  1241. my @queryargs;
  1242. my $query = qq|
  1243. SELECT login
  1244. FROM employee
  1245. WHERE login = ?|;
  1246. @queryargs = ( $form->{login} );
  1247. my $sth = $dbh->prepare($query);
  1248. $sth->execute(@queryargs) || $form->dberror($query);
  1249. my ($dbusername) = $sth->fetchrow_array;
  1250. $sth->finish;
  1251. return 0 if ( $dbusername ne $form->{login} );
  1252. # update name
  1253. $query = qq|
  1254. UPDATE employee
  1255. SET name = ?
  1256. WHERE login = ?|;
  1257. @queryargs = ( $form->{name}, $form->{login} );
  1258. $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query);
  1259. # get default currency
  1260. $query = qq|
  1261. SELECT value, (SELECT value FROM defaults
  1262. WHERE setting_key = 'businessnumber')
  1263. FROM defaults
  1264. WHERE setting_key = 'curr'|;
  1265. ( $form->{currency}, $form->{businessnumber} ) =
  1266. $dbh->selectrow_array($query);
  1267. $form->{currency} =~ s/:.*//;
  1268. $dbh->commit;
  1269. my $myconfig = LedgerSMB::User->new( $form->{login} );
  1270. map { $myconfig->{$_} = $form->{$_} if exists $form->{$_} }
  1271. qw(name email dateformat signature numberformat vclimit tel fax
  1272. company menuwidth countrycode address timeout stylesheet
  1273. printer password);
  1274. $myconfig->{password} = $form->{new_password}
  1275. if ( $form->{old_password} ne $form->{new_password} );
  1276. $myconfig->save_member();
  1277. 1;
  1278. }
  1279. =item AM->save_defaults($myconfig, $form);
  1280. Sets the values in the defaults table to values derived from $form. glnumber,
  1281. sinumber, vinumber, sonumber, ponumber, sqnumber, rfqnumber, partnumber,
  1282. employeenumber, customernumber, vendornumber, projectnumber, yearend, curr,
  1283. weightunit, and businessnumber are taken directly from the $form value with
  1284. the corresponding name. inventory_accno_id is the id of the account with the
  1285. number specified in $form->{IC}. In a similar manner, income_accno_id and
  1286. $form->{IC_income}, expense_accno_id and $form->{IC_expense}, fxgain_accno_id
  1287. and $form->{FX_gain}, and fxloss_accno_id and $form->{FX_loss} are related.
  1288. =cut
  1289. sub save_defaults {
  1290. my ( $self, $myconfig, $form ) = @_;
  1291. for (qw(IC IC_income IC_expense FX_gain FX_loss)) {
  1292. ( $form->{$_} ) = split /--/, $form->{$_};
  1293. }
  1294. my @a;
  1295. $form->{curr} =~ s/ //g;
  1296. for ( split /:/, $form->{curr} ) { push( @a, uc pack "A3", $_ ) if $_ }
  1297. $form->{curr} = join ':', @a;
  1298. # connect to database
  1299. my $dbh = $form->{dbh};
  1300. # save defaults
  1301. $sth_plain = $dbh->prepare( "
  1302. UPDATE defaults SET value = ? WHERE setting_key = ?" );
  1303. $sth_accno = $dbh->prepare(
  1304. qq|
  1305. UPDATE defaults
  1306. SET value = (SELECT id
  1307. FROM chart
  1308. WHERE accno = ?)
  1309. WHERE setting_key = ?|
  1310. );
  1311. my %translation = (
  1312. inventory_accno_id => 'IC',
  1313. income_accno_id => 'IC_income',
  1314. expense_accno_id => 'IC_expense',
  1315. fxgain_accno_id => 'FX_gain',
  1316. fxloss_accno_id => 'FX_loss'
  1317. );
  1318. for (
  1319. qw(inventory_accno_id income_accno_id expense_accno_id
  1320. fxgain_accno_id fxloss_accno_id glnumber sinumber vinumber
  1321. sonumber ponumber sqnumber rfqnumber partnumber employeenumber
  1322. customernumber vendornumber projectnumber yearend curr
  1323. weightunit businessnumber)
  1324. )
  1325. {
  1326. my $val = $form->{$_};
  1327. if ( $translation{$_} ) {
  1328. $val = $form->{ $translation{$_} };
  1329. }
  1330. if ( $_ =~ /accno/ ) {
  1331. $sth_accno->execute( $val, $_ )
  1332. || $form->dberror("Saving $_");
  1333. }
  1334. else {
  1335. $sth_plain->execute( $val, $_ )
  1336. || $form->dberror("Saving $_");
  1337. }
  1338. }
  1339. my $rc = $dbh->commit;
  1340. $rc;
  1341. }
  1342. =item AM->defaultaccounts($myconfig, $form);
  1343. Retrieves the numbers of default accounts and sets $form->{defaults}{$key} to
  1344. the appropriate account numbers, where $key can be 'IC', 'IC_income', 'IC_sale',
  1345. 'IC_expense', 'IC_cogs', 'FX_gain', and 'FX_loss'.
  1346. Sets the hashes refered to as $form->{accno}{IC_${type}}{$accno} to contain the
  1347. id and description of all accounts with IC elements in their link fields. The
  1348. possible types are all the IC_* values with IC_cogs merged into IC_expense and
  1349. IC_sale merged with IC_income.
  1350. Fills the hashes referred to as $form->{accno}{FX_(gain|loss)} with the id and
  1351. description of all income and expense accounts, keyed on the account number.
  1352. $myconfig is unused.
  1353. =cut
  1354. sub defaultaccounts {
  1355. my ( $self, $myconfig, $form ) = @_;
  1356. # connect to database
  1357. my $dbh = $form->{dbh};
  1358. # get defaults from defaults table
  1359. my $query = qq|
  1360. SELECT setting_key, value FROM defaults
  1361. WHERE setting_key LIKE ?|;
  1362. my $sth = $dbh->prepare($query);
  1363. $sth->execute('%accno_id') || $form->dberror($query);
  1364. my $ref;
  1365. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1366. $form->{ $ref->{setting_key} } = $ref->{value};
  1367. }
  1368. $form->{defaults}{IC} = $form->{inventory_accno_id};
  1369. $form->{defaults}{IC_income} = $form->{income_accno_id};
  1370. $form->{defaults}{IC_sale} = $form->{income_accno_id};
  1371. $form->{defaults}{IC_expense} = $form->{expense_accno_id};
  1372. $form->{defaults}{IC_cogs} = $form->{expense_accno_id};
  1373. $form->{defaults}{FX_gain} = $form->{fxgain_accno_id};
  1374. $form->{defaults}{FX_loss} = $form->{fxloss_accno_id};
  1375. $sth->finish;
  1376. $query = qq|
  1377. SELECT id, accno, description, link
  1378. FROM chart
  1379. WHERE link LIKE '%IC%'
  1380. ORDER BY accno|;
  1381. $sth = $dbh->prepare($query);
  1382. $sth->execute || $form->dberror($query);
  1383. my $nkey;
  1384. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1385. foreach my $key ( split( /:/, $ref->{link} ) ) {
  1386. if ( $key =~ /IC/ ) {
  1387. $nkey = $key;
  1388. if ( $key =~ /cogs/ ) {
  1389. $nkey = "IC_expense";
  1390. }
  1391. if ( $key =~ /sale/ ) {
  1392. $nkey = "IC_income";
  1393. }
  1394. %{ $form->{accno}{$nkey}{ $ref->{accno} } } = (
  1395. id => $ref->{id},
  1396. description => $ref->{description}
  1397. );
  1398. }
  1399. }
  1400. }
  1401. $sth->finish;
  1402. $query = qq|
  1403. SELECT id, accno, description
  1404. FROM chart
  1405. WHERE (category = 'I' OR category = 'E')
  1406. AND charttype = 'A'
  1407. ORDER BY accno|;
  1408. $sth = $dbh->prepare($query);
  1409. $sth->execute || $form->dberror($query);
  1410. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1411. %{ $form->{accno}{FX_gain}{ $ref->{accno} } } = (
  1412. id => $ref->{id},
  1413. description => $ref->{description}
  1414. );
  1415. %{ $form->{accno}{FX_loss}{ $ref->{accno} } } = (
  1416. id => $ref->{id},
  1417. description => $ref->{description}
  1418. );
  1419. }
  1420. $sth->finish;
  1421. $dbh->commit;
  1422. }
  1423. =item AM->taxes($myconfig, $form);
  1424. Retrieve details about all taxes in the database. $form->{taxrates} refers to a
  1425. list containing hashes with the chart id (id), account number (accno),
  1426. description, rate, taxnumber, validto, pass, and taxmodulename for a tax.
  1427. $form->{taxmodule_B<id>}, where B<id> is a taxmodule_id, is set to that
  1428. taxmodule's name.
  1429. $myconfig is unused.
  1430. =cut
  1431. sub taxes {
  1432. my ( $self, $myconfig, $form ) = @_;
  1433. my $taxaccounts = '';
  1434. # connect to database
  1435. my $dbh = $form->{dbh};
  1436. my $query = qq|
  1437. SELECT c.id, c.accno, c.description,
  1438. t.rate * 100 AS rate, t.taxnumber, t.validto,
  1439. t.pass, m.taxmodulename
  1440. FROM chart c
  1441. JOIN tax t ON (c.id = t.chart_id)
  1442. JOIN taxmodule m ON (t.taxmodule_id = m.taxmodule_id)
  1443. ORDER BY 3, 6|;
  1444. my $sth = $dbh->prepare($query);
  1445. $sth->execute || $form->dberror($query);
  1446. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1447. $form->db_parse_numeric(sth=>$sth, hashref=>$ref);
  1448. push @{ $form->{taxrates} }, $ref;
  1449. $taxaccounts .= " " . $ref{accno};
  1450. }
  1451. $sth->finish;
  1452. $query = qq|
  1453. SELECT taxmodule_id, taxmodulename FROM taxmodule
  1454. ORDER BY 2|;
  1455. $sth = $dbh->prepare($query);
  1456. $sth->execute || $form->dberror($query);
  1457. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1458. $form->{ "taxmodule_" . $ref->{taxmodule_id} } = $ref->{taxmodulename};
  1459. }
  1460. $sth->finish;
  1461. $dbh->commit;
  1462. }
  1463. =item AM->save_taxes($myconfig, $form);
  1464. Deletes B<all> entries from the tax table then re-inserts all taxes whose
  1465. accounts are part of the space separated list $form->{taxaccounts}. Each
  1466. element of $form->{taxaccounts} is of the form 'chartid_I<i>' where chartid is
  1467. the id of the chart entry for the tax and I<i> is a numeric index. The values
  1468. inserted for each tax are chart_id (from taxaccounts), rate (
  1469. form->{taxrate_I<i>} / 100), validto ($form->{validto_I<i>}), taxnumber
  1470. ($form->{taxnumber_I<i>}), pass ($form->{pass_I<i>}), and taxmodule_id
  1471. ($form->{taxmodule_id_I<i>}).
  1472. =cut
  1473. sub save_taxes {
  1474. my ( $self, $myconfig, $form ) = @_;
  1475. # connect to database
  1476. my $dbh = $form->{dbh};
  1477. my $query = qq|
  1478. UPDATE tax
  1479. SET validto = (now())::date
  1480. WHERE chart_id = ?|;
  1481. my $update_sth = $dbh->prepare($query) || $form->dberror($query);
  1482. $query = qq|
  1483. INSERT INTO tax (chart_id, rate, taxnumber, validto,
  1484. pass, taxmodule_id)
  1485. VALUES (?, ?, ?, ?, ?, ?)|;
  1486. my $sth = $dbh->prepare($query);
  1487. foreach my $item ( split / /, $form->{taxaccounts} ) {
  1488. my ( $chart_id, $i ) = split /_/, $item;
  1489. my $rate =
  1490. $form->parse_amount( $myconfig, $form->{"taxrate_$i"} ) / 100;
  1491. my $validto = $form->{"validto_$i"};
  1492. $validto = undef if not $validto;
  1493. my @queryargs = (
  1494. $chart_id, $rate, $form->{"taxnumber_$i"}, $validto,
  1495. $form->{"pass_$i"}, $form->{"taxmodule_id_$i"}
  1496. );
  1497. $update_sth->execute($chart_id) || $form->dberror($query);
  1498. $sth->execute(@queryargs) || $form->dberror($query);
  1499. }
  1500. my $rc = $dbh->commit;
  1501. $rc;
  1502. }
  1503. =item AM->backup($myconfig, $form);
  1504. Prepares and outputs a database backup of the current "dataset" using
  1505. "pg_dump -Fc". The means of output is determined by $form->{media}, which can
  1506. be either 'file' or 'email'. If email is the desired form of output, the email
  1507. address to send the backup to and who to claim it is from is determined by
  1508. $myconfig->{email} and $myconfig->{name}. File output sends the backup directly
  1509. out over HTTP.
  1510. =cut
  1511. sub backup {
  1512. my ( $self, $myconfig, $form ) = @_;
  1513. my $mail;
  1514. my $err;
  1515. my @t = localtime(time);
  1516. $t[4]++;
  1517. $t[5] += 1900;
  1518. $t[3] = substr( "0$t[3]", -2 );
  1519. $t[4] = substr( "0$t[4]", -2 );
  1520. my $boundary = time;
  1521. my $tmpfile =
  1522. "${LedgerSMB::Sysconfig::backuppath}/$boundary.$globalDBname-$form->{dbversion}-$t[5]$t[4]$t[3].sql";
  1523. $form->{OUT} = "$tmpfile";
  1524. open( OUT, '>:raw', "$form->{OUT}" ) or $form->error("$form->{OUT} : $!");
  1525. # get sequences, functions and triggers
  1526. my $today = scalar localtime;
  1527. # compress backup if gzip defined
  1528. my $suffix = "c";
  1529. ##SC: START Testing changes
  1530. $myconfig->{name} = "test";
  1531. $myconfig->{email} = 'seneca@localhost';
  1532. $myconfig->{dbport} = 5432;
  1533. $myconfig->{dbuser} = 'seneca';
  1534. $myconfig->{dbhost} = 'localhost';
  1535. $myconfig->{dbname} = 'ledgersmb-taxtest';
  1536. ##SC: END Testing changes
  1537. if ( $form->{media} eq 'email' ) {
  1538. print OUT
  1539. qx(PGPASSWORD="$myconfig->{dbpasswd}" pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} -Fc -p $myconfig->{dbport} $myconfig->{dbname});
  1540. close OUT;
  1541. use LedgerSMB::Mailer;
  1542. $mail = new LedgerSMB::Mailer(
  1543. to => qq|"$myconfig->{name}" <$myconfig->{email}>|,
  1544. from => qq|"$myconfig->{name}" <$myconfig->{email}>|,
  1545. subject => "LedgerSMB Backup / $globalDBname-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix",
  1546. message => qq|
  1547. This PostgreSQL backup can be restored using the pg_restore command.
  1548. --
  1549. LedgerSMB|,
  1550. );
  1551. $mail->attach(
  1552. 'file' => $tmpfile,
  1553. 'filename' => $tmpfile,
  1554. 'strip' => "$boundary.",
  1555. 'mimetype' => 'application/octet-stream',
  1556. );
  1557. $err = $mail->send;
  1558. }
  1559. if ( $form->{media} eq 'file' ) {
  1560. open( IN, '<:raw', "$tmpfile" ) or $form->error("$tmpfile : $!");
  1561. open( OUT, ">-" ) or $form->error("STDOUT : $!");
  1562. binmode( OUT, ':raw' );
  1563. print OUT qq|Content-Type: application/file;\n|
  1564. . qq|Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix"\n\n|;
  1565. print OUT
  1566. qx(PGPASSWORD="$myconfig->{dbpasswd}" pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} -Fc -p $myconfig->{dbport} $myconfig->{dbname});
  1567. }
  1568. unlink "$tmpfile";
  1569. }
  1570. =item AM->closedto($myconfig, $form);
  1571. Populates $form->{closedto}, $form->{revtrans}, and $form->{audittrail} with
  1572. their values in the defaults table.
  1573. $myconfig is unused.
  1574. =cut
  1575. sub closedto {
  1576. my ( $self, $myconfig, $form ) = @_;
  1577. my $dbh = $form->{dbh};
  1578. my $query = qq|
  1579. SELECT (SELECT value FROM defaults
  1580. WHERE setting_key = 'closedto'),
  1581. (SELECT value FROM defaults
  1582. WHERE setting_key = 'revtrans'),
  1583. (SELECT value FROM defaults
  1584. WHERE setting_key = 'audittrail')|;
  1585. ( $form->{closedto}, $form->{revtrans}, $form->{audittrail} ) =
  1586. $dbh->selectrow_array($query);
  1587. $dbh->commit;
  1588. }
  1589. =item AM->closebooks($myconfig, $form);
  1590. Updates the revtrans, closedto, and audittrail entries in the defaults table
  1591. using their corresponding $form values. If $form->{removeaudittrail} is set,
  1592. this used to remove all audittrail entries with a transdate prior to the date
  1593. given by $form->{removeaudittrail}, but has been disabled.
  1594. $myconfig is unused.
  1595. =cut
  1596. sub closebooks {
  1597. my ( $self, $myconfig, $form ) = @_;
  1598. my $dbh = $form->{dbh};
  1599. my $query = qq|
  1600. UPDATE defaults SET value = ?
  1601. WHERE setting_key = ?|;
  1602. my $sth = $dbh->prepare($query);
  1603. my $sth_closedto = $dbh->prepare(qq|
  1604. UPDATE defaults SET value = to_char(?::date, 'YYYY-MM-DD')
  1605. WHERE setting_key = ?|);
  1606. for (qw(revtrans closedto audittrail)) {
  1607. if ( $form->{$_} ) {
  1608. $val = $form->{$_};
  1609. }
  1610. else {
  1611. $val = 0;
  1612. }
  1613. if ($_ eq 'closedto'){
  1614. $sth_closedto->execute( $val || undef, $_);
  1615. } else {
  1616. $sth->execute( $val, $_ );
  1617. }
  1618. }
  1619. ## SC: Disabling audit trail removal
  1620. ## if ( $form->{removeaudittrail} ) {
  1621. ## $query = qq|
  1622. ## DELETE FROM audittrail
  1623. ## WHERE transdate < ?|;
  1624. ##
  1625. ## $dbh->do($query, undef, $form->{removeaudittrail}) || $form->dberror($query);
  1626. ## }
  1627. $dbh->commit;
  1628. }
  1629. =item AM->earningsaccounts($myconfig, $form);
  1630. Populates the list referred to as $form->{chart} with hashes containing the
  1631. account number (accno) and the description of all equity accounts, ordered by
  1632. the account number.
  1633. $myconfig is unused.
  1634. =cut
  1635. sub earningsaccounts {
  1636. my ( $self, $myconfig, $form ) = @_;
  1637. my ( $query, $sth, $ref );
  1638. # connect to database
  1639. my $dbh = $form->{dbh};
  1640. # get chart of accounts
  1641. $query = qq|
  1642. SELECT accno,description
  1643. FROM chart
  1644. WHERE charttype = 'A'
  1645. AND category = 'Q'
  1646. ORDER BY accno|;
  1647. $sth = $dbh->prepare($query);
  1648. $sth->execute || $form->dberror($query);
  1649. $form->{chart} = [];
  1650. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1651. push @{ $form->{chart} }, $ref;
  1652. }
  1653. $sth->finish;
  1654. $dbh->commit;
  1655. }
  1656. =item AM->post_yearend($myconfig, $form);
  1657. Posts the termination of a financial year. Makes use of the $form attributes
  1658. login, reference, notes, description, and transdate to populate the gl table
  1659. entry. The id of the gl transaction is placed in $form->{id}.
  1660. For every accno_$i in $form, where $i is between 1 and $form->{rowcount}, an
  1661. acc_trans entry will be added if credit_$i or debit_$i is non-zero.
  1662. A new yearend entry is populated with the id and transdate of the gl
  1663. transaction.
  1664. Adds an entry to the audittrail.
  1665. $myconfig is unused.
  1666. =cut
  1667. sub post_yearend {
  1668. my ( $self, $myconfig, $form ) = @_;
  1669. my $dbh = $form->{dbh};
  1670. my $query;
  1671. my @queryargs;
  1672. my $uid = localtime;
  1673. $uid .= "$$";
  1674. $query = qq|
  1675. INSERT INTO gl (reference, employee_id)
  1676. VALUES (?, (SELECT id FROM employee
  1677. WHERE login = ?))|;
  1678. $dbh->prepare($query)->execute( $uid, $form->{login} )
  1679. || $form->dberror($query);
  1680. $query = qq|
  1681. SELECT id
  1682. FROM gl
  1683. WHERE reference = ?|;
  1684. my $sth = $dbh->prepare($query);
  1685. $sth->execute($uid);
  1686. ( $form->{id} ) = $sth->fetchrow_array;
  1687. $query = qq|
  1688. UPDATE gl
  1689. SET reference = ?,
  1690. description = ?,
  1691. notes = ?,
  1692. transdate = ?,
  1693. department_id = 0
  1694. WHERE id = ?|;
  1695. @queryargs = (
  1696. $form->{reference}, $form->{description}, $form->{notes},
  1697. $form->{transdate}, $form->{id}
  1698. );
  1699. $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query);
  1700. my $amount;
  1701. my $accno;
  1702. $query = qq|
  1703. INSERT INTO acc_trans (trans_id, chart_id, amount, transdate,
  1704. source)
  1705. VALUES (?, (SELECT id
  1706. FROM chart
  1707. WHERE accno = ?),
  1708. ?, ?, ?)|;
  1709. # insert acc_trans transactions
  1710. for my $i ( 1 .. $form->{rowcount} ) {
  1711. # extract accno
  1712. ($accno) = split( /--/, $form->{"accno_$i"} );
  1713. $amount = 0;
  1714. if ( $form->{"credit_$i"} ) {
  1715. $amount = $form->{"credit_$i"};
  1716. }
  1717. if ( $form->{"debit_$i"} ) {
  1718. $amount = $form->{"debit_$i"} * -1;
  1719. }
  1720. # if there is an amount, add the record
  1721. if ($amount) {
  1722. my @args = (
  1723. $form->{id}, $accno, $amount, $form->{transdate},
  1724. $form->{reference}
  1725. );
  1726. $dbh->prepare($query)->execute(@args)
  1727. || $form->dberror($query);
  1728. }
  1729. }
  1730. $query = qq|
  1731. INSERT INTO yearend (trans_id, transdate)
  1732. VALUES (?, ?)|;
  1733. $dbh->prepare($query)->execute( $form->{id}, $form->{transdate} )
  1734. || $form->dberror($query);
  1735. my %audittrail = (
  1736. tablename => 'gl',
  1737. reference => $form->{reference},
  1738. formname => 'yearend',
  1739. action => 'posted',
  1740. id => $form->{id}
  1741. );
  1742. $form->audittrail( $dbh, "", \%audittrail );
  1743. # commit and redirect
  1744. my $rc = $dbh->commit;
  1745. $rc;
  1746. }
  1747. =item AM->get_all_defaults($form);
  1748. Retrieves all settings from defaults and sets the appropriate $form values.
  1749. Also runs AM->defaultaccounts.
  1750. =cut
  1751. sub get_all_defaults {
  1752. my ( $self, $form ) = @_;
  1753. my $dbh = $form->{dbh};
  1754. my $query = "select setting_key, value FROM defaults";
  1755. $sth = $dbh->prepare($query);
  1756. $sth->execute;
  1757. while ( ( $skey, $value ) = $sth->fetchrow_array() ) {
  1758. $form->{$skey} = $value;
  1759. }
  1760. $self->defaultaccounts( undef, $form );
  1761. $dbh->commit;
  1762. }
  1763. 1;
  1764. =back