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 $error = $self->SUPER::delete;
 210   return $error if $error;
 211
 212   unlink $reportname if $reportname;
 213
 214   '';
 215
 216 }
 217
 218 =item replace OLD_RECORD
 219
 220 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 221 returns the error, otherwise returns false.
 222
 223 =cut
 224
 225 # the replace method can be inherited from FS::Record
 226
 227 =item check
 228
 229 Checks all fields to make sure this is a valid job.  If there is
 230 an error, returns the error, otherwise returns false.  Called by the insert
 231 and replace methods.
 232
 233 =cut
 234
 235 sub check {
 236   my $self = shift;
 237   my $error =
 238     $self->ut_numbern('jobnum')
 239     || $self->ut_anything('job')
 240     || $self->ut_numbern('_date')
 241     || $self->ut_enum('status',['', qw( new locked failed done )])
 242     || $self->ut_anything('statustext')
 243     || $self->ut_numbern('svcnum')
 244     || $self->ut_foreign_keyn('usernum', 'access_user', 'usernum')
 245   ;
 246   return $error if $error;
 247
 248   $error = $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum');
 249   $self->svcnum('') if $error;
 250
 251   $self->status('new') unless $self->status;
 252   $self->_date(time) unless $self->_date;
 253
 254   $self->SUPER::check;
 255 }
 256
 257 =item args
 258
 259 Returns a list of the arguments associated with this job.
 260
 261 =cut
 262
 263 sub args {
 264   my $self = shift;
 265   map { $_->frozen ? thaw(decode_base64($_->arg)) : $_->arg }
 266     qsearch( 'queue_arg',
 267              { 'jobnum' => $self->jobnum },
 268              '',
 269              'ORDER BY argnum'
 270            );
 271 }
 272
 273 =item cust_svc
 274
 275 Returns the FS::cust_svc object associated with this job, if any.
 276
 277 =item queue_depend
 278
 279 Returns the FS::queue_depend objects associated with this job, if any.
 280 (Dependancies that must complete before this job can be run).
 281
 282 =item depend_insert OTHER_JOBNUM
 283
 284 Inserts a dependancy for this job - it will not be run until the other job
 285 specified completes.  If there is an error, returns the error, otherwise
 286 returns false.
 287
 288 When using job dependancies, you should wrap the insertion of all relevant jobs
 289 in a database transaction.
 290
 291 =cut
 292
 293 sub depend_insert {
 294   my($self, $other_jobnum) = @_;
 295   my $queue_depend = new FS::queue_depend ( {
 296     'jobnum'        => $self->jobnum,
 297     'depend_jobnum' => $other_jobnum,
 298   } );
 299   $queue_depend->insert;
 300 }
 301
 302 =item queue_depended
 303
 304 Returns the FS::queue_depend objects that associate other jobs with this job,
 305 if any.  (The jobs that are waiting for this job to complete before they can
 306 run).
 307
 308 =cut
 309
 310 sub queue_depended {
 311   my $self = shift;
 312   qsearch('queue_depend', { 'depend_jobnum' => $self->jobnum } );
 313 }
 314
 315 =item depended_delete
 316
 317 Deletes the other queued jobs (FS::queue objects) that are waiting for this
 318 job, if any.  If there is an error, returns the error, otherwise returns false.
 319
 320 =cut
 321
 322 sub depended_delete {
 323   my $self = shift;
 324   my $error;
 325   foreach my $job (
 326     map { qsearchs('queue', { 'jobnum' => $_->jobnum } ) } $self->queue_depended
 327   ) {
 328     $error = $job->depended_delete;
 329     return $error if $error;
 330     $error = $job->delete;
 331     return $error if $error
 332   }
 333 }
 334
 335 =item update_statustext VALUE
 336
 337 Updates the statustext value of this job to supplied value, in the database.
 338 If there is an error, returns the error, otherwise returns false.
 339
 340 =cut
 341
 342 use vars qw($_update_statustext_dbh);
 343 sub update_statustext {
 344   my( $self, $statustext ) = @_;
 345   return '' if $statustext eq $self->get('statustext'); #avoid rooturl expansion
 346   warn "updating statustext for $self to $statustext" if $DEBUG;
 347
 348   $_update_statustext_dbh ||= myconnect;
 349
 350   my $sth = $_update_statustext_dbh->prepare(
 351     'UPDATE queue set statustext = ? WHERE jobnum = ?'
 352   ) or return $_update_statustext_dbh->errstr;
 353
 354   $sth->execute($statustext, $self->jobnum) or return $sth->errstr;
 355   $_update_statustext_dbh->commit or die $_update_statustext_dbh->errstr;
 356   $self->set('statustext', $statustext); #avoid rooturl expansion
 357   '';
 358
 359   #my $new = new FS::queue { $self->hash };
 360   #$new->statustext($statustext);
 361   #my $error = $new->replace($self);
 362   #return $error if $error;
 363   #$self->statustext($statustext);
 364   #'';
 365 }
 366
 367 =item access_user
 368
 369 Returns FS::access_user object (if any) associated with this user.
 370
 371 Returns nothing if not found.
 372
 373 =cut
 374
 375 sub access_user {
 376   my $self = shift;
 377   my $usernum = $self->usernum || return ();
 378   return qsearchs('access_user',{ 'usernum' => $usernum }) || ();
 379 }
 380
 381 =back
 382
 383 =head1 SUBROUTINES
 384
 385 =over 4
 386
 387 =item joblisting HASHREF NOACTIONS
 388
 389 =cut
 390
 391 sub joblisting {
 392   my($hashref, $noactions) = @_;
 393
 394   use Date::Format;
 395   use HTML::Entities;
 396   use FS::CGI;
 397
 398   my @queue = qsearch( 'queue', $hashref );
 399   return '' unless scalar(@queue);
 400
 401   my $p = FS::CGI::popurl(2);
 402
 403   my $html = qq!<FORM ACTION="$p/misc/queue.cgi" METHOD="POST">!.
 404              FS::CGI::table(). <<END;
 405       <TR>
 406         <TH COLSPAN=2>Job</TH>
 407         <TH>Args</TH>
 408         <TH>Date</TH>
 409         <TH>Status</TH>
 410 END
 411   $html .= '<TH>Account</TH>' unless $hashref->{svcnum};
 412   $html .= '</TR>';
 413
 414   my $dangerous = $conf->exists('queue_dangerous_controls');
 415
 416   my $areboxes = 0;
 417
 418   foreach my $queue ( sort {
 419     $a->getfield('jobnum') <=> $b->getfield('jobnum')
 420   } @queue ) {
 421     my $queue_hashref = $queue->hashref;
 422     my $jobnum = $queue->jobnum;
 423
 424     my $args;
 425     if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) {
 426       $args = encode_entities( join(' ', $queue->args) );
 427     } else {
 428       $args = '';
 429     }
 430
 431     my $date = time2str( "%a %b %e %T %Y", $queue->_date );
 432     my $status = $queue->status;
 433     $status .= ': '. $queue->statustext if $queue->statustext;
 434     my @queue_depend = $queue->queue_depend;
 435     $status .= ' (waiting for '.
 436                join(', ', map { $_->depend_jobnum } @queue_depend ).
 437                ')'
 438       if @queue_depend;
 439     my $changable = $dangerous
 440          || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ );
 441     if ( $changable ) {
 442       $status .=
 443         qq! (&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A>&nbsp;|!.
 444         qq!&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A>&nbsp;)!;
 445     }
 446     my $cust_svc = $queue->cust_svc;
 447
 448     $html .= <<END;
 449       <TR>
 450         <TD>$jobnum</TD>
 451         <TD>$queue_hashref->{job}</TD>
 452         <TD>$args</TD>
 453         <TD>$date</TD>
 454         <TD>$status</TD>
 455 END
 456
 457     unless ( $hashref->{svcnum} ) {
 458       my $account;
 459       if ( $cust_svc ) {
 460         my $table = $cust_svc->part_svc->svcdb;
 461         my $label = ( $cust_svc->label )[1];
 462         $account = qq!<A HREF="../view/$table.cgi?!. $queue->svcnum.
 463                    qq!">$label</A>!;
 464       } else {
 465         $account = '';
 466       }
 467       $html .= "<TD>$account</TD>";
 468     }
 469
 470     if ( $changable ) {
 471       $areboxes=1;
 472       $html .=
 473         qq!<TD><INPUT NAME="jobnum$jobnum" TYPE="checkbox" VALUE="1"></TD>!;
 474
 475     }
 476
 477     $html .= '</TR>';
 478
 479 }
 480
 481   $html .= '</TABLE>';
 482
 483   if ( $areboxes ) {
 484     $html .= '<BR><INPUT TYPE="submit" NAME="action" VALUE="retry selected">'.
 485              '<INPUT TYPE="submit" NAME="action" VALUE="remove selected"><BR>';
 486   }
 487
 488   $html;
 489
 490 }
 491
 492 =back
 493
 494 =head1 BUGS
 495
 496 $jobnums global
 497
 498 =head1 SEE ALSO
 499
 500 L<FS::Record>, schema.html from the base documentation.
 501
 502 =cut
 503
 504 1;
 505