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