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