FS/FS/rate.pm

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