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