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