FS/FS/queue.pm

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