use strict;
use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
- $smtpmachine $Debug );
+ $smtpmachine $Debug $bop_processor $bop_login $bop_password
+ $bop_action @bop_options);
use Safe;
use Carp;
use Time::Local;
use Mail::Header;
use Business::CreditCard;
use FS::UID qw( getotaker dbh );
-use FS::Record qw( qsearchs qsearch );
+use FS::Record qw( qsearchs qsearch dbdef );
use FS::cust_pkg;
use FS::cust_bill;
use FS::cust_bill_pkg;
$xaction,
) = $conf->config('cybercash2');
$processor='cybercash2';
+ } elsif ( $conf->exists('business-onlinepayment') ) {
+ ( $bop_processor,
+ $bop_login,
+ $bop_password,
+ $bop_action,
+ @bop_options
+ ) = $conf->config('business-onlinepayment');
+ $bop_action ||= 'normal authorization';
+ eval "use Business::OnlinePayment";
+ $processor="Business::OnlinePayment::$bop_processor";
}
};
=item fax - phone (optional)
+=item ship_first - name
+
+=item ship_last - name
+
+=item ship_company - (optional)
+
+=item ship_address1
+
+=item ship_address2 - (optional)
+
+=item ship_city
+
+=item ship_county - (optional, see L<FS::cust_main_county>)
+
+=item ship_state - (see L<FS::cust_main_county>)
+
+=item ship_zip
+
+=item ship_country - (see L<FS::cust_main_county>)
+
+=item ship_daytime - phone (optional)
+
+=item ship_night - phone (optional)
+
+=item ship_fax - phone (optional)
+
=item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
=item otaker - order taker (assigned automatically, see L<FS::UID>)
+=item comments - comments (optional)
+
=back
=head1 METHODS
sub table { 'cust_main'; }
-=item insert
+=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
-There is a special insert mode in which you pass a data structure to the insert
-method containing FS::cust_pkg and FS::svc_I<tablename> objects. When
-running under a transactional database, all records are inserted atomicly, or
-the transaction is rolled back. There should be a better explanation of this,
+CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
+are inserted atomicly, or the transaction is rolled back (this requries a
+transactional database). Passing an empty hash reference is equivalent to
+not supplying this parameter. There should be a better explanation of this,
but until then, here's an example:
use Tie::RefHash;
tie %hash, 'Tie::RefHash'; #this part is important
- %hash = {
+ %hash = (
$cust_pkg => [ $svc_acct ],
- };
+ ...
+ );
$cust_main->insert( \%hash );
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">). Errors return as
+expected and rollback the entire transaction; it is not necessary to call
+check_invoicing_list first. The invoicing_list is set after the records in the
+CUST_PKG_HASHREF above are inserted, so it is now possible set set an
+invoicing_list destination to the newly-created svc_acct. Here's an example:
+
+ $cust_main->insert( {}, [ $email, 'POST' ] );
+
=cut
sub insert {
my $self = shift;
+ my @param = @_;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
my $error = $prepay_credit->delete;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "removing prepay_credit (transaction rolled back): $error";
}
}
my $error = $self->SUPER::insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "inserting cust_main record (transaction rolled back): $error";
}
- if ( @_ ) {
- my $cust_pkgs = shift;
+ if ( @param ) { # CUST_PKG_HASHREF
+ my $cust_pkgs = shift @param;
foreach my $cust_pkg ( keys %$cust_pkgs ) {
$cust_pkg->custnum( $self->custnum );
$error = $cust_pkg->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "inserting cust_pkg (transaction rolled back): $error";
}
foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
$svc_something->pkgnum( $cust_pkg->pkgnum );
$error = $svc_something->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "inserting svc_ (transaction rolled back): $error";
}
}
}
return "No svc_acct record to apply pre-paid time";
}
+ if ( @param ) { # INVOICING_LIST_ARYREF
+ my $invoicing_list = shift @param;
+ $error = $self->check_invoicing_list( $invoicing_list );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "checking invoicing_list (transaction rolled back): $error";
+ }
+ $self->invoicing_list( $invoicing_list );
+ }
+
if ( $amount ) {
my $cust_credit = new FS::cust_credit {
'custnum' => $self->custnum,
$error = $cust_credit->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "inserting credit (transaction rolled back): $error";
}
}
}
-=item replace OLD_RECORD
+=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">). Errors return as
+expected and rollback the entire transaction; it is not necessary to call
+check_invoicing_list first. Here's an example:
+
+ $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+
+=cut
+
+sub replace {
+ my $self = shift;
+ my $old = shift;
+ my @param = @_;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::replace($old);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( @param ) { # INVOICING_LIST_ARYREF
+ my $invoicing_list = shift @param;
+ $error = $self->check_invoicing_list( $invoicing_list );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $self->invoicing_list( $invoicing_list );
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=item check
Checks all fields to make sure this is a valid customer record. If there is
$self->ut_numbern('custnum')
|| $self->ut_number('agentnum')
|| $self->ut_number('refnum')
+ || $self->ut_name('last')
+ || $self->ut_name('first')
|| $self->ut_textn('company')
|| $self->ut_text('address1')
|| $self->ut_textn('address2')
|| $self->ut_text('city')
|| $self->ut_textn('county')
|| $self->ut_textn('state')
+ || $self->ut_country('country')
+ || $self->ut_anything('comments')
+ || $self->ut_numbern('referral_custnum')
;
+ #barf. need message catalogs. i18n. etc.
+ $error .= "Please select a referral."
+ if $error =~ /^Illegal or empty \(numeric\) refnum: /;
return $error if $error;
return "Unknown agent"
return "Unknown referral"
unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
- $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
- or return "Illegal last name: ". $self->getfield('last');
- $self->setfield('last',$1);
-
- $self->first =~ /^([\w \,\.\-\']+)$/
- or return "Illegal first name: ". $self->first;
- $self->first($1);
+ return "Unknown referring custnum ". $self->referral_custnum
+ unless ! $self->referral_custnum
+ || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
if ( $self->ss eq '' ) {
$self->ss('');
$self->ss("$1-$2-$3");
}
- $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
- $self->country($1);
unless ( qsearchs('cust_main_county', {
'country' => $self->country,
'state' => '',
$self->ut_phonen('daytime', $self->country)
|| $self->ut_phonen('night', $self->country)
|| $self->ut_phonen('fax', $self->country)
+ || $self->ut_zip('zip', $self->country)
;
return $error if $error;
- $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
- or return "Illegal zip: ". $self->zip;
- $self->zip($1);
+ my @addfields = qw(
+ last first company address1 address2 city county state zip
+ country daytime night fax
+ );
+
+ if ( defined $self->dbdef_table->column('ship_last') ) {
+ if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields
+ && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields
+ )
+ {
+ my $error =
+ $self->ut_name('ship_last')
+ || $self->ut_name('ship_first')
+ || $self->ut_textn('ship_company')
+ || $self->ut_text('ship_address1')
+ || $self->ut_textn('ship_address2')
+ || $self->ut_text('ship_city')
+ || $self->ut_textn('ship_county')
+ || $self->ut_textn('ship_state')
+ || $self->ut_country('ship_country')
+ ;
+ return $error if $error;
+
+ #false laziness with above
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->ship_country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown ship_state/ship_county/ship_country: ".
+ $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->ship_state,
+ 'county' => $self->ship_county,
+ 'country' => $self->ship_country,
+ } );
+ }
+ #eofalse
+
+ $error =
+ $self->ut_phonen('ship_daytime', $self->ship_country)
+ || $self->ut_phonen('ship_night', $self->ship_country)
+ || $self->ut_phonen('ship_fax', $self->ship_country)
+ || $self->ut_zip('ship_zip', $self->ship_country)
+ ;
+ return $error if $error;
+
+ } else { # ship_ info eq billing info, so don't store dup info in database
+ $self->setfield("ship_$_", '')
+ foreach qw( last first company address1 address2 city county state zip
+ country daytime night fax );
+ }
+ }
$self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
or return "Illegal payby: ". $self->payby;
or return "Illegal expiration date: ". $self->paydate;
if ( length($2) == 4 ) {
$self->paydate("$2-$1-01");
- } elsif ( $2 > 97 ) { #should pry change to check for "this year"
- $self->paydate("19$2-$1-01");
} else {
$self->paydate("20$2-$1-01");
}
my $setup = 0;
unless ( $cust_pkg->setup ) {
my $setup_prog = $part_pkg->getfield('setup');
+ $setup_prog =~ /^(.*)$/ #presumably trusted
+ or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
+ $setup_prog = $1;
my $cpt = new Safe;
#$cpt->permit(); #what is necessary?
$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
( $cust_pkg->getfield('bill') || 0 ) < $time
) {
my $recur_prog = $part_pkg->getfield('recur');
+ $recur_prog =~ /^(.*)$/ #presumably trusted
+ or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
+ $recur_prog = $1;
my $cpt = new Safe;
#$cpt->permit(); #what is necessary?
$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
return "Real time card processing not enabled!";
}
+ my $address = $self->address1;
+ $address .= ", ". $self->address2 if $self->address2;
+
+ #fix exp. date
+ #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+ $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ my $exp = "$2/$1";
+
if ( $processor =~ /^cybercash/ ) {
#fix exp. date for cybercash
my $payname = $self->payname ||
$self->getfield('first'). ' '. $self->getfield('last');
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
- my $country = 'USA' if $self->country eq 'US';
+ my $country = $self->country eq 'US' ? 'USA' : $self->country;
my @full_xaction = ( $xaction,
'Order-ID' => $paybatch,
return '';
}
+ } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
+
+ my($payname, $payfirst, $paylast);
+ if ( $self->payname ) {
+ $payname = $self->payname;
+ $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal payname $payname";
+ };
+ ($payfirst, $paylast) = ($1, $2);
+ } else {
+ $payfirst = $self->getfield('first');
+ $paylast = $self->getfield('first');
+ $payname = "$payfirst $paylast";
+ }
+
+ my $transaction = new Business::OnlinePayment( $1, @bop_options );
+ $transaction->content(
+ 'type' => 'CC',
+ 'login' => $bop_login,
+ 'password' => $bop_password,
+ 'action' => $bop_action,
+ 'amount' => $amount,
+ 'invoice_number' => $cust_bill->invnum,
+ 'customer_id' => $self->custnum,
+ 'last_name' => $paylast,
+ 'first_name' => $payfirst,
+ 'name' => $payname,
+ 'address' => $address,
+ 'city' => $self->city,
+ 'state' => $self->state,
+ 'zip' => $self->zip,
+ 'country' => $self->country,
+ 'card_number' => $self->payinfo,
+ 'expiration' => $exp,
+ );
+ $transaction->submit();
+
+ if ( $transaction->is_success()) {
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => 'CARD',
+ 'payinfo' => $self->payinfo,
+ 'paybatch' => "$processor:". $transaction->authorization,
+ } );
+ my $error = $cust_pay->insert;
+ if ( $error ) {
+ # gah, even with transactions.
+ $dbh->commit if $oldAutoCommit; #well.
+ my $e = 'WARNING: Card debited but database not updated - '.
+ 'error applying payment, invnum #' . $cust_bill->invnum.
+ " ($processor): $error";
+ warn $e;
+ return $e;
+ }
+ } elsif ( $options{'report_badcard'} ) {
+ $dbh->commit if $oldAutoCommit;
+ return "$processor error, invnum #". $cust_bill->invnum. ': '.
+ $transaction->result_code. ": ". $transaction->error_message;
+ } else {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return ''
+ }
+
} else {
$dbh->rollback if $oldAutoCommit;
return "Unknown real-time processor $processor\n";
'';
}
+=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
+
+Returns an array of customers referred by this customer (referral_custnum set
+to this custnum). If DEPTH is given, recurses up to the given depth, returning
+customers referred by customers referred by this customer and so on, inclusive.
+The default behavior is DEPTH 1 (no recursion).
+
+=cut
+
+sub referral_cust_main {
+ my $self = shift;
+ my $depth = @_ ? shift : 1;
+ my $exclude = @_ ? shift : {};
+
+ my @cust_main =
+ map { $exclude->{$_->custnum}++; $_; }
+ grep { ! $exclude->{ $_->custnum } }
+ qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
+
+ if ( $depth > 1 ) {
+ push @cust_main,
+ map { $_->referral_cust_main($depth-1, $exclude) }
+ @cust_main;
+ }
+
+ @cust_main;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item rebuild_fuzzyfile
+
+=cut
+
+sub rebuild_fuzzyfiles {
+ my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
+ push @all_last,
+ grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
+ if defined dbdef->table('cust_main')->column('ship_last');
+# open(
+
+}
+
=back
=head1 VERSION
-$Id: cust_main.pm,v 1.11 2001-04-09 23:05:15 ivan Exp $
+$Id: cust_main.pm,v 1.23 2001-09-01 20:11:07 ivan Exp $
=head1 BUGS
There should probably be a configuration file with a list of allowed credit
card types.
-CyberCash is the only processor.
-
No multiple currency support (probably a larger project than just this module).
=head1 SEE ALSO