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