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 with two keys: I<countrycode>
 280 and I<phonenum>.
 281
 282 An optional third key, I<weektime>, will return a timed rate (one with
 283 a non-null I<ratetimenum>) if one exists for a call at that time.  If
 284 no matching timed rate exists, the non-timed rate will be returned.
 285
 286 =cut
 287
 288 sub dest_detail {
 289   my $self = shift;
 290
 291   my $regionnum;
 292   my $weektime;
 293   if ( ref($_[0]) eq 'HASH' ) {
 294
 295     my $countrycode = $_[0]->{'countrycode'};
 296     my $phonenum    = $_[0]->{'phonenum'};
 297     $weektime       = $_[0]->{'weektime'};
 298
 299     #find a rate prefix, first look at most specific, then fewer digits,
 300     # finally trying the country code only
 301     my $rate_prefix = '';
 302     for my $len ( reverse(1..10) ) {
 303       $rate_prefix = qsearchs('rate_prefix', {
 304         'countrycode' => $countrycode,
 305         #'npa'         => { op=> 'LIKE', value=> substr($number, 0, $len) }
 306         'npa'         => substr($phonenum, 0, $len),
 307       } ) and last;
 308     }
 309     $rate_prefix ||= qsearchs('rate_prefix', {
 310       'countrycode' => $countrycode,
 311       'npa'         => '',
 312     });
 313
 314     return '' unless $rate_prefix;
 315
 316     $regionnum = $rate_prefix->regionnum;
 317
 318     #$rate_region = $rate_prefix->rate_region;
 319
 320   } else {
 321     $regionnum = ref($_[0]) ? shift->regionnum : shift;
 322   }
 323
 324   if(!defined($weektime)) {
 325     return qsearchs( 'rate_detail',
 326                             { 'ratenum'        => $self->ratenum,
 327                               'dest_regionnum' => $regionnum,
 328                               'ratetimenum'    => '',
 329                             } );
 330   }
 331   else {
 332     my @details = grep { my $rate_time = $_->rate_time;
 333                             $rate_time && $rate_time->contains($weektime) }
 334                        qsearch( 'rate_detail',
 335                                     { 'ratenum'        => $self->ratenum,
 336                                       'dest_regionnum' => $regionnum, } );
 337     if(!@details) {
 338       # this may change at some point
 339       return $self->dest_detail($regionnum);
 340     }
 341     elsif(@details == 1) {
 342       return $details[0];
 343     }
 344     else {
 345       die "overlapping rate_detail times (region $regionnum, time $weektime)\n";
 346     }
 347   }
 348 }
 349
 350 =item rate_detail
 351
 352 Returns all region-specific details  (see L<FS::rate_detail>) for this rate.
 353
 354 =cut
 355
 356 sub rate_detail {
 357   my $self = shift;
 358   qsearch( 'rate_detail', { 'ratenum' => $self->ratenum } );
 359 }
 360
 361
 362 =back
 363
 364 =head1 SUBROUTINES
 365
 366 =over 4
 367
 368 =item process
 369
 370 Experimental job-queue processor for web interface adds/edits
 371
 372 =cut
 373
 374 use Storable qw(thaw);
 375 use Data::Dumper;
 376 use MIME::Base64;
 377 sub process {
 378   my $job = shift;
 379
 380   my $param = thaw(decode_base64(shift));
 381   warn Dumper($param) if $DEBUG;
 382
 383   my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } )
 384     if $param->{'ratenum'};
 385
 386   my @rate_detail = map {
 387
 388     my $regionnum = $_->regionnum;
 389     if ( $param->{"sec_granularity$regionnum"} ) {
 390
 391       new FS::rate_detail {
 392         'dest_regionnum'  => $regionnum,
 393         map { $_ => $param->{"$_$regionnum"} }
 394             qw( min_included min_charge sec_granularity )
 395             #qw( min_included conn_charge conn_sec min_charge sec_granularity )
 396       };
 397
 398     } else {
 399
 400       new FS::rate_detail {
 401         'dest_regionnum'  => $regionnum,
 402         'min_included'    => 0,
 403         'conn_charge'     => 0,
 404         'conn_sec'        => 0,
 405         'conn_charge'     => 0,
 406         'min_charge'      => 0,
 407         'sec_granularity' => '60'
 408       };
 409
 410     }
 411
 412   } qsearch('rate_region', {} );
 413
 414   my $rate = new FS::rate {
 415     map { $_ => $param->{$_} }
 416         fields('rate')
 417   };
 418
 419   my $error = '';
 420   if ( $param->{'ratenum'} ) {
 421     warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
 422
 423     my @param = ( 'job'=>$job );
 424     push @param, 'rate_detail'=>\@rate_detail
 425       unless $param->{'preserve_rate_detail'};
 426
 427     $error = $rate->replace( $old, @param );
 428
 429   } else {
 430     warn "inserting $rate\n" if $DEBUG;
 431     $error = $rate->insert( 'rate_detail' => \@rate_detail,
 432                             'job'         => $job,
 433                           );
 434     #$ratenum = $rate->getfield('ratenum');
 435   }
 436
 437   die "$error\n" if $error;
 438
 439 }
 440
 441 =head1 BUGS
 442
 443 =head1 SEE ALSO
 444
 445 L<FS::Record>, schema.html from the base documentation.
 446
 447 =cut
 448
 449 1;
 450