#===================================================================== # LedgerSMB Small Medium Business Accounting # http://www.ledgersmb.org/ # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. # # This file contains source code included with or based on SQL-Ledger which # is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed # under the GNU General Public License version 2 or, at your option, any later # version. For a full list including contact information of contributors, # maintainers, and copyright holders, see the CONTRIBUTORS file. # # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): # Copyright (c) 2003 # # Author: DWS Systems Inc. # 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 # use LedgerSMB::AA; # any custom scripts for this one if ( -f "bin/custom/arap.pl" ) { eval { require "bin/custom/arap.pl"; }; } if ( -f "bin/custom/$form->{login}_arap.pl" ) { eval { require "bin/custom/$form->{login}_arap.pl"; }; } 1; # end of main sub check_name { my ($name) = @_; my ( $new_name, $new_id ) = split /--/, $form->{$name}; my $rv = 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 for ( split / /, $form->{taxaccounts} ) { delete $form->{"${_}_rate"}; } # for credit calculations $form->{oldinvtotal} = 0; $form->{oldtotalpaid} = 0; $form->{calctax} = 1; $form->{"${name}_id"} = $new_id; AA->get_name( \%myconfig, \%$form ); $form->{$name} = $form->{"old$name"} = "$new_name--$new_id"; $form->{currency} =~ s/ //g; # put employee together if there is a new employee_id $form->{employee} = "$form->{employee}--$form->{employee_id}" if $form->{employee_id}; $rv = 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 for ( split / /, $form->{taxaccounts} ) { delete $form->{"${_}_rate"}; } # for credit calculations $form->{oldinvtotal} = 0; $form->{oldtotalpaid} = 0; $form->{calctax} = 1; # return one name or a list of names in $form->{name_list} if ( ( $rv = $form->get_name( \%myconfig, $name, $form->{transdate} ) ) > 1 ) { &select_name($name); exit; } if ( $rv == 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"}|; AA->get_name( \%myconfig, \%$form ); $form->{currency} =~ s/ //g; # put employee together if there is a new employee_id $form->{employee} = "$form->{employee}--$form->{employee_id}" if $form->{employee_id}; } else { # name is not on file $msg = ucfirst $name . " not on file!"; $form->error( $locale->text($msg) ); } } } $rv; } # $locale->text('Customer not on file!') # $locale->text('Vendor not on file!') sub select_name { my ($table) = @_; @column_index = qw(ndx name address); $label = ucfirst $table; $column_data{ndx} = qq|