delete fees, RT#81713

[freeside.git] / FS / FS / banned_pay.pm

diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm
index a862028..0afff33 100644 (file)
--- a/FS/FS/banned_pay.pm
+++ b/FS/FS/banned_pay.pm
@@ -1,9 +1,11 @@
 package FS::banned_pay;
 package FS::banned_pay;

+use base qw( FS::otaker_Mixin FS::Record );

 
 use strict;
 
 use strict;

-use base qw( FS::otaker_Mixin FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::UID qw( getotaker );
+use Digest::MD5 qw(md5_base64);
+use Digest::SHA qw( sha512_base64 );
+use FS::Record qw( qsearch qsearchs dbh );
+use FS::CurrentUser;

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -32,18 +34,43 @@ supported:
 
 =over 4
 
 
 =over 4
 

-=item bannum - primary key
+=item bannum
+
+primary key
+
+=item payby
+
+I<CARD> or I<CHEK>

 
 

-=item payby - I<CARD> or I<CHEK>
+=item payinfo

 
 

-=item payinfo - fingerprint of banned card (base64-encoded MD5 digest)
+fingerprint of banned card (base64-encoded MD5 or SHA512 digest)

 
 

-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
+=item payinfo_hash
+
+Digest hash algorythm, currently either MD5 or SHA512.  Empty implies a legacy
+MD5 hash.
+
+=item _date
+
+specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see

 L<Time::Local> and L<Date::Parse> for conversion functions.
 
 L<Time::Local> and L<Date::Parse> for conversion functions.
 

-=item otaker - order taker (assigned automatically, see L<FS::UID>)
+=item end_date
+
+optional end date, also specified as a UNIX timestamp.

 
 

-=item reason - reason (text)
+=item usernum
+
+order taker (assigned automatically, see L<FS::access_user>)
+
+=item bantype
+
+Ban type: "" or null (regular ban), "warn" (warning)
+
+=item reason
+
+reason (text)

 
 =back
 
 
 =back
 


@@ -69,27 +96,15 @@ sub table { 'banned_pay'; }
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 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.
 
 =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.
 
 =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
 =item check
 
 Checks all fields to make sure this is a valid ban.  If there is


@@ -98,9 +113,6 @@ and replace methods.
 
 =cut
 
 
 =cut
 

-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-

 sub check {
   my $self = shift;
 
 sub check {
   my $self = shift;
 


@@ -108,21 +120,63 @@ sub check {
     $self->ut_numbern('bannum')
     || $self->ut_enum('payby', [ 'CARD', 'CHEK' ] )
     || $self->ut_text('payinfo')
     $self->ut_numbern('bannum')
     || $self->ut_enum('payby', [ 'CARD', 'CHEK' ] )
     || $self->ut_text('payinfo')

+    || $self->ut_enum('payinfo_hash', [ '', 'MD5', 'SHA512' ] )

     || $self->ut_numbern('_date')
     || $self->ut_numbern('_date')

+    || $self->ut_numbern('end_date')
+    || $self->ut_enum('bantype', [ '', 'warn' ] )

     || $self->ut_textn('reason')
   ;
   return $error if $error;
 
   $self->_date(time) unless $self->_date;
 
     || $self->ut_textn('reason')
   ;
   return $error if $error;
 
   $self->_date(time) unless $self->_date;
 

-  $self->otaker(getotaker) unless $self->otaker;
+  $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;

 
   $self->SUPER::check;
 }
 
 
   $self->SUPER::check;
 }
 

+=back
+
+=head1 CLASS METHODS
+
+=item ban_search OPTION => VALUE ...
+
+Takes two parameters: payby and payinfo, and searches for an (un-expired) ban
+matching those items.
+
+Returns the ban, or false if no ban was found.
+
+=cut
+
+sub ban_search {
+  my( $class, %opt ) = @_;
+  qsearchs({
+    'table'     => 'banned_pay',
+    'hashref'   => { 'payby' => $opt{payby}, },
+    'extra_sql' => "
+      AND (((payinfo_hash IS NULL OR payinfo_hash = '' OR payinfo_hash = 'MD5')
+              AND payinfo = ". dbh->quote( md5_base64($opt{payinfo}) ). "
+           )
+           OR 
+           (payinfo_hash = 'SHA256'
+              AND payinfo = ". dbh->quote( sha512_base64($opt{payinfo}) ). "
+           )
+          )
+      AND ( end_date IS NULL OR end_date >= ". time. " ) ",
+  });
+}
+

 # Used by FS::Upgrade to migrate to a new database.
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;
 # Used by FS::Upgrade to migrate to a new database.
 sub _upgrade_data {  # class method
   my ($class, %opts) = @_;

+
+  die "Cannot upgrade md5 banned_pay entries"
+    if qsearch({
+      'table'     => 'banned_pay',
+      'hashref'   => {},
+      'extra_sql' => "WHERE payinfo_hash IS NULL OR payinfo_hash = '' OR payinfo_hash = 'MD5'",
+    });
+

   $class->_upgrade_otaker(%opts);
 }
 
   $class->_upgrade_otaker(%opts);
 }