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 =item agent
 399
 400 =cut
 401
 402 sub agent {
 403   my $self = shift;
 404   eval "use FS::agent";
 405   die $@ if $@;
 406   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 407 }
 408
 409 =back
 410
 411 =head1 SUBROUTINES
 412
 413 =over 4
 414
 415 =item process
 416
 417 Job-queue processor for web interface adds/edits
 418
 419 =cut
 420
 421 use Storable qw(thaw);
 422 use Data::Dumper;
 423 use MIME::Base64;
 424 sub process {
 425   my $job = shift;
 426
 427   my $param = thaw(decode_base64(shift));
 428   warn Dumper($param) if $DEBUG;
 429
 430   my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } )
 431     if $param->{'ratenum'};
 432
 433   my @rate_detail = map {
 434
 435     my $regionnum = $_->regionnum;
 436     if ( $param->{"sec_granularity$regionnum"} ) {
 437
 438       new FS::rate_detail {
 439         'dest_regionnum'  => $regionnum,
 440         map { $_ => $param->{"$_$regionnum"} }
 441             qw( min_included min_charge sec_granularity )
 442             #qw( min_included conn_charge conn_sec min_charge sec_granularity )
 443       };
 444
 445     } else {
 446
 447       new FS::rate_detail {
 448         'dest_regionnum'  => $regionnum,
 449         'min_included'    => 0,
 450         'conn_charge'     => 0,
 451         'conn_sec'        => 0,
 452         'conn_charge'     => 0,
 453         'min_charge'      => 0,
 454         'sec_granularity' => '60'
 455       };
 456
 457     }
 458
 459   } qsearch('rate_region', {} );
 460
 461   my $rate = new FS::rate {
 462     map { $_ => $param->{$_} }
 463         fields('rate')
 464   };
 465
 466   my $error = '';
 467   if ( $param->{'ratenum'} ) {
 468     warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
 469
 470     my @param = ( 'job'=>$job );
 471     push @param, 'rate_detail'=>\@rate_detail
 472       unless $param->{'preserve_rate_detail'};
 473
 474     $error = $rate->replace( $old, @param );
 475
 476   } else {
 477     warn "inserting $rate\n" if $DEBUG;
 478     $error = $rate->insert( 'rate_detail' => \@rate_detail,
 479                             'job'         => $job,
 480                           );
 481     #$ratenum = $rate->getfield('ratenum');
 482   }
 483
 484   die "$error\n" if $error;
 485
 486 }
 487
 488 =head1 BUGS
 489
 490 =head1 SEE ALSO
 491
 492 L<FS::Record>, schema.html from the base documentation.
 493
 494 =cut
 495
 496 1;
 497