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