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