diff options
| -rw-r--r-- | FS/FS/Schema.pm | 26 | ||||
| -rw-r--r-- | FS/FS/banned_pay.pm | 136 | ||||
| -rw-r--r-- | FS/FS/cancel_reason.pm | 123 | ||||
| -rw-r--r-- | FS/FS/cust_main.pm | 51 | ||||
| -rw-r--r-- | FS/MANIFEST | 4 | ||||
| -rw-r--r-- | FS/t/banned_pay.t | 8 | ||||
| -rw-r--r-- | FS/t/cancel_reason.t | 8 | ||||
| -rwxr-xr-x | bin/generate-table-module | 2 | ||||
| -rwxr-xr-x | httemplate/misc/cust_main-cancel.cgi | 16 | ||||
| -rwxr-xr-x | httemplate/view/cust_main.cgi | 33 |
10 files changed, 392 insertions, 15 deletions
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 09e16fe75..c11fd05f1 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1229,6 +1229,32 @@ sub tables_hashref { 'index' => [ [ 'agentnum', 'cardtype' ], ], }, + 'banned_pay' => { + 'columns' => [ + 'bannum', 'serial', '', '', + 'payby', 'char', '', 4, + 'payinfo', 'varchar', '', 128, #say, a 512-big digest _hex encoded + #'paymask', 'varchar', 'NULL', $char_d, + '_date', @date_type, + 'otaker', 'varchar', '', 32, + 'reason', 'varchar', 'NULL', $char_d, + ], + 'primary_key' => 'bannum', + 'unique' => [ [ 'payby', 'payinfo' ] ], + 'index' => [], + }, + + 'cancel_reason' => { + 'columns' => [ + 'reasonnum', 'serial', '', '', + 'reason', 'varchar', '', $char_d, + 'disabled', 'char', 'NULL', 1, + ], + 'primary_key' => 'reasonnum', + 'unique' => [], + 'index' => [ [ 'disabled' ] ], + }, + }; } diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm new file mode 100644 index 000000000..1ad87f508 --- /dev/null +++ b/FS/FS/banned_pay.pm @@ -0,0 +1,136 @@ +package FS::banned_pay; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::UID qw( getotaker ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::banned_pay - Object methods for banned_pay records + +=head1 SYNOPSIS + + use FS::banned_pay; + + $record = new FS::banned_pay \%hash; + $record = new FS::banned_pay { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::banned_pay object represents an banned credit card or ACH account. +FS::banned_pay inherits from FS::Record. The following fields are currently +supported: + +=over 4 + +=item bannum - primary key + +=item payby - I<CARD> or I<CHEK> + +=item payinfo - fingerprint of banned card (base64-encoded MD5 digest) + +=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see +L<Time::Local> and L<Date::Parse> for conversion functions. + +=item otaker - order taker (assigned automatically, see L<FS::UID>) + +=item reason - reason (text) + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new ban. To add the ban 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 { 'banned_pay'; } + +=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 ban. 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('bannum') + || $self->ut_enum('payby', [ 'CARD', 'CHEK' ] ) + || $self->ut_text('payinfo') + || $self->ut_numbern('_date') + || $self->ut_textn('reason') + ; + return $error if $error; + + $self->_date(time) unless $self->_date; + + $self->otaker(getotaker); + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cancel_reason.pm b/FS/FS/cancel_reason.pm new file mode 100644 index 000000000..19cc7214e --- /dev/null +++ b/FS/FS/cancel_reason.pm @@ -0,0 +1,123 @@ +package FS::cancel_reason; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::cancel_reason - Object methods for cancel_reason records + +=head1 SYNOPSIS + + use FS::cancel_reason; + + $record = new FS::cancel_reason \%hash; + $record = new FS::cancel_reason { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cancel_reason object represents an cancellation reason. +FS::cancel_reason inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item reasonnum - primary key + +=item reason - + +=item disabled - empty or "Y" + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new cancellation reason. To add the reason 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 { 'cancel_reason'; } + +=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 reason. 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('reasonnum') + || $self->ut_text('reason') + || $self->ut_enum('disabled', [ '', 'Y' ] ) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0169039b9..bbe01bda6 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -14,6 +14,7 @@ BEGIN { #eval "use Time::Local qw(timelocal timelocal_nocheck);"; eval "use Time::Local qw(timelocal_nocheck);"; } +use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; use String::Approx qw(amatch); @@ -21,6 +22,7 @@ use Business::CreditCard 0.28; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); +use FS::Msgcat qw(gettext); use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; @@ -44,7 +46,7 @@ use FS::cust_tax_exempt; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; -use FS::Msgcat qw(gettext); +use FS::banned_pay; @ISA = qw( FS::Record ); @@ -1140,8 +1142,13 @@ sub check { $self->payinfo($payinfo); validate($payinfo) or return gettext('invalid_card'); # . ": ". $self->payinfo; + return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; + + my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + return "Banned credit card" if $ban; + if ( defined $self->dbdef_table->column('paycvv') ) { if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { if ( cardtype($self->payinfo) eq 'American Express card' ) { @@ -1191,6 +1198,9 @@ sub check { $self->payinfo($payinfo); $self->paycvv('') if $self->dbdef_table->column('paycvv'); + my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + return "Banned ACH account" if $ban; + } elsif ( $self->payby eq 'LECB' ) { my $payinfo = $self->payinfo; @@ -1428,19 +1438,56 @@ sub suspend_unless_pkgpart { Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer. -Available options are: I<quiet> +Available options are: I<quiet>, I<reasonnum>, and I<ban> I<quiet> can be set true to supress email cancellation notices. +# I<reasonnum> can be set to a cancellation reason (see L<FS::cancel_reason>) + +I<ban> can be set true to ban this customer's credit card or ACH information, +if present. + Always returns a list: an empty list on success or a list of errors. =cut sub cancel { my $self = shift; + my %opt = @_; + + if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { + + #should try decryption (we might have the private key) + # and if not maybe queue a job for the server that does? + return ( "Can't (yet) ban encrypted credit cards" ) + if $self->is_encrypted($self->payinfo); + + my $ban = new FS::banned_pay $self->_banned_pay_hashref; + my $error = $ban->insert; + return ( $error ) if $error; + + } + grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; } +sub _banned_pay_hashref { + my $self = shift; + + my %payby2ban = ( + 'CARD' => 'CARD', + 'DCRD' => 'CARD', + 'CHEK' => 'CHEK', + 'DCHK' => 'CHEK' + ); + + { + 'payby' => $payby2ban{$self->payby}, + 'payinfo' => md5_base64($self->payinfo), + #'reason' => + }; +} + =item agent Returns the agent (see L<FS::agent>) for this customer. diff --git a/FS/MANIFEST b/FS/MANIFEST index 50bc7b5db..f756b5c77 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -287,3 +287,7 @@ FS/option_Common.pm t/option_Common.t FS/agent_payment_gateway.pm t/agent_payment_gateway.t +FS/banned_pay.pm +t/banned_pay.t +FS/cancel_reason.pm +t/cancel_reason.t diff --git a/FS/t/banned_pay.t b/FS/t/banned_pay.t new file mode 100644 index 000000000..d361c588d --- /dev/null +++ b/FS/t/banned_pay.t @@ -0,0 +1,8 @@ +BEGIN { $| = 1; print "1..1 +" } +END {print "not ok 1 +" unless $loaded;} +use FS::banned_pay; +$loaded=1; +print "ok 1 +"; diff --git a/FS/t/cancel_reason.t b/FS/t/cancel_reason.t new file mode 100644 index 000000000..4cbda4a65 --- /dev/null +++ b/FS/t/cancel_reason.t @@ -0,0 +1,8 @@ +BEGIN { $| = 1; print "1..1 +" } +END {print "not ok 1 +" unless $loaded;} +use FS::cancel_reason; +$loaded=1; +print "ok 1 +"; diff --git a/bin/generate-table-module b/bin/generate-table-module index 0baf23d09..14ae653df 100755 --- a/bin/generate-table-module +++ b/bin/generate-table-module @@ -80,6 +80,8 @@ close TEST; # add them to MANIFEST ### +system('cvs edit FS/MANIFEST'); + open(MANIFEST,">>FS/MANIFEST") or die $!; print MANIFEST "FS/$table.pm\n", "t/$table.t\n"; diff --git a/httemplate/misc/cust_main-cancel.cgi b/httemplate/misc/cust_main-cancel.cgi index 257c3384f..519e6c2b2 100755 --- a/httemplate/misc/cust_main-cancel.cgi +++ b/httemplate/misc/cust_main-cancel.cgi @@ -1,13 +1,19 @@ <% -#untaint custnum -my($query) = $cgi->keywords; -$query =~ /^(\d+)$/ || die "Illegal custnum"; -my $custnum = $1; +my $custnum; +my $ban = ''; +if ( $cgi->param('custnum') =~ /^(\d+)$/ ) { + $custnum = $1; + $ban = $cgi->param('ban'); +} else { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/ || die "Illegal custnum"; + $custnum = $1; +} my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ); -my @errors = $cust_main->cancel; +my @errors = $cust_main->cancel( 'ban' => $ban ); eidiot(join(' / ', @errors)) if scalar(@errors); #print $cgi->redirect($p. "view/cust_main.cgi?". $cust_main->custnum); diff --git a/httemplate/view/cust_main.cgi b/httemplate/view/cust_main.cgi index 8794f3074..50f121816 100755 --- a/httemplate/view/cust_main.cgi +++ b/httemplate/view/cust_main.cgi @@ -35,18 +35,35 @@ print qq!<A HREF="${p}edit/cust_main.cgi?$custnum">Edit this customer</A>!; %> -<SCRIPT> -function areyousure(href, message) { - if (confirm(message) == true) - window.location.href = href; +<SCRIPT TYPE="text/javascript" SRC="../elements/overlibmws.js"></SCRIPT> +<SCRIPT TYPE="text/javascript" SRC="../elements/overlibmws_iframe.js"></SCRIPT> +<SCRIPT TYPE="text/javascript" SRC="../elements/overlibmws_draggable.js"></SCRIPT> +<SCRIPT TYPE="text/javascript"> + +<% +my $ban = ''; +if ( $cust_main->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { + $ban = '<BR><P ALIGN="center">'. + '<INPUT TYPE="checkbox" NAME="ban" VALUE="1"> Ban this customer\\\'s '; + if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { + $ban .= 'credit card'; + } elsif ( $cust_main->payby =~ /^(CHEK|DCHK)$/ ) { + $ban .= 'ACH account'; + } } +%> + +var confirm_cancel = '<FORM METHOD="POST" ACTION="<%= $p %>misc/cust_main-cancel.cgi"> <INPUT TYPE="hidden" NAME="custnum" VALUE="<%= $custnum %>"> <BR><P ALIGN="center"><B>Perminantly delete all services and cancel this customer?</B> <%= $ban%><BR><P ALIGN="CENTER"> <INPUT TYPE="submit" VALUE="Cancel customer"> <INPUT TYPE="BUTTON" VALUE="Don\'t cancel" onClick="cClick()"> </FORM> '; + </SCRIPT> -<% +<% if ( $cust_main->ncancelled_pkgs ) { %> + + | <A HREF="javascript:void(0);" onClick="overlib(confirm_cancel, CAPTION, 'Confirm cancellation', STICKY, AUTOSTATUSCAP, CLOSETEXT, '', MIDX, 0, MIDY, 0, DRAGGABLE, WIDTH, 576, HEIGHT, 128, TEXTSIZE, 3, BGCOLOR, '#ff0000', CGCOLOR, '#ff0000' ); return false; ">Cancel this customer</A> -print qq! | <A HREF="javascript:areyousure('${p}misc/cust_main-cancel.cgi?$custnum', 'Perminantly delete all services and cancel this customer?')">!. - 'Cancel this customer</A>' - if $cust_main->ncancelled_pkgs; +<% } %> + +<% print qq! | <A HREF="${p}misc/delete-customer.cgi?$custnum">!. 'Delete this customer</A>' |