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   $main::lxdebug->enter_sub();
 344
 345   my $form     = $main::form;
 346   my $locale   = $main::locale;
 347   my $cgi      = $main::cgi;
 348
 349   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
 350                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
 351
 352   my ($is_global, $nextsub) = @_;
 353
 354   my @column_index = qw(ndx projectnumber description);
 355
 356   my %column_data;
 357   $column_data{ndx}           = qq|<th>&nbsp;</th>|;
 358   $column_data{projectnumber} = qq|<th>| . $locale->text('Number') . qq|</th>|;
 359   $column_data{description}   =
 360     qq|<th>| . $locale->text('Description') . qq|</th>|;
 361
 362   # list items with radio button on a form
 363   $form->header;
 364
 365   my $title = $locale->text('Select from one of the projects below');
 366
 367   print qq|
 368 <body>
 369
 370 <form method=post action=$form->{script}>
 371
 372 <input type=hidden name=rownumber value=$form->{rownumber}>
 373
 374 <table width=100%>
 375   <tr>
 376     <th class=listtop>$title</th>
 377   </tr>
 378   <tr space=5></tr>
 379   <tr>
 380     <td>
 381       <table width=100%>
 382         <tr class=listheading>|;
 383
 384   map { print "\n$column_data{$_}" } @column_index;
 385
 386   print qq|
 387         </tr>
 388 |;
 389
 390   my $i = 0;
 391   my $j;
 392   foreach my $ref (@{ $form->{project_list} }) {
 393     my $checked = ($i++) ? "" : "checked";
 394
 395     $ref->{name} =~ s/\"/&quot;/g;
 396
 397     $column_data{ndx} =
 398       qq|<td><input name=ndx class=radio type=radio value=$i $checked></td>|;
 399     $column_data{projectnumber} =
 400       qq|<td><input name="new_projectnumber_$i" type=hidden value="$ref->{projectnumber}">$ref->{projectnumber}</td>|;
 401     $column_data{description} = qq|<td>$ref->{description}</td>|;
 402
 403     $j++;
 404     $j %= 2;
 405     print qq|
 406         <tr class=listrow$j>|;
 407
 408     map { print "\n$column_data{$_}" } @column_index;
 409
 410     print qq|
 411         </tr>
 412
 413 <input name="new_id_$i" type=hidden value=$ref->{id}>
 414
 415 |;
 416
 417   }
 418
 419   print qq|
 420       </table>
 421     </td>
 422   </tr>
 423   <tr>
 424     <td><hr size=3 noshade></td>
 425   </tr>
 426 </table>
 427
 428 <input name=lastndx type=hidden value=$i>
 429
 430 |;
 431
 432   # delete action variable
 433   map { delete $form->{$_} } qw(action project_list header update);
 434
 435   # save all other form variables
 436   foreach my $key (keys %${form}) {
 437     next if (($key eq 'login') || ($key eq 'password') || ('' ne ref $form->{$key}));
 438     $form->{$key} =~ s/\"/&quot;/g;
 439     print qq|<input name=$key type=hidden value="$form->{$key}">\n|;
 440   }
 441
 442   print
 443       $cgi->hidden('-name' => 'is_global',                '-default' => [$is_global])
 444     . $cgi->hidden('-name' => 'project_selected_nextsub', '-default' => [$nextsub])
 445     . qq|<input type=hidden name=nextsub value=project_selected>
 446
 447 <br>
 448 <input class=submit type=submit name=action value="|
 449     . $locale->text('Continue') . qq|">
 450 </form>
 451
 452 </body>
 453 </html>
 454 |;
 455
 456   $main::lxdebug->leave_sub();
 457 }
 458
 459 sub project_selected {
 460   $main::lxdebug->enter_sub();
 461
 462   my $form     = $main::form;
 463
 464   $main::auth->assert('general_ledger         | vendor_invoice_edit  | sales_order_edit    | invoice_edit |' .
 465                 'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash         | report');
 466
 467   # replace the variable with the one checked
 468
 469   # index for new item
 470   my $i = $form->{ndx};
 471
 472   my $prefix = $form->{"is_global"} ? "global" : "";
 473   my $suffix = $form->{"is_global"} ? "" : "_$form->{rownumber}";
 474
 475   $form->{"${prefix}projectnumber${suffix}"} =
 476     $form->{"new_projectnumber_$i"};
 477   $form->{"old${prefix}projectnumber${suffix}"} =
 478     $form->{"new_projectnumber_$i"};
 479   $form->{"${prefix}project_id${suffix}"} = $form->{"new_id_$i"};
 480
 481   # delete all the new_ variables
 482   for $i (1 .. $form->{lastndx}) {
 483     map { delete $form->{"new_${_}_$i"} } qw(id projectnumber description);
 484   }
 485
 486   my $nextsub = $form->{project_selected_nextsub} || 'update';
 487
 488   map { delete $form->{$_} } qw(ndx lastndx nextsub is_global project_selected_nextsub);
 489
 490   call_sub($nextsub);
 491
 492   $main::lxdebug->leave_sub();
 493 }
 494
 495 sub continue       { call_sub($main::form->{"nextsub"}); }
 496
 497 1;
 498
 499 __END__
 500
 501 =head1 NAME
 502
 503 <<<<<<< HEAD:bin/mozilla/arap.pl
 504 bin/mozilla/arap.pl - helper routines for invoiceing frontend.
 505
 506 =head1 SYNOPSIS
 507
 508 nothing yet
 509
 510 =head1 DESCRIPTION
 511
 512 nothing yet
 513 =======
 514 arap.pl - helper functions or customer/vendor retrieval
 515
 516 =head1 SYNOPSIS
 517
 518  check_name('vendor')
 519  check_project();
 520
 521 =head1 DESCRIPTION
 522
 523 Don't use anyting in this file without extreme care, and even then be prepared for massive headaches.
 524
 525 It's a collection of helper routines that wrap the customer/vendor dropdown/textfield duality into something even complexer.
 526 >>>>>>> 88f5a78... check_name erweitert um ein no_select flag. siehe perldoc bin/mozilla/arap.pl:bin/mozilla/arap.pl
 527
 528 =head1 FUNCTIONS
 529
 530 =head2 check_name customer|vendor
 531
 532 <<<<<<< HEAD:bin/mozilla/arap.pl
 533 check_name was originally meant to update the selected customer or vendor. The
 534 way it does that has generted more hate than almost any other part of this
 535 software.
 536
 537 What it does is:
 538
 539 =over 4
 540
 541 =item
 542
 543 It checks if a vendor or customer is given. No failsafe, vendor fallback if
 544 $_[0] is something fancy.
 545
 546 =item
 547
 548 It assumes, that there is a field named customer or vendor in $form.
 549
 550 =item
 551
 552 It assumes, that this field is filled with name--id, and tries to split that.
 553 sql ledger uses that combination to get ids into the select keys.
 554
 555 =item
 556
 557 It looks for a field selectcustomer or selectvendor in $form. sql ledger used
 558 to store a copy of the html select in there. (again, don't ask)
 559
 560 =item
 561
 562 If this field exists, it looks for a field called oldcustomer or oldvendor, in
 563 which the old name--id string was stored in sql ledger, and compares those.
 564
 565 =item
 566
 567 if they don't match, it will set customer_id or vendor_id in $form, load the
 568 entry (which will clobber everything in $form named like a column in customer
 569 oder vendor) and return.
 570
 571 =item
 572
 573 If there was no select* entry, it assumes that vclimit was lower than the
 574 number of entries, and that an input field was generated. In that case the
 575 splitting is omitted (since users don't generally include ids in entered names)
 576
 577 =item
 578
 579 It looks for a *_id field, and combines it with the given input into a name--id
 580 entry and compares it to the old* entry. (Missing any of these will instantly
 581 break check_namea.
 582
 583 =item
 584
 585 If those do not match, $form->get_name is called to get matching results.
 586 get_name only matches by *number and name, not by id, don't try to get it to do
 587 so.
 588
 589 =item
 590
 591 The results are stored in $form>{name_list} but a count is returned, and
 592 checked.
 593
 594 =item
 595
 596 If only one result was found, *_id, * and old* are copied into $form, the entry
 597 is loaded (like above, clobbering)
 598
 599 =item
 600
 601 If there is more than one, a selection dialog is rendered
 602
 603 =item
 604
 605 If none is found, an error is generated.
 606
 607 =back
 608
 609 =head3 I built a customer/vendor box somewhere and it doesn't work, what's wrong?
 610
 611 Make sure a select* field is given if and only if you render a select box. The
 612 actual contents are ignored, but recognition fails if not present.
 613
 614 Make sure old* and *_id fields are set correctly (name--id form for old*). They
 615 are necessary in all steps and branches.
 616
 617 Since get_customer and get_vendor clobber a lot of fields, make sure what
 618 changes exactly.
 619 =======
 620 This function will take the contents of $form->{vendor} or $form->{customer}, try to guess if there was a selectbox or not, and search for matching customer/vendors.
 621
 622 This mostly works great, except for the case when there is more than one match.
 623 In that case check_name will display a select form, that will redirect to the
 624 original C<nextsub>. Unfortunately any hidden vars or input fields will be lost
 625 in the process unless saved before in a callback.
 626
 627 If you still want to use it, you can disable this feature, like this:
 628
 629   check_name('customer', no_select => 1)
 630
 631 In that case multiple matches will trigger an error.
 632
 633 =head1 BUGS
 634
 635 =head1 AUTHOR
 636 >>>>>>> 88f5a78... check_name erweitert um ein no_select flag. siehe perldoc bin/mozilla/arap.pl:bin/mozilla/arap.pl
 637
 638 =cut