Projekt

Allgemein

Profil

Herunterladen (14,8 KB) Statistiken
| Zweig: | Markierung: | Revision:
d319704a Moritz Bunkus
#=====================================================================
# LX-Office ERP
# Copyright (C) 2004
# Based on SQL-Ledger Version 2.1.9
# Web http://www.lx-office.org
#
#=====================================================================
# SQL-Ledger Accounting
# Copyright (c) 2002
#
# Author: Dieter Simader
# Email: dsimader@sql-ledger.org
# Web: http://www.sql-ledger.org
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#======================================================================
#
# common routines for gl, ar, ap, is, ir, oe
#

08844064 Moritz Bunkus
use SL::Projects;

2e798373 Sven Schöling
use strict;

d319704a Moritz Bunkus
# any custom scripts for this one
d629acd8 Sven Schöling
if (-f "bin/mozilla/custom_arap.pl") {
eval { require "bin/mozilla/custom_arap.pl"; };
d319704a Moritz Bunkus
}
2e798373 Sven Schöling
if (-f "bin/mozilla/$main::form->{login}_arap.pl") {
eval { require "bin/mozilla/$main::form->{login}_arap.pl"; };
d319704a Moritz Bunkus
}

1;

40782548 Moritz Bunkus
require "bin/mozilla/common.pl";

d319704a Moritz Bunkus
# end of main

sub check_name {
2e798373 Sven Schöling
$main::lxdebug->enter_sub();

my $form = $main::form;
my %myconfig = %main::myconfig;
my $locale = $main::locale;
d319704a Moritz Bunkus
2e798373 Sven Schöling
$main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
8536d9ca Moritz Bunkus
'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash |' .
'purchase_delivery_order_edit | sales_delivery_order_edit');
8c7e4493 Moritz Bunkus
1521c33d Sven Schöling
my ($name, %params) = @_;
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$name = $name eq "customer" ? "customer" : "vendor";

d319704a Moritz Bunkus
my ($new_name, $new_id) = split /--/, $form->{$name};
my $i = 0;
# if we use a selection
if ($form->{"select$name"}) {
if ($form->{"old$name"} ne $form->{$name}) {

# this is needed for is, ir and oe
54e4131e Moritz Bunkus
$form->{update} = 0;
d319704a Moritz Bunkus
# for credit calculations
$form->{oldinvtotal} = 0;
$form->{oldtotalpaid} = 0;
$form->{calctax} = 1;

$form->{"${name}_id"} = $new_id;

IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');

$form->{$name} = $form->{"old$name"} = "$new_name--$new_id";

$i = 1;
}
} else {

# check name, combine name and id
if ($form->{"old$name"} ne qq|$form->{$name}--$form->{"${name}_id"}|) {

# this is needed for is, ir and oe
54e4131e Moritz Bunkus
$form->{update} = 0;
d319704a Moritz Bunkus
# for credit calculations
$form->{oldinvtotal} = 0;
$form->{oldtotalpaid} = 0;
$form->{calctax} = 1;

# return one name or a list of names in $form->{name_list}
1521c33d Sven Schöling
$i = $form->get_name(\%myconfig, $name);

if ($i > 1) {
if ($params{no_select}) {
# $locale->text('Customer')
# $locale->text('Vendor')
$form->error($locale->text("More than one #1 found matching, please be more specific.", $locale->text(ucfirst $name)));
} else {
&select_name($name);
b2945bf6 Sven Schöling
::end_of_request();
1521c33d Sven Schöling
}
d319704a Moritz Bunkus
}

if ($i == 1) {

# we got one name
$form->{"${name}_id"} = $form->{name_list}[0]->{id};
$form->{$name} = $form->{name_list}[0]->{name};
$form->{"old$name"} = qq|$form->{$name}--$form->{"${name}_id"}|;

IS->get_customer(\%myconfig, \%$form) if ($name eq 'customer');
IR->get_vendor(\%myconfig, \%$form) if ($name eq 'vendor');

} else {

# name is not on file
948670d8 Moritz Bunkus
# $locale->text('Customer not on file or locked!')
# $locale->text('Vendor not on file or locked!')
2e798373 Sven Schöling
my $msg = ucfirst $name . " not on file or locked!";
d319704a Moritz Bunkus
$form->error($locale->text($msg));
}
}
}
54e4131e Moritz Bunkus
$form->language_payment(\%myconfig);
d319704a Moritz Bunkus
2e798373 Sven Schöling
$main::lxdebug->leave_sub();
d319704a Moritz Bunkus
return $i;
}

# $locale->text('Customer not on file!')
# $locale->text('Vendor not on file!')

sub select_name {
2e798373 Sven Schöling
$main::lxdebug->enter_sub();
d319704a Moritz Bunkus
2e798373 Sven Schöling
my $form = $main::form;
my $locale = $main::locale;

$main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
8c7e4493 Moritz Bunkus
'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');

d319704a Moritz Bunkus
my ($table) = @_;

2e798373 Sven Schöling
my @column_index = qw(ndx name address);
d319704a Moritz Bunkus
2e798373 Sven Schöling
my $label = ucfirst $table;
my %column_data;
d319704a Moritz Bunkus
$column_data{ndx} = qq|<th>&nbsp;</th>|;
$column_data{name} =
qq|<th class=listheading>| . $locale->text($label) . qq|</th>|;
$column_data{address} =
qq|<th class=listheading>| . $locale->text('Address') . qq|</th>|;

# list items with radio button on a form
$form->header;

2e798373 Sven Schöling
my $title = $locale->text('Select from one of the names below');
d319704a Moritz Bunkus
print qq|
<body>

<form method=post action=$form->{script}>

<table width=100%>
<tr>
<th class=listtop>$title</th>
</tr>
<tr space=5></tr>
<tr>
<td>
<table width=100%>
b65a230d Sven Schöling
<tr class=listheading>|;
d319704a Moritz Bunkus
map { print "\n$column_data{$_}" } @column_index;

print qq|
b65a230d Sven Schöling
</tr>
d319704a Moritz Bunkus
|;

my $i = 0;
2e798373 Sven Schöling
my $j;
foreach my $ref (@{ $form->{name_list} }) {
my $checked = ($i++) ? "" : "checked";
d319704a Moritz Bunkus
$ref->{name} =~ s/\"/&quot;/g;

$column_data{ndx} =
qq|<td><input name=ndx class=radio type=radio value=$i $checked></td>|;
$column_data{name} =
qq|<td><input name="new_name_$i" type=hidden value="$ref->{name}">$ref->{name}</td>|;
$column_data{address} = qq|<td>$ref->{address}&nbsp;</td>|;

$j++;
$j %= 2;
print qq|
b65a230d Sven Schöling
<tr class=listrow$j>|;
d319704a Moritz Bunkus
map { print "\n$column_data{$_}" } @column_index;

print qq|
b65a230d Sven Schöling
</tr>
d319704a Moritz Bunkus
<input name="new_id_$i" type=hidden value=$ref->{id}>

|;

}

print qq|
</table>
</td>
</tr>
<tr>
<td><hr size=3 noshade></td>
</tr>
</table>

<input name=lastndx type=hidden value=$i>

|;

# delete variables
map { delete $form->{$_} } qw(action name_list header);

# save all other form variables
2e798373 Sven Schöling
foreach my $key (keys %${form}) {
8c7e4493 Moritz Bunkus
next if (($key eq 'login') || ($key eq 'password') || ('' ne ref $form->{$key}));
d319704a Moritz Bunkus
$form->{$key} =~ s/\"/&quot;/g;
print qq|<input name=$key type=hidden value="$form->{$key}">\n|;
}

print qq|
<input type=hidden name=nextsub value=name_selected>

<input type=hidden name=vc value=$table>
<br>
<input class=submit type=submit name=action value="|
. $locale->text('Continue') . qq|">
</form>

</body>
</html>
|;

2e798373 Sven Schöling
$main::lxdebug->leave_sub();
d319704a Moritz Bunkus
}

sub name_selected {
2e798373 Sven Schöling
$main::lxdebug->enter_sub();

my $form = $main::form;
my %myconfig = %main::myconfig;
d319704a Moritz Bunkus
2e798373 Sven Schöling
$main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
8c7e4493 Moritz Bunkus
'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash');

d319704a Moritz Bunkus
# replace the variable with the one checked

# index for new item
2e798373 Sven Schöling
my $i = $form->{ndx};
d319704a Moritz Bunkus
$form->{ $form->{vc} } = $form->{"new_name_$i"};
$form->{"$form->{vc}_id"} = $form->{"new_id_$i"};
$form->{"old$form->{vc}"} =
qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|;

# delete all the new_ variables
for $i (1 .. $form->{lastndx}) {
0acabd54 Udo Spallek
map { delete $form->{"new_${_}_$i"} } qw(id name);
d319704a Moritz Bunkus
}

map { delete $form->{$_} } qw(ndx lastndx nextsub);

IS->get_customer(\%myconfig, \%$form) if ($form->{vc} eq 'customer');
IR->get_vendor(\%myconfig, \%$form) if ($form->{vc} eq 'vendor');

&update(1);

2e798373 Sven Schöling
$main::lxdebug->leave_sub();
d319704a Moritz Bunkus
}

sub check_project {
2e798373 Sven Schöling
$main::lxdebug->enter_sub();
d319704a Moritz Bunkus
2e798373 Sven Schöling
my $form = $main::form;
my $locale = $main::locale;

$main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
8c7e4493 Moritz Bunkus
'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash | report');

7148aad6 Moritz Bunkus
my $nextsub = shift || 'update';

2e798373 Sven Schöling
for my $i (1 .. $form->{rowcount}) {
82c78486 Moritz Bunkus
my $suffix = $i ? "_$i" : "";
my $prefix = $i ? "" : "global";
$form->{"${prefix}project_id${suffix}"} = "" unless $form->{"${prefix}projectnumber$suffix"};
if ($form->{"${prefix}projectnumber${suffix}"} ne $form->{"old${prefix}projectnumber${suffix}"}) {
if ($form->{"${prefix}projectnumber${suffix}"}) {
d319704a Moritz Bunkus
# get new project
82c78486 Moritz Bunkus
$form->{projectnumber} = $form->{"${prefix}projectnumber${suffix}"};
08844064 Moritz Bunkus
my %params = map { $_ => $form->{$_} } qw(projectnumber description active);
2e798373 Sven Schöling
my $rows;
08844064 Moritz Bunkus
if (($rows = Projects->search_projects(%params)) > 1) {
d319704a Moritz Bunkus
# check form->{project_list} how many there are
$form->{rownumber} = $i;
7148aad6 Moritz Bunkus
&select_project($i ? undef : 1, $nextsub);
b2945bf6 Sven Schöling
::end_of_request();
d319704a Moritz Bunkus
}

if ($rows == 1) {
8c7e4493 Moritz Bunkus
$form->{"${prefix}project_id${suffix}"} = $form->{project_list}->[0]->{id};
$form->{"${prefix}projectnumber${suffix}"} = $form->{project_list}->[0]->{projectnumber};
$form->{"old${prefix}projectnumber${suffix}"} = $form->{project_list}->[0]->{projectnumber};
d319704a Moritz Bunkus
} else {

# not on file
$form->error($locale->text('Project not on file!'));
}
} else {
82c78486 Moritz Bunkus
$form->{"old${prefix}projectnumber${suffix}"} = "";
d319704a Moritz Bunkus
}
}
}

2e798373 Sven Schöling
$main::lxdebug->leave_sub();
d319704a Moritz Bunkus
}

sub select_project {
9816fbfe Sven Schöling
$::lxdebug->enter_sub;
d319704a Moritz Bunkus
9816fbfe Sven Schöling
$::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash | report');
8c7e4493 Moritz Bunkus
7148aad6 Moritz Bunkus
my ($is_global, $nextsub) = @_;
9816fbfe Sven Schöling
my $project_list = delete $::form->{project_list};
82c78486 Moritz Bunkus
9816fbfe Sven Schöling
map { delete $::form->{$_} } qw(action header update);
d319704a Moritz Bunkus
9816fbfe Sven Schöling
my @hiddens;
for my $key (keys %$::form) {
next if $key eq 'login' || $key eq 'password' || '' ne ref $::form->{$key};
push @hiddens, { key => $key, value => $::form->{$key} };
d319704a Moritz Bunkus
}
9816fbfe Sven Schöling
push @hiddens, { key => 'is_global', value => $is_global },
{ key => 'project_selected_nextsub', value => $nextsub };
d319704a Moritz Bunkus
9816fbfe Sven Schöling
$::form->header;
print $::form->parse_html_template('arap/select_project', { hiddens => \@hiddens, project_list => $project_list });
d319704a Moritz Bunkus
9816fbfe Sven Schöling
$::lxdebug->leave_sub;
d319704a Moritz Bunkus
}

sub project_selected {
2e798373 Sven Schöling
$main::lxdebug->enter_sub();

my $form = $main::form;
d319704a Moritz Bunkus
2e798373 Sven Schöling
$main::auth->assert('general_ledger | vendor_invoice_edit | sales_order_edit | invoice_edit |' .
8c7e4493 Moritz Bunkus
'request_quotation_edit | sales_quotation_edit | purchase_order_edit | cash | report');

d319704a Moritz Bunkus
# replace the variable with the one checked

# index for new item
2e798373 Sven Schöling
my $i = $form->{ndx};
d319704a Moritz Bunkus
82c78486 Moritz Bunkus
my $prefix = $form->{"is_global"} ? "global" : "";
my $suffix = $form->{"is_global"} ? "" : "_$form->{rownumber}";

$form->{"${prefix}projectnumber${suffix}"} =
d319704a Moritz Bunkus
$form->{"new_projectnumber_$i"};
82c78486 Moritz Bunkus
$form->{"old${prefix}projectnumber${suffix}"} =
d319704a Moritz Bunkus
$form->{"new_projectnumber_$i"};
82c78486 Moritz Bunkus
$form->{"${prefix}project_id${suffix}"} = $form->{"new_id_$i"};
d319704a Moritz Bunkus
# delete all the new_ variables
for $i (1 .. $form->{lastndx}) {
map { delete $form->{"new_${_}_$i"} } qw(id projectnumber description);
}

7148aad6 Moritz Bunkus
my $nextsub = $form->{project_selected_nextsub} || 'update';
d319704a Moritz Bunkus
7148aad6 Moritz Bunkus
map { delete $form->{$_} } qw(ndx lastndx nextsub is_global project_selected_nextsub);

call_sub($nextsub);
d319704a Moritz Bunkus
2e798373 Sven Schöling
$main::lxdebug->leave_sub();
d319704a Moritz Bunkus
}

2e798373 Sven Schöling
sub continue { call_sub($main::form->{"nextsub"}); }
d319704a Moritz Bunkus
ad4cb09d Sven Schöling
1;

__END__

=head1 NAME

1521c33d Sven Schöling
arap.pl - helper functions or customer/vendor retrieval

=head1 SYNOPSIS

check_name('vendor')
check_project();

=head1 DESCRIPTION

Don't use anyting in this file without extreme care, and even then be prepared for massive headaches.

It's a collection of helper routines that wrap the customer/vendor dropdown/textfield duality into something even complexer.
ad4cb09d Sven Schöling
=head1 FUNCTIONS

=head2 check_name customer|vendor

check_name was originally meant to update the selected customer or vendor. The
way it does that has generted more hate than almost any other part of this
software.

What it does is:

=over 4

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
It checks if a vendor or customer is given. No failsafe, vendor fallback if
$_[0] is something fancy.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
It assumes, that there is a field named customer or vendor in $form.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
It assumes, that this field is filled with name--id, and tries to split that.
sql ledger uses that combination to get ids into the select keys.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
It looks for a field selectcustomer or selectvendor in $form. sql ledger used
to store a copy of the html select in there. (again, don't ask)

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
If this field exists, it looks for a field called oldcustomer or oldvendor, in
which the old name--id string was stored in sql ledger, and compares those.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
if they don't match, it will set customer_id or vendor_id in $form, load the
entry (which will clobber everything in $form named like a column in customer
oder vendor) and return.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
If there was no select* entry, it assumes that vclimit was lower than the
number of entries, and that an input field was generated. In that case the
splitting is omitted (since users don't generally include ids in entered names)

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
It looks for a *_id field, and combines it with the given input into a name--id
entry and compares it to the old* entry. (Missing any of these will instantly
break check_namea.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
If those do not match, $form->get_name is called to get matching results.
get_name only matches by *number and name, not by id, don't try to get it to do
so.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
The results are stored in $form>{name_list} but a count is returned, and
checked.

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
If only one result was found, *_id, * and old* are copied into $form, the entry
is loaded (like above, clobbering)

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
If there is more than one, a selection dialog is rendered

e24551e6 Sven Schöling
=item *
ad4cb09d Sven Schöling
If none is found, an error is generated.

=back

=head3 I built a customer/vendor box somewhere and it doesn't work, what's wrong?

Make sure a select* field is given if and only if you render a select box. The
actual contents are ignored, but recognition fails if not present.

Make sure old* and *_id fields are set correctly (name--id form for old*). They
are necessary in all steps and branches.

Since get_customer and get_vendor clobber a lot of fields, make sure what
changes exactly.
1521c33d Sven Schöling
e24551e6 Sven Schöling
=head3 select- version works fine, but things go awry when I use a textbox, any idea?

If there is more than one match, check_name will display a select form, that
will redirect to the original C<nextsub>. Unfortunately any hidden vars or
input fields will be lost in the process unless saved before in a callback.
1521c33d Sven Schöling
If you still want to use it, you can disable this feature, like this:

check_name('customer', no_select => 1)

In that case multiple matches will trigger an error.

e24551e6 Sven Schöling
Otherwise you'll have to care to include a complete state in callback.
ad4cb09d Sven Schöling
=cut