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