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