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