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., 51 Franklin Street, Fifth Floor, Boston,
 
  29 #======================================================================
 
  31 # common routines for gl, ar, ap, is, ir, oe
 
  36 # any custom scripts for this one
 
  37 if (-f "bin/mozilla/custom_arap.pl") {
 
  38   eval { require "bin/mozilla/custom_arap.pl"; };
 
  40 if (-f "bin/mozilla/$::myconfig{login}_arap.pl") {
 
  41   eval { require "bin/mozilla/$::myconfig{login}_arap.pl"; };
 
  46 require "bin/mozilla/common.pl";
 
  51   $main::lxdebug->enter_sub();
 
  53   my $form     = $main::form;
 
  54   my %myconfig = %main::myconfig;
 
  55   my $locale   = $main::locale;
 
  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');
 
  61   my ($name, %params) = @_;
 
  63   $name = $name eq "customer" ? "customer" : "vendor";
 
  65   my ($new_name,$new_id) = $form->{$name} =~ /^(.*?)--(\d+)$/;
 
  67   # if we use a selection
 
  68   if ($form->{"select$name"}) {
 
  69     if ($form->{"old$name"} ne $form->{$name}) {
 
  71       # this is needed for is, ir and oe
 
  73       # for credit calculations
 
  74       $form->{oldinvtotal}  = 0;
 
  75       $form->{oldtotalpaid} = 0;
 
  78       $form->{"${name}_id"} = $new_id;
 
  81       delete @{ $form }{qw(payment_id)};
 
  83       IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
 
  84       IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
 
  86       $form->{$name} = $form->{"old$name"} = "$new_name--$new_id";
 
  92     # check name, combine name and id
 
  93     if ($form->{"old$name"} ne qq|$form->{$name}--$form->{"${name}_id"}|) {
 
  95       # this is needed for is, ir and oe
 
  98       # for credit calculations
 
  99       $form->{oldinvtotal}  = 0;
 
 100       $form->{oldtotalpaid} = 0;
 
 101       $form->{calctax}      = 1;
 
 103       # return one name or a list of names in $form->{name_list}
 
 104       $i = $form->get_name(\%myconfig, $name);
 
 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)));
 
 113           $::dispatcher->end_request;
 
 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"}|;
 
 124         _reset_salesman_id();
 
 125         delete @{ $form }{qw(payment_id)};
 
 127         IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
 
 128         IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
 
 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));
 
 140   $form->language_payment(\%myconfig);
 
 142   $main::lxdebug->leave_sub();
 
 147 # $locale->text('Customer not on file!')
 
 148 # $locale->text('Vendor not on file!')
 
 151   $main::lxdebug->enter_sub();
 
 153   my $form     = $main::form;
 
 154   my $locale   = $main::locale;
 
 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');
 
 161   my @column_index = qw(ndx name address);
 
 163   my $label             = ucfirst $table;
 
 165   $column_data{ndx}  = qq|<th> </th>|;
 
 167     qq|<th class=listheading>| . $locale->text($label) . qq|</th>|;
 
 168   $column_data{address} =
 
 169     qq|<th class=listheading>| . $locale->text('Address') . qq|</th>|;
 
 171   # list items with radio button on a form
 
 174   my $title = $locale->text('Select from one of the names below');
 
 179 <form method=post action=$form->{script}>
 
 185         <tr class=listheading>|;
 
 187   map { print "\n$column_data{$_}" } @column_index;
 
 195   foreach my $ref (@{ $form->{name_list} }) {
 
 196     my $checked = ($i++) ? "" : "checked";
 
 198     $ref->{name} =~ s/\"/"/g;
 
 201       qq|<td><input name=ndx class=radio type=radio value=$i $checked></td>|;
 
 203       qq|<td><input name="new_name_$i" type=hidden value="$ref->{name}">$ref->{name}</td>|;
 
 204     $column_data{address} = qq|<td>$ref->{address} </td>|;
 
 209         <tr class=listrow$j>|;
 
 211     map { print "\n$column_data{$_}" } @column_index;
 
 216 <input name="new_id_$i" type=hidden value=$ref->{id}>
 
 227     <td><hr size=3 noshade></td>
 
 231 <input name=lastndx type=hidden value=$i>
 
 236   map { delete $form->{$_} } qw(action name_list header);
 
 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/\"/"/g;
 
 242     print qq|<input name=$key type=hidden value="$form->{$key}">\n|;
 
 246 <input type=hidden name=nextsub value=name_selected>
 
 248 <input type=hidden name=vc value=$table>
 
 250 <input class=submit type=submit name=action value="|
 
 251     . $locale->text('Continue') . qq|">
 
 255   $main::lxdebug->leave_sub();
 
 259   $main::lxdebug->enter_sub();
 
 261   my $form     = $main::form;
 
 262   my %myconfig = %main::myconfig;
 
 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');
 
 267   # replace the variable with the one checked
 
 270   my $i = $form->{ndx};
 
 272   _reset_salesman_id();
 
 273   delete @{ $form }{qw(payment_id)};
 
 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"}|;
 
 280   # delete all the new_ variables
 
 281   for $i (1 .. $form->{lastndx}) {
 
 282     map { delete $form->{"new_${_}_$i"} } qw(id name);
 
 285   map { delete $form->{$_} } qw(ndx lastndx nextsub);
 
 287   IS->get_customer(\%myconfig, \%$form) if ($form->{vc} eq 'customer');
 
 288   IR->get_vendor(\%myconfig, \%$form) if ($form->{vc} eq 'vendor');
 
 292   $main::lxdebug->leave_sub();
 
 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};
 
 304   $::lxdebug->enter_sub;
 
 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');
 
 309   my ($is_global, $nextsub) = @_;
 
 310   my $project_list = delete $::form->{project_list};
 
 312   map { delete $::form->{$_} } qw(action header update);
 
 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} };
 
 319   push @hiddens, { key => 'is_global',                value => $is_global },
 
 320                  { key => 'project_selected_nextsub', value => $nextsub };
 
 323   print $::form->parse_html_template('arap/select_project', { hiddens => \@hiddens, project_list => $project_list });
 
 325   $::lxdebug->leave_sub;
 
 328 sub project_selected {
 
 329   $main::lxdebug->enter_sub();
 
 331   my $form     = $main::form;
 
 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');
 
 336   # replace the variable with the one checked
 
 339   my $i = $form->{ndx};
 
 341   my $prefix = $form->{"is_global"} ? "global" : "";
 
 342   my $suffix = $form->{"is_global"} ? "" : "_$form->{rownumber}";
 
 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"};
 
 350   # delete all the new_ variables
 
 351   for $i (1 .. $form->{lastndx}) {
 
 352     map { delete $form->{"new_${_}_$i"} } qw(id projectnumber description);
 
 355   my $nextsub = $form->{project_selected_nextsub} || 'update';
 
 357   map { delete $form->{$_} } qw(ndx lastndx nextsub is_global project_selected_nextsub);
 
 361   $main::lxdebug->leave_sub();
 
 364 sub continue       { call_sub($main::form->{"nextsub"}); }
 
 372 arap.pl - helper functions or customer/vendor retrieval
 
 380 Don't use anyting in this file without extreme care, and even then be prepared for massive headaches.
 
 382 It's a collection of helper routines that wrap the customer/vendor dropdown/textfield duality into something even complexer.
 
 386 =head2 check_name customer|vendor
 
 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
 
 398 It checks if a vendor or customer is given. No failsafe, vendor fallback if
 
 399 $_[0] is something fancy.
 
 403 It assumes, that there is a field named customer or vendor in $form.
 
 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.
 
 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)
 
 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.
 
 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.
 
 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)
 
 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
 
 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
 
 446 The results are stored in $form>{name_list} but a count is returned, and
 
 451 If only one result was found, *_id, * and old* are copied into $form, the entry
 
 452 is loaded (like above, clobbering)
 
 456 If there is more than one, a selection dialog is rendered
 
 460 If none is found, an error is generated.
 
 464 =head3 I built a customer/vendor box somewhere and it doesn't work, what's wrong?
 
 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.
 
 469 Make sure old* and *_id fields are set correctly (name--id form for old*). They
 
 470 are necessary in all steps and branches.
 
 472 Since get_customer and get_vendor clobber a lot of fields, make sure what
 
 475 =head3 select- version works fine, but things go awry when I use a textbox, any idea?
 
 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.
 
 481 If you still want to use it, you can disable this feature, like this:
 
 483   check_name('customer', no_select => 1)
 
 485 In that case multiple matches will trigger an error.
 
 487 Otherwise you'll have to care to include a complete state in callback.