FS/FS/cust_pkg_discount.pm

   1 package FS::cust_pkg_discount;
   2 use base qw( FS::otaker_Mixin
   3              FS::cust_main_Mixin
   4              FS::pkg_discount_Mixin
   5              FS::Record );
   6
   7 use strict;
   8 use FS::Record qw( dbh ); # qsearch qsearchs dbh );
   9 use FS::discount;
  10
  11 =head1 NAME
  12
  13 FS::cust_pkg_discount - Object methods for cust_pkg_discount records
  14
  15 =head1 SYNOPSIS
  16
  17   use FS::cust_pkg_discount;
  18
  19   $record = new FS::cust_pkg_discount \%hash;
  20   $record = new FS::cust_pkg_discount { 'column' => 'value' };
  21
  22   $error = $record->insert;
  23
  24   $error = $new_record->replace($old_record);
  25
  26   $error = $record->delete;
  27
  28   $error = $record->check;
  29
  30 =head1 DESCRIPTION
  31
  32 An FS::cust_pkg_discount object represents the application of a discount to a
  33 customer package.  FS::cust_pkg_discount inherits from FS::Record.  The
  34 following fields are currently supported:
  35
  36 =over 4
  37
  38 =item pkgdiscountnum
  39
  40 primary key
  41
  42 =item pkgnum
  43
  44 Customer package (see L<FS::cust_pkg>)
  45
  46 =item discountnum
  47
  48 Discount (see L<FS::discount>)
  49
  50 =item months_used
  51
  52 months_used
  53
  54 =item end_date
  55
  56 end_date
  57
  58 =item usernum
  59
  60 order taker, see L<FS::access_user>
  61
  62 =item setuprecur
  63
  64 whether this discount applies to setup fees or recurring fees
  65
  66 =back
  67
  68 =head1 METHODS
  69
  70 =over 4
  71
  72 =item new HASHREF
  73
  74 Creates a new discount application.  To add the record to the database, see
  75  L<"insert">.
  76
  77 Note that this stores the hash reference, not a distinct copy of the hash it
  78 points to.  You can ask the object for a copy with the I<hash> method.
  79
  80 =cut
  81
  82 # the new method can be inherited from FS::Record, if a table method is defined
  83
  84 sub table { 'cust_pkg_discount'; }
  85
  86 =item insert
  87
  88 Adds this record to the database.  If there is an error, returns the error,
  89 otherwise returns false.
  90
  91 =item delete
  92
  93 Delete this record from the database.
  94
  95 =cut
  96
  97 # the delete method can be inherited from FS::Record
  98
  99 =item replace OLD_RECORD
 100
 101 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 102 returns the error, otherwise returns false.
 103
 104 =cut
 105
 106 # the replace method can be inherited from FS::Record
 107
 108 =item check
 109
 110 Checks all fields to make sure this is a valid discount applciation.  If there
 111 is an error, returns the error, otherwise returns false.  Called by the insert
 112 and replace methods.
 113
 114 =cut
 115
 116 # the check method should currently be supplied - FS::Record contains some
 117 # data checking routines
 118
 119 sub check {
 120   my $self = shift;
 121
 122   my $error =
 123     $self->ut_numbern('pkgdiscountnum')
 124     || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
 125     || $self->ut_foreign_key('discountnum', 'discount', 'discountnum' )
 126     || $self->ut_sfloat('months_used') #actually decimal, but this will do
 127     || $self->ut_numbern('end_date')
 128     || $self->ut_alphan('otaker')
 129     || $self->ut_numbern('usernum')
 130     || $self->ut_enum('disabled', [ '', 'Y' ] )
 131     || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] )
 132   ;
 133   return $error if $error;
 134
 135   my $cust_pkg = $self->cust_pkg;
 136   my $discount = $self->discount;
 137   if ( $self->setuprecur eq 'setup' ) {
 138     if ( !$discount->setup ) {
 139       # UI prevents this, and historical discounts should never have it either
 140       return "Discount #".$self->discountnum." can't be applied to setup fees.";
 141     } elsif ( $cust_pkg->base_setup == 0 ) {
 142       # and this
 143       return "Can't apply setup discount to a package with no setup fee.";
 144     }
 145     # else we're good. do NOT disallow applying setup discounts when the
 146     # setup date is already set; upgrades use that.
 147   } else {
 148     if ( $self->cust_pkg->base_recur == 0 ) {
 149       return "Can't apply recur discount to a package with no recurring fee.";
 150     } elsif ( $cust_pkg->part_pkg->freq eq '0' ) {
 151       return "Can't apply recur discount to a one-time charge.";
 152     }
 153   }
 154
 155   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
 156
 157   $self->SUPER::check;
 158 }
 159
 160 =item cust_pkg
 161
 162 Returns the customer package (see L<FS::cust_pkg>).
 163
 164 =item discount
 165
 166 Returns the discount (see L<FS::discount>).
 167
 168 =item increment_months_used MONTHS
 169
 170 Increments months_used by the given parameter
 171
 172 =cut
 173
 174 sub increment_months_used {
 175   my( $self, $used ) = @_;
 176   #UPDATE cust_pkg_discount SET months_used = months_used + ?
 177   #leaves no history, and billing is mutexed per-customer, so the dum way is ok
 178   $self->months_used( $self->months_used + $used );
 179   $self->replace();
 180 }
 181
 182 =item decrement_months_used MONTHS
 183
 184 Decrement months_used by the given parameter
 185
 186 (Note: as in, extending the length of the discount.  Typically only used to
 187 stack/extend a discount when the customer package has one active already.)
 188
 189 =cut
 190
 191 sub decrement_months_used {
 192   my( $self, $recharged ) = @_;
 193   #UPDATE cust_pkg_discount SET months_used = months_used - ?
 194   #leaves no history, and billing is mutexed per-customer
 195
 196   #we're run from part_event/Action/referral_pkg_discount on behalf of a
 197   # different customer, so we need to grab this customer's mutex.
 198   #   incidentally, that's some inelegant encapsulation breaking shit, and a
 199   #   great argument in favor of native-DB trigger history so we can trust
 200   #   in normal ACID like the SQL above instead of this
 201   $self->cust_pkg->cust_main->select_for_update;
 202
 203   $self->months_used( $self->months_used - $recharged );
 204   $self->replace();
 205 }
 206
 207 =item status
 208
 209 =cut
 210
 211 sub status {
 212   my $self = shift;
 213   my $discount = $self->discount;
 214
 215   if ( $self->disabled ne 'Y'
 216        and ( ! $discount->months || $self->months_used < $discount->months )
 217              #XXX also end date
 218      ) {
 219     'active';
 220   } else {
 221     'expired';
 222   }
 223 }
 224
 225 # Used by FS::Upgrade to migrate to a new database.
 226 sub _upgrade_data {  # class method
 227   my ($class, %opts) = @_;
 228   $class->_upgrade_otaker(%opts);
 229
 230   # #14092: set setuprecur field on discounts. if we get one that applies to
 231   # both setup and recur, split it into two discounts.
 232   my $search = FS::Cursor->new({
 233       table   => 'cust_pkg_discount',
 234       hashref => { setuprecur => '' }
 235   });
 236   while ( my $cust_pkg_discount = $search->fetch ) {
 237     my $discount = $cust_pkg_discount->discount;
 238     my $cust_pkg = $cust_pkg_discount->cust_pkg;
 239     # 1. Does it apply to the setup fee?
 240     # Yes, if: the discount applies to setup fees generally, and the package
 241     # has a setup fee.
 242     # No, if: the discount is a flat amount, and is not first-month only.
 243     if ( $discount->setup
 244         and $cust_pkg->base_setup > 0
 245         and ($discount->amount == 0 or $discount->months == 1)
 246        )
 247     {
 248       # then clone this discount into a new one
 249       my $setup_discount = FS::cust_pkg_discount->new({
 250           $cust_pkg_discount->hash,
 251           setuprecur      => 'setup',
 252           pkgdiscountnum  => ''
 253       });
 254       my $error = $setup_discount->insert;
 255       die "$error (migrating cust_pkg_discount to setup discount)" if $error;
 256     }
 257     # 2. Does it apply to the recur fee?
 258     # Yes, if: the package has a recur fee.
 259     if ( $cust_pkg->base_recur > 0 ) {
 260       # then modify this discount in place
 261       $cust_pkg_discount->set('setuprecur' => 'recur');
 262       my $error = $cust_pkg_discount->replace;
 263       die "$error (migrating cust_pkg_discount)" if $error;
 264     }
 265     # not in here yet: splitting the cust_bill_pkg_discount records.
 266     # (not really necessary)
 267   }
 268 }
 269
 270 =back
 271
 272 =head1 BUGS
 273
 274 =head1 SEE ALSO
 275
 276 L<FS::discount>, L<FS::cust_pkg>, L<FS::Record>, schema.html from the base documentation.
 277
 278 =cut
 279
 280 1;
 281