debug enter/leave_sub balanciert
[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 SL::Projects;
34
35 use strict;
36
37 # any custom scripts for this one
38 if (-f "bin/mozilla/custom_arap.pl") {
39   eval { require "bin/mozilla/custom_arap.pl"; };
40 }
41 if (-f "bin/mozilla/$main::form->{login}_arap.pl") {
42   eval { require "bin/mozilla/$main::form->{login}_arap.pl"; };
43 }
44
45 1;
46
47 require "bin/mozilla/common.pl";
48
49 # end of main
50
51 sub check_name {
52   $main::lxdebug->enter_sub();
53
54   my $form     = $main::form;
55   my %myconfig = %main::myconfig;
56   my $locale   = $main::locale;
57
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');
61
62   my ($name, %params) = @_;
63
64   $name = $name eq "customer" ? "customer" : "vendor";
65
66   my ($new_name, $new_id) = split /--/, $form->{$name};
67   my $i = 0;
68   # if we use a selection
69   if ($form->{"select$name"}) {
70     if ($form->{"old$name"} ne $form->{$name}) {
71
72       # this is needed for is, ir and oe
73       $form->{update} = 0;
74       # for credit calculations
75       $form->{oldinvtotal}  = 0;
76       $form->{oldtotalpaid} = 0;
77       $form->{calctax}      = 1;
78
79       $form->{"${name}_id"} = $new_id;
80
81       IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
82       IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
83
84       $form->{$name} = $form->{"old$name"} = "$new_name--$new_id";
85
86       $i = 1;
87     }
88   } else {
89
90     # check name, combine name and id
91     if ($form->{"old$name"} ne qq|$form->{$name}--$form->{"${name}_id"}|) {
92
93       # this is needed for is, ir and oe
94       $form->{update} = 0;
95
96       # for credit calculations
97       $form->{oldinvtotal}  = 0;
98       $form->{oldtotalpaid} = 0;
99       $form->{calctax}      = 1;
100
101       # return one name or a list of names in $form->{name_list}
102       $i = $form->get_name(\%myconfig, $name);
103
104       if ($i > 1) {
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)));
109         } else {
110           &select_name($name);
111           ::end_of_request();
112         }
113       }
114
115       if ($i == 1) {
116
117         # we got one 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"}|;
121
122         IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
123         IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
124
125       } else {
126
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));
132       }
133     }
134   }
135   $form->language_payment(\%myconfig);
136
137   $main::lxdebug->leave_sub();
138
139   return $i;
140 }
141
142 # $locale->text('Customer not on file!')
143 # $locale->text('Vendor not on file!')
144
145 sub select_name {
146   $main::lxdebug->enter_sub();
147
148   my $form     = $main::form;
149   my $locale   = $main::locale;
150
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');
153
154   my ($table) = @_;
155
156   my @column_index = qw(ndx name address);
157
158   my $label             = ucfirst $table;
159   my %column_data;
160   $column_data{ndx}  = qq|<th>&nbsp;</th>|;
161   $column_data{name} =
162     qq|<th class=listheading>| . $locale->text($label) . qq|</th>|;
163   $column_data{address} =
164     qq|<th class=listheading>| . $locale->text('Address') . qq|</th>|;
165
166   # list items with radio button on a form
167   $form->header;
168
169   my $title = $locale->text('Select from one of the names below');
170
171   print qq|
172 <body>
173
174 <form method=post action=$form->{script}>
175
176 <table width=100%>
177   <tr>
178     <th class=listtop>$title</th>
179   </tr>
180   <tr space=5></tr>
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 </body>
254 </html>
255 |;
256
257   $main::lxdebug->leave_sub();
258 }
259
260 sub name_selected {
261   $main::lxdebug->enter_sub();
262
263   my $form     = $main::form;
264   my %myconfig = %main::myconfig;
265
266   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
267                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');
268
269   # replace the variable with the one checked
270
271   # index for new item
272   my $i = $form->{ndx};
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 sub check_project {
295   $main::lxdebug->enter_sub();
296
297   my $form     = $main::form;
298   my $locale   = $main::locale;
299
300   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
301                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
302
303   my $nextsub = shift || 'update';
304
305   for my $i (1 .. $form->{rowcount}) {
306     my $suffix = $i ? "_$i" : "";
307     my $prefix = $i ? "" : "global";
308     $form->{"${prefix}project_id${suffix}"} = "" unless $form->{"${prefix}projectnumber$suffix"};
309     if ($form->{"${prefix}projectnumber${suffix}"} ne $form->{"old${prefix}projectnumber${suffix}"}) {
310       if ($form->{"${prefix}projectnumber${suffix}"}) {
311
312         # get new project
313         $form->{projectnumber} = $form->{"${prefix}projectnumber${suffix}"};
314         my %params             = map { $_ => $form->{$_} } qw(projectnumber description active);
315         my $rows;
316         if (($rows = Projects->search_projects(%params)) > 1) {
317
318           # check form->{project_list} how many there are
319           $form->{rownumber} = $i;
320           &select_project($i ? undef : 1, $nextsub);
321           ::end_of_request();
322         }
323
324         if ($rows == 1) {
325           $form->{"${prefix}project_id${suffix}"}       = $form->{project_list}->[0]->{id};
326           $form->{"${prefix}projectnumber${suffix}"}    = $form->{project_list}->[0]->{projectnumber};
327           $form->{"old${prefix}projectnumber${suffix}"} = $form->{project_list}->[0]->{projectnumber};
328         } else {
329
330           # not on file
331           $form->error($locale->text('Project not on file!'));
332         }
333       } else {
334         $form->{"old${prefix}projectnumber${suffix}"} = "";
335       }
336     }
337   }
338
339   $main::lxdebug->leave_sub();
340 }
341
342 sub select_project {
343   $::lxdebug->enter_sub;
344
345   $::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
346                   'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
347
348   my ($is_global, $nextsub) = @_;
349   my $project_list = delete $::form->{project_list};
350
351   map { delete $::form->{$_} } qw(action header update);
352
353   my @hiddens;
354   for my $key (keys %$::form) {
355     next if $key eq 'login' || $key eq 'password' || '' ne ref $::form->{$key};
356     push @hiddens, { key => $key, value => $::form->{$key} };
357   }
358   push @hiddens, { key => 'is_global',                value => $is_global },
359                  { key => 'project_selected_nextsub', value => $nextsub };
360
361   $::form->header;
362   print $::form->parse_html_template('arap/select_project', { hiddens => \@hiddens, project_list => $project_list });
363
364   $::lxdebug->leave_sub;
365 }
366
367 sub project_selected {
368   $main::lxdebug->enter_sub();
369
370   my $form     = $main::form;
371
372   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
373                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
374
375   # replace the variable with the one checked
376
377   # index for new item
378   my $i = $form->{ndx};
379
380   my $prefix = $form->{"is_global"} ? "global" : "";
381   my $suffix = $form->{"is_global"} ? "" : "_$form->{rownumber}";
382
383   $form->{"${prefix}projectnumber${suffix}"} =
384     $form->{"new_projectnumber_$i"};
385   $form->{"old${prefix}projectnumber${suffix}"} =
386     $form->{"new_projectnumber_$i"};
387   $form->{"${prefix}project_id${suffix}"} = $form->{"new_id_$i"};
388
389   # delete all the new_ variables
390   for $i (1 .. $form->{lastndx}) {
391     map { delete $form->{"new_${_}_$i"} } qw(id projectnumber description);
392   }
393
394   my $nextsub = $form->{project_selected_nextsub} || 'update';
395
396   map { delete $form->{$_} } qw(ndx lastndx nextsub is_global project_selected_nextsub);
397
398   call_sub($nextsub);
399
400   $main::lxdebug->leave_sub();
401 }
402
403 sub continue       { call_sub($main::form->{"nextsub"}); }
404
405 1;
406
407 __END__
408
409 =head1 NAME
410
411 arap.pl - helper functions or customer/vendor retrieval
412
413 =head1 SYNOPSIS
414
415  check_name('vendor')
416  check_project();
417
418 =head1 DESCRIPTION
419
420 Don't use anyting in this file without extreme care, and even then be prepared for massive headaches.
421
422 It's a collection of helper routines that wrap the customer/vendor dropdown/textfield duality into something even complexer.
423
424 =head1 FUNCTIONS
425
426 =head2 check_name customer|vendor
427
428 check_name was originally meant to update the selected customer or vendor. The
429 way it does that has generted more hate than almost any other part of this
430 software.
431
432 What it does is:
433
434 =over 4
435
436 =item *
437
438 It checks if a vendor or customer is given. No failsafe, vendor fallback if
439 $_[0] is something fancy.
440
441 =item *
442
443 It assumes, that there is a field named customer or vendor in $form.
444
445 =item *
446
447 It assumes, that this field is filled with name--id, and tries to split that.
448 sql ledger uses that combination to get ids into the select keys.
449
450 =item *
451
452 It looks for a field selectcustomer or selectvendor in $form. sql ledger used
453 to store a copy of the html select in there. (again, don't ask)
454
455 =item *
456
457 If this field exists, it looks for a field called oldcustomer or oldvendor, in
458 which the old name--id string was stored in sql ledger, and compares those.
459
460 =item *
461
462 if they don't match, it will set customer_id or vendor_id in $form, load the
463 entry (which will clobber everything in $form named like a column in customer
464 oder vendor) and return.
465
466 =item *
467
468 If there was no select* entry, it assumes that vclimit was lower than the
469 number of entries, and that an input field was generated. In that case the
470 splitting is omitted (since users don't generally include ids in entered names)
471
472 =item *
473
474 It looks for a *_id field, and combines it with the given input into a name--id
475 entry and compares it to the old* entry. (Missing any of these will instantly
476 break check_namea.
477
478 =item *
479
480 If those do not match, $form->get_name is called to get matching results.
481 get_name only matches by *number and name, not by id, don't try to get it to do
482 so.
483
484 =item *
485
486 The results are stored in $form>{name_list} but a count is returned, and
487 checked.
488
489 =item *
490
491 If only one result was found, *_id, * and old* are copied into $form, the entry
492 is loaded (like above, clobbering)
493
494 =item *
495
496 If there is more than one, a selection dialog is rendered
497
498 =item *
499
500 If none is found, an error is generated.
501
502 =back
503
504 =head3 I built a customer/vendor box somewhere and it doesn't work, what's wrong?
505
506 Make sure a select* field is given if and only if you render a select box. The
507 actual contents are ignored, but recognition fails if not present.
508
509 Make sure old* and *_id fields are set correctly (name--id form for old*). They
510 are necessary in all steps and branches.
511
512 Since get_customer and get_vendor clobber a lot of fields, make sure what
513 changes exactly.
514
515 =head3 select- version works fine, but things go awry when I use a textbox, any idea?
516
517 If there is more than one match, check_name will display a select form, that
518 will redirect to the original C<nextsub>. Unfortunately any hidden vars or
519 input fields will be lost in the process unless saved before in a callback.
520
521 If you still want to use it, you can disable this feature, like this:
522
523   check_name('customer', no_select => 1)
524
525 In that case multiple matches will trigger an error.
526
527 Otherwise you'll have to care to include a complete state in callback.
528
529 =cut