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.  Destination can be specified as an FS::rate_detail
 276 object or regionnum (see L<FS::rate_detail>), or as a hashref with two keys:
 277 I<countrycode> and I<phonenum>.
 278
 279 =cut
 280
 281 sub dest_detail {
 282   my $self = shift;
 283
 284   my $regionnum;
 285   if ( ref($_[0]) eq 'HASH' ) {
 286
 287     my $countrycode = $_[0]->{'countrycode'};
 288     my $phonenum    = $_[0]->{'phonenum'};
 289
 290     #find a rate prefix, first look at most specific (4 digits) then 3, etc.,
 291     # finally trying the country code only
 292     my $rate_prefix = '';
 293     for my $len ( reverse(1..10) ) {
 294       $rate_prefix = qsearchs('rate_prefix', {
 295         'countrycode' => $countrycode,
 296         #'npa'         => { op=> 'LIKE', value=> substr($number, 0, $len) }
 297         'npa'         => substr($phonenum, 0, $len),
 298       } ) and last;
 299     }
 300     $rate_prefix ||= qsearchs('rate_prefix', {
 301       'countrycode' => $countrycode,
 302       'npa'         => '',
 303     });
 304
 305     #
 306     #die "Can't find rate for call $to_or_from +$countrycode $number\n"
 307     die "Can't find rate for +$countrycode $phonenum\n"
 308       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       };
 368
 369     } else {
 370
 371       new FS::rate_detail {
 372         'dest_regionnum'  => $regionnum,
 373         'min_included'    => 0,
 374         'min_charge'      => 0,
 375         'sec_granularity' => '60'
 376       };
 377
 378     }
 379
 380   } qsearch('rate_region', {} );
 381
 382   my $rate = new FS::rate {
 383     map { $_ => $param->{$_} }
 384         fields('rate')
 385   };
 386
 387   my $error = '';
 388   if ( $param->{'ratenum'} ) {
 389     warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
 390     $error = $rate->replace( $old,
 391                              'rate_detail' => \@rate_detail,
 392                              'job'         => $job,
 393                            );
 394   } else {
 395     warn "inserting $rate\n" if $DEBUG;
 396     $error = $rate->insert( 'rate_detail' => \@rate_detail,
 397                             'job'         => $job,
 398                           );
 399     #$ratenum = $rate->getfield('ratenum');
 400   }
 401
 402   die "$error\n" if $error;
 403
 404 }
 405
 406 =head1 BUGS
 407
 408 =head1 SEE ALSO
 409
 410 L<FS::Record>, schema.html from the base documentation.
 411
 412 =cut
 413
 414 1;
 415