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