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