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