FS/FS/rate.pm

   1 package FS::rate;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use Storable qw(thaw);
   6 use Data::Dumper;
   7 use FS::Record qw( qsearch qsearchs dbh fields );
   8 use FS::rate_detail;
   9
  10 @ISA = qw(FS::Record);
  11
  12 $DEBUG = 1;
  13
  14 =head1 NAME
  15
  16 FS::rate - Object methods for rate records
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::rate;
  21
  22   $record = new FS::rate \%hash;
  23   $record = new FS::rate { 'column' => 'value' };
  24
  25   $error = $record->insert;
  26
  27   $error = $new_record->replace($old_record);
  28
  29   $error = $record->delete;
  30
  31   $error = $record->check;
  32
  33 =head1 DESCRIPTION
  34
  35 An FS::rate object represents an rate plan.  FS::rate inherits from
  36 FS::Record.  The following fields are currently supported:
  37
  38 =over 4
  39
  40 =item ratenum - primary key
  41
  42 =item ratename
  43
  44 =back
  45
  46 =head1 METHODS
  47
  48 =over 4
  49
  50 =item new HASHREF
  51
  52 Creates a new rate plan.  To add the rate plan to the database, see L<"insert">.
  53
  54 Note that this stores the hash reference, not a distinct copy of the hash it
  55 points to.  You can ask the object for a copy with the I<hash> method.
  56
  57 =cut
  58
  59 # the new method can be inherited from FS::Record, if a table method is defined
  60
  61 sub table { 'rate'; }
  62
  63 =item insert [ , OPTION => VALUE ... ]
  64
  65 Adds this record to the database.  If there is an error, returns the error,
  66 otherwise returns false.
  67
  68 Currently available options are: I<rate_detail>
  69
  70 If I<rate_detail> is set to an array reference of FS::rate_detail objects, the
  71 objects will have their ratenum field set and will be inserted after this
  72 record.
  73
  74 =cut
  75
  76 sub insert {
  77   my $self = shift;
  78   my %options = @_;
  79
  80   local $SIG{HUP} = 'IGNORE';
  81   local $SIG{INT} = 'IGNORE';
  82   local $SIG{QUIT} = 'IGNORE';
  83   local $SIG{TERM} = 'IGNORE';
  84   local $SIG{TSTP} = 'IGNORE';
  85   local $SIG{PIPE} = 'IGNORE';
  86
  87   my $oldAutoCommit = $FS::UID::AutoCommit;
  88   local $FS::UID::AutoCommit = 0;
  89   my $dbh = dbh;
  90
  91   my $error = $self->check;
  92   return $error if $error;
  93
  94   $error = $self->SUPER::insert;
  95   if ( $error ) {
  96     $dbh->rollback if $oldAutoCommit;
  97     return $error;
  98   }
  99
 100   if ( $options{'rate_detail'} ) {
 101
 102     my( $num, $last, $min_sec ) = (0, time, 5); #progressbar foo
 103
 104     foreach my $rate_detail ( @{$options{'rate_detail'}} ) {
 105
 106       $rate_detail->ratenum($self->ratenum);
 107       $error = $rate_detail->insert;
 108       if ( $error ) {
 109         $dbh->rollback if $oldAutoCommit;
 110         return $error;
 111       }
 112
 113       if ( $options{'job'} ) {
 114         $num++;
 115         if ( time - $min_sec > $last ) {
 116           my $error = $options{'job'}->update_statustext(
 117             int( 100 * $num / scalar( @{$options{'rate_detail'}} ) )
 118           );
 119           if ( $error ) {
 120             $dbh->rollback if $oldAutoCommit;
 121             return $error;
 122           }
 123           $last = time;
 124         }
 125       }
 126
 127     }
 128   }
 129
 130   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 131
 132   '';
 133 }
 134
 135
 136
 137 =item delete
 138
 139 Delete this record from the database.
 140
 141 =cut
 142
 143 # the delete method can be inherited from FS::Record
 144
 145 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
 146
 147 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 148 returns the error, otherwise returns false.
 149
 150 Currently available options are: I<rate_detail>
 151
 152 If I<rate_detail> is set to an array reference of FS::rate_detail objects, the
 153 objects will have their ratenum field set and will be inserted after this
 154 record.  Any existing rate_detail records associated with this record will be
 155 deleted.
 156
 157 =cut
 158
 159 sub replace {
 160   my ($new, $old) = (shift, shift);
 161   my %options = @_;
 162
 163   local $SIG{HUP} = 'IGNORE';
 164   local $SIG{INT} = 'IGNORE';
 165   local $SIG{QUIT} = 'IGNORE';
 166   local $SIG{TERM} = 'IGNORE';
 167   local $SIG{TSTP} = 'IGNORE';
 168   local $SIG{PIPE} = 'IGNORE';
 169
 170   my $oldAutoCommit = $FS::UID::AutoCommit;
 171   local $FS::UID::AutoCommit = 0;
 172   my $dbh = dbh;
 173
 174 #  my @old_rate_detail = ();
 175 #  @old_rate_detail = $old->rate_detail if $options{'rate_detail'};
 176
 177   my $error = $new->SUPER::replace($old);
 178   if ($error) {
 179     $dbh->rollback if $oldAutoCommit;
 180     return $error;
 181   }
 182
 183 #  foreach my $old_rate_detail ( @old_rate_detail ) {
 184 #
 185 #    my $error = $old_rate_detail->delete;
 186 #    if ($error) {
 187 #      $dbh->rollback if $oldAutoCommit;
 188 #      return $error;
 189 #    }
 190 #
 191 #    if ( $options{'job'} ) {
 192 #      $num++;
 193 #      if ( time - $min_sec > $last ) {
 194 #        my $error = $options{'job'}->update_statustext(
 195 #          int( 50 * $num / scalar( @old_rate_detail ) )
 196 #        );
 197 #        if ( $error ) {
 198 #          $dbh->rollback if $oldAutoCommit;
 199 #          return $error;
 200 #        }
 201 #        $last = time;
 202 #      }
 203 #    }
 204 #
 205 #  }
 206   if ( $options{'rate_detail'} ) {
 207     my $sth = $dbh->prepare('DELETE FROM rate_detail WHERE ratenum = ?') or do {
 208       $dbh->rollback if $oldAutoCommit;
 209       return $dbh->errstr;
 210     };
 211
 212     $sth->execute($old->ratenum) or do {
 213       $dbh->rollback if $oldAutoCommit;
 214       return $sth->errstr;
 215     };
 216
 217     my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
 218 #  $num = 0;
 219     foreach my $rate_detail ( @{$options{'rate_detail'}} ) {
 220
 221       $rate_detail->ratenum($new->ratenum);
 222       $error = $rate_detail->insert;
 223       if ( $error ) {
 224         $dbh->rollback if $oldAutoCommit;
 225         return $error;
 226       }
 227
 228       if ( $options{'job'} ) {
 229         $num++;
 230         if ( time - $min_sec > $last ) {
 231           my $error = $options{'job'}->update_statustext(
 232             int( 100 * $num / scalar( @{$options{'rate_detail'}} ) )
 233           );
 234           if ( $error ) {
 235             $dbh->rollback if $oldAutoCommit;
 236             return $error;
 237           }
 238           $last = time;
 239         }
 240       }
 241
 242     }
 243
 244   }
 245
 246   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 247   '';
 248
 249 }
 250
 251 =item check
 252
 253 Checks all fields to make sure this is a valid rate plan.  If there is
 254 an error, returns the error, otherwise returns false.  Called by the insert
 255 and replace methods.
 256
 257 =cut
 258
 259 # the check method should currently be supplied - FS::Record contains some
 260 # data checking routines
 261
 262 sub check {
 263   my $self = shift;
 264
 265   my $error =
 266        $self->ut_numbern('ratenum')
 267     || $self->ut_text('ratename')
 268   ;
 269   return $error if $error;
 270
 271   $self->SUPER::check;
 272 }
 273
 274 =item dest_detail REGIONNUM | RATE_REGION_OBJECTD
 275
 276 Returns the rate detail (see L<FS::rate_detail>) for this rate to the
 277 specificed destination.
 278
 279 =cut
 280
 281 sub dest_detail {
 282   my $self = shift;
 283   my $regionnum = ref($_[0]) ? shift->regionnum : shift;
 284   qsearchs( 'rate_detail', { 'ratenum'        => $self->ratenum,
 285                              'dest_regionnum' => $regionnum,     } );
 286 }
 287
 288 =item rate_detail
 289
 290 Returns all region-specific details  (see L<FS::rate_detail>) for this rate.
 291
 292 =cut
 293
 294 sub rate_detail {
 295   my $self = shift;
 296   qsearch( 'rate_detail', { 'ratenum' => $self->ratenum } );
 297 }
 298
 299
 300 =back
 301
 302 =head1 SUBROUTINES
 303
 304 =over 4
 305
 306 =item process
 307
 308 Experimental job-queue processor for web interface adds/edits
 309
 310 =cut
 311
 312 use MIME::Base64;
 313 sub process {
 314   my $job = shift;
 315
 316   #my %param = @_;
 317
 318   #my $param = shift;
 319   #my %param = split(/[;=]/, $param);
 320
 321   my $param = thaw(decode_base64(shift));
 322   warn Dumper($param) if $DEBUG;
 323
 324   my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } )
 325     if $param->{'ratenum'};
 326
 327   my @rate_detail = map {
 328
 329     my $regionnum = $_->regionnum;
 330     if ( $param->{"sec_granularity$regionnum"} ) {
 331
 332       new FS::rate_detail {
 333         'dest_regionnum'  => $regionnum,
 334         map { $_ => $param->{"$_$regionnum"} }
 335             qw( min_included min_charge sec_granularity )
 336       };
 337
 338     } else {
 339
 340       new FS::rate_detail {
 341         'dest_regionnum'  => $regionnum,
 342         'min_included'    => 0,
 343         'min_charge'      => 0,
 344         'sec_granularity' => '60'
 345       };
 346
 347     }
 348
 349   } qsearch('rate_region', {} );
 350
 351   my $rate = new FS::rate {
 352     map { $_ => $param->{$_} }
 353         fields('rate')
 354   };
 355
 356   my $error = '';
 357   if ( $param->{'ratenum'} ) {
 358     warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
 359     $error = $rate->replace( $old,
 360                              'rate_detail' => \@rate_detail,
 361                              'job'         => $job,
 362                            );
 363   } else {
 364     warn "inserting $rate\n" if $DEBUG;
 365     $error = $rate->insert( 'rate_detail' => \@rate_detail,
 366                             'job'         => $job,
 367                           );
 368     #$ratenum = $rate->getfield('ratenum');
 369   }
 370
 371   die $error if $error;
 372
 373 }
 374
 375 # begin JSRPC code...
 376
 377 package FS::rate::JSRPC;
 378 use vars qw(@ISA $DEBUG);
 379 use JavaScript::RPC::Server::CGI;
 380 use FS::UID;
 381 @ISA = qw( JavaScript::RPC::Server::CGI );
 382 $DEBUG = 1;
 383
 384 sub process_rate {
 385   my $self = shift;
 386
 387   my %param = @_;
 388   warn "FS::rate::JSRPC::process_rate\n".
 389        join('', map "  $_ => $param{$_}\n", keys %param )
 390     if $DEBUG;
 391
 392   #progressbar prototype code...  should be generalized
 393
 394   #first get the CGI params shipped off to a job ASAP so an id can be returned
 395   #to the caller
 396
 397   my $job = new FS::queue { 'job' => 'FS::rate::process' };
 398
 399   #too slow to insert all the cgi params as individual args..,?
 400   #my $error = $queue->insert('_JOB', $cgi->Vars);
 401
 402   #my $bigstring = join(';', map { "$_=". scalar($cgi->param($_)) } $cgi->param );
 403   my $bigstring = join(';', map { "$_=". $param{$_} } keys %param );
 404   my $error = $job->insert('_JOB', $bigstring);
 405
 406   if ( $error ) {
 407     $error;
 408   } else {
 409     $job->jobnum;
 410   }
 411
 412 }
 413
 414 sub get_new_query {
 415   FS::UID::cgi();
 416 }
 417
 418 # end JSRPC code...
 419
 420 =head1 BUGS
 421
 422 =head1 SEE ALSO
 423
 424 L<FS::Record>, schema.html from the base documentation.
 425
 426 =cut
 427
 428 1;
 429