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