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     $rate_prefix = qsearchs({
 312         'table'     => 'rate_prefix',
 313         'addl_from' => ' JOIN rate_region USING (regionnum)',
 314         'hashref'   => {
 315           'countrycode' => $countrycode,
 316           'npa'         => $phonenum,
 317         },
 318         'extra_sql' => ' AND exact_match = \'Y\''
 319     });
 320     if (!$rate_prefix) {
 321       for my $len ( reverse(1..10) ) {
 322         $rate_prefix = qsearchs('rate_prefix', {
 323           'countrycode' => $countrycode,
 324           #'npa'         => { op=> 'LIKE', value=> substr($number, 0, $len) }
 325           'npa'         => substr($phonenum, 0, $len),
 326         } ) and last;
 327       }
 328       $rate_prefix ||= qsearchs('rate_prefix', {
 329         'countrycode' => $countrycode,
 330         'npa'         => '',
 331       });
 332     }
 333
 334     return '' unless $rate_prefix;
 335
 336     $regionnum = $rate_prefix->regionnum;
 337
 338   } else {
 339     $regionnum = ref($_[0]) ? shift->regionnum : shift;
 340   }
 341
 342   my %hash = (
 343     'ratenum'         => $self->ratenum,
 344     'dest_regionnum'  => $regionnum,
 345   );
 346
 347   # find all rates matching ratenum, regionnum, cdrtypenum
 348   my @details = qsearch( 'rate_detail', {
 349       %hash,
 350       'cdrtypenum' => $cdrtypenum
 351     });
 352   # find all rates maching ratenum, regionnum and null cdrtypenum
 353   if ( !@details and $cdrtypenum ) {
 354     @details = qsearch( 'rate_detail', {
 355         %hash,
 356         'cdrtypenum' => ''
 357       });
 358   }
 359   # find one of those matching weektime
 360   if ( defined($weektime) ) {
 361     my @exact = grep {
 362       my $rate_time = $_->rate_time;
 363       $rate_time && $rate_time->contains($weektime)
 364     } @details;
 365     if ( @exact == 1 ) {
 366       return $exact[0];
 367     }
 368     elsif ( @exact > 1 ) {
 369       die "overlapping rate_detail times (region $regionnum, time $weektime)\n"
 370     }
 371     # else @exact == 0
 372   }
 373   # if not found or there is no weektime, find one matching null weektime
 374   foreach (@details) {
 375     return $_ if $_->ratetimenum eq '';
 376   }
 377   # found nothing
 378   return;
 379 }
 380
 381 =item rate_detail
 382
 383 Returns all region-specific details  (see L<FS::rate_detail>) for this rate.
 384
 385 =cut
 386
 387 sub rate_detail {
 388   my $self = shift;
 389   qsearch( 'rate_detail', { 'ratenum' => $self->ratenum } );
 390 }
 391
 392
 393 =back
 394
 395 =head1 SUBROUTINES
 396
 397 =over 4
 398
 399 =item process
 400
 401 Job-queue processor for web interface adds/edits
 402
 403 =cut
 404
 405 use Storable qw(thaw);
 406 use Data::Dumper;
 407 use MIME::Base64;
 408 sub process {
 409   my $job = shift;
 410
 411   my $param = thaw(decode_base64(shift));
 412   warn Dumper($param) if $DEBUG;
 413
 414   my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } )
 415     if $param->{'ratenum'};
 416
 417   my @rate_detail = map {
 418
 419     my $regionnum = $_->regionnum;
 420     if ( $param->{"sec_granularity$regionnum"} ) {
 421
 422       new FS::rate_detail {
 423         'dest_regionnum'  => $regionnum,
 424         map { $_ => $param->{"$_$regionnum"} }
 425             qw( min_included min_charge sec_granularity )
 426             #qw( min_included conn_charge conn_sec min_charge sec_granularity )
 427       };
 428
 429     } else {
 430
 431       new FS::rate_detail {
 432         'dest_regionnum'  => $regionnum,
 433         'min_included'    => 0,
 434         'conn_charge'     => 0,
 435         'conn_sec'        => 0,
 436         'conn_charge'     => 0,
 437         'min_charge'      => 0,
 438         'sec_granularity' => '60'
 439       };
 440
 441     }
 442
 443   } qsearch('rate_region', {} );
 444
 445   my $rate = new FS::rate {
 446     map { $_ => $param->{$_} }
 447         fields('rate')
 448   };
 449
 450   my $error = '';
 451   if ( $param->{'ratenum'} ) {
 452     warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
 453
 454     my @param = ( 'job'=>$job );
 455     push @param, 'rate_detail'=>\@rate_detail
 456       unless $param->{'preserve_rate_detail'};
 457
 458     $error = $rate->replace( $old, @param );
 459
 460   } else {
 461     warn "inserting $rate\n" if $DEBUG;
 462     $error = $rate->insert( 'rate_detail' => \@rate_detail,
 463                             'job'         => $job,
 464                           );
 465     #$ratenum = $rate->getfield('ratenum');
 466   }
 467
 468   die "$error\n" if $error;
 469
 470 }
 471
 472 =head1 BUGS
 473
 474 =head1 SEE ALSO
 475
 476 L<FS::Record>, schema.html from the base documentation.
 477
 478 =cut
 479
 480 1;
 481