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       _reset_salesman_id();
  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           ::end_of_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         IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
 125         IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');
 126
 127       } else {
 128
 129         # name is not on file
 130         # $locale->text('Customer not on file or locked!')
 131         # $locale->text('Vendor not on file or locked!')
 132         my $msg = ucfirst $name . " not on file or locked!";
 133         $form->error($locale->text($msg));
 134       }
 135     }
 136   }
 137   $form->language_payment(\%myconfig);
 138
 139   $main::lxdebug->leave_sub();
 140
 141   return $i;
 142 }
 143
 144 # $locale->text('Customer not on file!')
 145 # $locale->text('Vendor not on file!')
 146
 147 sub select_name {
 148   $main::lxdebug->enter_sub();
 149
 150   my $form     = $main::form;
 151   my $locale   = $main::locale;
 152
 153   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
 154                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');
 155
 156   my ($table) = @_;
 157
 158   my @column_index = qw(ndx name address);
 159
 160   my $label             = ucfirst $table;
 161   my %column_data;
 162   $column_data{ndx}  = qq|<th>&nbsp;</th>|;
 163   $column_data{name} =
 164     qq|<th class=listheading>| . $locale->text($label) . qq|</th>|;
 165   $column_data{address} =
 166     qq|<th class=listheading>| . $locale->text('Address') . qq|</th>|;
 167
 168   # list items with radio button on a form
 169   $form->header;
 170
 171   my $title = $locale->text('Select from one of the names below');
 172
 173   print qq|
 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
 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('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_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
 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"}|;
 277
 278   # delete all the new_ variables
 279   for $i (1 .. $form->{lastndx}) {
 280     map { delete $form->{"new_${_}_$i"} } qw(id name);
 281   }
 282
 283   map { delete $form->{$_} } qw(ndx lastndx nextsub);
 284
 285   IS->get_customer(\%myconfig, \%$form) if ($form->{vc} eq 'customer');
 286   IR->get_vendor(\%myconfig, \%$form) if ($form->{vc} eq 'vendor');
 287
 288   &update(1);
 289
 290   $main::lxdebug->leave_sub();
 291 }
 292
 293 # Reset the $::form field 'salesman_id' to the ID of the currently
 294 # logged in user. Useful when changing to a customer/vendor that has
 295 # no salesman listed in their master data.
 296 sub _reset_salesman_id {
 297   my $current_employee   = SL::DB::Manager::Employee->current;
 298   $::form->{salesman_id} = $current_employee->id if $current_employee && exists $::form->{salesman_id};
 299 }
 300
 301 sub check_project {
 302   $main::lxdebug->enter_sub();
 303
 304   my $form     = $main::form;
 305   my $locale   = $main::locale;
 306
 307   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
 308                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
 309
 310   my $nextsub = shift || 'update';
 311
 312   for my $i (1 .. $form->{rowcount}) {
 313     my $suffix = $i ? "_$i" : "";
 314     my $prefix = $i ? "" : "global";
 315     $form->{"${prefix}project_id${suffix}"} = "" unless $form->{"${prefix}projectnumber$suffix"};
 316     if ($form->{"${prefix}projectnumber${suffix}"} ne $form->{"old${prefix}projectnumber${suffix}"}) {
 317       if ($form->{"${prefix}projectnumber${suffix}"}) {
 318
 319         # get new project
 320         $form->{projectnumber} = $form->{"${prefix}projectnumber${suffix}"};
 321         my %params             = map { $_ => $form->{$_} } qw(projectnumber description active);
 322         my $rows;
 323         if (($rows = Projects->search_projects(%params)) > 1) {
 324
 325           # check form->{project_list} how many there are
 326           $form->{rownumber} = $i;
 327           &select_project($i ? undef : 1, $nextsub);
 328           ::end_of_request();
 329         }
 330
 331         if ($rows == 1) {
 332           $form->{"${prefix}project_id${suffix}"}       = $form->{project_list}->[0]->{id};
 333           $form->{"${prefix}projectnumber${suffix}"}    = $form->{project_list}->[0]->{projectnumber};
 334           $form->{"old${prefix}projectnumber${suffix}"} = $form->{project_list}->[0]->{projectnumber};
 335         } else {
 336
 337           # not on file
 338           $form->error($locale->text('Project not on file!'));
 339         }
 340       } else {
 341         $form->{"old${prefix}projectnumber${suffix}"} = "";
 342       }
 343     }
 344   }
 345
 346   $main::lxdebug->leave_sub();
 347 }
 348
 349 sub select_project {
 350   $::lxdebug->enter_sub;
 351
 352   $::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
 353                   'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
 354
 355   my ($is_global, $nextsub) = @_;
 356   my $project_list = delete $::form->{project_list};
 357
 358   map { delete $::form->{$_} } qw(action header update);
 359
 360   my @hiddens;
 361   for my $key (keys %$::form) {
 362     next if $key eq 'login' || $key eq 'password' || '' ne ref $::form->{$key};
 363     push @hiddens, { key => $key, value => $::form->{$key} };
 364   }
 365   push @hiddens, { key => 'is_global',                value => $is_global },
 366                  { key => 'project_selected_nextsub', value => $nextsub };
 367
 368   $::form->header;
 369   print $::form->parse_html_template('arap/select_project', { hiddens => \@hiddens, project_list => $project_list });
 370
 371   $::lxdebug->leave_sub;
 372 }
 373
 374 sub project_selected {
 375   $main::lxdebug->enter_sub();
 376
 377   my $form     = $main::form;
 378
 379   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
 380                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
 381
 382   # replace the variable with the one checked
 383
 384   # index for new item
 385   my $i = $form->{ndx};
 386
 387   my $prefix = $form->{"is_global"} ? "global" : "";
 388   my $suffix = $form->{"is_global"} ? "" : "_$form->{rownumber}";
 389
 390   $form->{"${prefix}projectnumber${suffix}"} =
 391     $form->{"new_projectnumber_$i"};
 392   $form->{"old${prefix}projectnumber${suffix}"} =
 393     $form->{"new_projectnumber_$i"};
 394   $form->{"${prefix}project_id${suffix}"} = $form->{"new_id_$i"};
 395
 396   # delete all the new_ variables
 397   for $i (1 .. $form->{lastndx}) {
 398     map { delete $form->{"new_${_}_$i"} } qw(id projectnumber description);
 399   }
 400
 401   my $nextsub = $form->{project_selected_nextsub} || 'update';
 402
 403   map { delete $form->{$_} } qw(ndx lastndx nextsub is_global project_selected_nextsub);
 404
 405   call_sub($nextsub);
 406
 407   $main::lxdebug->leave_sub();
 408 }
 409
 410 sub continue       { call_sub($main::form->{"nextsub"}); }
 411
 412 1;
 413
 414 __END__
 415
 416 =head1 NAME
 417
 418 arap.pl - helper functions or customer/vendor retrieval
 419
 420 =head1 SYNOPSIS
 421
 422  check_name('vendor')
 423  check_project();
 424
 425 =head1 DESCRIPTION
 426
 427 Don't use anyting in this file without extreme care, and even then be prepared for massive headaches.
 428
 429 It's a collection of helper routines that wrap the customer/vendor dropdown/textfield duality into something even complexer.
 430
 431 =head1 FUNCTIONS
 432
 433 =head2 check_name customer|vendor
 434
 435 check_name was originally meant to update the selected customer or vendor. The
 436 way it does that has generted more hate than almost any other part of this
 437 software.
 438
 439 What it does is:
 440
 441 =over 4
 442
 443 =item *
 444
 445 It checks if a vendor or customer is given. No failsafe, vendor fallback if
 446 $_[0] is something fancy.
 447
 448 =item *
 449
 450 It assumes, that there is a field named customer or vendor in $form.
 451
 452 =item *
 453
 454 It assumes, that this field is filled with name--id, and tries to split that.
 455 sql ledger uses that combination to get ids into the select keys.
 456
 457 =item *
 458
 459 It looks for a field selectcustomer or selectvendor in $form. sql ledger used
 460 to store a copy of the html select in there. (again, don't ask)
 461
 462 =item *
 463
 464 If this field exists, it looks for a field called oldcustomer or oldvendor, in
 465 which the old name--id string was stored in sql ledger, and compares those.
 466
 467 =item *
 468
 469 if they don't match, it will set customer_id or vendor_id in $form, load the
 470 entry (which will clobber everything in $form named like a column in customer
 471 oder vendor) and return.
 472
 473 =item *
 474
 475 If there was no select* entry, it assumes that vclimit was lower than the
 476 number of entries, and that an input field was generated. In that case the
 477 splitting is omitted (since users don't generally include ids in entered names)
 478
 479 =item *
 480
 481 It looks for a *_id field, and combines it with the given input into a name--id
 482 entry and compares it to the old* entry. (Missing any of these will instantly
 483 break check_namea.
 484
 485 =item *
 486
 487 If those do not match, $form->get_name is called to get matching results.
 488 get_name only matches by *number and name, not by id, don't try to get it to do
 489 so.
 490
 491 =item *
 492
 493 The results are stored in $form>{name_list} but a count is returned, and
 494 checked.
 495
 496 =item *
 497
 498 If only one result was found, *_id, * and old* are copied into $form, the entry
 499 is loaded (like above, clobbering)
 500
 501 =item *
 502
 503 If there is more than one, a selection dialog is rendered
 504
 505 =item *
 506
 507 If none is found, an error is generated.
 508
 509 =back
 510
 511 =head3 I built a customer/vendor box somewhere and it doesn't work, what's wrong?
 512
 513 Make sure a select* field is given if and only if you render a select box. The
 514 actual contents are ignored, but recognition fails if not present.
 515
 516 Make sure old* and *_id fields are set correctly (name--id form for old*). They
 517 are necessary in all steps and branches.
 518
 519 Since get_customer and get_vendor clobber a lot of fields, make sure what
 520 changes exactly.
 521
 522 =head3 select- version works fine, but things go awry when I use a textbox, any idea?
 523
 524 If there is more than one match, check_name will display a select form, that
 525 will redirect to the original C<nextsub>. Unfortunately any hidden vars or
 526 input fields will be lost in the process unless saved before in a callback.
 527
 528 If you still want to use it, you can disable this feature, like this:
 529
 530   check_name('customer', no_select => 1)
 531
 532 In that case multiple matches will trigger an error.
 533
 534 Otherwise you'll have to care to include a complete state in callback.
 535
 536 =cut