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