1 #=====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #=====================================================================
8 # SQL-Ledger Accounting
11 # Author: Dieter Simader
12 # Email: dsimader@sql-ledger.org
13 # Web: http://www.sql-ledger.org
16 # This program is free software; you can redistribute it and/or modify
17 # it under the terms of the GNU General Public License as published by
18 # the Free Software Foundation; either version 2 of the License, or
19 # (at your option) any later version.
21 # This program is distributed in the hope that it will be useful,
22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 # GNU General Public License for more details.
25 # You should have received a copy of the GNU General Public License
26 # along with this program; if not, write to the Free Software
27 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
28 #======================================================================
30 # common routines for gl, ar, ap, is, ir, oe
37 # any custom scripts for this one
38 if (-f "bin/mozilla/custom_arap.pl") {
39 eval { require "bin/mozilla/custom_arap.pl"; };
41 if (-f "bin/mozilla/$main::form->{login}_arap.pl") {
42 eval { require "bin/mozilla/$main::form->{login}_arap.pl"; };
47 require "bin/mozilla/common.pl";
52 $main::lxdebug->enter_sub();
54 my $form = $main::form;
55 my %myconfig = %main::myconfig;
56 my $locale = $main::locale;
58 $main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
59 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash |' .
60 'purchase_delivery_order_edit | sales_delivery_order_edit');
62 my ($name, %params) = @_;
64 $name = $name eq "customer" ? "customer" : "vendor";
66 my ($new_name, $new_id) = split /--/, $form->{$name};
68 # if we use a selection
69 if ($form->{"select$name"}) {
70 if ($form->{"old$name"} ne $form->{$name}) {
72 # this is needed for is, ir and oe
74 # for credit calculations
75 $form->{oldinvtotal} = 0;
76 $form->{oldtotalpaid} = 0;
79 $form->{"${name}_id"} = $new_id;
81 IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
82 IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
84 $form->{$name} = $form->{"old$name"} = "$new_name--$new_id";
90 # check name, combine name and id
91 if ($form->{"old$name"} ne qq|$form->{$name}--$form->{"${name}_id"}|) {
93 # this is needed for is, ir and oe
96 # for credit calculations
97 $form->{oldinvtotal} = 0;
98 $form->{oldtotalpaid} = 0;
101 # return one name or a list of names in $form->{name_list}
102 $i = $form->get_name(\%myconfig, $name);
105 if ($params{no_select}) {
106 # $locale->text('Customer')
107 # $locale->text('Vendor')
108 $form->error($locale->text("More than one #1 found matching, please be more specific.", $locale->text(ucfirst $name)));
118 $form->{"${name}_id"} = $form->{name_list}[0]->{id};
119 $form->{$name} = $form->{name_list}[0]->{name};
120 $form->{"old$name"} = qq|$form->{$name}--$form->{"${name}_id"}|;
122 IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
123 IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
127 # name is not on file
128 # $locale->text('Customer not on file or locked!')
129 # $locale->text('Vendor not on file or locked!')
130 my $msg = ucfirst $name . " not on file or locked!";
131 $form->error($locale->text($msg));
135 $form->language_payment(\%myconfig);
137 $main::lxdebug->leave_sub();
142 # $locale->text('Customer not on file!')
143 # $locale->text('Vendor not on file!')
146 $main::lxdebug->enter_sub();
148 my $form = $main::form;
149 my $locale = $main::locale;
151 $main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
152 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');
156 my @column_index = qw(ndx name address);
158 my $label = ucfirst $table;
160 $column_data{ndx} = qq|<th> </th>|;
162 qq|<th class=listheading>| . $locale->text($label) . qq|</th>|;
163 $column_data{address} =
164 qq|<th class=listheading>| . $locale->text('Address') . qq|</th>|;
166 # list items with radio button on a form
169 my $title = $locale->text('Select from one of the names below');
174 <form method=post action=$form->{script}>
178 <th class=listtop>$title</th>
184 <tr class=listheading>|;
186 map { print "\n$column_data{$_}" } @column_index;
194 foreach my $ref (@{ $form->{name_list} }) {
195 my $checked = ($i++) ? "" : "checked";
197 $ref->{name} =~ s/\"/"/g;
200 qq|<td><input name=ndx class=radio type=radio value=$i $checked></td>|;
202 qq|<td><input name="new_name_$i" type=hidden value="$ref->{name}">$ref->{name}</td>|;
203 $column_data{address} = qq|<td>$ref->{address} </td>|;
208 <tr class=listrow$j>|;
210 map { print "\n$column_data{$_}" } @column_index;
215 <input name="new_id_$i" type=hidden value=$ref->{id}>
226 <td><hr size=3 noshade></td>
230 <input name=lastndx type=hidden value=$i>
235 map { delete $form->{$_} } qw(action name_list header);
237 # save all other form variables
238 foreach my $key (keys %${form}) {
239 next if (($key eq 'login') || ($key eq 'password') || ('' ne ref $form->{$key}));
240 $form->{$key} =~ s/\"/"/g;
241 print qq|<input name=$key type=hidden value="$form->{$key}">\n|;
245 <input type=hidden name=nextsub value=name_selected>
247 <input type=hidden name=vc value=$table>
249 <input class=submit type=submit name=action value="|
250 . $locale->text('Continue') . qq|">
256 $main::lxdebug->leave_sub();
260 $main::lxdebug->enter_sub();
262 my $form = $main::form;
263 my %myconfig = %main::myconfig;
265 $main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
266 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');
268 # replace the variable with the one checked
271 my $i = $form->{ndx};
273 $form->{ $form->{vc} } = $form->{"new_name_$i"};
274 $form->{"$form->{vc}_id"} = $form->{"new_id_$i"};
275 $form->{"old$form->{vc}"} =
276 qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|;
278 # delete all the new_ variables
279 for $i (1 .. $form->{lastndx}) {
280 map { delete $form->{"new_${_}_$i"} } qw(id name);
283 map { delete $form->{$_} } qw(ndx lastndx nextsub);
285 IS->get_customer(\%myconfig, \%$form) if ($form->{vc} eq 'customer');
286 IR->get_vendor(\%myconfig, \%$form) if ($form->{vc} eq 'vendor');
290 $main::lxdebug->leave_sub();
294 $main::lxdebug->enter_sub();
296 my $form = $main::form;
297 my $locale = $main::locale;
299 $main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
300 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash | report');
302 my $nextsub = shift || 'update';
304 for my $i (1 .. $form->{rowcount}) {
305 my $suffix = $i ? "_$i" : "";
306 my $prefix = $i ? "" : "global";
307 $form->{"${prefix}project_id${suffix}"} = "" unless $form->{"${prefix}projectnumber$suffix"};
308 if ($form->{"${prefix}projectnumber${suffix}"} ne $form->{"old${prefix}projectnumber${suffix}"}) {
309 if ($form->{"${prefix}projectnumber${suffix}"}) {
312 $form->{projectnumber} = $form->{"${prefix}projectnumber${suffix}"};
313 my %params = map { $_ => $form->{$_} } qw(projectnumber description active);
315 if (($rows = Projects->search_projects(%params)) > 1) {
317 # check form->{project_list} how many there are
318 $form->{rownumber} = $i;
319 &select_project($i ? undef : 1, $nextsub);
324 $form->{"${prefix}project_id${suffix}"} = $form->{project_list}->[0]->{id};
325 $form->{"${prefix}projectnumber${suffix}"} = $form->{project_list}->[0]->{projectnumber};
326 $form->{"old${prefix}projectnumber${suffix}"} = $form->{project_list}->[0]->{projectnumber};
330 $form->error($locale->text('Project not on file!'));
333 $form->{"old${prefix}projectnumber${suffix}"} = "";
338 $main::lxdebug->leave_sub();
342 $::lxdebug->enter_sub;
344 $::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
345 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash | report');
347 my ($is_global, $nextsub) = @_;
348 my $project_list = delete $::form->{project_list};
350 map { delete $::form->{$_} } qw(action header update);
353 for my $key (keys %$::form) {
354 next if $key eq 'login' || $key eq 'password' || '' ne ref $::form->{$key};
355 push @hiddens, { key => $key, value => $::form->{$key} };
357 push @hiddens, { key => 'is_global', value => $is_global },
358 { key => 'project_selected_nextsub', value => $nextsub };
361 print $::form->parse_html_template('arap/select_project', { hiddens => \@hiddens, project_list => $project_list });
363 $::lxdebug->leave_sub;
366 sub project_selected {
367 $main::lxdebug->enter_sub();
369 my $form = $main::form;
371 $main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
372 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash | report');
374 # replace the variable with the one checked
377 my $i = $form->{ndx};
379 my $prefix = $form->{"is_global"} ? "global" : "";
380 my $suffix = $form->{"is_global"} ? "" : "_$form->{rownumber}";
382 $form->{"${prefix}projectnumber${suffix}"} =
383 $form->{"new_projectnumber_$i"};
384 $form->{"old${prefix}projectnumber${suffix}"} =
385 $form->{"new_projectnumber_$i"};
386 $form->{"${prefix}project_id${suffix}"} = $form->{"new_id_$i"};
388 # delete all the new_ variables
389 for $i (1 .. $form->{lastndx}) {
390 map { delete $form->{"new_${_}_$i"} } qw(id projectnumber description);
393 my $nextsub = $form->{project_selected_nextsub} || 'update';
395 map { delete $form->{$_} } qw(ndx lastndx nextsub is_global project_selected_nextsub);
399 $main::lxdebug->leave_sub();
402 sub continue { call_sub($main::form->{"nextsub"}); }
410 arap.pl - helper functions or customer/vendor retrieval
419 Don't use anyting in this file without extreme care, and even then be prepared for massive headaches.
421 It's a collection of helper routines that wrap the customer/vendor dropdown/textfield duality into something even complexer.
425 =head2 check_name customer|vendor
427 check_name was originally meant to update the selected customer or vendor. The
428 way it does that has generted more hate than almost any other part of this
437 It checks if a vendor or customer is given. No failsafe, vendor fallback if
438 $_[0] is something fancy.
442 It assumes, that there is a field named customer or vendor in $form.
446 It assumes, that this field is filled with name--id, and tries to split that.
447 sql ledger uses that combination to get ids into the select keys.
451 It looks for a field selectcustomer or selectvendor in $form. sql ledger used
452 to store a copy of the html select in there. (again, don't ask)
456 If this field exists, it looks for a field called oldcustomer or oldvendor, in
457 which the old name--id string was stored in sql ledger, and compares those.
461 if they don't match, it will set customer_id or vendor_id in $form, load the
462 entry (which will clobber everything in $form named like a column in customer
463 oder vendor) and return.
467 If there was no select* entry, it assumes that vclimit was lower than the
468 number of entries, and that an input field was generated. In that case the
469 splitting is omitted (since users don't generally include ids in entered names)
473 It looks for a *_id field, and combines it with the given input into a name--id
474 entry and compares it to the old* entry. (Missing any of these will instantly
479 If those do not match, $form->get_name is called to get matching results.
480 get_name only matches by *number and name, not by id, don't try to get it to do
485 The results are stored in $form>{name_list} but a count is returned, and
490 If only one result was found, *_id, * and old* are copied into $form, the entry
491 is loaded (like above, clobbering)
495 If there is more than one, a selection dialog is rendered
499 If none is found, an error is generated.
503 =head3 I built a customer/vendor box somewhere and it doesn't work, what's wrong?
505 Make sure a select* field is given if and only if you render a select box. The
506 actual contents are ignored, but recognition fails if not present.
508 Make sure old* and *_id fields are set correctly (name--id form for old*). They
509 are necessary in all steps and branches.
511 Since get_customer and get_vendor clobber a lot of fields, make sure what
514 =head3 select- version works fine, but things go awry when I use a textbox, any idea?
516 If there is more than one match, check_name will display a select form, that
517 will redirect to the original C<nextsub>. Unfortunately any hidden vars or
518 input fields will be lost in the process unless saved before in a callback.
520 If you still want to use it, you can disable this feature, like this:
522 check_name('customer', no_select => 1)
524 In that case multiple matches will trigger an error.
526 Otherwise you'll have to care to include a complete state in callback.