fix FSF address
[kivitendo-erp.git] / bin / mozilla / arap.pl
1 #=====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (c) 2002
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 #
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.
20 #
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., 51 Franklin Street, Fifth Floor, Boston,
28 # MA 02110-1335, USA.
29 #======================================================================
30 #
31 # common routines for gl, ar, ap, is, ir, oe
32 #
33
34 use strict;
35
36 # any custom scripts for this one
37 if (-f "bin/mozilla/custom_arap.pl") {
38   eval { require "bin/mozilla/custom_arap.pl"; };
39 }
40 if (-f "bin/mozilla/$::myconfig{login}_arap.pl") {
41   eval { require "bin/mozilla/$::myconfig{login}_arap.pl"; };
42 }
43
44 1;
45
46 require "bin/mozilla/common.pl";
47
48 # end of main
49
50 sub check_name {
51   $main::lxdebug->enter_sub();
52
53   my $form     = $main::form;
54   my %myconfig = %main::myconfig;
55   my $locale   = $main::locale;
56
57   $main::auth->assert('ar_transactions | ap_transactions | vendor_invoice_edit       | sales_order_edit    | invoice_edit |' .
58                 'request_quotation_edit       | sales_quotation_edit      | purchase_order_edit | cash         |' .
59                 'purchase_delivery_order_edit | sales_delivery_order_edit');
60
61   my ($name, %params) = @_;
62
63   $name = $name eq "customer" ? "customer" : "vendor";
64
65   my ($new_name,$new_id) = $form->{$name} =~ /^(.*?)--(\d+)$/;
66   my $i = 0;
67   # if we use a selection
68   if ($form->{"select$name"}) {
69     if ($form->{"old$name"} ne $form->{$name}) {
70
71       # this is needed for is, ir and oe
72       $form->{update} = 0;
73       # for credit calculations
74       $form->{oldinvtotal}  = 0;
75       $form->{oldtotalpaid} = 0;
76       $form->{calctax}      = 1;
77
78       $form->{"${name}_id"} = $new_id;
79
80       _reset_salesman_id();
81       delete @{ $form }{qw(payment_id)};
82
83       IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
84       IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
85
86       $form->{$name} = $form->{"old$name"} = "$new_name--$new_id";
87
88       $i = 1;
89     }
90   } else {
91
92     # check name, combine name and id
93     if ($form->{"old$name"} ne qq|$form->{$name}--$form->{"${name}_id"}|) {
94
95       # this is needed for is, ir and oe
96       $form->{update} = 0;
97
98       # for credit calculations
99       $form->{oldinvtotal}  = 0;
100       $form->{oldtotalpaid} = 0;
101       $form->{calctax}      = 1;
102
103       # return one name or a list of names in $form->{name_list}
104       $i = $form->get_name(\%myconfig, $name);
105
106       if ($i > 1) {
107         if ($params{no_select}) {
108           # $locale->text('Customer')
109           # $locale->text('Vendor')
110           $form->error($locale->text("More than one #1 found matching, please be more specific.", $locale->text(ucfirst $name)));
111         } else {
112           &select_name($name);
113           $::dispatcher->end_request;
114         }
115       }
116
117       if ($i == 1) {
118
119         # we got one name
120         $form->{"${name}_id"} = $form->{name_list}[0]->{id};
121         $form->{$name}        = $form->{name_list}[0]->{name};
122         $form->{"old$name"}   = qq|$form->{$name}--$form->{"${name}_id"}|;
123
124         _reset_salesman_id();
125         delete @{ $form }{qw(payment_id)};
126
127         IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
128         IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
129
130       } else {
131
132         # name is not on file
133         # $locale->text('Customer not on file or locked!')
134         # $locale->text('Vendor not on file or locked!')
135         my $msg = ucfirst $name . " not on file or locked!";
136         $form->error($locale->text($msg));
137       }
138     }
139   }
140   $form->language_payment(\%myconfig);
141
142   $main::lxdebug->leave_sub();
143
144   return $i;
145 }
146
147 # $locale->text('Customer not on file!')
148 # $locale->text('Vendor not on file!')
149
150 sub select_name {
151   $main::lxdebug->enter_sub();
152
153   my $form     = $main::form;
154   my $locale   = $main::locale;
155
156   $main::auth->assert('ar_transactions| ap_transactions | vendor_invoice_edit  | sales_order_edit    | invoice_edit | sales_delivery_order_edit |' .
157                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');
158
159   my ($table) = @_;
160
161   my @column_index = qw(ndx name address);
162
163   my $label             = ucfirst $table;
164   my %column_data;
165   $column_data{ndx}  = qq|<th>&nbsp;</th>|;
166   $column_data{name} =
167     qq|<th class=listheading>| . $locale->text($label) . qq|</th>|;
168   $column_data{address} =
169     qq|<th class=listheading>| . $locale->text('Address') . qq|</th>|;
170
171   # list items with radio button on a form
172   $form->header;
173
174   my $title = $locale->text('Select from one of the names below');
175
176   print qq|
177     <h1>$title</h1>
178
179 <form method=post action=$form->{script}>
180
181 <table width=100%>
182   <tr>
183     <td>
184       <table width=100%>
185         <tr class=listheading>|;
186
187   map { print "\n$column_data{$_}" } @column_index;
188
189   print qq|
190         </tr>
191 |;
192
193   my $i = 0;
194   my $j;
195   foreach my $ref (@{ $form->{name_list} }) {
196     my $checked = ($i++) ? "" : "checked";
197
198     $ref->{name} =~ s/\"/&quot;/g;
199
200     $column_data{ndx} =
201       qq|<td><input name=ndx class=radio type=radio value=$i $checked></td>|;
202     $column_data{name} =
203       qq|<td><input name="new_name_$i" type=hidden value="$ref->{name}">$ref->{name}</td>|;
204     $column_data{address} = qq|<td>$ref->{address}&nbsp;</td>|;
205
206     $j++;
207     $j %= 2;
208     print qq|
209         <tr class=listrow$j>|;
210
211     map { print "\n$column_data{$_}" } @column_index;
212
213     print qq|
214         </tr>
215
216 <input name="new_id_$i" type=hidden value=$ref->{id}>
217
218 |;
219
220   }
221
222   print qq|
223       </table>
224     </td>
225   </tr>
226   <tr>
227     <td><hr size=3 noshade></td>
228   </tr>
229 </table>
230
231 <input name=lastndx type=hidden value=$i>
232
233 |;
234
235   # delete variables
236   map { delete $form->{$_} } qw(action name_list header);
237
238   # save all other form variables
239   foreach my $key (keys %${form}) {
240     next if (($key eq 'login') || ($key eq 'password') || ('' ne ref $form->{$key}));
241     $form->{$key} =~ s/\"/&quot;/g;
242     print qq|<input name=$key type=hidden value="$form->{$key}">\n|;
243   }
244
245   print qq|
246 <input type=hidden name=nextsub value=name_selected>
247
248 <input type=hidden name=vc value=$table>
249 <br>
250 <input class=submit type=submit name=action value="|
251     . $locale->text('Continue') . qq|">
252 </form>
253 |;
254
255   $main::lxdebug->leave_sub();
256 }
257
258 sub name_selected {
259   $main::lxdebug->enter_sub();
260
261   my $form     = $main::form;
262   my %myconfig = %main::myconfig;
263
264   $main::auth->assert('ar_transactions | ap_transactions | vendor_invoice_edit  | sales_order_edit    | invoice_edit | sales_delivery_order_edit | ' .
265                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');
266
267   # replace the variable with the one checked
268
269   # index for new item
270   my $i = $form->{ndx};
271
272   _reset_salesman_id();
273   delete @{ $form }{qw(payment_id)};
274
275   $form->{ $form->{vc} }    = $form->{"new_name_$i"};
276   $form->{"$form->{vc}_id"} = $form->{"new_id_$i"};
277   $form->{"old$form->{vc}"} =
278     qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|;
279
280   # delete all the new_ variables
281   for $i (1 .. $form->{lastndx}) {
282     map { delete $form->{"new_${_}_$i"} } qw(id name);
283   }
284
285   map { delete $form->{$_} } qw(ndx lastndx nextsub);
286
287   IS->get_customer(\%myconfig, \%$form) if ($form->{vc} eq 'customer');
288   IR->get_vendor(\%myconfig, \%$form) if ($form->{vc} eq 'vendor');
289
290   &update(1);
291
292   $main::lxdebug->leave_sub();
293 }
294
295 # Reset the $::form field 'salesman_id' to the ID of the currently
296 # logged in user. Useful when changing to a customer/vendor that has
297 # no salesman listed in their master data.
298 sub _reset_salesman_id {
299   my $current_employee   = SL::DB::Manager::Employee->current;
300   $::form->{salesman_id} = $current_employee->id if $current_employee && exists $::form->{salesman_id};
301 }
302
303 sub select_project {
304   $::lxdebug->enter_sub;
305
306   $::auth->assert('ar_transactions | ap_transactions | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
307                   'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
308
309   my ($is_global, $nextsub) = @_;
310   my $project_list = delete $::form->{project_list};
311
312   map { delete $::form->{$_} } qw(action header update);
313
314   my @hiddens;
315   for my $key (keys %$::form) {
316     next if $key eq 'login' || $key eq 'password' || '' ne ref $::form->{$key};
317     push @hiddens, { key => $key, value => $::form->{$key} };
318   }
319   push @hiddens, { key => 'is_global',                value => $is_global },
320                  { key => 'project_selected_nextsub', value => $nextsub };
321
322   $::form->header;
323   print $::form->parse_html_template('arap/select_project', { hiddens => \@hiddens, project_list => $project_list });
324
325   $::lxdebug->leave_sub;
326 }
327
328 sub project_selected {
329   $main::lxdebug->enter_sub();
330
331   my $form     = $main::form;
332
333   $main::auth->assert('ar_transactions  | ap_transactions    | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
334                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
335
336   # replace the variable with the one checked
337
338   # index for new item
339   my $i = $form->{ndx};
340
341   my $prefix = $form->{"is_global"} ? "global" : "";
342   my $suffix = $form->{"is_global"} ? "" : "_$form->{rownumber}";
343
344   $form->{"${prefix}projectnumber${suffix}"} =
345     $form->{"new_projectnumber_$i"};
346   $form->{"old${prefix}projectnumber${suffix}"} =
347     $form->{"new_projectnumber_$i"};
348   $form->{"${prefix}project_id${suffix}"} = $form->{"new_id_$i"};
349
350   # delete all the new_ variables
351   for $i (1 .. $form->{lastndx}) {
352     map { delete $form->{"new_${_}_$i"} } qw(id projectnumber description);
353   }
354
355   my $nextsub = $form->{project_selected_nextsub} || 'update';
356
357   map { delete $form->{$_} } qw(ndx lastndx nextsub is_global project_selected_nextsub);
358
359   call_sub($nextsub);
360
361   $main::lxdebug->leave_sub();
362 }
363
364 sub continue       { call_sub($main::form->{"nextsub"}); }
365
366 1;
367
368 __END__
369
370 =head1 NAME
371
372 arap.pl - helper functions or customer/vendor retrieval
373
374 =head1 SYNOPSIS
375
376  check_name('vendor')
377
378 =head1 DESCRIPTION
379
380 Don't use anyting in this file without extreme care, and even then be prepared for massive headaches.
381
382 It's a collection of helper routines that wrap the customer/vendor dropdown/textfield duality into something even complexer.
383
384 =head1 FUNCTIONS
385
386 =head2 check_name customer|vendor
387
388 check_name was originally meant to update the selected customer or vendor. The
389 way it does that has generted more hate than almost any other part of this
390 software.
391
392 What it does is:
393
394 =over 4
395
396 =item *
397
398 It checks if a vendor or customer is given. No failsafe, vendor fallback if
399 $_[0] is something fancy.
400
401 =item *
402
403 It assumes, that there is a field named customer or vendor in $form.
404
405 =item *
406
407 It assumes, that this field is filled with name--id, and tries to split that.
408 sql ledger uses that combination to get ids into the select keys.
409
410 =item *
411
412 It looks for a field selectcustomer or selectvendor in $form. sql ledger used
413 to store a copy of the html select in there. (again, don't ask)
414
415 =item *
416
417 If this field exists, it looks for a field called oldcustomer or oldvendor, in
418 which the old name--id string was stored in sql ledger, and compares those.
419
420 =item *
421
422 if they don't match, it will set customer_id or vendor_id in $form, load the
423 entry (which will clobber everything in $form named like a column in customer
424 oder vendor) and return.
425
426 =item *
427
428 If there was no select* entry, it assumes that vclimit was lower than the
429 number of entries, and that an input field was generated. In that case the
430 splitting is omitted (since users don't generally include ids in entered names)
431
432 =item *
433
434 It looks for a *_id field, and combines it with the given input into a name--id
435 entry and compares it to the old* entry. (Missing any of these will instantly
436 break check_namea.
437
438 =item *
439
440 If those do not match, $form->get_name is called to get matching results.
441 get_name only matches by *number and name, not by id, don't try to get it to do
442 so.
443
444 =item *
445
446 The results are stored in $form>{name_list} but a count is returned, and
447 checked.
448
449 =item *
450
451 If only one result was found, *_id, * and old* are copied into $form, the entry
452 is loaded (like above, clobbering)
453
454 =item *
455
456 If there is more than one, a selection dialog is rendered
457
458 =item *
459
460 If none is found, an error is generated.
461
462 =back
463
464 =head3 I built a customer/vendor box somewhere and it doesn't work, what's wrong?
465
466 Make sure a select* field is given if and only if you render a select box. The
467 actual contents are ignored, but recognition fails if not present.
468
469 Make sure old* and *_id fields are set correctly (name--id form for old*). They
470 are necessary in all steps and branches.
471
472 Since get_customer and get_vendor clobber a lot of fields, make sure what
473 changes exactly.
474
475 =head3 select- version works fine, but things go awry when I use a textbox, any idea?
476
477 If there is more than one match, check_name will display a select form, that
478 will redirect to the original C<nextsub>. Unfortunately any hidden vars or
479 input fields will be lost in the process unless saved before in a callback.
480
481 If you still want to use it, you can disable this feature, like this:
482
483   check_name('customer', no_select => 1)
484
485 In that case multiple matches will trigger an error.
486
487 Otherwise you'll have to care to include a complete state in callback.
488
489 =cut