FS/FS/discount.pm

   1 package FS::discount;
   2 use base qw( FS::Record );
   3
   4 use strict;
   5 use FS::Record qw( qsearch qsearchs );
   6 use FS::discount_class;
   7
   8 =head1 NAME
   9
  10 FS::discount - Object methods for discount records
  11
  12 =head1 SYNOPSIS
  13
  14   use FS::discount;
  15
  16   $record = new FS::discount \%hash;
  17   $record = new FS::discount { 'column' => 'value' };
  18
  19   $error = $record->insert;
  20
  21   $error = $new_record->replace($old_record);
  22
  23   $error = $record->delete;
  24
  25   $error = $record->check;
  26
  27 =head1 DESCRIPTION
  28
  29 An FS::discount object represents a discount definition.  FS::discount inherits
  30 from FS::Record.  The following fields are currently supported:
  31
  32 =over 4
  33
  34 =item discountnum
  35
  36 primary key
  37
  38 =item name
  39
  40 name
  41
  42 =item amount
  43
  44 amount
  45
  46 =item percent
  47
  48 percent
  49
  50 =item months
  51
  52 months
  53
  54 =item disabled
  55
  56 disabled
  57
  58 =item setup - apply discount to setup fee (not just to recurring fee)
  59
  60 If the discount is based on a percentage, then the % will be applied to the
  61 setup and recurring portions.
  62
  63 =back
  64
  65 =head1 METHODS
  66
  67 =over 4
  68
  69 =item new HASHREF
  70
  71 Creates a new discount.  To add the discount to the database, see L<"insert">.
  72
  73 Note that this stores the hash reference, not a distinct copy of the hash it
  74 points to.  You can ask the object for a copy with the I<hash> method.
  75
  76 =cut
  77
  78 # the new method can be inherited from FS::Record, if a table method is defined
  79
  80 sub table { 'discount'; }
  81
  82 =item insert
  83
  84 Adds this record to the database.  If there is an error, returns the error,
  85 otherwise returns false.
  86
  87 =cut
  88
  89 # the insert method can be inherited from FS::Record
  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.  If there is
 111 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   if ( $self->_type eq 'Select discount type' ) {
 123     return 'Please select a discount type';
 124   } elsif ( $self->_type eq 'Amount' ) {
 125     $self->percent('0');
 126     return 'Amount must be greater than 0' unless $self->amount > 0;
 127   } elsif ( $self->_type eq 'Percentage' ) {
 128     $self->amount('0.00');
 129     return 'Percentage must be greater than 0' unless $self->percent > 0;
 130   }
 131
 132   my $error =
 133     $self->ut_numbern('discountnum')
 134     || $self->ut_foreign_keyn('classnum', 'discount_class', 'classnum')
 135     || $self->ut_textn('name')
 136     || $self->ut_money('amount')
 137     || $self->ut_float('percent') #actually decimal, but this will do
 138     || $self->ut_floatn('months') #actually decimal, but this will do
 139     || $self->ut_enum('disabled', [ '', 'Y' ])
 140     || $self->ut_enum('setup', [ '', 'Y' ])
 141     #|| $self->ut_enum('linked', [ '', 'Y' ])
 142   ;
 143   return $error if $error;
 144
 145 #causes "months must be integers greater than 1" errors when you go back and
 146 # try to edit an existing discount (because the months format as NN.000)
 147 #not worth whatever reason it came in with "prepayment discounts rt#5318" for
 148 #  #discourage non-integer months for package discounts
 149 #  if ($self->discountnum) {
 150 #    my $sql =
 151 #      "SELECT count(*) FROM part_pkg_discount WHERE part_pkg_discount.discountnum = ".
 152 #      $self->discountnum;
 153 #
 154 #    my $count = $self->scalar_sql($sql);
 155 #    return "months must be integers greater than 1"
 156 #      if ( $count && ($self->ut_number('months') || $self->months < 2) );
 157 #  }
 158
 159   $self->SUPER::check;
 160 }
 161
 162 =item description_short
 163
 164 =item description
 165
 166 Returns a text description incorporating the amount, percent and months fields.
 167
 168 description_short omits term information
 169
 170 =cut
 171
 172 sub description_short {
 173   my $self = shift;
 174
 175   my $conf = new FS::Conf;
 176   my $money_char = $conf->config('money_char') || '$';
 177
 178   my $desc = $self->name ? $self->name.': ' : '';
 179   $desc .= $money_char. sprintf('%.2f/month ', $self->amount)
 180     if $self->amount > 0;
 181
 182   ( my $percent = $self->percent ) =~ s/\.0+$//;
 183   $percent =~ s/(\.\d*[1-9])0+$/$1/;
 184   $desc .= $percent. '% '
 185     if $self->percent > 0;
 186
 187   $desc;
 188 }
 189
 190 sub description {
 191   my $self = shift;
 192   my $desc = $self->description_short;
 193
 194   ( my $months = $self->months ) =~ s/\.0+$//;
 195   $months =~ s/(\.\d*[1-9])0+$/$1/;
 196   $desc .= " for $months months" if $months;
 197
 198   $desc .= ', applies to setup' if $self->setup;
 199
 200   $desc;
 201 }
 202
 203 sub classname {
 204   my $self = shift;
 205   my $discount_class = $self->discount_class;
 206   $discount_class ? $discount_class->classname : '(none)';
 207 }
 208
 209 sub discount_class {
 210   my $self = shift;
 211   qsearchs('discount_class', { 'classnum' => $self->classnum });
 212 }
 213
 214
 215 =back
 216
 217 =head1 BUGS
 218
 219 =head1 SEE ALSO
 220
 221 L<FS::cust_pkg_discount>, L<FS::Record>, schema.html from the base documentation.
 222
 223 =cut
 224
 225 1;
 226