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