summaryrefslogtreecommitdiff
path: root/scripts/vouchers.pl
blob: 5173045aed14e195b32e3e9976e2649b50021296 (plain)
  1. #!/usr/bin/perl
  2. # This file is copyright (C) 2007the LedgerSMB core team and licensed under
  3. # the GNU General Public License. For more information please see the included
  4. # LICENSE and COPYRIGHT files
  5. # THIS FILE NEEDS POD
  6. package LedgerSMB::Scripts::vouchers;
  7. our $VERSION = '0.1';
  8. $menufile = "menu.ini";
  9. use LedgerSMB::Batch;
  10. use LedgerSMB::Voucher;
  11. use LedgerSMB::Template;
  12. use strict;
  13. # custom_batch_types hash provides hooks for handling additional batch types
  14. # beyond the default types. Entries can be added in a custom file.
  15. # Each entry is a hash, keyed by name, with the following keys:
  16. # * map_to int (maps to another type, not needed for new types in batch_class
  17. # table)
  18. # * select_method (maps to the selection stored proc)
  19. #
  20. # for example:
  21. # $custom_batch_types->{ap_sample} =
  22. # {map_to => 1,
  23. # select_method => 'custom_sample_ap_select'};
  24. #
  25. # --CT
  26. our $custom_batch_types = {};
  27. eval { do "scripts/custom/vouchers.pl"};
  28. sub create_batch {
  29. my ($request) = @_;
  30. $request->{hidden} = [
  31. {name => "batch_type", value => $request->{batch_type}},
  32. ];
  33. my $batch = LedgerSMB::Batch->new({base => $request});
  34. $batch->{class_id} = $batch->get_class_id($batch->{batch_type});
  35. $batch->get_search_results({mini => 1});
  36. my $template = LedgerSMB::Template->new(
  37. user =>$request->{_user},
  38. locale => $request->{_locale},
  39. path => 'UI',
  40. template => 'create_batch',
  41. format => 'HTML'
  42. );
  43. $template->render($batch);
  44. }
  45. sub create_vouchers {
  46. my ($request) = shift @_;
  47. my $batch = LedgerSMB::Batch->new({base => $request});
  48. $batch->{batch_class} = $request->{batch_type};
  49. $batch->create;
  50. add_vouchers($batch);
  51. }
  52. sub add_vouchers {
  53. # This function is not safe for caching as long as the scripts are in bin.
  54. # This is because these scripts import all functions into the *current*
  55. # namespace. People using fastcgi and modperl should *not* cache this
  56. # module at the moment. -- CT
  57. # Also-- request is in 'our' scope here due to the redirect logic.
  58. our ($request) = shift @_;
  59. use LedgerSMB::Form;
  60. my $batch = LedgerSMB::Batch->new({base => $request});
  61. our $vouchers_dispatch =
  62. {
  63. ap => {script => 'bin/ap.pl', function => sub {add()}},
  64. ar => {script => 'bin/ar.pl', function => sub {add()}},
  65. gl => {script => 'bin/gl.pl', function => sub {add()}},
  66. receipt => {script => 'scripts/payment.pl',
  67. function => sub {
  68. my ($request) = @_;
  69. $request->{account_class} = 2;
  70. LedgerSMB::Scripts::payment::payments($request);
  71. }},
  72. payment => {script => 'scripts/payment.pl',
  73. function => sub {
  74. my ($request) = @_;
  75. $request->{account_class} = 1;
  76. LedgerSMB::Scripts::payment::payments($request);
  77. }},
  78. payment_reversal => {
  79. script => 'scripts/payment.pl',
  80. function => sub {
  81. my ($request) = @_;
  82. $request->{account_class} = 1;
  83. LedgerSMB::Scripts::payment::get_search_criteria($request, $custom_batch_types);
  84. }},
  85. receipt_reversal => {
  86. script => 'scripts/payment.pl',
  87. function => sub {
  88. my ($request) = @_;
  89. $request->{account_class} = 2;
  90. LedgerSMB::Scripts::payment::get_search_criteria($request, $custom_batch_types);
  91. }},
  92. };
  93. our $form = new Form;
  94. our $locale = $request->{_locale};
  95. for (keys %$request){
  96. $form->{$_} = $request->{$_};
  97. }
  98. $form->{batch_id} = $batch->{id};
  99. $form->{approved} = 0;
  100. $form->{transdate} = $request->{batch_date};
  101. $request->{batch_id} = $batch->{id};
  102. $request->{approved} = 0;
  103. $request->{transdate} = $request->{batch_date};
  104. my $script = $vouchers_dispatch->{$request->{batch_type}}{script};
  105. $form->{script} = $script;
  106. $form->{script} =~ s|.*/||;
  107. delete $form->{id};
  108. delete $request->{id};
  109. if ($script =~ /^bin/){
  110. # Note that the line below is generally considered incredibly bad form.
  111. # However, the code we are including is going to require it for now.
  112. # -- CT
  113. { no strict; no warnings 'redefine'; do $script; }
  114. } elsif ($script =~ /scripts/) {
  115. # Maybe we should move this to a require statement? --CT
  116. { do $script }
  117. }
  118. $vouchers_dispatch->{$request->{batch_type}}{function}($request);
  119. }
  120. sub search_batch {
  121. my ($request) = @_;
  122. my $batch_request = LedgerSMB::Batch->new(base => $request);
  123. $batch_request->get_search_criteria($custom_batch_types);
  124. my $template = LedgerSMB::Template->new(
  125. user => $request->{_user},
  126. locale => $request->{_locale},
  127. path => 'UI/batch',
  128. template => 'filter',
  129. format => 'HTML',
  130. );
  131. $template->render($batch_request);
  132. }
  133. sub list_batches {
  134. my ($request) = @_;
  135. my $batch = LedgerSMB::Batch->new(base => $request);
  136. my @search_results = $batch->get_search_results({custom_types => $custom_batch_types});
  137. $batch->{script} = "vouchers.pl";
  138. my @columns =
  139. qw(select id control_code description transaction_total payment_total);
  140. my $base_href = "vouchers.pl";
  141. my $search_href = "$base_href?action=list_batches";
  142. my $batch_href = "$base_href?action=get_batch";
  143. for my $key (
  144. qw(class_id approved created_by description amount_gt amount_lt)
  145. ){
  146. $search_href .= "&$key=$batch->{key}";
  147. }
  148. my %column_heading = (
  149. 'select' => $batch->{_locale}->text('Select'),
  150. transaction_total => {
  151. text => $batch->{_locale}->text('AR/AP/GL Total'),
  152. href => "$search_href&order_by=transaction_total"
  153. },
  154. payment_total => {
  155. text => $batch->{_locale}->text('Paid/Received Total'),
  156. href => "$search_href&order_by=payment_total"
  157. },
  158. description => {
  159. text => $batch->{_locale}->text('Description'),
  160. href => "$search_href&order_by=description"
  161. },
  162. control_code => {
  163. text => $batch->{_locale}->text('Batch Number'),
  164. href => "$search_href&order_by=control_code"
  165. },
  166. id => {
  167. text => $batch->{_locale}->text('ID'),
  168. href => "$search_href&order_by=control_code"
  169. },
  170. );
  171. my $count = 0;
  172. my @rows;
  173. for my $result (@search_results){
  174. ++$count;
  175. $batch->{"row_$count"} = $result->{id};
  176. push @rows, {
  177. 'select' => {
  178. input => {
  179. type => 'checkbox',
  180. value => 1,
  181. name => "batch_$result->{id}"
  182. }
  183. },
  184. transaction_total => $batch->format_amount(
  185. amount => $result->{transaction_total}
  186. ),
  187. payment_total => $batch->format_amount (
  188. amount => $result->{payment_total}
  189. ),
  190. description => $result->{description},
  191. control_code => {
  192. text => $result->{control_code},
  193. href => "$batch_href&batch_id=$result->{id}",
  194. },
  195. id => $result->{id},
  196. };
  197. }
  198. $batch->{rowcount} = $count;
  199. my $template = LedgerSMB::Template->new(
  200. user => $request->{_user},
  201. locale => $request->{_locale},
  202. path => 'UI',
  203. template => 'form-dynatable',
  204. format => ($batch->{format}) ? $batch->{format} : 'HTML',
  205. );
  206. my $hiddens = $batch->take_top_level();
  207. $batch->{rowcount} = "$count";
  208. delete $batch->{search_results};
  209. $template->render({
  210. form => $batch,
  211. columns => \@columns,
  212. heading => \%column_heading,
  213. rows => \@rows,
  214. hiddens => $hiddens,
  215. buttons => [{
  216. name => 'action',
  217. type => 'submit',
  218. text => $request->{_locale}->text('Post'),
  219. value => 'batch_approve',
  220. class => 'submit',
  221. },{
  222. name => 'action',
  223. type => 'submit',
  224. text => $request->{_locale}->text('Delete'),
  225. value => 'batch_delete',
  226. class => 'submit',
  227. }]
  228. });
  229. }
  230. sub get_batch {
  231. my ($request) = @_;
  232. my $batch = LedgerSMB::Batch->new(base => $request);
  233. $batch->{script} = 'vouchers.pl';
  234. my $rows = [];
  235. $batch->{id} ||= $batch->{batch_id};
  236. # $batch->get;
  237. my @vouchers = $batch->list_vouchers;
  238. my $base_href = "vouchers.pl?action=get_batch&batch_id=$batch->{batch_id}";
  239. my @columns = qw(selected id description batch_class reference amount date);
  240. my $heading = {
  241. selected => $request->{_locale}->text('Selected'),
  242. id => {
  243. text => $request->{_locale}->text('ID'),
  244. href => "$base_href&order_by=id"
  245. },
  246. description => {
  247. href => "$base_href&order_by=description",
  248. text => $request->{_locale}->text('Description'),
  249. },
  250. batch_class => {
  251. text => $request->{_locale}->text('Class'),
  252. href => "$base_href&order_by=class"
  253. },
  254. amount => {
  255. text => $request->{_locale}->text('Amount'),
  256. href => "$base_href&order_by=amount"
  257. },
  258. reference => {
  259. text => $request->{_locale}->text('Source/Reference'),
  260. href => "$base_href&order_by=reference"
  261. },
  262. date => {
  263. text => $request->{_locale}->text('Date'),
  264. href => "$base_href&order_by=date"
  265. }
  266. };
  267. my $classcount;
  268. my $count = 1;
  269. for my $row (@vouchers) {
  270. $classcount = ($classcount + 1) % 2;
  271. $classcount ||= 0;
  272. push @$rows, {
  273. description => $row->{description},
  274. id => $row->{id},
  275. batch_class => $row->{batch_class},
  276. amount => $batch->format_amount(amount => $row->{amount}),
  277. date => $row->{transaction_date},
  278. reference => $row->{reference},
  279. i => "$classcount",
  280. selected => {
  281. input => {
  282. type => 'checkbox',
  283. name => "voucher_$row->{id}",
  284. value => "1"
  285. }
  286. }
  287. };
  288. $batch->{"row_$count"} = $row->{id};
  289. ++$count;
  290. }
  291. $batch->{rowcount} = $count;
  292. $batch->{title} = "Batch ID: $batch->{batch_id}";
  293. my $template = LedgerSMB::Template->new(
  294. user => $request->{_user},
  295. locale => $request->{_locale},
  296. path => 'UI',
  297. template => 'form-dynatable',
  298. format => ($batch->{format}) ? $batch->{format} : 'HTML',
  299. );
  300. my $hiddens = $batch->take_top_level();
  301. $template->render({
  302. form => $batch,
  303. columns => \@columns,
  304. heading => $heading,
  305. rows => $rows,
  306. hiddens => $hiddens,
  307. buttons => [{
  308. name => 'action',
  309. type => 'submit',
  310. text => $request->{_locale}->text('Post Batch'),
  311. value => 'batch_approve',
  312. class => 'submit',
  313. },{
  314. name => 'action',
  315. type => 'submit',
  316. text => $request->{_locale}->text('Delete Batch'),
  317. value => 'batch_delete',
  318. class => 'submit',
  319. },{
  320. name => 'action',
  321. type => 'submit',
  322. text => $request->{_locale}->text('Delete Vouchers'),
  323. value => 'voucher_delete',
  324. class => 'submit',
  325. }]
  326. });
  327. }
  328. sub list_batches_batch_delete {
  329. batch_delete(@_);
  330. }
  331. sub list_batches_batch_approve {
  332. batch_approve(@_);
  333. }
  334. sub get_batch__batch_approve {
  335. batch_approve(@_);
  336. }
  337. sub get_batch_voucher_delete {
  338. my ($request) = @_;
  339. my $batch = LedgerSMB::Batch->new(base => $request);
  340. for my $count (1 .. $batch->{rowcount}){
  341. my $voucher_id = $batch->{"row_$count"};
  342. next unless $batch->{"voucher_$voucher_id"};
  343. $batch->delete_voucher($voucher_id);
  344. }
  345. search_batch($request);
  346. }
  347. sub batch_approve {
  348. my ($request) = @_;
  349. my $batch = LedgerSMB::Batch->new(base => $request);
  350. for my $count (1 .. $batch->{rowcount}){
  351. next unless $batch->{"batch_" . $batch->{"row_$count"}};
  352. $batch->{batch_id} = $batch->{"row_$count"};
  353. $batch->post;
  354. }
  355. search_batch($request);
  356. }
  357. sub batch_delete {
  358. my ($request) = @_;
  359. my $batch = LedgerSMB::Batch->new(base => $request);
  360. for my $count (1 .. $batch->{rowcount}){
  361. next unless $batch->{"batch_" . $batch->{"row_$count"}};
  362. $batch->{batch_id} = $batch->{"row_$count"};
  363. $batch->delete;
  364. }
  365. search_batch($request);
  366. }
  367. eval { do "scripts/custom/vouchers.pl"};
  368. 1;