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 =item access_user
 410
 411 Returns FS::access_user object (if any) associated with this user.
 412
 413 Returns nothing if not found.
 414
 415 =cut
 416
 417 sub access_user {
 418   my $self = shift;
 419   my $usernum = $self->usernum || return ();
 420   return qsearchs('access_user',{ 'usernum' => $usernum }) || ();
 421 }
 422
 423 =back
 424
 425 =head1 SUBROUTINES
 426
 427 =over 4
 428
 429 =item joblisting HASHREF NOACTIONS
 430
 431 =cut
 432
 433 sub joblisting {
 434   my($hashref, $noactions) = @_;
 435
 436   use Date::Format;
 437   use HTML::Entities;
 438   use FS::CGI;
 439
 440   my @queue = qsearch( 'queue', $hashref );
 441   return '' unless scalar(@queue);
 442
 443   my $p = FS::CGI::popurl(2);
 444
 445   my $html = qq!<FORM ACTION="$p/misc/queue.cgi" METHOD="POST">!.
 446              FS::CGI::table(). <<END;
 447       <TR>
 448         <TH COLSPAN=2>Job</TH>
 449         <TH>Args</TH>
 450         <TH>Date</TH>
 451         <TH>Status</TH>
 452 END
 453   $html .= '<TH>Account</TH>' unless $hashref->{svcnum};
 454   $html .= '</TR>';
 455
 456   my $dangerous = $conf->exists('queue_dangerous_controls');
 457
 458   my $areboxes = 0;
 459
 460   foreach my $queue ( sort {
 461     $a->getfield('jobnum') <=> $b->getfield('jobnum')
 462   } @queue ) {
 463     my $queue_hashref = $queue->hashref;
 464     my $jobnum = $queue->jobnum;
 465
 466     my $args;
 467     if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) {
 468       $args = encode_entities( join(' ', $queue->args) );
 469     } else {
 470       $args = '';
 471     }
 472
 473     my $date = time2str( "%a %b %e %T %Y", $queue->_date );
 474     my $status = $queue->status;
 475     $status .= ': '. $queue->statustext if $queue->statustext;
 476     my @queue_depend = $queue->queue_depend;
 477     $status .= ' (waiting for '.
 478                join(', ', map { $_->depend_jobnum } @queue_depend ).
 479                ')'
 480       if @queue_depend;
 481     my $changable = $dangerous
 482          || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ );
 483     if ( $changable ) {
 484       $status .=
 485         qq! (&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A>&nbsp;|!.
 486         qq!&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A>&nbsp;)!;
 487     }
 488     my $cust_svc = $queue->cust_svc;
 489
 490     $html .= <<END;
 491       <TR>
 492         <TD>$jobnum</TD>
 493         <TD>$queue_hashref->{job}</TD>
 494         <TD>$args</TD>
 495         <TD>$date</TD>
 496         <TD>$status</TD>
 497 END
 498
 499     unless ( $hashref->{svcnum} ) {
 500       my $account;
 501       if ( $cust_svc ) {
 502         my $table = $cust_svc->part_svc->svcdb;
 503         my $label = ( $cust_svc->label )[1];
 504         $account = qq!<A HREF="../view/$table.cgi?!. $queue->svcnum.
 505                    qq!">$label</A>!;
 506       } else {
 507         $account = '';
 508       }
 509       $html .= "<TD>$account</TD>";
 510     }
 511
 512     if ( $changable ) {
 513       $areboxes=1;
 514       $html .=
 515         qq!<TD><INPUT NAME="jobnum$jobnum" TYPE="checkbox" VALUE="1"></TD>!;
 516
 517     }
 518
 519     $html .= '</TR>';
 520
 521 }
 522
 523   $html .= '</TABLE>';
 524
 525   if ( $areboxes ) {
 526     $html .= '<BR><INPUT TYPE="submit" NAME="action" VALUE="retry selected">'.
 527              '<INPUT TYPE="submit" NAME="action" VALUE="remove selected"><BR>';
 528   }
 529
 530   $html;
 531
 532 }
 533
 534 =back
 535
 536 =head1 BUGS
 537
 538 $jobnums global
 539
 540 =head1 SEE ALSO
 541
 542 L<FS::Record>, schema.html from the base documentation.
 543
 544 =cut
 545
 546 1;
 547