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