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