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 = 1;
  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
 273
 274 Returns the rate detail (see L<FS::rate_detail>) for this rate to the
 275 specificed destination.
 276
 277 =cut
 278
 279 sub dest_detail {
 280   my $self = shift;
 281   my $regionnum = ref($_[0]) ? shift->regionnum : shift;
 282   qsearchs( 'rate_detail', { 'ratenum'        => $self->ratenum,
 283                              'dest_regionnum' => $regionnum,     } );
 284 }
 285
 286 =item rate_detail
 287
 288 Returns all region-specific details  (see L<FS::rate_detail>) for this rate.
 289
 290 =cut
 291
 292 sub rate_detail {
 293   my $self = shift;
 294   qsearch( 'rate_detail', { 'ratenum' => $self->ratenum } );
 295 }
 296
 297
 298 =back
 299
 300 =head1 SUBROUTINES
 301
 302 =over 4
 303
 304 =item process
 305
 306 Experimental job-queue processor for web interface adds/edits
 307
 308 =cut
 309
 310 sub process {
 311   my $job = shift;
 312
 313   #my %param = @_;
 314
 315   my $param = shift;
 316   my %param = split(/[;=]/, $param);
 317
 318   my $old = qsearchs('rate', { 'ratenum' => $param{'ratenum'} } )
 319     if $param{'ratenum'};
 320
 321   my @rate_detail = map {
 322
 323     my $regionnum = $_->regionnum;
 324     if ( $param{"sec_granularity$regionnum"} ) {
 325
 326       new FS::rate_detail {
 327         'dest_regionnum'  => $regionnum,
 328         map { $_ => $param{"$_$regionnum"} }
 329             qw( min_included min_charge sec_granularity )
 330       };
 331
 332     } else {
 333
 334       new FS::rate_detail {
 335         'dest_regionnum'  => $regionnum,
 336         'min_included'    => 0,
 337         'min_charge'      => 0,
 338         'sec_granularity' => '60'
 339       };
 340
 341     }
 342
 343   } qsearch('rate_region', {} );
 344
 345   my $rate = new FS::rate {
 346     map { $_ => $param{$_} }
 347         fields('rate')
 348   };
 349
 350   my $error = '';
 351   if ( $param{'ratenum'} ) {
 352     warn "$rate replacing $old ($param{'ratenum'})\n" if $DEBUG;
 353     $error = $rate->replace( $old,
 354                              'rate_detail' => \@rate_detail,
 355                              'job'         => $job,
 356                            );
 357   } else {
 358     warn "inserting $rate\n" if $DEBUG;
 359     $error = $rate->insert( 'rate_detail' => \@rate_detail,
 360                             'job'         => $job,
 361                           );
 362     #$ratenum = $rate->getfield('ratenum');
 363   }
 364
 365   die $error if $error;
 366
 367 }
 368
 369 # begin JSRPC code...
 370
 371 package FS::rate::JSRPC;
 372 use vars qw(@ISA $DEBUG);
 373 use JavaScript::RPC::Server::CGI;
 374 use FS::UID;
 375 @ISA = qw( JavaScript::RPC::Server::CGI );
 376 $DEBUG = 1;
 377
 378 sub process_rate {
 379   my $self = shift;
 380
 381   my %param = @_;
 382   warn "FS::rate::JSRPC::process_rate\n".
 383        join('', map "  $_ => $param{$_}\n", keys %param )
 384     if $DEBUG;
 385
 386   #progressbar prototype code...  should be generalized
 387
 388   #first get the CGI params shipped off to a job ASAP so an id can be returned
 389   #to the caller
 390
 391   my $job = new FS::queue { 'job' => 'FS::rate::process' };
 392
 393   #too slow to insert all the cgi params as individual args..,?
 394   #my $error = $queue->insert('_JOB', $cgi->Vars);
 395
 396   #my $bigstring = join(';', map { "$_=". scalar($cgi->param($_)) } $cgi->param );
 397   my $bigstring = join(';', map { "$_=". $param{$_} } keys %param );
 398   my $error = $job->insert('_JOB', $bigstring);
 399
 400   if ( $error ) {
 401     $error;
 402   } else {
 403     $job->jobnum;
 404   }
 405
 406 }
 407
 408 sub get_new_query {
 409   FS::UID::cgi();
 410 }
 411
 412 # end JSRPC code...
 413
 414 =head1 BUGS
 415
 416 =head1 SEE ALSO
 417
 418 L<FS::Record>, schema.html from the base documentation.
 419
 420 =cut
 421
 422 1;
 423