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