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