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::agent; #causes a weird dep loop in freeside-cdrrated, only needed for v3-style manual FK-checking, so, probably not bother
   8 use FS::rate_detail;
   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 =back
 392
 393 =head1 SUBROUTINES
 394
 395 =over 4
 396
 397 =item process
 398
 399 Job-queue processor for web interface adds/edits
 400
 401 =cut
 402
 403 use Storable qw(thaw);
 404 use Data::Dumper;
 405 use MIME::Base64;
 406 sub process {
 407   my $job = shift;
 408
 409   my $param = thaw(decode_base64(shift));
 410   warn Dumper($param) if $DEBUG;
 411
 412   my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } )
 413     if $param->{'ratenum'};
 414
 415   my @rate_detail = map {
 416
 417     my $regionnum = $_->regionnum;
 418     if ( $param->{"sec_granularity$regionnum"} ) {
 419
 420       new FS::rate_detail {
 421         'dest_regionnum'  => $regionnum,
 422         map { $_ => $param->{"$_$regionnum"} }
 423             qw( min_included min_charge sec_granularity )
 424             #qw( min_included conn_charge conn_sec min_charge sec_granularity )
 425       };
 426
 427     } else {
 428
 429       new FS::rate_detail {
 430         'dest_regionnum'  => $regionnum,
 431         'min_included'    => 0,
 432         'conn_charge'     => 0,
 433         'conn_sec'        => 0,
 434         'conn_charge'     => 0,
 435         'min_charge'      => 0,
 436         'sec_granularity' => '60'
 437       };
 438
 439     }
 440
 441   } qsearch('rate_region', {} );
 442
 443   my $rate = new FS::rate {
 444     map { $_ => $param->{$_} }
 445         fields('rate')
 446   };
 447
 448   my $error = '';
 449   if ( $param->{'ratenum'} ) {
 450     warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
 451
 452     my @param = ( 'job'=>$job );
 453     push @param, 'rate_detail'=>\@rate_detail
 454       unless $param->{'preserve_rate_detail'};
 455
 456     $error = $rate->replace( $old, @param );
 457
 458   } else {
 459     warn "inserting $rate\n" if $DEBUG;
 460     $error = $rate->insert( 'rate_detail' => \@rate_detail,
 461                             'job'         => $job,
 462                           );
 463     #$ratenum = $rate->getfield('ratenum');
 464   }
 465
 466   die "$error\n" if $error;
 467
 468 }
 469
 470 =head1 BUGS
 471
 472 =head1 SEE ALSO
 473
 474 L<FS::Record>, schema.html from the base documentation.
 475
 476 =cut
 477
 478 1;
 479