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