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