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