FS/FS/queue.pm

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