71513: Card tokenization [v3 test tweak]
[freeside.git] / FS / FS / rate.pm
1 package FS::rate;
2
3 use strict;
4 use vars qw( @ISA $DEBUG );
5 use FS::Record qw( qsearch qsearchs dbh fields );
6 use FS::rate_detail;
7
8 @ISA = qw(FS::Record);
9
10 $DEBUG = 0;
11
12 =head1 NAME
13
14 FS::rate - Object methods for rate records
15
16 =head1 SYNOPSIS
17
18   use FS::rate;
19
20   $record = new FS::rate \%hash;
21   $record = new FS::rate { 'column' => 'value' };
22
23   $error = $record->insert;
24
25   $error = $new_record->replace($old_record);
26
27   $error = $record->delete;
28
29   $error = $record->check;
30
31 =head1 DESCRIPTION
32
33 An FS::rate object represents an rate plan.  FS::rate inherits from
34 FS::Record.  The following fields are currently supported:
35
36 =over 4
37
38 =item ratenum
39
40 primary key
41
42 =item ratename
43
44 Rate name
45
46 =item agentnum
47
48 Optional agent (see L<FS::agent>) for agent-virtualized rates.
49
50 =item default_detailnum 
51
52 Optional rate detail to apply when a call doesn't match any region in the 
53 rate plan. If this is not set, the call will either be left unrated (though
54 it may still be processed under a different pricing addon package), or be 
55 marked as 'skipped', or throw a fatal error, depending on the setting of 
56 the 'ignore_unrateable' package option.
57
58 Deprecated; we now find the default detail by its lack of regionnum.
59
60 =item 
61
62 =back
63
64 =head1 METHODS
65
66 =over 4
67
68 =item new HASHREF
69
70 Creates a new rate plan.  To add the rate plan to the database, see 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 { 'rate'; }
80
81 =item insert [ , OPTION => VALUE ... ]
82
83 Adds this record to the database.  If there is an error, returns the error,
84 otherwise returns false.
85
86 Currently available options are: I<rate_detail>
87
88 If I<rate_detail> is set to an array reference of FS::rate_detail objects, the
89 objects will have their ratenum field set and will be inserted after this
90 record.
91
92 =cut
93
94 sub insert {
95   my $self = shift;
96   my %options = @_;
97
98   local $SIG{HUP} = 'IGNORE';
99   local $SIG{INT} = 'IGNORE';
100   local $SIG{QUIT} = 'IGNORE';
101   local $SIG{TERM} = 'IGNORE';
102   local $SIG{TSTP} = 'IGNORE';
103   local $SIG{PIPE} = 'IGNORE';
104
105   my $oldAutoCommit = $FS::UID::AutoCommit;
106   local $FS::UID::AutoCommit = 0;
107   my $dbh = dbh;
108
109   my $error = $self->check;
110   return $error if $error;
111
112   $error = $self->SUPER::insert;
113   if ( $error ) {
114     $dbh->rollback if $oldAutoCommit;
115     return $error;
116   }
117
118   if ( $options{'rate_detail'} ) {
119
120     my( $num, $last, $min_sec ) = (0, time, 5); #progressbar foo
121
122     foreach my $rate_detail ( @{$options{'rate_detail'}} ) {
123
124       $rate_detail->ratenum($self->ratenum);
125       $error = $rate_detail->insert;
126       if ( $error ) {
127         $dbh->rollback if $oldAutoCommit;
128         return $error;
129       }
130
131       if ( $options{'job'} ) {
132         $num++;
133         if ( time - $min_sec > $last ) {
134           my $error = $options{'job'}->update_statustext(
135             int( 100 * $num / scalar( @{$options{'rate_detail'}} ) )
136           );
137           if ( $error ) {
138             $dbh->rollback if $oldAutoCommit;
139             return $error;
140           }
141           $last = time;
142         }
143       }
144
145     }
146   }
147
148   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
149
150   '';
151 }
152
153
154
155 =item delete
156
157 Delete this record from the database.
158
159 =cut
160
161 # the delete method can be inherited from FS::Record
162
163 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
164
165 Replaces the OLD_RECORD with this one in the database.  If there is an error,
166 returns the error, otherwise returns false.
167
168 Currently available options are: I<rate_detail>
169
170 If I<rate_detail> is set to an array reference of FS::rate_detail objects, the
171 objects will have their ratenum field set and will be inserted after this
172 record.  Any existing rate_detail records associated with this record will be
173 deleted.
174
175 =cut
176
177 sub replace {
178   my ($new, $old) = (shift, shift);
179   my %options = @_;
180
181   local $SIG{HUP} = 'IGNORE';
182   local $SIG{INT} = 'IGNORE';
183   local $SIG{QUIT} = 'IGNORE';
184   local $SIG{TERM} = 'IGNORE';
185   local $SIG{TSTP} = 'IGNORE';
186   local $SIG{PIPE} = 'IGNORE';
187
188   my $oldAutoCommit = $FS::UID::AutoCommit;
189   local $FS::UID::AutoCommit = 0;
190   my $dbh = dbh;
191
192 #  my @old_rate_detail = ();
193 #  @old_rate_detail = $old->rate_detail if $options{'rate_detail'};
194
195   my $error = $new->SUPER::replace($old);
196   if ($error) {
197     $dbh->rollback if $oldAutoCommit;
198     return $error;
199   }
200
201 #  foreach my $old_rate_detail ( @old_rate_detail ) {
202 #
203 #    my $error = $old_rate_detail->delete;
204 #    if ($error) {
205 #      $dbh->rollback if $oldAutoCommit;
206 #      return $error;
207 #    }
208 #
209 #    if ( $options{'job'} ) {
210 #      $num++;
211 #      if ( time - $min_sec > $last ) {
212 #        my $error = $options{'job'}->update_statustext(
213 #          int( 50 * $num / scalar( @old_rate_detail ) )
214 #        );
215 #        if ( $error ) {
216 #          $dbh->rollback if $oldAutoCommit;
217 #          return $error;
218 #        }
219 #        $last = time;
220 #      }
221 #    }
222 #
223 #  }
224   if ( $options{'rate_detail'} ) {
225     my $sth = $dbh->prepare('DELETE FROM rate_detail WHERE ratenum = ?') or do {
226       $dbh->rollback if $oldAutoCommit;
227       return $dbh->errstr;
228     };
229   
230     $sth->execute($old->ratenum) or do {
231       $dbh->rollback if $oldAutoCommit;
232       return $sth->errstr;
233     };
234
235     my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
236 #  $num = 0;
237     foreach my $rate_detail ( @{$options{'rate_detail'}} ) {
238   
239       $rate_detail->ratenum($new->ratenum);
240       $error = $rate_detail->insert;
241       if ( $error ) {
242         $dbh->rollback if $oldAutoCommit;
243         return $error;
244       }
245   
246       if ( $options{'job'} ) {
247         $num++;
248         if ( time - $min_sec > $last ) {
249           my $error = $options{'job'}->update_statustext(
250             int( 100 * $num / scalar( @{$options{'rate_detail'}} ) )
251           );
252           if ( $error ) {
253             $dbh->rollback if $oldAutoCommit;
254             return $error;
255           }
256           $last = time;
257         }
258       }
259   
260     }
261
262   }
263
264   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
265   '';
266
267 }
268
269 =item check
270
271 Checks all fields to make sure this is a valid rate plan.  If there is
272 an error, returns the error, otherwise returns false.  Called by the insert
273 and replace methods.
274
275 =cut
276
277 sub check {
278   my $self = shift;
279
280   my $error =
281        $self->ut_numbern('ratenum')
282     || $self->ut_text('ratename')
283     #|| $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
284     || $self->ut_numbern('default_detailnum')
285   ;
286   return $error if $error;
287
288   $self->SUPER::check;
289 }
290
291 =item dest_detail REGIONNUM | RATE_REGION_OBJECTD | HASHREF
292
293 Returns the rate detail (see L<FS::rate_detail>) for this rate to the
294 specificed destination. If no rate can be found, returns the default 
295 rate if there is one, and an empty string otherwise.
296
297 Destination can be specified as an FS::rate_detail object or regionnum
298 (see L<FS::rate_detail>), or as a hashref containing the following keys:
299
300 =over 2
301
302 =item I<countrycode> - required.
303
304 =item I<phonenum> - required.
305
306 =item I<weektime> - optional.  Specifies a time in seconds from the start 
307 of the week, and will return a timed rate (one with a non-null I<ratetimenum>)
308 if one exists at that time.  If not, returns a non-timed rate.
309
310 =item I<cdrtypenum> - optional.  Specifies a value for the cdrtypenum 
311 field, and will return a rate matching that, if one exists.  If not, returns 
312 a rate with null cdrtypenum.
313
314 =cut
315
316 sub dest_detail {
317   my $self = shift;
318
319   my( $regionnum, $weektime, $cdrtypenum );
320   if ( ref($_[0]) eq 'HASH' ) {
321
322     my $countrycode = $_[0]->{'countrycode'};
323     my $phonenum    = $_[0]->{'phonenum'};
324     $weektime       = $_[0]->{'weektime'};
325     $cdrtypenum     = $_[0]->{'cdrtypenum'} || '';
326
327     #find a rate prefix, first look at most specific, then fewer digits,
328     # finally trying the country code only
329     my $rate_prefix = '';
330     $rate_prefix = qsearchs({
331         'table'     => 'rate_prefix',
332         'addl_from' => ' JOIN rate_region USING (regionnum)',
333         'hashref'   => {
334           'countrycode' => $countrycode,
335           'npa'         => $phonenum,
336         },
337         'extra_sql' => ' AND exact_match = \'Y\''
338     });
339     if (!$rate_prefix) {
340       for my $len ( reverse(1..10) ) {
341         $rate_prefix = qsearchs('rate_prefix', {
342           'countrycode' => $countrycode,
343           #'npa'         => { op=> 'LIKE', value=> substr($number, 0, $len) }
344           'npa'         => substr($phonenum, 0, $len),
345         } ) and last;
346       }
347       $rate_prefix ||= qsearchs('rate_prefix', {
348         'countrycode' => $countrycode,
349         'npa'         => '',
350       });
351     }
352
353     if ( !$rate_prefix ) {
354       # then this call doesn't match any known region; just return the
355       # appropriate anywhere rate
356       return $self->default_detail($cdrtypenum) || $self->default_detail('');
357     }
358
359     $regionnum = $rate_prefix->regionnum;
360
361   } else {
362     $regionnum = ref($_[0]) ? shift->regionnum : shift;
363   }
364
365   my %hash = (
366     'ratenum'         => $self->ratenum,
367     'dest_regionnum'  => $regionnum,
368   );
369
370   # find all rates matching ratenum, regionnum, cdrtypenum
371   my @details = qsearch( 'rate_detail', { 
372       %hash,
373       'cdrtypenum' => $cdrtypenum
374     });
375   # failing that, return the global default for this plan with the correct
376   # cdrtypenum (skips weektime processing)
377   if ( !@details and $cdrtypenum ) {
378     my $detail = $self->default_detail($cdrtypenum);
379     return $detail if $detail;
380   }
381   # failing that, find all rates maching ratenum, regionnum and null cdrtypenum
382   # (these can have weektime stuff)
383   if ( !@details and $cdrtypenum ) {
384     @details = qsearch( 'rate_detail', {
385         %hash,
386         'cdrtypenum' => ''
387       });
388   }
389   # find one of those matching weektime
390   if ( defined($weektime) ) {
391     my @exact = grep { 
392       my $rate_time = $_->rate_time;
393       $rate_time && $rate_time->contains($weektime)
394     } @details;
395     if ( @exact == 1 ) {
396       return $exact[0];
397     }
398     elsif ( @exact > 1 ) {
399       die "overlapping rate_detail times (region $regionnum, time $weektime)\n"
400     }
401     # else @exact == 0
402   }
403   # if not found or there is no weektime, find one matching null weektime
404   foreach (@details) {
405     return $_ if $_->ratetimenum eq '';
406   }
407   # if still nothing, return the global default rate for this plan
408   return $self->default_detail('');
409 }
410
411 =item rate_detail
412
413 Returns all region-specific details  (see L<FS::rate_detail>) for this rate.
414
415 =cut
416
417 sub rate_detail {
418   my $self = shift;
419   qsearch( 'rate_detail', { 'ratenum' => $self->ratenum } );
420 }
421
422 =item agent
423
424 =cut
425
426 sub agent {
427   my $self = shift;
428   eval "use FS::agent";
429   die $@ if $@;
430   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
431 }
432
433 =back
434
435 =item default_detail [ CDRTYPENUM ]
436
437 Returns the default rate detail for CDRTYPENUM (or for null CDR type, if not
438 specified).
439
440 =cut
441
442 sub default_detail {
443   my $self = shift;
444   my $cdrtypenum = shift || '';
445 #  $self->default_detailnum ?
446 #    FS::rate_detail->by_key($self->default_detailnum) : ''
447   qsearchs( 'rate_detail', {
448       ratenum         => $self->ratenum,
449       cdrtypenum      => $cdrtypenum,
450       dest_regionnum  => '',
451       orig_regionnum  => '',
452   }) || '';
453 }
454
455 =head1 SUBROUTINES
456
457 =over 4
458
459 =item process
460
461 Job-queue processor for web interface adds/edits
462
463 =cut
464
465 use Storable qw(thaw);
466 use Data::Dumper;
467 use MIME::Base64;
468 sub process {
469   my $job = shift;
470
471   my $param = thaw(decode_base64(shift));
472   warn Dumper($param) if $DEBUG;
473
474   my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } )
475     if $param->{'ratenum'};
476
477   my @rate_detail = map {
478
479     my $regionnum = $_->regionnum;
480     if ( $param->{"sec_granularity$regionnum"} ) {
481
482       new FS::rate_detail {
483         'dest_regionnum'  => $regionnum,
484         map { $_ => $param->{"$_$regionnum"} }
485             qw( min_included min_charge sec_granularity )
486             #qw( min_included conn_charge conn_sec min_charge sec_granularity )
487       };
488
489     } else {
490
491       new FS::rate_detail {
492         'dest_regionnum'  => $regionnum,
493         'min_included'    => 0,
494         'conn_charge'     => 0,
495         'conn_sec'        => 0,
496         'conn_charge'     => 0,
497         'min_charge'      => 0,
498         'sec_granularity' => '60'
499       };
500
501     }
502     
503   } qsearch('rate_region', {} );
504   
505   my $rate = new FS::rate {
506     map { $_ => $param->{$_} }
507         fields('rate')
508   };
509
510   my $error = '';
511   if ( $param->{'ratenum'} ) {
512     warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
513
514     my @param = ( 'job'=>$job );
515     
516     $rate->default_detailnum($old->default_detailnum);
517
518     $error = $rate->replace( $old, @param );
519
520   } else {
521     warn "inserting $rate\n" if $DEBUG;
522     $error = $rate->insert( 'rate_detail' => \@rate_detail,
523                             'job'         => $job,
524                           );
525     #$ratenum = $rate->getfield('ratenum');
526   }
527
528   die "$error\n" if $error;
529
530 }
531
532 =head1 BUGS
533
534 =head1 SEE ALSO
535
536 L<FS::Record>, schema.html from the base documentation.
537
538 =cut
539
540 1;
541