[freeside-commits] freeside/FS/FS Schema.pm, NONE, 1.1 Record.pm,
1.104, 1.105 cust_main.pm, 1.189, 1.190 payment_gateway.pm,
NONE, 1.1 payment_gateway_option.pm, NONE,
1.1 option_Common.pm, NONE, 1.1 part_export.pm, 1.98,
1.99 part_pkg.pm, 1.41, 1.42 part_export_option.pm, 1.5, 1.6
Ivan,,,
ivan at wavetail.420.am
Wed Aug 17 15:23:48 PDT 2005
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail:/tmp/cvs-serv31511/FS/FS
Modified Files:
Record.pm cust_main.pm part_export.pm part_pkg.pm
part_export_option.pm
Added Files:
Schema.pm payment_gateway.pm payment_gateway_option.pm
option_Common.pm
Log Message:
infrastructure for easier schema changes, and: add payment_gateway, payment_gateway_option and agent_payment_gateway tables, add paystart_month, paystart_year, payissue and payip fields to cust_main, add preliminary gateway and gateway override editing to web UI, use payment gateway override when processing payments (card type, not taxclass yet)
Index: part_export_option.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_export_option.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- part_export_option.pm 5 Aug 2003 00:20:43 -0000 1.5
+++ part_export_option.pm 17 Aug 2005 22:23:45 -0000 1.6
@@ -104,7 +104,7 @@
my $error =
$self->ut_numbern('optionnum')
- || $self->ut_number('exportnum')
+ || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
|| $self->ut_alpha('optionname')
|| $self->ut_anything('optionvalue')
;
Index: part_export.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_export.pm,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -d -r1.98 -r1.99
--- part_export.pm 26 Oct 2004 12:07:26 -0000 1.98
+++ part_export.pm 17 Aug 2005 22:23:45 -0000 1.99
@@ -5,11 +5,12 @@
use Exporter;
use Tie::IxHash;
use FS::Record qw( qsearch qsearchs dbh );
+use FS::option_Common;
use FS::part_svc;
use FS::part_export_option;
use FS::export_svc;
- at ISA = qw(FS::Record);
+ at ISA = qw( FS::option_Common );
@EXPORT_OK = qw(export_info);
$DEBUG = 0;
@@ -103,48 +104,6 @@
If a hash reference of options is supplied, part_export_option records are
created (see L<FS::part_export_option>).
-=cut
-
-#false laziness w/queue.pm
-sub insert {
- my $self = shift;
- my $options = shift;
- 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::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $optionname ( keys %{$options} ) {
- my $part_export_option = new FS::part_export_option ( {
- 'exportnum' => $self->exportnum,
- 'optionname' => $optionname,
- 'optionvalue' => $options->{$optionname},
- } );
- $error = $part_export_option->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
=item delete
Delete this record from the database.
@@ -171,14 +130,6 @@
return $error;
}
- foreach my $part_export_option ( $self->part_export_option ) {
- my $error = $part_export_option->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
foreach my $export_svc ( $self->export_svc ) {
my $error = $export_svc->delete;
if ( $error ) {
@@ -193,72 +144,6 @@
}
-=item replace OLD_RECORD HASHREF
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-If a hash reference of options is supplied, part_export_option records are
-created or modified (see L<FS::part_export_option>).
-
-=cut
-
-sub replace {
- my $self = shift;
- my $old = shift;
- my $options = shift;
- 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;
- }
-
- foreach my $optionname ( keys %{$options} ) {
- my $old = qsearchs( 'part_export_option', {
- 'exportnum' => $self->exportnum,
- 'optionname' => $optionname,
- } );
- my $new = new FS::part_export_option ( {
- 'exportnum' => $self->exportnum,
- 'optionname' => $optionname,
- 'optionvalue' => $options->{$optionname},
- } );
- $new->optionnum($old->optionnum) if $old;
- my $error = $old ? $new->replace($old) : $new->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- #remove extraneous old options
- foreach my $opt (
- grep { !exists $options->{$_->optionname} } $old->part_export_option
- ) {
- my $error = $opt->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-};
-
=item check
Checks all fields to make sure this is a valid export. If there is
@@ -347,36 +232,17 @@
sub part_export_option {
my $self = shift;
- qsearch('part_export_option', { 'exportnum' => $self->exportnum } );
+ $self->option_objects;
}
=item options
Returns a list of option names and values suitable for assigning to a hash.
-=cut
-
-sub options {
- my $self = shift;
- map { $_->optionname => $_->optionvalue } $self->part_export_option;
-}
-
=item option OPTIONNAME
Returns the option value for the given name, or the empty string.
-=cut
-
-sub option {
- my $self = shift;
- my $part_export_option =
- qsearchs('part_export_option', {
- exportnum => $self->exportnum,
- optionname => shift,
- } );
- $part_export_option ? $part_export_option->optionvalue : '';
-}
-
=item _rebless
Reblesses the object into the FS::part_export::EXPORTTYPE class, where
--- NEW FILE: payment_gateway.pm ---
package FS::payment_gateway;
use strict;
use vars qw( @ISA );
use FS::Record qw( qsearch qsearchs );
use FS::option_Common;
@ISA = qw( FS::option_Common );
=head1 NAME
FS::payment_gateway - Object methods for payment_gateway records
=head1 SYNOPSIS
use FS::payment_gateway;
$record = new FS::payment_gateway \%hash;
$record = new FS::payment_gateway { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::payment_gateway object represents an payment gateway.
FS::payment_gateway inherits from FS::Record. The following fields are
currently supported:
=over 4
=item gatewaynum - primary key
=item gateway_module - Business::OnlinePayment:: module name
=item gateway_username - payment gateway username
=item gateway_password - payment gateway password
=item gateway_action - optional action or actions (multiple actions are separated with `,': for example: `Authorization Only, Post Authorization'). Defaults to `Normal Authorization'.
=item disabled - Disabled flag, empty or 'Y'
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new payment gateway. To add the payment gateway to the database, see
L<"insert">.
Note that this stores the hash reference, not a distinct copy of the hash it
points to. You can ask the object for a copy with the I<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'payment_gateway'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
=cut
# the insert method can be inherited from FS::Record
=item delete
Delete this record from the database.
=cut
# the delete method can be inherited from FS::Record
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
# the replace method can be inherited from FS::Record
=item check
Checks all fields to make sure this is a valid payment gateway. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
=cut
# the check method should currently be supplied - FS::Record contains some
# data checking routines
sub check {
my $self = shift;
my $error =
$self->ut_numbern('gatewaynum')
|| $self->ut_alpha('gateway_module')
|| $self->ut_textn('gateway_username')
|| $self->ut_anything('gateway_password')
|| $self->ut_enum('disabled', [ '', 'Y' ] )
#|| $self->ut_textn('gateway_action')
;
return $error if $error;
if ( $self->gateway_action ) {
my @actions = split(/,\s*/, $self->gateway_action);
$self->gateway_action(
join( ',', map { /^(Normal Authorization|Authorization Only|Credit|Post Authorization)$/
or return "Unknown action $_";
$1
}
@actions
)
);
} else {
$self->gateway_action('Normal Authorization');
}
$self->SUPER::check;
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::Record>, schema.html from the base documentation.
=cut
1;
--- NEW FILE: payment_gateway_option.pm ---
package FS::payment_gateway_option;
use strict;
use vars qw( @ISA );
use FS::Record qw( qsearch qsearchs );
@ISA = qw(FS::Record);
=head1 NAME
FS::payment_gateway_option - Object methods for payment_gateway_option records
=head1 SYNOPSIS
use FS::payment_gateway_option;
$record = new FS::payment_gateway_option \%hash;
$record = new FS::payment_gateway_option { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::payment_gateway_option object represents an option key and value for
a payment gateway. FS::payment_gateway_option inherits from
FS::Record. The following fields are currently supported:
=over 4
=item optionnum - primary key
=item gatewaynum -
=item optionname -
=item optionvalue -
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new option. To add the option to the database, see L<"insert">.
Note that this stores the hash reference, not a distinct copy of the hash it
points to. You can ask the object for a copy with the I<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'payment_gateway_option'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
=cut
# the insert method can be inherited from FS::Record
=item delete
Delete this record from the database.
=cut
# the delete method can be inherited from FS::Record
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
# the replace method can be inherited from FS::Record
=item check
Checks all fields to make sure this is a valid option. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
=cut
# the check method should currently be supplied - FS::Record contains some
# data checking routines
sub check {
my $self = shift;
my $error =
$self->ut_numbern('optionnum')
|| $self->ut_foreign_key('gatewaynum', 'payment_gateway', 'gatewaynum')
|| $self->ut_text('optionname')
|| $self->ut_textn('optionvalue')
;
return $error if $error;
$self->SUPER::check;
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::Record>, schema.html from the base documentation.
=cut
1;
--- NEW FILE: option_Common.pm ---
package FS::option_Common;
use strict;
use vars qw( @ISA $DEBUG );
use FS::Record qw( qsearch qsearchs dbh );
@ISA = qw( FS::Record );
$DEBUG = 0;
=head1 NAME
FS::option_Common - Base class for option sub-classes
=head1 SYNOPSIS
use FS::option_Common;
@ISA = qw( FS::option_Common );
=head1 DESCRIPTION
FS::option_Common is intended as a base class for classes which have a
simple one-to-many class associated with them, used to store a hash-like data
structure of keys and values.
=head1 METHODS
=over 4
=item insert [ HASHREF | OPTION => VALUE ... ]
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
If a list or hash reference of options is supplied, option records are also
created.
=cut
#false laziness w/queue.pm
sub insert {
my $self = shift;
my $options =
( ref($_[0]) eq 'HASH' )
? shift
: { @_ };
warn "FS::option_Common::insert called on $self with options ".
join(', ', map "$_ => ".$options->{$_}, keys %$options)
if $DEBUG;
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::insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
my $pkey = $self->pkey;
my $option_table = $self->option_table;
foreach my $optionname ( keys %{$options} ) {
my $href = {
$pkey => $self->get($pkey),
'optionname' => $optionname,
'optionvalue' => $options->{$optionname},
};
#my $option_record = eval "new FS::$option_table \$href";
#if ( $@ ) {
# $dbh->rollback if $oldAutoCommit;
# return $@;
#}
my $option_record = $option_table->new($href);
$error = $option_record->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
=item delete
Delete this record from the database. Any associated option records are also
deleted.
=cut
#foreign keys would make this much less tedious... grr dumb mysql
sub delete {
my $self = shift;
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::delete;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
my $pkey = $self->pkey;
my $option_table = $self->option_table;
foreach my $obj ( $self->option_objects ) {
my $error = $obj->delete;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
=item replace [ HASHREF | OPTION => VALUE ... ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
If a list hash reference of options is supplied, part_export_option records are
created or modified (see L<FS::part_export_option>).
=cut
sub replace {
my $self = shift;
my $old = shift;
my $options =
( ref($_[0]) eq 'HASH' )
? shift
: { @_ };
warn "FS::option_Common::insert called on $self with options ".
join(', ', map "$_ => ". $options->{$_}, keys %$options)
if $DEBUG;
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;
}
my $pkey = $self->pkey;
my $option_table = $self->option_table;
foreach my $optionname ( keys %{$options} ) {
my $old = qsearchs( $option_table, {
$pkey => $self->get($pkey),
'optionname' => $optionname,
} );
my $href = {
$pkey => $self->get($pkey),
'optionname' => $optionname,
'optionvalue' => $options->{$optionname},
};
#my $new = eval "new FS::$option_table \$href";
#if ( $@ ) {
# $dbh->rollback if $oldAutoCommit;
# return $@;
#}
my $new = $option_table->new($href);
$new->optionnum($old->optionnum) if $old;
my $error = $old ? $new->replace($old) : $new->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
#remove extraneous old options
foreach my $opt (
grep { !exists $options->{$_->optionname} } $old->option_objects
) {
my $error = $opt->delete;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
=item option_objects
Returns all options as FS::I<tablename>_option objects.
=cut
sub option_objects {
my $self = shift;
my $pkey = $self->pkey;
my $option_table = $self->option_table;
qsearch($option_table, { $pkey => $self->get($pkey) } );
}
=item options
Returns a list of option names and values suitable for assigning to a hash.
=cut
sub options {
my $self = shift;
map { $_->optionname => $_->optionvalue } $self->option_objects;
}
=item option OPTIONNAME
Returns the option value for the given name, or the empty string.
=cut
sub option {
my $self = shift;
my $pkey = $self->pkey;
my $option_table = $self->option_table;
my $obj =
qsearchs($option_table, {
$pkey => $self->get($pkey),
optionname => shift,
} );
$obj ? $obj->optionvalue : '';
}
sub pkey {
my $self = shift;
my $pkey = $self->dbdef_table->primary_key;
}
sub option_table {
my $self = shift;
my $option_table = $self->table . '_option';
eval "use FS::$option_table";
die $@ if $@;
$option_table;
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::Record>
=cut
1;
Index: part_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_pkg.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- part_pkg.pm 9 Jun 2005 09:15:34 -0000 1.41
+++ part_pkg.pm 17 Aug 2005 22:23:45 -0000 1.42
@@ -13,7 +13,9 @@
use FS::type_pkgs;
use FS::part_pkg_option;
- at ISA = qw( FS::Record );
+ at ISA = qw( FS::Record ); # FS::option_Common ); # this can use option_Common
+ # when all the plandata bs is
+ # gone
$DEBUG = 0;
@@ -755,6 +757,8 @@
setup and recur semantics are not yet defined (and are implemented in
FS::cust_bill. hmm.).
+plandata should go
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.189
retrieving revision 1.190
diff -u -d -r1.189 -r1.190
--- cust_main.pm 14 Jul 2005 11:55:01 -0000 1.189
+++ cust_main.pm 17 Aug 2005 22:23:45 -0000 1.190
@@ -256,13 +256,18 @@
return $paymask;
}
+=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
+=item paystart_month - start date month (maestro/solo cards only)
+=item paystart_year - start date year (maestro/solo cards only)
-=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
+=item payissue - issue number (maestro/solo cards only)
=item payname - name on card or billing name
+=item payip - IP address from which payment information was received
+
=item tax - tax exempt, empty or `Y'
=item otaker - order taker (assigned automatically, see L<FS::UID>)
@@ -1099,6 +1104,19 @@
$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
or return "Illegal payby: ". $self->payby;
+ $error = $self->ut_numbern('paystart_month')
+ || $self->ut_numbern('paystart_year')
+ || $self->ut_numbern('payissue')
+ ;
+ return $error if $error;
+
+ if ( $self->payip eq '' ) {
+ $self->payip('');
+ } else {
+ $error = $self->ut_ip('payip');
+ return $error if $error;
+ }
+
# If it is encrypted and the private key is not availaible then we can't
# check the credit card.
@@ -1110,7 +1128,7 @@
$self->payby($1);
- if ( $check_payinfo && ($self->payby eq 'CARD' || $self->payby eq 'DCRD')) {
+ if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
@@ -1138,7 +1156,31 @@
}
}
- } elsif ($check_payinfo && ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' )) {
+ my $cardtype = cardtype($payinfo);
+ if ( $cardtype =~ /^(Switch|Solo)$/i ) {
+
+ return "Start date or issue number is required for $cardtype cards"
+ unless $self->paystart_month && $self->paystart_year or $self->payissue;
+
+ return "Start month must be between 1 and 12"
+ if $self->paystart_month
+ and $self->paystart_month < 1 || $self->paystart_month > 12;
+
+ return "Start year must be 1990 or later"
+ if $self->paystart_year
+ and $self->paystart_year < 1990;
+
+ return "Issue number must be beween 1 and 99"
+ if $self->payissue
+ and $self->payissue < 1 || $self->payissue > 99;
+
+ } else {
+ $self->paystart_month('');
+ $self->paystart_year('');
+ $self->payissue('');
+ }
+
+ } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/[^\d\@]//g;
@@ -2036,25 +2078,77 @@
$options{'description'} ||= 'Internet services';
- #pre-requisites
- die "Real-time processing not enabled\n"
- unless $conf->exists('business-onlinepayment');
eval "use Business::OnlinePayment";
die $@ if $@;
- #load up config
- my $bop_config = 'business-onlinepayment';
- $bop_config .= '-ach'
- if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
- my ( $processor, $login, $password, $action, @bop_options ) =
- $conf->config($bop_config);
- $action ||= 'normal authorization';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
- die "No real-time processor is enabled - ".
- "did you set the business-onlinepayment configuration value?\n"
- unless $processor;
+ my $payinfo = exists($options{'payinfo'})
+ ? $options{'payinfo'}
+ : $self->payinfo;
- #massage data
+ ###
+ # select a gateway
+ ###
+
+ my $taxclass = ''; #XXX not yet
+
+ #look for an agent gateway override first
+ my $cardtype;
+ if ( $method eq 'CC' ) {
+ $cardtype = cardtype($payinfo);
+ } elsif ( $method eq 'ECHECK' ) {
+ $cardtype = 'ACH';
+ } else {
+ $cardtype = $method;
+ }
+
+ my $override =
+ qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
+ cardtype => $cardtype,
+ taxclass => $taxclass, } )
+ || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
+ cardtype => '',
+ taxclass => $taxclass, } )
+ || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
+ cardtype => $cardtype,
+ taxclass => '', } )
+ || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
+ cardtype => '',
+ taxclass => '', } );
+
+ my $payment_gateway = '';
+ my( $processor, $login, $password, $action, @bop_options );
+ if ( $override ) { #use a payment gateway override
+
+ $payment_gateway = $override->payment_gateway;
+
+ $processor = $payment_gateway->gateway_module;
+ $login = $payment_gateway->gateway_username;
+ $password = $payment_gateway->gateway_password;
+ $action = $payment_gateway->gateway_action;
+ @bop_options = $payment_gateway->options;
+
+ } else { #use the standard settings from the config
+
+ die "Real-time processing not enabled\n"
+ unless $conf->exists('business-onlinepayment');
+
+ #load up config
+ my $bop_config = 'business-onlinepayment';
+ $bop_config .= '-ach'
+ if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
+ ( $processor, $login, $password, $action, @bop_options ) =
+ $conf->config($bop_config);
+ $action ||= 'normal authorization';
+ pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
+ die "No real-time processor is enabled - ".
+ "did you set the business-onlinepayment configuration value?\n"
+ unless $processor;
+
+ }
+
+ ###
+ # massage data
+ ###
my $address = exists($options{'address1'})
? $options{'address1'}
@@ -2088,10 +2182,6 @@
? $conf->config('business-onlinepayment-email-override')
: $invoicing_list[0];
- my $payinfo = exists($options{'payinfo'})
- ? $options{'payinfo'}
- : $self->payinfo;
-
my %content = ();
if ( $method eq 'CC' ) {
@@ -2130,7 +2220,9 @@
$content{phone} = $payinfo;
}
- #transaction(s)
+ ###
+ # run transaction(s)
+ ###
my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
@@ -2208,7 +2300,10 @@
}
- #remove paycvv after initial transaction
+ ###
+ # remove paycvv after initial transaction
+ ###
+
#false laziness w/misc/process/payment.cgi - check both to make sure working
# correctly
if ( defined $self->dbdef_table->column('paycvv')
@@ -2221,7 +2316,10 @@
}
}
- #result handling
+ ###
+ # result handling
+ ###
+
if ( $transaction->is_success() ) {
my %method2payby = (
@@ -2230,7 +2328,13 @@
'LEC' => 'LECB',
);
- my $paybatch = "$processor:". $transaction->authorization;
+ my $paybatch = '';
+ if ( $payment_gateway ) { # agent override
+ $paybatch = $payment_gateway->gatewaynum. '-';
+ }
+
+ $paybatch .= "$processor:". $transaction->authorization;
+
$paybatch .= ':'. $transaction->order_number
if $transaction->can('order_number')
&& length($transaction->order_number);
@@ -3278,17 +3382,10 @@
=cut
-my $recurring_sql = "
- '0' != ( select freq from part_pkg
- where cust_pkg.pkgpart = part_pkg.pkgpart )
-";
-
sub active_sql { "
0 < ( SELECT COUNT(*) FROM cust_pkg
WHERE cust_pkg.custnum = cust_main.custnum
- AND $recurring_sql
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
+ AND ". FS::cust_pkg->active_sql. "
)
"; }
@@ -3299,6 +3396,12 @@
=cut
+#my $recurring_sql = FS::cust_pkg->recurring_sql;
+my $recurring_sql = "
+ '0' != ( select freq from part_pkg
+ where cust_pkg.pkgpart = part_pkg.pkgpart )
+";
+
sub suspended_sql { susp_sql(@_); }
sub susp_sql { "
0 < ( SELECT COUNT(*) FROM cust_pkg
@@ -3308,9 +3411,7 @@
)
AND 0 = ( SELECT COUNT(*) FROM cust_pkg
WHERE cust_pkg.custnum = cust_main.custnum
- AND $recurring_sql
- AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
+ AND ". FS::cust_pkg->active_sql. "
)
"; }
Index: Record.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Record.pm,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -d -r1.104 -r1.105
--- Record.pm 12 Jul 2005 09:13:19 -0000 1.104
+++ Record.pm 17 Aug 2005 22:23:45 -0000 1.105
@@ -1,9 +1,8 @@
package FS::Record;
use strict;
-use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $me %dbdef_cache %virtual_fields_cache $nowarn_identical );
-use subs qw(reload_dbdef);
+use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+ $me %virtual_fields_cache $nowarn_identical );
use Exporter;
use Carp qw(carp cluck croak confess);
use File::CounterFile;
@@ -11,6 +10,7 @@
use DBI qw(:sql_types);
use DBIx::DBSchema 0.25;
use FS::UID qw(dbh getotaker datasrc driver_name);
+use FS::Schema qw(dbdef);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
use FS::Conf;
@@ -20,6 +20,8 @@
use Tie::IxHash;
@ISA = qw(Exporter);
+
+#export dbdef for now... everything else expects to find it here
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
$DEBUG = 0;
@@ -33,13 +35,10 @@
my $rsa_encrypt;
my $rsa_decrypt;
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::Record'} = sub {
+FS::UID->install_callback( sub {
$conf = new FS::Conf;
$File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
- $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
- &reload_dbdef unless $setup_hack; #$setup_hack needed now?
-};
+} );
=head1 NAME
@@ -48,7 +47,7 @@
=head1 SYNOPSIS
use FS::Record;
- use FS::Record qw(dbh fields qsearch qsearchs dbdef);
+ use FS::Record qw(dbh fields qsearch qsearchs);
$record = new FS::Record 'table', \%hash;
$record = new FS::Record 'table', { 'column' => 'value', ... };
@@ -94,10 +93,6 @@
$error = $record->ut_anything('column');
$error = $record->ut_name('column');
- $dbdef = reload_dbdef;
- $dbdef = reload_dbdef "/non/standard/filename";
- $dbdef = dbdef;
-
$quoted_value = _quote($value,'table','field');
#deprecated
@@ -218,7 +213,7 @@
my $dbh = dbh;
my $table = $cache ? $cache->table : $stable;
- my $dbdef_table = $dbdef->table($table)
+ my $dbdef_table = dbdef->table($table)
or die "No schema for table $table found - ".
"do you need to create it or run dbdef-create?";
my $pkey = $dbdef_table->primary_key;
@@ -254,7 +249,7 @@
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( $op eq '=' ) {
if ( driver_name eq 'Pg' ) {
- my $type = $dbdef->table($table)->column($column)->type;
+ my $type = dbdef->table($table)->column($column)->type;
if ( $type =~ /(int|serial)/i ) {
qq-( $column IS NULL )-;
} else {
@@ -265,7 +260,7 @@
}
} elsif ( $op eq '!=' ) {
if ( driver_name eq 'Pg' ) {
- my $type = $dbdef->table($table)->column($column)->type;
+ my $type = dbdef->table($table)->column($column)->type;
if ( $type =~ /(int|serial)/i ) {
qq-( $column IS NOT NULL )-;
} else {
@@ -335,7 +330,7 @@
grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
) {
if ( $record->{$field} =~ /^\d+(\.\d+)?$/
- && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
+ && dbdef->table($table)->column($field)->type =~ /(int|serial)/i
) {
$sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
} else {
@@ -446,7 +441,7 @@
my $table = $class->table
or croak "No table for $class found";
- my $dbdef_table = $dbdef->table($table)
+ my $dbdef_table = dbdef->table($table)
or die "No schema for table $table found - ".
"do you need to create it or run dbdef-create?";
my $pkey = $dbdef_table->primary_key
@@ -520,7 +515,7 @@
sub dbdef_table {
my($self)=@_;
my($table)=$self->table;
- $dbdef->table($table);
+ dbdef->table($table);
}
=item get, getfield COLUMN
@@ -787,7 +782,7 @@
my $h_sth;
- if ( defined $dbdef->table('h_'. $table) ) {
+ if ( defined dbdef->table('h_'. $table) ) {
my $h_statement = $self->_h_statement('insert');
warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or do {
@@ -848,7 +843,7 @@
my $sth = dbh->prepare($statement) or return dbh->errstr;
my $h_sth;
- if ( defined $dbdef->table('h_'. $self->table) ) {
+ if ( defined dbdef->table('h_'. $self->table) ) {
my $h_statement = $self->_h_statement('delete');
warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or return dbh->errstr;
@@ -992,7 +987,7 @@
my $sth = dbh->prepare($statement) or return dbh->errstr;
my $h_old_sth;
- if ( defined $dbdef->table('h_'. $old->table) ) {
+ if ( defined dbdef->table('h_'. $old->table) ) {
my $h_old_statement = $old->_h_statement('replace_old');
warn "[debug]$me $h_old_statement\n" if $DEBUG > 2;
$h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
@@ -1001,7 +996,7 @@
}
my $h_new_sth;
- if ( defined $dbdef->table('h_'. $new->table) ) {
+ if ( defined dbdef->table('h_'. $new->table) ) {
my $h_new_statement = $new->_h_statement('replace_new');
warn "[debug]$me $h_new_statement\n" if $DEBUG > 2;
$h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
@@ -1552,9 +1547,9 @@
my $table;
$table = $self->table or confess "virtual_fields called on non-table";
- confess "Unknown table $table" unless $dbdef->table($table);
+ confess "Unknown table $table" unless dbdef->table($table);
- return () unless $self->dbdef->table('part_virtual_field');
+ return () unless dbdef->table('part_virtual_field');
unless ( $virtual_fields_cache{$table} ) {
my $query = 'SELECT name from part_virtual_field ' .
@@ -1622,40 +1617,11 @@
sub real_fields {
my $table = shift;
- my($table_obj) = $dbdef->table($table);
+ my($table_obj) = dbdef->table($table);
confess "Unknown table $table" unless $table_obj;
$table_obj->columns;
}
-=item reload_dbdef([FILENAME])
-
-Load a database definition (see L<DBIx::DBSchema>), optionally from a
-non-default filename. This command is executed at startup unless
-I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object.
-
-=cut
-
-sub reload_dbdef {
- my $file = shift || $dbdef_file;
-
- unless ( exists $dbdef_cache{$file} ) {
- warn "[debug]$me loading dbdef for $file\n" if $DEBUG;
- $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
- or die "can't load database schema from $file";
- } else {
- warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG;
- }
- $dbdef = $dbdef_cache{$file};
-}
-
-=item dbdef
-
-Returns the current database definition. See L<DBIx::DBSchema>.
-
-=cut
-
-sub dbdef { $dbdef; }
-
=item _quote VALUE, TABLE, COLUMN
This is an internal function used to construct SQL statements. It returns
@@ -1666,7 +1632,7 @@
sub _quote {
my($value, $table, $column) = @_;
- my $column_obj = $dbdef->table($table)->column($column);
+ my $column_obj = dbdef->table($table)->column($column);
my $column_type = $column_obj->type;
my $nullable = $column_obj->null;
@@ -1701,7 +1667,7 @@
my $self = shift;
my $table = $self->table;
- return {} unless $self->dbdef->table('part_virtual_field');
+ return {} unless dbdef->table('part_virtual_field');
my $dbh = dbh;
my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
--- NEW FILE: Schema.pm ---
package FS::Schema;
use vars qw(@ISA @EXPORT_OK $DEBUG $setup_hack %dbdef_cache);
use subs qw(reload_dbdef);
use Exporter;
use DBIx::DBSchema 0.25;
use DBIx::DBSchema::Table;
use DBIx::DBSchema::Column;
use DBIx::DBSchema::ColGroup::Unique;
use DBIx::DBSchema::ColGroup::Index;
use FS::UID qw(datasrc);
@ISA = qw(Exporter);
@EXPORT_OK = qw( dbdef dbdef_dist reload_dbdef );
$DEBUG = 0;
$me = '[FS::Schema]';
#ask FS::UID to run this stuff for us later
[...1208 lines suppressed...]
'unique' => [],
'index' => [ [ 'agentnum', 'cardtype' ], ],
},
};
}
=back
=head1 BUGS
=head1 SEE ALSO
L<DBIx::DBSchema>
=cut
1;
More information about the freeside-commits
mailing list