FS/FS/queue.pm

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