summaryrefslogtreecommitdiff
path: root/LedgerSMB/PE.pm
blob: 3d7f9a7b6abc62cbafb8044bac20bc1c0387f0ae (plain)
  1. =head1 NAME
  2. PE
  3. =head1 SYNOPSIS
  4. Support functions for projects, partsgroups, and parts
  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) 2003
  24. #
  25. # Author: DWS Systems Inc.
  26. # Web: http://www.sql-ledger.org
  27. #
  28. # Contributors:
  29. #
  30. #====================================================================
  31. #
  32. # This file has undergone whitespace cleanup.
  33. #
  34. #====================================================================
  35. #
  36. # Project module
  37. # also used for partsgroups
  38. #
  39. #====================================================================
  40. =head1 METHODS
  41. =over
  42. =cut
  43. package PE;
  44. =item PE->($myconfig, $form);
  45. Populates the list referred to as $form->{all_project} with hashes containing
  46. details about projects. Each hash contains the project record's fields along
  47. with the name of any associated customer. If $form->{status} is 'orphaned',
  48. only add projects that aren't referred to in any transactions, invoices,
  49. orders, or time cards. If $form->{status} is 'active', only projects that have
  50. not reached their enddate are added; when $form->{status} is 'inactive', only
  51. add projects that have reached their enddates. When $form->{year} and
  52. $form->{month} are set, use their values, along with that of $form->{interval},
  53. to set the startdatefrom and startdateto attributes of $form. These attributes
  54. are used to prepare a date range for accepted start dates. Both
  55. $form->{description} and $form->{projectnumber} are used to limit the results.
  56. Returns the number of projects added to the list. $myconfig is unused.
  57. =cut
  58. sub projects {
  59. my ( $self, $myconfig, $form ) = @_;
  60. my $dbh = $form->{dbh};
  61. $form->{sort} = "projectnumber" unless $form->{sort};
  62. my @a = ( $form->{sort} );
  63. my %ordinal = (
  64. projectnumber => 2,
  65. description => 3,
  66. startdate => 4,
  67. enddate => 5,
  68. );
  69. my $sortorder = $form->sort_order( \@a, \%ordinal );
  70. my $query;
  71. my $where = "WHERE 1=1";
  72. $query = qq|
  73. SELECT pr.*, c.name
  74. FROM project pr
  75. LEFT JOIN customer c ON (c.id = pr.customer_id)|;
  76. if ( $form->{type} eq 'job' ) {
  77. $where .= qq| AND pr.id NOT IN (SELECT DISTINCT id
  78. FROM parts
  79. WHERE project_id > 0)|;
  80. }
  81. my $var;
  82. if ( $form->{projectnumber} ne "" ) {
  83. $var = $dbh->quote( $form->like( lc $form->{projectnumber} ) );
  84. $where .= " AND lower(pr.projectnumber) LIKE $var";
  85. }
  86. if ( $form->{description} ne "" ) {
  87. $var = $dbh->quote( $form->like( lc $form->{description} ) );
  88. $where .= " AND lower(pr.description) LIKE $var";
  89. }
  90. ( $form->{startdatefrom}, $form->{startdateto} ) =
  91. $form->from_to( $form->{year}, $form->{month}, $form->{interval} )
  92. if $form->{year} && $form->{month};
  93. if ( $form->{startdatefrom} ) {
  94. $where .=
  95. " AND (pr.startdate IS NULL OR pr.startdate >= "
  96. . $dbh->quote( $form->{startdatefrom} ) . ")";
  97. }
  98. if ( $form->{startdateto} ) {
  99. $where .=
  100. " AND (pr.startdate IS NULL OR pr.startdate <= "
  101. . $dbh->quote( $form->{startdateto} ) . ")";
  102. }
  103. if ( $form->{status} eq 'orphaned' ) {
  104. $where .= qq| AND pr.id NOT IN (SELECT DISTINCT project_id
  105. FROM acc_trans
  106. WHERE project_id > 0
  107. UNION
  108. SELECT DISTINCT project_id
  109. FROM invoice
  110. WHERE project_id > 0
  111. UNION
  112. SELECT DISTINCT project_id
  113. FROM orderitems
  114. WHERE project_id > 0
  115. UNION
  116. SELECT DISTINCT project_id
  117. FROM jcitems
  118. WHERE project_id > 0)
  119. |;
  120. } elsif ( $form->{status} eq 'active' ) {
  121. $where .= qq|
  122. AND (pr.enddate IS NULL
  123. OR pr.enddate >= current_date)|;
  124. } elsif ( $form->{status} eq 'inactive' ) {
  125. $where .= qq| AND pr.enddate <= current_date|;
  126. }
  127. $query .= qq|
  128. $where
  129. ORDER BY $sortorder|;
  130. $sth = $dbh->prepare($query);
  131. $sth->execute || $form->dberror($query);
  132. my $i = 0;
  133. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  134. push @{ $form->{all_project} }, $ref;
  135. $i++;
  136. }
  137. $sth->finish;
  138. $dbh->commit;
  139. $i;
  140. }
  141. =item PE->get_project($myconfig, $form)
  142. If $form->{id} is set, populates the $form attributes projectnumber,
  143. description, startdate, enddate, parts_id, production, completed, and
  144. customer_id with details from the project record and name with the associated
  145. customer name. If the project is not used in any transaction, invoice, order,
  146. or time card, $form->{orphaned} is set to true, otherwise false.
  147. Even if $form->{id} is false, PE->get_customer is run, along with any custom
  148. SELECT queries for the table 'project'.
  149. =cut
  150. sub get_project {
  151. my ( $self, $myconfig, $form ) = @_;
  152. my $dbh = $form->{dbh};
  153. my $query;
  154. my $sth;
  155. my $ref;
  156. my $where;
  157. if ( $form->{id} ) {
  158. $query = qq|
  159. SELECT pr.*, c.name AS customer
  160. FROM project pr
  161. LEFT JOIN customer c ON (c.id = pr.customer_id)
  162. WHERE pr.id = ?|;
  163. $sth = $dbh->prepare($query);
  164. $sth->execute( $form->{id} ) || $form->dberror($query);
  165. $ref = $sth->fetchrow_hashref(NAME_lc);
  166. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  167. $sth->finish;
  168. # check if it is orphaned
  169. $query = qq|
  170. SELECT count(*)
  171. FROM acc_trans
  172. WHERE project_id = ?
  173. UNION
  174. SELECT count(*)
  175. FROM invoice
  176. WHERE project_id = ?
  177. UNION
  178. SELECT count(*)
  179. FROM orderitems
  180. WHERE project_id = ?
  181. UNION
  182. SELECT count(*)
  183. FROM jcitems
  184. WHERE project_id = ?|;
  185. $sth = $dbh->prepare($query);
  186. $sth->execute( $form->{id}, $form->{id}, $form->{id}, $form->{id} )
  187. || $form->dberror($query);
  188. my $count;
  189. while ( ($count) = $sth->fetchrow_array ) {
  190. $form->{orphaned} += $count;
  191. }
  192. $sth->finish;
  193. $form->{orphaned} = !$form->{orphaned};
  194. }
  195. PE->get_customer( $myconfig, $form, $dbh );
  196. $form->run_custom_queries( 'project', 'SELECT' );
  197. $dbh->commit;
  198. }
  199. =item PE->save_project($myconfig, $form)
  200. Updates a project, or adds a new one if $form->{id} is not set.
  201. The $form attributes of startdate, enddate, customer_id, description, and
  202. projectnumber are used for the project record. If $form->{projectnumber} is
  203. false, a new one is obtained through $form->update_defaults. When a new
  204. project is added, $form->{id} is set to that new id. Any custom queries for
  205. UPDATE on the project table are run.
  206. =cut
  207. sub save_project {
  208. my ( $self, $myconfig, $form ) = @_;
  209. my $dbh = $form->{dbh};
  210. $form->{customer_id} ||= undef;
  211. $form->{projectnumber} =
  212. $form->update_defaults( $myconfig, "projectnumber", $dbh )
  213. unless $form->{projectnumber};
  214. my $enddate;
  215. my $startdate;
  216. $enddate = $form->{enddate} if $form->{enddate};
  217. $startdate = $form->{startdate} if $form->{startdate};
  218. if ( $form->{id} ) {
  219. $query = qq|
  220. UPDATE project
  221. SET projectnumber = ?,
  222. description = ?,
  223. startdate = ?,
  224. enddate = ?,
  225. customer_id = ?
  226. WHERE id = | . $dbh->quote( $form->{id} );
  227. }
  228. else {
  229. $query = qq|
  230. INSERT INTO project (projectnumber, description,
  231. startdate, enddate, customer_id)
  232. VALUES (?, ?, ?, ?, ?)|;
  233. }
  234. $sth = $dbh->prepare($query);
  235. $sth->execute( $form->{projectnumber},
  236. $form->{description}, $startdate, $enddate, $form->{customer_id} )
  237. || $form->dberror($query);
  238. if (!$form->{id}){
  239. $query = "SELECT currval('id')";
  240. ($form->{id}) = $dbh->selectrow_array($query) || $form->dberror($query);
  241. }
  242. $form->run_custom_queries( 'project', 'UPDATE' );
  243. $dbh->commit;
  244. }
  245. =item PE->list_stock($myconfig, $form);
  246. Populates the list referred to as $form->{all_project} with hashes that contain
  247. details about projects.
  248. Sets $form->{stockingdate} to the current date if it is not already set.
  249. This function is probably unused.
  250. $myconfig is unused.
  251. =cut
  252. sub list_stock {
  253. my ( $self, $myconfig, $form ) = @_;
  254. my $dbh = $form->{dbh};
  255. my $var;
  256. my $where = "1 = 1";
  257. if ( $form->{status} eq 'active' ) {
  258. $where = qq|
  259. (pr.enddate IS NULL OR pr.enddate >= current_date)
  260. AND pr.completed < pr.production|;
  261. } elsif ( $form->{status} eq 'inactive' ) {
  262. $where = qq|pr.completed = pr.production|;
  263. }
  264. if ( $form->{projectnumber} ) {
  265. $var = $dbh->quote( $form->like( lc $form->{projectnumber} ) );
  266. $where .= " AND lower(pr.projectnumber) LIKE $var";
  267. }
  268. if ( $form->{description} ) {
  269. $var = $dbh->quote( $form->like( lc $form->{description} ) );
  270. $where .= " AND lower(pr.description) LIKE $var";
  271. }
  272. $form->{sort} = "projectnumber" unless $form->{sort};
  273. my @a = ( $form->{sort} );
  274. my %ordinal = ( projectnumber => 2, description => 3 );
  275. my $sortorder = $form->sort_order( \@a, \%ordinal );
  276. my $query = qq|
  277. SELECT pr.*, p.partnumber
  278. FROM project pr
  279. JOIN parts p ON (p.id = pr.parts_id)
  280. WHERE $where
  281. ORDER BY $sortorder|;
  282. $sth = $dbh->prepare($query);
  283. $sth->execute || $form->dberror($query);
  284. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  285. push @{ $form->{all_project} }, $ref;
  286. }
  287. $sth->finish;
  288. $query = qq|SELECT current_date|;
  289. ( $form->{stockingdate} ) = $dbh->selectrow_array($query)
  290. if !$form->{stockingdate};
  291. $dbh->commit;
  292. }
  293. =item PE->jobs($myconfig, $form);
  294. This function is probably unused.
  295. $myconfig is unused.
  296. =cut
  297. sub jobs {
  298. my ( $self, $myconfig, $form ) = @_;
  299. my $dbh = $form->{dbh};
  300. $form->{sort} = "projectnumber" unless $form->{sort};
  301. my @a = ( $form->{sort} );
  302. my %ordinal = ( projectnumber => 2, description => 3, startdate => 4 );
  303. my $sortorder = $form->sort_order( \@a, \%ordinal );
  304. my $query = qq|
  305. SELECT pr.*, p.partnumber, p.onhand, c.name
  306. FROM project pr
  307. JOIN parts p ON (p.id = pr.parts_id)
  308. LEFT JOIN customer c ON (c.id = pr.customer_id)
  309. WHERE 1=1|;
  310. if ( $form->{projectnumber} ne "" ) {
  311. $var = $dbh->quote( $form->like( lc $form->{projectnumber} ) );
  312. $query .= " AND lower(pr.projectnumber) LIKE $var";
  313. }
  314. if ( $form->{description} ne "" ) {
  315. $var = $dbh->quote( $form->like( lc $form->{description} ) );
  316. $query .= " AND lower(pr.description) LIKE $var";
  317. }
  318. ( $form->{startdatefrom}, $form->{startdateto} ) =
  319. $form->from_to( $form->{year}, $form->{month}, $form->{interval} )
  320. if $form->{year} && $form->{month};
  321. if ( $form->{startdatefrom} ) {
  322. $query .=
  323. " AND pr.startdate >= " . $dbh->quote( $form->{startdatefrom} );
  324. }
  325. if ( $form->{startdateto} ) {
  326. $query .= " AND pr.startdate <= " . $dbh->quote( $form->{startdateto} );
  327. }
  328. if ( $form->{status} eq 'active' ) {
  329. $query .= qq| AND NOT pr.production = pr.completed|;
  330. }
  331. if ( $form->{status} eq 'inactive' ) {
  332. $query .= qq| AND pr.production = pr.completed|;
  333. }
  334. if ( $form->{status} eq 'orphaned' ) {
  335. $query .= qq|
  336. AND pr.completed = 0
  337. AND (pr.id NOT IN
  338. (SELECT DISTINCT project_id
  339. FROM invoice
  340. WHERE project_id > 0
  341. UNION
  342. SELECT DISTINCT project_id
  343. FROM orderitems
  344. WHERE project_id > 0
  345. UNION
  346. SELECT DISTINCT project_id
  347. FROM jcitems
  348. WHERE project_id > 0)
  349. )|;
  350. }
  351. $query .= qq|
  352. ORDER BY $sortorder|;
  353. $sth = $dbh->prepare($query);
  354. $sth->execute || $form->dberror($query);
  355. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  356. push @{ $form->{all_project} }, $ref;
  357. }
  358. $sth->finish;
  359. $dbh->commit;
  360. }
  361. =item PE->get_job($myconfig, $form);
  362. This function is probably unused as part of Dieter's incomplete job costing.
  363. =cut
  364. sub get_job {
  365. my ( $self, $myconfig, $form ) = @_;
  366. # connect to database
  367. my $dbh = $form->{dbh};
  368. my $query;
  369. my $sth;
  370. my $ref;
  371. if ( $form->{id} ) {
  372. $query = qq|
  373. SELECT value FROM defaults
  374. WHERE setting_key = 'weightunit'|;
  375. ( $form->{weightunit} ) = $dbh->selectrow_array($query);
  376. $query = qq|
  377. SELECT pr.*, p.partnumber,
  378. p.description AS partdescription, p.unit,
  379. p.listprice, p.sellprice, p.priceupdate,
  380. p.weight, p.notes, p.bin, p.partsgroup_id,
  381. ch.accno AS income_accno,
  382. ch.description AS income_description,
  383. pr.customer_id, c.name AS customer,
  384. pg.partsgroup
  385. FROM project pr
  386. LEFT JOIN parts p ON (p.id = pr.parts_id)
  387. LEFT JOIN chart ch ON (ch.id = p.income_accno_id)
  388. LEFT JOIN customer c ON (c.id = pr.customer_id)
  389. LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id)
  390. WHERE pr.id = | . $dbh->quote( $form->{id} );
  391. }
  392. else {
  393. $query = qq|
  394. SELECT value, current_date AS startdate FROM defaults
  395. WHERE setting_key = 'weightunit'|;
  396. }
  397. $sth = $dbh->prepare($query);
  398. $sth->execute || $form->dberror($query);
  399. $ref = $sth->fetchrow_hashref(NAME_lc);
  400. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  401. $sth->finish;
  402. if ( $form->{id} ) {
  403. # check if it is orphaned
  404. $query = qq|
  405. SELECT count(*)
  406. FROM invoice
  407. WHERE project_id = ?
  408. UNION
  409. SELECT count(*)
  410. FROM orderitems
  411. WHERE project_id = ?
  412. UNION
  413. SELECT count(*)
  414. FROM jcitems
  415. WHERE project_id = ?|;
  416. $sth = $dbh->prepare($query);
  417. $sth->execute( $form->{id}, $form->{id}, $form->{id} )
  418. || $form->dberror($query);
  419. my $count;
  420. my $count;
  421. while ( ($count) = $sth->fetchrow_array ) {
  422. $form->{orphaned} += $count;
  423. }
  424. $sth->finish;
  425. }
  426. $form->{orphaned} = !$form->{orphaned};
  427. $query = qq|
  428. SELECT accno, description, link
  429. FROM chart
  430. WHERE link LIKE ?
  431. ORDER BY accno|;
  432. $sth = $dbh->prepare($query);
  433. $sth->execute('%IC%') || $form->dberror($query);
  434. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  435. for ( split /:/, $ref->{link} ) {
  436. if (/IC/) {
  437. push @{ $form->{IC_links}{$_} },
  438. {
  439. accno => $ref->{accno},
  440. description => $ref->{description}
  441. };
  442. }
  443. }
  444. }
  445. $sth->finish;
  446. if ( $form->{id} ) {
  447. $query = qq|
  448. SELECT ch.accno
  449. FROM parts p
  450. JOIN partstax pt ON (pt.parts_id = p.id)
  451. JOIN chart ch ON (pt.chart_id = ch.id)
  452. WHERE p.id = ?|;
  453. $sth = $dbh->prepare($query);
  454. $sth->execute( $form->{id} ) || $form->dberror($query);
  455. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  456. $form->{amount}{ $ref->{accno} } = $ref->{accno};
  457. }
  458. $sth->finish;
  459. }
  460. PE->get_customer( $myconfig, $form, $dbh );
  461. $dbh->commit;
  462. }
  463. =item PE->get_customer($myconfig, $form[, $dbh]);
  464. Populates the list referred to as $form->{all_customer} with hashes containing
  465. the ids and names of customers unless the number of customers added would be
  466. greater than or equal to $myconfig->{vclimit}. $form->{startdate} and
  467. $form->{enddate} form a date range to limit the results. If
  468. $form->{customer_id} is set, then the customer with that id will be in the
  469. result set.
  470. =cut
  471. sub get_customer {
  472. my ( $self, $myconfig, $form, $dbh ) = @_;
  473. if ( !$dbh ) {
  474. $dbh = $form->{dbh};
  475. }
  476. my $query;
  477. my $sth;
  478. my $ref;
  479. if ( !$form->{startdate} ) {
  480. $query = qq|SELECT current_date|;
  481. ( $form->{startdate} ) = $dbh->selectrow_array($query);
  482. }
  483. my $where =
  484. qq|(startdate >= |
  485. . $dbh->quote( $form->{startdate} )
  486. . qq| OR startdate IS NULL OR enddate IS NULL)|;
  487. if ( $form->{enddate} ) {
  488. $where .=
  489. qq| AND (enddate >= |
  490. . $dbh->quote( $form->{enddate} )
  491. . qq| OR enddate IS NULL)|;
  492. }
  493. else {
  494. $where .= qq| AND (enddate >= current_date OR enddate IS NULL)|;
  495. }
  496. $query = qq|
  497. SELECT count(*)
  498. FROM customer
  499. WHERE $where|;
  500. my ($count) = $dbh->selectrow_array($query);
  501. if ( $count < $myconfig->{vclimit} ) {
  502. $query = qq|
  503. SELECT id, name
  504. FROM customer
  505. WHERE $where|;
  506. if ( $form->{customer_id} ) {
  507. $query .= qq|
  508. UNION
  509. SELECT id,name
  510. FROM customer
  511. WHERE id = | . $dbh->quote( $form->{customer_id} );
  512. }
  513. $query .= qq|
  514. ORDER BY name|;
  515. $sth = $dbh->prepare($query);
  516. $sth->execute || $form->dberror($query);
  517. @{ $form->{all_customer} } = ();
  518. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  519. push @{ $form->{all_customer} }, $ref;
  520. }
  521. $sth->finish;
  522. }
  523. }
  524. =item PE->save_job($myconfig, $form);
  525. Yet another save function. This one is related to the incomplete job handling.
  526. =cut
  527. sub save_job {
  528. my ( $self, $myconfig, $form ) = @_;
  529. $form->{projectnumber} =
  530. $form->update_defaults( $myconfig, "projectnumber", $dbh )
  531. unless $form->{projectnumber};
  532. my $dbh = $form->{dbh};
  533. my ($income_accno) = split /--/, $form->{IC_income};
  534. my ( $partsgroup, $partsgroup_id ) = split /--/, $form->{partsgroup};
  535. if ( $form->{id} ) {
  536. $query = qq|
  537. SELECT id FROM project
  538. WHERE id = | . $dbh->quote( $form->{id} );
  539. ( $form->{id} ) = $dbh->selectrow_array($query);
  540. }
  541. if ( !$form->{id} ) {
  542. my $uid = localtime;
  543. $uid .= "$$";
  544. $query = qq|
  545. INSERT INTO project (projectnumber)
  546. VALUES ('$uid')|;
  547. $dbh->do($query) || $form->dberror($query);
  548. $query = qq|
  549. SELECT id FROM project
  550. WHERE projectnumber = '$uid'|;
  551. ( $form->{id} ) = $dbh->selectrow_array($query);
  552. }
  553. $query = qq|
  554. UPDATE project
  555. SET projectnumber = ?,
  556. description = ?,
  557. startdate = ?,
  558. enddate = ?,
  559. parts_id = ?
  560. production = ?,
  561. customer_id = ?
  562. WHERE id = ?|;
  563. $sth = $dbh->prepare($query);
  564. $sth->execute(
  565. $form->{projectnumber}, $form->{description}, $form->{startdate},
  566. $form->{enddate}, $form->{id}, $form->{production},
  567. $form->{customer_id}, $form->{id}
  568. ) || $form->dberror($query);
  569. #### add/edit assembly
  570. $query = qq|SELECT id FROM parts WHERE id = | . $dbh->quote( $form->{id} );
  571. my ($id) = $dbh->selectrow_array($query);
  572. if ( !$id ) {
  573. $query = qq|
  574. INSERT INTO parts (id)
  575. VALUES (| . $dbh->quote( $form->{id} ) . qq|)|;
  576. $dbh->do($query) || $form->dberror($query);
  577. }
  578. my $partnumber =
  579. ( $form->{partnumber} )
  580. ? $form->{partnumber}
  581. : $form->{projectnumber};
  582. $query = qq|
  583. UPDATE parts
  584. SET partnumber = ?,
  585. description = ?,
  586. priceupdate = ?,
  587. listprice = ?,
  588. sellprice = ?,
  589. weight = ?,
  590. bin = ?,
  591. unit = ?,
  592. notes = ?,
  593. income_accno_id = (SELECT id FROM chart
  594. WHERE accno = ?),
  595. partsgroup_id = ?,
  596. assembly = '1',
  597. obsolete = '1',
  598. project_id = ?
  599. WHERE id = ?|;
  600. $sth = $dbh->prepare($query);
  601. $sth->execute(
  602. $partnumber,
  603. $form->{partdescription},
  604. $form->{priceupdate},
  605. $form->parse_amount( $myconfig, $form->{listprice} ),
  606. $form->parse_amount( $myconfig, $form->{sellprice} ),
  607. $form->parse_amount( $myconfig, $form->{weight} ),
  608. $form->{bin},
  609. $form->{unit},
  610. $form->{notes},
  611. $income_accno,
  612. ($partsgroup_id) ? $partsgroup_id : undef,
  613. $form->{id},
  614. $form->{id}
  615. ) || $form->dberror($query);
  616. $query =
  617. qq|DELETE FROM partstax WHERE parts_id = | . $dbh->qupte( $form->{id} );
  618. $dbh->do($query) || $form->dberror($query);
  619. $query = qq|
  620. INSERT INTO partstax (parts_id, chart_id)
  621. VALUES (?, (SELECT id FROM chart WHERE accno = ?))|;
  622. $sth = $dbh->prepare($query);
  623. for ( split / /, $form->{taxaccounts} ) {
  624. if ( $form->{"IC_tax_$_"} ) {
  625. $sth->execute( $form->{id}, $_ )
  626. || $form->dberror($query);
  627. }
  628. }
  629. $dbh->commit;
  630. }
  631. =item PE->stock_assembly($myconfig, $form)
  632. Looks like more of that job control code. IC.pm has the functions actually
  633. used by assemblies.
  634. =cut
  635. sub stock_assembly {
  636. my ( $self, $myconfig, $form ) = @_;
  637. my $dbh = $form->{dbh};
  638. my $ref;
  639. my $query = qq|SELECT * FROM project WHERE id = ?|;
  640. my $sth = $dbh->prepare($query) || $form->dberror($query);
  641. $query = qq|SELECT COUNT(*) FROM parts WHERE project_id = ?|;
  642. my $rvh = $dbh->prepare($query) || $form->dberror($query);
  643. if ( !$form->{stockingdate} ) {
  644. $query = qq|SELECT current_date|;
  645. ( $form->{stockingdate} ) = $dbh->selectrow_array($query);
  646. }
  647. $query = qq|SELECT * FROM parts WHERE id = ?|;
  648. my $pth = $dbh->prepare($query) || $form->dberror($query);
  649. $query = qq|
  650. SELECT j.*, p.lastcost FROM jcitems j
  651. JOIN parts p ON (p.id = j.parts_id)
  652. WHERE j.project_id = ?
  653. AND j.checkedin <= | . $dbh->quote( $form->{stockingdate} ) . qq|
  654. ORDER BY parts_id|;
  655. my $jth = $dbh->prepare($query) || $form->dberror($query);
  656. $query = qq|
  657. INSERT INTO assembly (id, parts_id, qty, bom, adj)
  658. VALUES (?, ?, ?, '0', '0')|;
  659. my $ath = $dbh->prepare($query) || $form->dberror($query);
  660. my $i = 0;
  661. my $sold;
  662. my $ship;
  663. while (1) {
  664. $i++;
  665. last unless $form->{"id_$i"};
  666. $stock = $form->parse_amount( $myconfig, $form->{"stock_$i"} );
  667. if ($stock) {
  668. $sth->execute( $form->{"id_$i"} );
  669. $ref = $sth->fetchrow_hashref(NAME_lc);
  670. if ( $stock > ( $ref->{production} - $ref->{completed} ) ) {
  671. $stock = $ref->{production} - $ref->{completed};
  672. }
  673. if ( ( $stock * -1 ) > $ref->{completed} ) {
  674. $stock = $ref->{completed} * -1;
  675. }
  676. $pth->execute( $form->{"id_$i"} );
  677. $pref = $pth->fetchrow_hashref(NAME_lc);
  678. my %assembly = ();
  679. my $lastcost = 0;
  680. my $sellprice = 0;
  681. my $listprice = 0;
  682. $jth->execute( $form->{"id_$i"} );
  683. while ( $jref = $jth->fetchrow_hashref(NAME_lc) ) {
  684. $assembly{qty}{ $jref->{parts_id} } +=
  685. ( $jref->{qty} - $jref->{allocated} );
  686. $assembly{parts_id}{ $jref->{parts_id} } = $jref->{parts_id};
  687. $assembly{jcitems}{ $jref->{id} } = $jref->{id};
  688. $lastcost +=
  689. $form->round_amount(
  690. $jref->{lastcost} * ( $jref->{qty} - $jref->{allocated} ),
  691. 2 );
  692. $sellprice += $form->round_amount(
  693. $jref->{sellprice} * ( $jref->{qty} - $jref->{allocated} ),
  694. 2
  695. );
  696. $listprice += $form->round_amount(
  697. $jref->{listprice} * ( $jref->{qty} - $jref->{allocated} ),
  698. 2
  699. );
  700. }
  701. $jth->finish;
  702. $uid = localtime;
  703. $uid .= "$$";
  704. $query = qq|
  705. INSERT INTO parts (partnumber)
  706. VALUES ('$uid')|;
  707. $dbh->do($query) || $form->dberror($query);
  708. $query = qq|
  709. SELECT id
  710. FROM parts
  711. WHERE partnumber = '$uid'|;
  712. ($uid) = $dbh->selectrow_array($query);
  713. $lastcost = $form->round_amount( $lastcost / $stock, 2 );
  714. $sellprice =
  715. ( $pref->{sellprice} )
  716. ? $pref->{sellprice}
  717. : $form->round_amount( $sellprice / $stock, 2 );
  718. $listprice =
  719. ( $pref->{listprice} )
  720. ? $pref->{listprice}
  721. : $form->round_amount( $listprice / $stock, 2 );
  722. $rvh->execute( $form->{"id_$i"} );
  723. my ($rev) = $rvh->fetchrow_array;
  724. $rvh->finish;
  725. $query = qq|
  726. UPDATE parts
  727. SET partnumber = ?,
  728. description = ?,
  729. priceupdate = ?,
  730. unit = ?,
  731. listprice = ?,
  732. sellprice = ?,
  733. lastcost = ?,
  734. weight = ?,
  735. onhand = ?,
  736. notes = ?,
  737. assembly = '1',
  738. income_accno_id = ?,
  739. bin = ?,
  740. project_id = ?
  741. WHERE id = ?|;
  742. $sth = $dbh->prepare($query);
  743. $sth->execute(
  744. "$pref->{partnumber}-$rev", $pref->{partdescription},
  745. $form->{stockingdate}, $pref->{unit},
  746. $listprice, $sellprice,
  747. $lastcost, $pref->{weight},
  748. $stock, $pref->{notes},
  749. $pref->{income_accno_id}, $pref->{bin},
  750. $form->{"id_$i"}, $uid
  751. ) || $form->dberror($query);
  752. $query = qq|
  753. INSERT INTO partstax (parts_id, chart_id)
  754. SELECT ?, chart_id FROM partstax
  755. WHERE parts_id = ?|;
  756. $sth = $dbh->prepare($query);
  757. $sth->execute( $uid, $pref->{id} )
  758. || $form->dberror($query);
  759. $pth->finish;
  760. for ( keys %{ $assembly{parts_id} } ) {
  761. if ( $assembly{qty}{$_} ) {
  762. $ath->execute(
  763. $uid,
  764. $assembly{parts_id}{$_},
  765. $form->round_amount( $assembly{qty}{$_} / $stock, 4 )
  766. );
  767. $ath->finish;
  768. }
  769. }
  770. $form->update_balance( $dbh, "project", "completed",
  771. qq|id = $form->{"id_$i"}|, $stock );
  772. $query = qq|
  773. UPDATE jcitems
  774. SET allocated = qty
  775. WHERE allocated != qty
  776. AND checkedin <= ?
  777. AND project_id = ?|;
  778. $sth = $dbh->prepare($query);
  779. $sth->execute( $form->{stockingdate}, $form->{"id_$i"} )
  780. || $form->dberror($query);
  781. $sth->finish;
  782. }
  783. }
  784. my $rc = $dbh->commit;
  785. $rc;
  786. }
  787. =item PE->delete_project($myconfig, $form);
  788. Deletes the database entry in project identified by $form->{id} and associated
  789. translations.
  790. $myconfig is unused.
  791. =cut
  792. sub delete_project {
  793. my ( $self, $myconfig, $form ) = @_;
  794. my $dbh = $form->{dbh};
  795. $query = qq|DELETE FROM project WHERE id = ?|;
  796. $sth = $dbh->prepare($query);
  797. $sth->execute( $form->{id} ) || $form->dberror($query);
  798. $query = qq|DELETE FROM translation
  799. WHERE trans_id = ?|;
  800. $sth = $dbh->prepare($query);
  801. $sth->execute( $form->{id} ) || $form->dberror($query);
  802. my $rc = $dbh->commit;
  803. $rc;
  804. }
  805. =item PE->delete_partsgroup($myconfig, $form);
  806. Deletes the entry in partsgroup identified by $form->{id} and associated
  807. translations.
  808. $myconfig is unused.
  809. =cut
  810. sub delete_partsgroup {
  811. my ( $self, $myconfig, $form ) = @_;
  812. my $dbh = $form->{dbh};
  813. $query = qq|DELETE FROM partsgroup WHERE id = ?|;
  814. $sth = $dbh->prepare($query);
  815. $sth->execute( $form->{id} ) || $form->dberror($query);
  816. $query = qq|DELETE FROM translation WHERE trans_id = ?|;
  817. $sth = $dbh->prepare($query);
  818. $sth->execute( $form->{id} ) || $form->dberror($query);
  819. my $rc = $dbh->commit;
  820. $rc;
  821. }
  822. =item PE->delete_pricegroup($myconfig, $form);
  823. Deletes the pricegroup entry identified by $form->{id}.
  824. $myconfig is unused.
  825. =cut
  826. sub delete_pricegroup {
  827. my ( $self, $myconfig, $form ) = @_;
  828. my $dbh = $form->{dbh};
  829. $query = qq|DELETE FROM pricegroup WHERE id = ?|;
  830. $sth = $dbh->prepare($query);
  831. $sth->execute( $form->{id} ) || $form->dberror($query);
  832. my $rc = $dbh->commit;
  833. $rc;
  834. }
  835. =item PE->delete_job($myconfig, $form);
  836. An "enhanced" variant of PE->delete_project. In addition to deleting the
  837. project identified by $form->{id} and the associated translations, also deletes
  838. all parts and assemblies with $form->{id} as a project_id. This function adds
  839. an audit trail entry for the table 'project' and the action 'deleted' where the
  840. formname is taken from $form->{type}.
  841. $myconfig is unused.
  842. =cut
  843. sub delete_job {
  844. my ( $self, $myconfig, $form ) = @_;
  845. my $dbh = $form->{dbh};
  846. my %audittrail = (
  847. tablename => 'project',
  848. reference => $form->{id},
  849. formname => $form->{type},
  850. action => 'deleted',
  851. id => $form->{id}
  852. );
  853. $form->audittrail( $dbh, "", \%audittrail );
  854. my $query = qq|DELETE FROM project WHERE id = ?|;
  855. $sth = $dbh->prepare($query);
  856. $sth->execute( $form->{id} ) || $form->dberror($query);
  857. $query = qq|DELETE FROM translation WHERE trans_id = ?|;
  858. $sth = $dbh->prepare($query);
  859. $sth->execute( $form->{id} ) || $form->dberror($query);
  860. # delete all the assemblies
  861. $query = qq|
  862. DELETE FROM assembly a
  863. JOIN parts p ON (a.id = p.id)
  864. WHERE p.project_id = ?|;
  865. $sth = $dbh->prepare($query);
  866. $sth->execute( $form->{id} ) || $form->dberror($query);
  867. $query = qq|DELETE FROM parts WHERE project_id = ?|;
  868. $sth = $dbh->prepare($query);
  869. $sth->execute( $form->{id} ) || $form->dberror($query);
  870. my $rc = $dbh->commit;
  871. $rc;
  872. }
  873. =item PE->partsgroups($myconfig, $form);
  874. Populates the list referred to as $form->{item_list} with hashes containing
  875. the id and partsgroup (name) for all the partsgroups in the database. If
  876. $form->{partsgroup} is non-empty, the results are limited to the partsgroups
  877. that contain that value in their name (case insensitive). If $form->{status}
  878. is 'orphaned', only partsgroups that are not associated with a part are added.
  879. The number of partsgroups added to $form->{item_list} is returned.
  880. $myconfig is unused.
  881. =cut
  882. sub partsgroups {
  883. my ( $self, $myconfig, $form ) = @_;
  884. my $var;
  885. my $dbh = $form->{dbh};
  886. $form->{sort} = "partsgroup" unless $form->{partsgroup};
  887. my @a = (partsgroup);
  888. my $sortorder = $form->sort_order( \@a );
  889. my $query = qq|SELECT g.* FROM partsgroup g|;
  890. my $where = "1 = 1";
  891. if ( $form->{partsgroup} ne "" ) {
  892. $var = $dbh->quote( $form->like( lc $form->{partsgroup} ) );
  893. $where .= " AND lower(partsgroup) LIKE $var";
  894. }
  895. $query .= qq| WHERE $where ORDER BY $sortorder|;
  896. if ( $form->{status} eq 'orphaned' ) {
  897. $query = qq|
  898. SELECT g.*
  899. FROM partsgroup g
  900. LEFT JOIN parts p ON (p.partsgroup_id = g.id)
  901. WHERE $where
  902. EXCEPT
  903. SELECT g.*
  904. FROM partsgroup g
  905. JOIN parts p ON (p.partsgroup_id = g.id)
  906. WHERE $where
  907. ORDER BY $sortorder|;
  908. }
  909. $sth = $dbh->prepare($query);
  910. $sth->execute || $form->dberror($query);
  911. my $i = 0;
  912. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  913. push @{ $form->{item_list} }, $ref;
  914. $i++;
  915. }
  916. $sth->finish;
  917. $i;
  918. }
  919. =item PE->save_partsgroup($myconfig, $form);
  920. Save a partsgroup record. If $form->{id} is set, update the description of
  921. the partsgroup with that id to be $form->{partsgroup}. Otherwise, create a
  922. new partsgroup with that description.
  923. $myconfig is unused.
  924. =cut
  925. sub save_partsgroup {
  926. my ( $self, $myconfig, $form ) = @_;
  927. my $dbh = $form->{dbh};
  928. my @group = ($form->{partsgroup});
  929. if ( $form->{id} ) {
  930. $query = qq|
  931. UPDATE partsgroup
  932. SET partsgroup = ?
  933. WHERE id = ?|;
  934. push @group, $form->{id};
  935. }
  936. else {
  937. $query = qq|
  938. INSERT INTO partsgroup (partsgroup)
  939. VALUES (?)|;
  940. }
  941. $dbh->do($query, undef, @group) || $form->dberror($query);
  942. $dbh->commit;
  943. }
  944. =item PE->get_partsgroup($myconfig, $form);
  945. Sets $form->{partsgroup} to the description of the partsgroup identified by
  946. $form->{id}. If there are no parts entries associated with that partsgroup,
  947. $form->{orphaned} is made true, otherwise it is set to false.
  948. $myconfig is unused.
  949. =cut
  950. sub get_partsgroup {
  951. my ( $self, $myconfig, $form ) = @_;
  952. my $dbh = $form->{dbh};
  953. my $query = qq|SELECT * FROM partsgroup WHERE id = ?|;
  954. my $sth = $dbh->prepare($query);
  955. $sth->execute( $form->{id} ) || $form->dberror($query);
  956. my $ref = $sth->fetchrow_hashref(NAME_lc);
  957. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  958. $sth->finish;
  959. # check if it is orphaned
  960. $query = qq|SELECT count(*) FROM parts WHERE partsgroup_id = ?|;
  961. $sth = $dbh->prepare($query);
  962. $sth->execute( $form->{id} ) || $form->dberror($query);
  963. ( $form->{orphaned} ) = $sth->fetchrow_array;
  964. $form->{orphaned} = !$form->{orphaned};
  965. $sth->finish;
  966. $dbh->commit;
  967. }
  968. =item PE->pricegroups($myconfig, $form);
  969. Populates the list referred to as $form->{item_list} with hashes containing
  970. details (id and pricegroup (description)) about pricegroups. All the groups
  971. are added unless $form->{pricegroup} is set, in which case it will search for
  972. groups with that description, or $form->{status} is 'orphaned', which limits
  973. the results to those not related to any customers (partscustomer table). The
  974. return value is the number of pricegroups added to the list.
  975. $myconfig is unused.
  976. =cut
  977. sub pricegroups {
  978. my ( $self, $myconfig, $form ) = @_;
  979. my $var;
  980. my $dbh = $form->{dbh};
  981. $form->{sort} = "pricegroup" unless $form->{sort};
  982. my @a = (pricegroup);
  983. my $sortorder = $form->sort_order( \@a );
  984. my $query = qq|SELECT g.* FROM pricegroup g|;
  985. my $where = "1 = 1";
  986. if ( $form->{pricegroup} ne "" ) {
  987. $var = $dbh->quote( $form->like( lc $form->{pricegroup} ) );
  988. $where .= " AND lower(pricegroup) LIKE $var";
  989. }
  990. $query .= qq|
  991. WHERE $where ORDER BY $sortorder|;
  992. if ( $form->{status} eq 'orphaned' ) {
  993. $query = qq|
  994. SELECT g.*
  995. FROM pricegroup g
  996. WHERE $where
  997. AND g.id NOT IN (SELECT DISTINCT pricegroup_id
  998. FROM partscustomer
  999. WHERE pricegroup_id > 0)
  1000. ORDER BY $sortorder|;
  1001. }
  1002. $sth = $dbh->prepare($query);
  1003. $sth->execute || $form->dberror($query);
  1004. my $i = 0;
  1005. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1006. push @{ $form->{item_list} }, $ref;
  1007. $i++;
  1008. }
  1009. $sth->finish;
  1010. $dbh->commit;
  1011. $i;
  1012. }
  1013. =item PE->save_pricegroup($myconfig, $form);
  1014. Adds or updates a pricegroup. If $form->{id} is set, update the pricegroup
  1015. value using $form->{pricegroup}. If $form->{id} is not set, adds a new
  1016. pricegroup with a pricegroup value of $form->{pricegroup}.
  1017. $myconfig is unused.
  1018. =cut
  1019. sub save_pricegroup {
  1020. my ( $self, $myconfig, $form ) = @_;
  1021. my $dbh = $form->{dbh};
  1022. if ( $form->{id} ) {
  1023. $query = qq|
  1024. UPDATE pricegroup SET
  1025. pricegroup = ?
  1026. WHERE id = | . $dbh->quote( $form->{id} );
  1027. }
  1028. else {
  1029. $query = qq|
  1030. INSERT INTO pricegroup (pricegroup)
  1031. VALUES (?)|;
  1032. }
  1033. $sth = $dbh->prepare($query);
  1034. $sth->execute( $form->{pricegroup} ) || $form->dberror($query);
  1035. $dbh->commit;
  1036. }
  1037. =item PE->get_pricegroup($myconfig, $form);
  1038. Sets $form->{pricegroup} to the description of the pricegroup identified by
  1039. $form->{id}. If the pricegroup is not mentioned in partscustomer,
  1040. $form->{orphaned} is set true, otherwise false.
  1041. =cut
  1042. sub get_pricegroup {
  1043. my ( $self, $myconfig, $form ) = @_;
  1044. my $dbh = $form->{dbh};
  1045. my $query = qq|SELECT * FROM pricegroup WHERE id = ?|;
  1046. my $sth = $dbh->prepare($query);
  1047. $sth->execute( $form->{id} ) || $form->dberror($query);
  1048. my $ref = $sth->fetchrow_hashref(NAME_lc);
  1049. for ( keys %$ref ) { $form->{$_} = $ref->{$_} }
  1050. $sth->finish;
  1051. # check if it is orphaned
  1052. $query = "SELECT count(*) FROM partscustomer WHERE pricegroup_id = ?";
  1053. $sth = $dbh->prepare($query);
  1054. $sth->execute( $form->{id} ) || $form->dberror($query);
  1055. ( $form->{orphaned} ) = $sth->fetchrow_array;
  1056. $form->{orphaned} = !$form->{orphaned};
  1057. $sth->finish;
  1058. $dbh->commit;
  1059. }
  1060. =item PE::description_translations('', $myconfig, $form);
  1061. Populates the list referred to as $form->{translations} with hashes detailing
  1062. non-obsolete goods and services and their translated descriptions. The main
  1063. details hash immediately precedes its set of translations and has the
  1064. attributes id, partnumber, and description. The translations have the
  1065. attributes id (same as in the main hash), language, translation, and code.
  1066. When $form->{id} is set, only adds an entry for the item having that id, but
  1067. also populates $form->{all_language} using PE::get_language. The attributes
  1068. partnumber and description are searchable and if set, will limit the results to
  1069. only those that match them.
  1070. $myconfig is unused. $form->{trans_id} is set to the last encountered part id.
  1071. =cut
  1072. sub description_translations {
  1073. my ( $self, $myconfig, $form ) = @_;
  1074. my $dbh = $form->{dbh};
  1075. my $where = "1 = 1";
  1076. my $var;
  1077. my $ref;
  1078. for (qw(partnumber description)) {
  1079. if ( $form->{$_} ) {
  1080. $var = $dbh->quote( $form->like( lc $form->{$_} ) );
  1081. $where .= " AND lower(p.$_) LIKE $var";
  1082. }
  1083. }
  1084. $where .= " AND p.obsolete = '0'";
  1085. $where .= " AND p.id = " . $dbh->quote( $form->{id} ) if $form->{id};
  1086. my %ordinal = ( 'partnumber' => 2, 'description' => 3 );
  1087. my @a = qw(partnumber description);
  1088. my $sortorder = $form->sort_order( \@a, \%ordinal );
  1089. my $query = qq|
  1090. SELECT l.description AS language,
  1091. t.description AS translation, l.code
  1092. FROM translation t
  1093. JOIN language l ON (l.code = t.language_code)
  1094. WHERE trans_id = ?
  1095. ORDER BY 1|;
  1096. my $tth = $dbh->prepare($query);
  1097. $query = qq|
  1098. SELECT p.id, p.partnumber, p.description
  1099. FROM parts p
  1100. WHERE $where
  1101. ORDER BY $sortorder|;
  1102. my $sth = $dbh->prepare($query);
  1103. $sth->execute || $form->dberror($query);
  1104. my $tra;
  1105. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1106. push @{ $form->{translations} }, $ref;
  1107. # get translations for description
  1108. $tth->execute( $ref->{id} ) || $form->dberror;
  1109. while ( $tra = $tth->fetchrow_hashref(NAME_lc) ) {
  1110. $form->{trans_id} = $ref->{id};
  1111. $tra->{id} = $ref->{id};
  1112. push @{ $form->{translations} }, $tra;
  1113. }
  1114. $tth->finish;
  1115. }
  1116. $sth->finish;
  1117. &get_language( "", $dbh, $form ) if $form->{id};
  1118. $dbh->commit;
  1119. }
  1120. =item PE::partsgroup_translations("", $myconfig, $form)
  1121. Populates the list referred to as $form->{translations} with hashrefs containing
  1122. details about partsgroups and their translated names. A master hash contains
  1123. the id and description of the partsgroup and is immediately followed by its
  1124. translation hashes, which contain the language, translation, and code of the
  1125. translation. The list contains the details for all partsgroups unless
  1126. $form->{description} is set, in which case only partsgroups with a matching
  1127. description are included, or $form->{id} is set. When $form->{id} is set, only
  1128. translations for the partgroup with that are included and $form->{all_language}
  1129. is populated by get_language.
  1130. $myconfig is unused. $form->{trans_id} is set to the last id encountered.
  1131. =cut
  1132. sub partsgroup_translations {
  1133. my ( $self, $myconfig, $form ) = @_;
  1134. my $dbh = $form->{dbh};
  1135. my $where = "1 = 1";
  1136. my $ref;
  1137. my $var;
  1138. if ( $form->{description} ) {
  1139. $var = $dbh->quote( $form->like( lc $form->{description} ) );
  1140. $where .= " AND lower(p.partsgroup) LIKE $var";
  1141. }
  1142. $where .= " AND p.id = " . $dbh->quote( $form->{id} ) if $form->{id};
  1143. my $query = qq|
  1144. SELECT l.description AS language,
  1145. t.description AS translation, l.code
  1146. FROM translation t
  1147. JOIN language l ON (l.code = t.language_code)
  1148. WHERE trans_id = ?
  1149. ORDER BY 1|;
  1150. my $tth = $dbh->prepare($query);
  1151. $form->sort_order();
  1152. $query = qq|
  1153. SELECT p.id, p.partsgroup AS description
  1154. FROM partsgroup p
  1155. WHERE $where
  1156. ORDER BY 2 $form->{direction}|;
  1157. my $sth = $dbh->prepare($query);
  1158. $sth->execute || $form->dberror($query);
  1159. my $tra;
  1160. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1161. push @{ $form->{translations} }, $ref;
  1162. # get translations for partsgroup
  1163. $tth->execute( $ref->{id} ) || $form->dberror;
  1164. while ( $tra = $tth->fetchrow_hashref(NAME_lc) ) {
  1165. $form->{trans_id} = $ref->{id};
  1166. push @{ $form->{translations} }, $tra;
  1167. }
  1168. $tth->finish;
  1169. }
  1170. $sth->finish;
  1171. &get_language( "", $dbh, $form ) if $form->{id};
  1172. $dbh->commit;
  1173. }
  1174. =item PE::project_translations("", $myconfig, $form)
  1175. Populates the list referred to as $form->{translations} with hashrefs containing
  1176. details about projects and their translated names. A master hash contains the
  1177. id, project number, and description of the project and is immediately followed
  1178. by its translation hashes, which have the same id as the master and also
  1179. contain the language, translation, and code of the translation. The list
  1180. contains the details for all projects unless $form->{description} or
  1181. $form->{projectnumber} is set, in which case only projects that match the
  1182. appropriate field are included, or $form->{id} is set. When $form->{id} is
  1183. set, only translations for the project with that id are included and
  1184. $form->{all_language} is populated by get_language.
  1185. $myconfig is unused. $form->{trans_id} is set to the last encountered id.
  1186. =cut
  1187. sub project_translations {
  1188. my ( $self, $myconfig, $form ) = @_;
  1189. my $dbh = $form->{dbh};
  1190. my $where = "1 = 1";
  1191. my $var;
  1192. my $ref;
  1193. for (qw(projectnumber description)) {
  1194. if ( $form->{$_} ) {
  1195. $var = $dbh->quote( $form->like( lc $form->{$_} ) );
  1196. $where .= " AND lower(p.$_) LIKE $var";
  1197. }
  1198. }
  1199. $where .= " AND p.id = " . $dbh->quote( $form->{id} ) if $form->{id};
  1200. my %ordinal = ( 'projectnumber' => 2, 'description' => 3 );
  1201. my @a = qw(projectnumber description);
  1202. my $sortorder = $form->sort_order( \@a, \%ordinal );
  1203. my $query = qq|
  1204. SELECT l.description AS language,
  1205. t.description AS translation, l.code
  1206. FROM translation t
  1207. JOIN language l ON (l.code = t.language_code)
  1208. WHERE trans_id = ?
  1209. ORDER BY 1|;
  1210. my $tth = $dbh->prepare($query);
  1211. $query = qq|
  1212. SELECT p.id, p.projectnumber, p.description
  1213. FROM project p
  1214. WHERE $where
  1215. ORDER BY $sortorder|;
  1216. my $sth = $dbh->prepare($query);
  1217. $sth->execute || $form->dberror($query);
  1218. my $tra;
  1219. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1220. push @{ $form->{translations} }, $ref;
  1221. # get translations for description
  1222. $tth->execute( $ref->{id} ) || $form->dberror;
  1223. while ( $tra = $tth->fetchrow_hashref(NAME_lc) ) {
  1224. $form->{trans_id} = $ref->{id};
  1225. $tra->{id} = $ref->{id};
  1226. push @{ $form->{translations} }, $tra;
  1227. }
  1228. $tth->finish;
  1229. }
  1230. $sth->finish;
  1231. &get_language( "", $dbh, $form ) if $form->{id};
  1232. $dbh->commit;
  1233. }
  1234. =item PE::get_language("", $dbh, $form)
  1235. Populates the list referred to as $form->{all_language} with hashes containing
  1236. the code and description of all languages registered with the system in the
  1237. language table.
  1238. =cut
  1239. sub get_language {
  1240. my ( $self, $dbh, $form ) = @_;
  1241. my $query = qq|SELECT * FROM language ORDER BY 2|;
  1242. my $sth = $dbh->prepare($query);
  1243. $sth->execute || $form->dberror($query);
  1244. while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1245. push @{ $form->{all_language} }, $ref;
  1246. }
  1247. $sth->finish;
  1248. }
  1249. =item PE::save_translation("", $myconfig, $form);
  1250. Deletes all translations with the trans_id (part id, project id, or partsgroup
  1251. id) of $form->{id} then adds new entries for $form->{id}. The number of
  1252. translation entries is obtained from $form->{translation_rows}. The actual
  1253. translation entries are derived from $form->{language_code_I<i>} and
  1254. $form->{translation_I<i>}, where I<i> is some integer between 1 and
  1255. $form->{translation_rows} inclusive.
  1256. $myconfig is unused.
  1257. =cut
  1258. sub save_translation {
  1259. my ( $self, $myconfig, $form ) = @_;
  1260. my $dbh = $form->{dbh};
  1261. my $query = qq|DELETE FROM translation WHERE trans_id = ?|;
  1262. $sth = $dbh->prepare($query);
  1263. $sth->execute( $form->{id} ) || $form->dberror($query);
  1264. $query = qq|
  1265. INSERT INTO translation (trans_id, language_code, description)
  1266. VALUES (?, ?, ?)|;
  1267. my $sth = $dbh->prepare($query) || $form->dberror($query);
  1268. foreach my $i ( 1 .. $form->{translation_rows} ) {
  1269. if ( $form->{"language_code_$i"} ne "" ) {
  1270. $sth->execute(
  1271. $form->{id},
  1272. $form->{"language_code_$i"},
  1273. $form->{"translation_$i"}
  1274. );
  1275. $sth->finish;
  1276. }
  1277. }
  1278. $dbh->commit;
  1279. }
  1280. =item PE::delete_translation("", $myconfig, $form);
  1281. Deletes all translation entries that have the trans_id of $form->{id}.
  1282. $myconfig is unused.
  1283. =cut
  1284. sub delete_translation {
  1285. my ( $self, $myconfig, $form ) = @_;
  1286. my $dbh = $form->{dbh};
  1287. my $query = qq|DELETE FROM translation WHERE trans_id = ?|;
  1288. $sth = $dbh->prepare($query);
  1289. $sth->execute( $form->{id} ) || $form->dberror($query);
  1290. $dbh->commit;
  1291. }
  1292. =item PE->timecard_get_currency($form);
  1293. Sets $form->{currency} to the currency set for the customer who has the id
  1294. $form->{customer_id}.
  1295. =cut
  1296. sub timecard_get_currency {
  1297. my $self = shift @_;
  1298. my $form = shift @_;
  1299. my $dbh = $form->{dbh};
  1300. my $query = qq|SELECT curr FROM customer WHERE id = ?|;
  1301. my $sth = $dbh->prepare($query);
  1302. $sth->execute( $form->{customer_id} );
  1303. my ($curr) = $sth->fetchrow_array;
  1304. $form->{currency} = $curr;
  1305. }
  1306. =item PE::project_sales_order("", $myconfig, $form)
  1307. Executes $form->all_years, $form->all_projects, and $form->all_employees, with
  1308. a limiting transdate of the current date.
  1309. =cut
  1310. sub project_sales_order {
  1311. my ( $self, $myconfig, $form ) = @_;
  1312. # connect to database
  1313. my $dbh = $form->{dbh};
  1314. my $query = qq|SELECT current_date|;
  1315. my ($transdate) = $dbh->selectrow_array($query);
  1316. $form->all_years( $myconfig, $dbh );
  1317. $form->all_projects( $myconfig, $dbh, $transdate );
  1318. $form->all_employees( $myconfig, $dbh, $transdate );
  1319. $dbh->commit;
  1320. }
  1321. =item PE->get_jcitems($myconfig, $form);
  1322. This function is used as part of the sales order generation accessible from the
  1323. projects interface, to generate the list of possible orders.
  1324. Populates the list referred to as $form->{jcitems} with hashes containing
  1325. details about sales orders that can be generated that relate to projects. Each
  1326. of the hashes has the attributes id (timecard id), description (timecard
  1327. description), qty (unallocated chargeable hours), sellprice (hourly rate),
  1328. parts_id (service id), customer_id, project_id, transdate (date on timecard),
  1329. notes, customer (customer name), projectnumber, partnumber, taxaccounts (space
  1330. separated list that contains the account numbers of taxes that apply to the
  1331. service), and amount (qty*sellprice). If $form->{summary} is true, the
  1332. description field contains the service description instead of the timecard
  1333. description.
  1334. All possible, unconsolidated sales orders are normally listed. If
  1335. $form->{projectnumber} is set, only orders associated with the project are
  1336. listed. $form->{employee} limits the list to timecards with the given employee.
  1337. When $form->{year} and $form->{month} are set, the transdatefrom and transdateto
  1338. attributes are populated with values derived from the year, month, and interval
  1339. $form attributes. $form->{transdatefrom} is used to limit the results to
  1340. time cards checked in on or after that date. $form->{transdateto} limits to
  1341. time cards checked out on or before the provided date. $form->{vc} must be
  1342. 'customer'.
  1343. Regardless of the values added to $form->{jcitems}, this function sets
  1344. $form->{currency} and $form->{defaultcurrency} to the first currency mentioned
  1345. in defaults. It also fills $form->{taxaccounts} with a space separated list
  1346. of the account numbers of all tax accounts and for each accno forms a
  1347. $form->{${accno}_rate} attribute that contains the tax's rate as expressed in
  1348. the tax table.
  1349. $myconfig is unused.
  1350. =cut
  1351. sub get_jcitems {
  1352. my ( $self, $myconfig, $form ) = @_;
  1353. my $dbh = $form->{dbh};
  1354. my $null;
  1355. my $var;
  1356. my $where;
  1357. if ( $form->{projectnumber} ) {
  1358. ( $null, $var ) = split /--/, $form->{projectnumber};
  1359. $var = $dbh->quote($var);
  1360. $where .= " AND j.project_id = $var";
  1361. }
  1362. if ( $form->{employee} ) {
  1363. ( $null, $var ) = split /--/, $form->{employee};
  1364. $var = $dbh->quote($var);
  1365. $where .= " AND j.employee_id = $var";
  1366. }
  1367. ( $form->{transdatefrom}, $form->{transdateto} ) =
  1368. $form->from_to( $form->{year}, $form->{month}, $form->{interval} )
  1369. if $form->{year} && $form->{month};
  1370. if ( $form->{transdatefrom} ) {
  1371. $where .=
  1372. " AND j.checkedin >= " . $dbh->quote( $form->{transdatefrom} );
  1373. }
  1374. if ( $form->{transdateto} ) {
  1375. $where .=
  1376. " AND j.checkedout <= (date "
  1377. . $dbh->quote( $form->{transdateto} )
  1378. . " + interval '1 days')";
  1379. }
  1380. my $query;
  1381. my $ref;
  1382. $query = qq|
  1383. SELECT j.id, j.description, j.qty - j.allocated AS qty,
  1384. j.sellprice, j.parts_id, pr.$form->{vc}_id,
  1385. j.project_id, j.checkedin::date AS transdate,
  1386. j.notes, c.name AS $form->{vc}, pr.projectnumber,
  1387. p.partnumber
  1388. FROM jcitems j
  1389. JOIN project pr ON (pr.id = j.project_id)
  1390. JOIN employee e ON (e.id = j.employee_id)
  1391. JOIN parts p ON (p.id = j.parts_id)
  1392. LEFT JOIN $form->{vc} c ON (c.id = pr.$form->{vc}_id)
  1393. WHERE pr.parts_id IS NULL
  1394. AND j.allocated != j.qty $where
  1395. ORDER BY pr.projectnumber, c.name, j.checkedin::date|;
  1396. if ( $form->{summary} ) {
  1397. $query =~ s/j\.description/p\.description/;
  1398. $query =~ s/c\.name,/c\.name, j\.parts_id, /;
  1399. }
  1400. $sth = $dbh->prepare($query);
  1401. $sth->execute || $form->dberror($query);
  1402. # tax accounts
  1403. $query = qq|
  1404. SELECT c.accno
  1405. FROM chart c
  1406. JOIN partstax pt ON (pt.chart_id = c.id)
  1407. WHERE pt.parts_id = ?|;
  1408. my $tth = $dbh->prepare($query) || $form->dberror($query);
  1409. my $ptref;
  1410. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1411. $form->db_parse_numeric(sth=>$sth, hashref=>$ref);
  1412. $tth->execute( $ref->{parts_id} );
  1413. $ref->{taxaccounts} = "";
  1414. while ( $ptref = $tth->fetchrow_hashref(NAME_lc) ) {
  1415. $ref->{taxaccounts} .= "$ptref->{accno} ";
  1416. }
  1417. $tth->finish;
  1418. chop $ref->{taxaccounts};
  1419. $ref->{amount} = $ref->{sellprice} * $ref->{qty};
  1420. push @{ $form->{jcitems} }, $ref;
  1421. }
  1422. $sth->finish;
  1423. $query = qq|SELECT value FROM defaults WHERE setting_key = 'curr'|;
  1424. ( $form->{currency} ) = $dbh->selectrow_array($query);
  1425. $form->{currency} =~ s/:.*//;
  1426. $form->{defaultcurrency} = $form->{currency};
  1427. $query = qq|
  1428. SELECT c.accno, t.rate
  1429. FROM tax t
  1430. JOIN chart c ON (c.id = t.chart_id)|;
  1431. $sth = $dbh->prepare($query);
  1432. $sth->execute || $form->dberror($query);
  1433. while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) {
  1434. $form->{taxaccounts} .= "$ref->{accno} ";
  1435. $form->{"$ref->{accno}_rate"} = $ref->{rate};
  1436. }
  1437. chop $form->{taxaccounts};
  1438. $sth->finish;
  1439. $dbh->commit;
  1440. }
  1441. =item PE->allocate_projectitems($myconfig, $form);
  1442. Updates the jcitems table to adjust the allocated quantities of time. The
  1443. time cards, and allocated time, to update is obtained from the various space
  1444. separated lists $form->{jcitems_I<i>}, where I<i> is between 1 and the value of
  1445. $form->{rowcount}. Each element of those space separated lists is a colon
  1446. separated pair where the first element is the time card id and the second
  1447. element is the increase in allocated hours.
  1448. $myconfig is unused.
  1449. =cut
  1450. sub allocate_projectitems {
  1451. my ( $self, $myconfig, $form ) = @_;
  1452. my $dbh = $form->{dbh};
  1453. for my $i ( 1 .. $form->{rowcount} ) {
  1454. for ( split / /, $form->{"jcitems_$i"} ) {
  1455. my ( $id, $qty ) = split /:/, $_;
  1456. $form->update_balance( $dbh, 'jcitems', 'allocated', "id = $id",
  1457. $qty );
  1458. }
  1459. }
  1460. $rc = $dbh->commit;
  1461. $rc;
  1462. }
  1463. 1;
  1464. =back