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