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