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