Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / 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 # not needed in 4
368 #=item access_user
369 #
370 #Returns FS::access_user object (if any) associated with this user.
371 #
372 #Returns nothing if not found.
373 #
374 #=cut
375 #
376 #sub access_user {
377 #  my $self = shift;
378 #  my $usernum = $self->usernum || return ();
379 #  return qsearchs('access_user',{ 'usernum' => $usernum }) || ();
380 #}
381
382 =back
383
384 =head1 SUBROUTINES
385
386 =over 4
387
388 =item joblisting HASHREF NOACTIONS
389
390 =cut
391
392 sub joblisting {
393   my($hashref, $noactions) = @_;
394
395   use Date::Format;
396   use HTML::Entities;
397   use FS::CGI;
398
399   my @queue = qsearch( 'queue', $hashref );
400   return '' unless scalar(@queue);
401
402   my $p = FS::CGI::popurl(2);
403
404   my $html = qq!<FORM ACTION="$p/misc/queue.cgi" METHOD="POST">!.
405              FS::CGI::table(). <<END;
406       <TR>
407         <TH COLSPAN=2>Job</TH>
408         <TH>Args</TH>
409         <TH>Date</TH>
410         <TH>Status</TH>
411 END
412   $html .= '<TH>Account</TH>' unless $hashref->{svcnum};
413   $html .= '</TR>';
414
415   my $dangerous = $conf->exists('queue_dangerous_controls');
416
417   my $areboxes = 0;
418
419   foreach my $queue ( sort { 
420     $a->getfield('jobnum') <=> $b->getfield('jobnum')
421   } @queue ) {
422     my $queue_hashref = $queue->hashref;
423     my $jobnum = $queue->jobnum;
424
425     my $args;
426     if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) {
427       $args = encode_entities( join(' ', $queue->args) );
428     } else {
429       $args = '';
430     }
431
432     my $date = time2str( "%a %b %e %T %Y", $queue->_date );
433     my $status = $queue->status;
434     $status .= ': '. $queue->statustext if $queue->statustext;
435     my @queue_depend = $queue->queue_depend;
436     $status .= ' (waiting for '.
437                join(', ', map { $_->depend_jobnum } @queue_depend ). 
438                ')'
439       if @queue_depend;
440     my $changable = $dangerous
441          || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ );
442     if ( $changable ) {
443       $status .=
444         qq! (&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A>&nbsp;|!.
445         qq!&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A>&nbsp;)!;
446     }
447     my $cust_svc = $queue->cust_svc;
448
449     $html .= <<END;
450       <TR>
451         <TD>$jobnum</TD>
452         <TD>$queue_hashref->{job}</TD>
453         <TD>$args</TD>
454         <TD>$date</TD>
455         <TD>$status</TD>
456 END
457
458     unless ( $hashref->{svcnum} ) {
459       my $account;
460       if ( $cust_svc ) {
461         my $table = $cust_svc->part_svc->svcdb;
462         my $label = ( $cust_svc->label )[1];
463         $account = qq!<A HREF="../view/$table.cgi?!. $queue->svcnum.
464                    qq!">$label</A>!;
465       } else {
466         $account = '';
467       }
468       $html .= "<TD>$account</TD>";
469     }
470
471     if ( $changable ) {
472       $areboxes=1;
473       $html .=
474         qq!<TD><INPUT NAME="jobnum$jobnum" TYPE="checkbox" VALUE="1"></TD>!;
475
476     }
477
478     $html .= '</TR>';
479
480 }
481
482   $html .= '</TABLE>';
483
484   if ( $areboxes ) {
485     $html .= '<BR><INPUT TYPE="submit" NAME="action" VALUE="retry selected">'.
486              '<INPUT TYPE="submit" NAME="action" VALUE="remove selected"><BR>';
487   }
488
489   $html;
490
491 }
492
493 =back
494
495 =head1 BUGS
496
497 $jobnums global
498
499 =head1 SEE ALSO
500
501 L<FS::Record>, schema.html from the base documentation.
502
503 =cut
504
505 1;
506