FS/FS/queue.pm

   1 package FS::queue;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums);
   5 use Exporter;
   6 use MIME::Base64;
   7 use Storable qw( nfreeze thaw );
   8 use FS::UID qw(myconnect);
   9 use FS::Conf;
  10 use FS::Record qw( qsearch qsearchs dbh );
  11 #use FS::queue;
  12 use FS::queue_arg;
  13 use FS::queue_depend;
  14 use FS::cust_svc;
  15
  16 @ISA = qw(FS::Record);
  17 @EXPORT_OK = qw( joblisting );
  18
  19 $DEBUG = 0;
  20
  21 $FS::UID::callback{'FS::queue'} = sub {
  22   $conf = new FS::Conf;
  23 };
  24
  25 $jobnums = '';
  26
  27 =head1 NAME
  28
  29 FS::queue - Object methods for queue records
  30
  31 =head1 SYNOPSIS
  32
  33   use FS::queue;
  34
  35   $record = new FS::queue \%hash;
  36   $record = new FS::queue { 'column' => 'value' };
  37
  38   $error = $record->insert;
  39
  40   $error = $new_record->replace($old_record);
  41
  42   $error = $record->delete;
  43
  44   $error = $record->check;
  45
  46 =head1 DESCRIPTION
  47
  48 An FS::queue object represents an queued job.  FS::queue inherits from
  49 FS::Record.  The following fields are currently supported:
  50
  51 =over 4
  52
  53 =item jobnum
  54
  55 Primary key
  56
  57 =item job
  58
  59 Fully-qualified subroutine name
  60
  61 =item status
  62
  63 Job status (new, locked, or failed)
  64
  65 =item statustext
  66
  67 Freeform text status message
  68
  69 =item _date
  70
  71 UNIX timestamp
  72
  73 =item svcnum
  74
  75 Optional link to service (see L<FS::cust_svc>).
  76
  77 =item custnum
  78
  79 Optional link to customer (see L<FS::cust_main>).
  80
  81 =item secure
  82
  83 Secure flag, 'Y' indicates that when using encryption, the job needs to be
  84 run on a machine with the private key.
  85
  86 =cut
  87
  88 =back
  89
  90 =head1 METHODS
  91
  92 =over 4
  93
  94 =item new HASHREF
  95
  96 Creates a new job.  To add the job to the database, see L<"insert">.
  97
  98 Note that this stores the hash reference, not a distinct copy of the hash it
  99 points to.  You can ask the object for a copy with the I<hash> method.
 100
 101 =cut
 102
 103 # the new method can be inherited from FS::Record, if a table method is defined
 104
 105 sub table { 'queue'; }
 106
 107 =item insert [ ARGUMENT, ARGUMENT... ]
 108
 109 Adds this record to the database.  If there is an error, returns the error,
 110 otherwise returns false.
 111
 112 If any arguments are supplied, a queue_arg record for each argument is also
 113 created (see L<FS::queue_arg>).
 114
 115 =cut
 116
 117 #false laziness w/part_export.pm
 118 sub insert {
 119   my( $self, @args ) = @_;
 120
 121   local $SIG{HUP} = 'IGNORE';
 122   local $SIG{INT} = 'IGNORE';
 123   local $SIG{QUIT} = 'IGNORE';
 124   local $SIG{TERM} = 'IGNORE';
 125   local $SIG{TSTP} = 'IGNORE';
 126   local $SIG{PIPE} = 'IGNORE';
 127
 128   my $oldAutoCommit = $FS::UID::AutoCommit;
 129   local $FS::UID::AutoCommit = 0;
 130   my $dbh = dbh;
 131
 132   my %args = ();
 133   {
 134     no warnings "misc";
 135     %args = @args;
 136   }
 137
 138   $self->custnum( $args{'custnum'} ) if $args{'custnum'};
 139
 140   my $error = $self->SUPER::insert;
 141   if ( $error ) {
 142     $dbh->rollback if $oldAutoCommit;
 143     return $error;
 144   }
 145
 146   foreach my $arg ( @args ) {
 147     my $freeze = ref($arg) ? 'Y' : '';
 148     my $queue_arg = new FS::queue_arg ( {
 149       'jobnum' => $self->jobnum,
 150       'frozen' => $freeze,
 151       'arg'    => $freeze ? encode_base64(nfreeze($arg)) : $arg,# always freeze?
 152     } );
 153     $error = $queue_arg->insert;
 154     if ( $error ) {
 155       $dbh->rollback if $oldAutoCommit;
 156       return $error;
 157     }
 158   }
 159
 160   if ( $jobnums ) {
 161     warn "jobnums global is active: $jobnums\n" if $DEBUG;
 162     push @$jobnums, $self->jobnum;
 163   }
 164
 165   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 166
 167   '';
 168
 169 }
 170
 171 =item delete
 172
 173 Delete this record from the database.  Any corresponding queue_arg records are
 174 deleted as well
 175
 176 =cut
 177
 178 sub delete {
 179   my $self = shift;
 180
 181   local $SIG{HUP} = 'IGNORE';
 182   local $SIG{INT} = 'IGNORE';
 183   local $SIG{QUIT} = 'IGNORE';
 184   local $SIG{TERM} = 'IGNORE';
 185   local $SIG{TSTP} = 'IGNORE';
 186   local $SIG{PIPE} = 'IGNORE';
 187
 188   my $oldAutoCommit = $FS::UID::AutoCommit;
 189   local $FS::UID::AutoCommit = 0;
 190   my $dbh = dbh;
 191
 192   my @del = qsearch( 'queue_arg', { 'jobnum' => $self->jobnum } );
 193   push @del, qsearch( 'queue_depend', { 'depend_jobnum' => $self->jobnum } );
 194
 195   my $error = $self->SUPER::delete;
 196   if ( $error ) {
 197     $dbh->rollback if $oldAutoCommit;
 198     return $error;
 199   }
 200
 201   foreach my $del ( @del ) {
 202     $error = $del->delete;
 203     if ( $error ) {
 204       $dbh->rollback if $oldAutoCommit;
 205       return $error;
 206     }
 207   }
 208
 209   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 210
 211   '';
 212
 213 }
 214
 215 =item replace OLD_RECORD
 216
 217 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 218 returns the error, otherwise returns false.
 219
 220 =cut
 221
 222 # the replace method can be inherited from FS::Record
 223
 224 =item check
 225
 226 Checks all fields to make sure this is a valid job.  If there is
 227 an error, returns the error, otherwise returns false.  Called by the insert
 228 and replace methods.
 229
 230 =cut
 231
 232 sub check {
 233   my $self = shift;
 234   my $error =
 235     $self->ut_numbern('jobnum')
 236     || $self->ut_anything('job')
 237     || $self->ut_numbern('_date')
 238     || $self->ut_enum('status',['', qw( new locked failed )])
 239     || $self->ut_anything('statustext')
 240     || $self->ut_numbern('svcnum')
 241   ;
 242   return $error if $error;
 243
 244   $error = $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum');
 245   $self->svcnum('') if $error;
 246
 247   $self->status('new') unless $self->status;
 248   $self->_date(time) unless $self->_date;
 249
 250   $self->SUPER::check;
 251 }
 252
 253 =item args
 254
 255 Returns a list of the arguments associated with this job.
 256
 257 =cut
 258
 259 sub args {
 260   my $self = shift;
 261   map { $_->frozen ? thaw(decode_base64($_->arg)) : $_->arg }
 262     qsearch( 'queue_arg',
 263              { 'jobnum' => $self->jobnum },
 264              '',
 265              'ORDER BY argnum'
 266            );
 267 }
 268
 269 =item cust_svc
 270
 271 Returns the FS::cust_svc object associated with this job, if any.
 272
 273 =cut
 274
 275 sub cust_svc {
 276   my $self = shift;
 277   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 278 }
 279
 280 =item queue_depend
 281
 282 Returns the FS::queue_depend objects associated with this job, if any.
 283 (Dependancies that must complete before this job can be run).
 284
 285 =cut
 286
 287 sub queue_depend {
 288   my $self = shift;
 289   qsearch('queue_depend', { 'jobnum' => $self->jobnum } );
 290 }
 291
 292 =item depend_insert OTHER_JOBNUM
 293
 294 Inserts a dependancy for this job - it will not be run until the other job
 295 specified completes.  If there is an error, returns the error, otherwise
 296 returns false.
 297
 298 When using job dependancies, you should wrap the insertion of all relevant jobs
 299 in a database transaction.
 300
 301 =cut
 302
 303 sub depend_insert {
 304   my($self, $other_jobnum) = @_;
 305   my $queue_depend = new FS::queue_depend ( {
 306     'jobnum'        => $self->jobnum,
 307     'depend_jobnum' => $other_jobnum,
 308   } );
 309   $queue_depend->insert;
 310 }
 311
 312 =item queue_depended
 313
 314 Returns the FS::queue_depend objects that associate other jobs with this job,
 315 if any.  (The jobs that are waiting for this job to complete before they can
 316 run).
 317
 318 =cut
 319
 320 sub queue_depended {
 321   my $self = shift;
 322   qsearch('queue_depend', { 'depend_jobnum' => $self->jobnum } );
 323 }
 324
 325 =item depended_delete
 326
 327 Deletes the other queued jobs (FS::queue objects) that are waiting for this
 328 job, if any.  If there is an error, returns the error, otherwise returns false.
 329
 330 =cut
 331
 332 sub depended_delete {
 333   my $self = shift;
 334   my $error;
 335   foreach my $job (
 336     map { qsearchs('queue', { 'jobnum' => $_->jobnum } ) } $self->queue_depended
 337   ) {
 338     $error = $job->depended_delete;
 339     return $error if $error;
 340     $error = $job->delete;
 341     return $error if $error
 342   }
 343 }
 344
 345 =item update_statustext VALUE
 346
 347 Updates the statustext value of this job to supplied value, in the database.
 348 If there is an error, returns the error, otherwise returns false.
 349
 350 =cut
 351
 352 use vars qw($_update_statustext_dbh);
 353 sub update_statustext {
 354   my( $self, $statustext ) = @_;
 355   return '' if $statustext eq $self->statustext;
 356   warn "updating statustext for $self to $statustext" if $DEBUG;
 357
 358   $_update_statustext_dbh ||= myconnect;
 359
 360   my $sth = $_update_statustext_dbh->prepare(
 361     'UPDATE queue set statustext = ? WHERE jobnum = ?'
 362   ) or return $_update_statustext_dbh->errstr;
 363
 364   $sth->execute($statustext, $self->jobnum) or return $sth->errstr;
 365   $_update_statustext_dbh->commit or die $_update_statustext_dbh->errstr;
 366   $self->statustext($statustext);
 367   '';
 368
 369   #my $new = new FS::queue { $self->hash };
 370   #$new->statustext($statustext);
 371   #my $error = $new->replace($self);
 372   #return $error if $error;
 373   #$self->statustext($statustext);
 374   #'';
 375 }
 376
 377 =back
 378
 379 =head1 SUBROUTINES
 380
 381 =over 4
 382
 383 =item joblisting HASHREF NOACTIONS
 384
 385 =cut
 386
 387 sub joblisting {
 388   my($hashref, $noactions) = @_;
 389
 390   use Date::Format;
 391   use HTML::Entities;
 392   use FS::CGI;
 393
 394   my @queue = qsearch( 'queue', $hashref );
 395   return '' unless scalar(@queue);
 396
 397   my $p = FS::CGI::popurl(2);
 398
 399   my $html = qq!<FORM ACTION="$p/misc/queue.cgi" METHOD="POST">!.
 400              FS::CGI::table(). <<END;
 401       <TR>
 402         <TH COLSPAN=2>Job</TH>
 403         <TH>Args</TH>
 404         <TH>Date</TH>
 405         <TH>Status</TH>
 406 END
 407   $html .= '<TH>Account</TH>' unless $hashref->{svcnum};
 408   $html .= '</TR>';
 409
 410   my $dangerous = $conf->exists('queue_dangerous_controls');
 411
 412   my $areboxes = 0;
 413
 414   foreach my $queue ( sort {
 415     $a->getfield('jobnum') <=> $b->getfield('jobnum')
 416   } @queue ) {
 417     my $queue_hashref = $queue->hashref;
 418     my $jobnum = $queue->jobnum;
 419
 420     my $args;
 421     if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) {
 422       $args = encode_entities( join(' ', $queue->args) );
 423     } else {
 424       $args = '';
 425     }
 426
 427     my $date = time2str( "%a %b %e %T %Y", $queue->_date );
 428     my $status = $queue->status;
 429     $status .= ': '. $queue->statustext if $queue->statustext;
 430     my @queue_depend = $queue->queue_depend;
 431     $status .= ' (waiting for '.
 432                join(', ', map { $_->depend_jobnum } @queue_depend ).
 433                ')'
 434       if @queue_depend;
 435     my $changable = $dangerous
 436          || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ );
 437     if ( $changable ) {
 438       $status .=
 439         qq! (&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A>&nbsp;|!.
 440         qq!&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A>&nbsp;)!;
 441     }
 442     my $cust_svc = $queue->cust_svc;
 443
 444     $html .= <<END;
 445       <TR>
 446         <TD>$jobnum</TD>
 447         <TD>$queue_hashref->{job}</TD>
 448         <TD>$args</TD>
 449         <TD>$date</TD>
 450         <TD>$status</TD>
 451 END
 452
 453     unless ( $hashref->{svcnum} ) {
 454       my $account;
 455       if ( $cust_svc ) {
 456         my $table = $cust_svc->part_svc->svcdb;
 457         my $label = ( $cust_svc->label )[1];
 458         $account = qq!<A HREF="../view/$table.cgi?!. $queue->svcnum.
 459                    qq!">$label</A>!;
 460       } else {
 461         $account = '';
 462       }
 463       $html .= "<TD>$account</TD>";
 464     }
 465
 466     if ( $changable ) {
 467       $areboxes=1;
 468       $html .=
 469         qq!<TD><INPUT NAME="jobnum$jobnum" TYPE="checkbox" VALUE="1"></TD>!;
 470
 471     }
 472
 473     $html .= '</TR>';
 474
 475 }
 476
 477   $html .= '</TABLE>';
 478
 479   if ( $areboxes ) {
 480     $html .= '<BR><INPUT TYPE="submit" NAME="action" VALUE="retry selected">'.
 481              '<INPUT TYPE="submit" NAME="action" VALUE="remove selected"><BR>';
 482   }
 483
 484   $html;
 485
 486 }
 487
 488 =back
 489
 490 =head1 BUGS
 491
 492 $jobnums global
 493
 494 =head1 SEE ALSO
 495
 496 L<FS::Record>, schema.html from the base documentation.
 497
 498 =cut
 499
 500 1;
 501