source: A2P/a2p/A2P/Job.pm @ 3

Last change on this file since 3 was 3, checked in by guillaume, 17 years ago
  • AUTHORS: Ajout des différents contributeurs
  • COPYING: Ajout de la licence GPL v3
  • a2p: Préparation des sources pour leur publication sous GPL
  • Property svn:keywords set to Id
File size: 64.2 KB
Line 
1#
2# Copyright (c) 2004-2007 - Consultas, PKG.fr
3#
4# This file is part of A2P.
5#
6# A2P is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version.
10#
11# A2P is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with A2P; if not, write to the Free Software
18# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19#
20# $Id: Job.pm 3 2007-10-18 16:20:19Z guillaume $
21#
22# Class to implement job object to be tramsmitted between threads
23#
24
25package A2P::Job;
26
27use strict;
28use A2P::Globals ;
29use A2P::Syslog;
30use AFPDS::PCL;
31use Time::HiRes  qw( time gettimeofday tv_interval );
32use A2P::Com   qw( GetCom comJOB comZIP comFILE );
33use A2P::Tools qw( ShortID );
34use A2P::Syslog 'AttachZipToAlertError' ;
35use A2P::JobStatus 'a2pjobstate' ;
36
37BEGIN {
38    our $VERSION = sprintf "%s", q$Rev: 1180 $ =~ /(\d[0-9.]+)\s+/ ;
39}
40our $VERSION ;
41
42my %uniqid = () ;
43
44sub new {
45    my $class  = shift ;
46    my $time = time ; # time is here the Time::HiRes 'time' version
47    my @Date = localtime($time);
48    my $DayTick = ($time - int($time -
49        ( $Date[0] + $Date[1]*60 + $Date[2]*3600 ))) * 193 ;
50
51    my $self = {
52        ERROR   => 0    ,   STEP        => 0        ,   JOBS        => 0    ,
53        START   => time ,   FILE        => ""       ,   STATE       => 0    ,
54        A2PJOB  => ""   ,   PURGE       => 0        ,   PURGETRYOUT => 10   ,
55        JOBDIR  => ""   ,   CANPURGE    => undef    ,   MOVE_CMDS   => undef,
56        ALERTED => undef,   ANSWER      => ""       ,   ERRORS      => []   ,
57                            SEQREADY    => 0        ,   CLIENTREF   => 0    ,
58        NB_CMDS => 0    ,   FILE2MOVE   => 0        , NB_CMDS_CHECK => 0    ,
59        STEPDONE=> 0    ,   NB_CMDS_UNIT=> 0        ,   SEQREMOVED  => 0    ,
60        BIRTH   => time ,   JOBDIR      => "undefined",
61        API_REV => "a2p v".A2P_RPM_VERSION." (".__PACKAGE__." v$VERSION)"
62    };
63    @{$self->{DELETE}} = () ; # List of files to delete without checking them
64    @{$self->{CLEAN}}  = () ; # List of files to check and keep if not empty
65    @{$self->{PDFS}}   = () ; # List of generated PDF files
66    @{$self->{MOVE}}   = () ; # List of files to move
67    @{$self->{INFO}}   = () ; # Keep some info until they are useful
68    $self->{KEEP_INFO} = {} ; # Keep some info for KEEP_DYNAMIC_JOB_LOG option
69    $self->{TIMED_INFO}= [] ;
70    $self->{CLONES}    = [] ; # List of clones as indexed list
71
72    # Initializes print sequence
73    %{$self->{SEQUENCE}} = () ;
74    %{$self->{LPRSEQ}}   = () ;
75    %{$self->{VLPRSEQ}}  = () ;
76
77    # Construct an ID for that job with :
78    # - 1 char for the year: A -> 2005, B -> 2006, etc...
79    # - 3 digits for the year day : 001 to 365
80    # - 1 '-' separator char
81    # - 6 hex digits for a time since midnigh (in ~ 1/193 of sec or ~5.2 ms)
82    # - 1 '-' separator char
83    # - 4 chars to keep a short human friendly identifier
84    if ( @_ ) {
85        $self->{ID}         = shift ;
86        $self->{CLIENTREF}  = shift ;
87        $self->{CLIENTINFO} = [ ] ;
88        # We must check if job is still running before starting it again
89        if (defined($uniqid{$self->{ID}})) {
90            &Warn("Aborting attempt to restart $self->{ID} running job");
91            return 0 ;
92        }
93
94    } else {
95        my $retries = 100 ; # Paranoid just in case
96        my $baseid = sprintf("%c%03D-%06X-", $Date[5]-40 , $Date[7] , $DayTick);
97        my $nameid = '' ;
98        while ((! $nameid or defined($uniqid{$baseid.$nameid})) and $retries ) {
99            $nameid = &ShortID ;
100            $retries -- ;
101        }
102        $self->{ID} = $baseid . $nameid ;
103    }
104
105    # Set uniqueness information
106    $uniqid{$self->{ID}} = 1 ;
107
108    &Debug("new Job object v$VERSION created with ID=" . $self->{ID} .
109        ( $self->{CLIENTREF} ? " for " . $self->{CLIENTREF} : "" ));
110    return bless $self , $class ;
111}
112
113sub newjob {
114    &TIMESTAT('NEW_JOB');
115    my $self  = shift ;
116    my $class = ref($self);
117    my %clone = %{$self} ;
118    my $clone = bless \%clone , $class ;
119
120    # Be sure to not resplit again
121    delete $clone->{'SPLIT_FILE'} if ($self->is_splitted());
122
123    # Compute environment calculated by ControlRecord.pm and given as answer
124    # conversion
125    map {
126        my ( $key , $value );
127        eval q|$clone->{| . $key . q|} = | .
128            ( $value =~ /^\d+$/ ? $value : qq|'$value'| )
129            if ( ( $key , $value ) = m|<env *key=["']?(\w+)["']? *>(.*)$|i )
130    } split( '</env>' , $self->getanswer );
131
132    # Handle split event for JobManager to do the job
133    if (exists($clone->{'SPLIT_FILE'})) {
134        $self->{'SPLIT_TAG'}   = $clone->{'SPLIT_TAG'} ;
135        $self->{'SPLIT_TAG2'}  = $clone->{'SPLIT_TAG2'} ;
136        my ( $prevpos , $nextpos ) = $clone->{'SPLIT_FILE'} =~ /^(\d+):(\d+)$/ ;
137        $self->{'SPLIT_FILE'}  = $nextpos ;
138
139        # Count original AFP with split events
140        &UPSTAT('SPLITTED_AFP') unless ($prevpos);
141
142        # Defined the trigger for the splitter command
143        $self->{'SPLIT_TRIGGER'} = 1 ;
144
145        # Reset step status
146        $self->setanswer('');
147
148        # Save the splitted file at the split only
149        ( $self->{'SPLITTED_FILE'} ) = $self->{'FILE'} =~ m|$LOCKID/[^/]*$| ?
150            $self->{'FILE'} =~ m|($LOCKID/[^/]*)$|
151            :
152            $self->{'FILE'} =~ m|([^/]*)$|
153            unless (defined($self->{'SPLITTED_FILE'})) ;
154
155        my $count_format = '%02d' ;
156
157        # Save tags list and control last one was not used before
158        if (defined($self->{'SPLIT_TAGS'})) {
159            # Control case where TAG are identical (as in auto-split)
160            if ( $self->{'SPLIT_TAG'} eq $self->{'SPLIT_TAG2'} ) {
161                my $count = scalar(keys(%{$self->{'SPLIT_TAGS'}})) ;
162                $self->{'SPLIT_TAG2'} .= sprintf( $count_format, $count ) ;
163            }
164
165            # Replace TAG in case it was previously updated
166            $self->{'SPLIT_TAG'} = $self->{'SPLIT_TAGS'}->{$prevpos}
167                if (exists($self->{'SPLIT_TAGS'}->{$prevpos}));
168
169            # Control TAG2 has not still been set
170            my @tags = values(%{$self->{'SPLIT_TAGS'}}) ;
171            my ( $tag, $ctrl, $iter ) = ( $self->{'SPLIT_TAG2'}, 2, 0 ) ;
172            while ( grep { /^$tag$/ } @tags ) {
173                $tag = $self->{'SPLIT_TAG2'} . '.' . &ShortID($ctrl) ;
174                $ctrl += 2 unless ( ++$iter % 100 );
175            }
176            # Save uniq tag
177            $self->{'SPLIT_TAGS'}->{$nextpos} = $self->{'SPLIT_TAG2'} = $tag ;
178
179        } else {
180            # Control case where TAG are identical (as in auto-split)
181            if ( $self->{'SPLIT_TAG'} eq $self->{'SPLIT_TAG2'} ) {
182                $self->{'SPLIT_TAG'}  .= sprintf( $count_format, 0 ) ;
183                $self->{'SPLIT_TAG2'} .= sprintf( $count_format, 1 ) ;
184            }
185
186            # Initialize known tags list
187            $self->{'SPLIT_TAGS'} = {
188                 $prevpos => $self->{'SPLIT_TAG'},
189                 $nextpos => $self->{'SPLIT_TAG2'}
190                } ;
191
192            # We should also link on AFP name for the first splitted status
193            my $newafp = $self->{'AFPNAME'} . '.' . $self->{'SPLIT_TAG'} ;
194            $self->jobstatus( 'o', {
195                LINKEDAFP => $self->{'AFPNAME'},
196                AFP       => $newafp
197            } )
198                or &Info("Can't initialize '$newafp' status");
199        }
200
201        &TIMESTAT('NEW_JOB');
202        return undef ;
203    }
204
205    &UPSTAT('NEW_JOB');
206
207    # Keep AFPNAME only on A2P job on the first sub job
208    $self->{'AFPNAME'} = $clone->{'AFPNAME'}
209        unless (exists($self->{'AFPNAME'}));
210    delete $clone->{'AFPNAME'} ;
211
212    # This counter is not the real jobs index in AFP file as com don't guaranty
213    # the com from Converter comes here in the right order
214    $self->{JOBS} ++ ;
215    $self->{JOBSTODO} ++ ;
216
217    # OUTFILE is set from environment returned by conversion
218    ( $clone->{PATH} , $clone->{FILE} ) =
219        $clone->{OUTFILE} =~ m|^(.*)/([^/]*)$| ;
220
221    # Set index to the real number of this job
222    my ( $index ) = $clone->{PATH} =~ /AFP-(\d+)$/ ;
223
224    # Keep this index to control splitting event keeping the maximum value
225    $self->{MAX_CLONE_INDEX} = $index
226        unless ( defined($self->{MAX_CLONE_INDEX})
227        and $index < $self->{MAX_CLONE_INDEX} );
228
229    # Initialize my clone
230    (
231        $clone->{ID},
232        $clone->{ANSWER},
233        $clone->{STATE},
234        $clone->{ERROR},
235        $clone->{ERRORS},
236        $clone->{A2PJOB},
237        $clone->{PARENT},
238        $clone->{INDEX}
239    ) = (
240        $self->{ID} . "-" . $index,
241        "", 0, 0, [],
242        $self->{ID},
243        $self,
244        $index
245    );
246
247    # Undef some unused ref in clone
248    undef $clone->{CLONES} ;
249    undef $clone->{CLONES_OBJ} ;
250
251    # Update print sequence when agregating
252    my $destid = $clone->getdestid ;
253    if ( $destid and $AGREGATE_PRINT ) {
254        $self->{SEQUENCE}->{$destid}->[$index-1] = $clone->{ID} ;
255        $self->jobdebug("Job '$clone->{ID}' is the " .
256            scalar(@{$self->{SEQUENCE}->{$destid}}) . " job found for the '" .
257            $destid . "' sequence");
258
259        $self->{LPRSEQ}->{$destid}  = 0
260            unless (defined($self->{LPRSEQ}->{$destid}));
261        $self->{VLPRSEQ}->{$destid} = 0
262            unless (defined($self->{VLPRSEQ}->{$destid}));
263
264        # Decide now if next print is this clone (yes for the first one and
265        # previous clone is still printed after a long conversion or first one
266        # for a new destid)
267        my $next = $self->{SEQUENCE}->{$destid}->[$self->{LPRSEQ}->{$destid}] ;
268        $clone->{DO_LPR_NOW}  = ($next =~ /^$clone->{ID}$/)? 1 : 0 ;
269        $next = $self->{SEQUENCE}->{$destid}->[$self->{VLPRSEQ}->{$destid}] ;
270        $clone->{DO_VLPR_NOW} = ($next =~ /^$clone->{ID}$/)? 1 : 0 ;
271    }
272
273    # Update filename with clone ID to identify file in zip file and avoid
274    # zipping error
275    $clone->{FILE} = $clone->{ID}   . '-' . $clone->{FILE} ;
276
277    # rename files created by afpds2tex
278    foreach my $ext ( 'tex' , 'arch' , 'trayone' , 'traytwo', 'afp' ) {
279        my ( $orig , $dest ) = (
280            $clone->{OUTFILE} . '.' . $ext ,
281            $clone->{PATH} . '/' . $clone->{FILE} . '.' . $ext
282            );
283
284        if ( -e $orig ) {
285            if ( $ext =~ /tray/ ) {
286                link $orig , $dest
287                    or $clone->error(1,"Can't link '$orig' to '$dest': $!");
288                $self->todelete($orig);
289            } else {
290                rename $orig , $dest
291                    or $clone->error(1,"Can't rename '$orig': $!");
292            }
293        }
294
295        $clone->jobdebug("$ext file renamed to '$clone->{FILE}.$ext'")
296            if ( -e $dest );
297
298        # Set files to be cleaned
299        $self->toclean($dest);
300    }
301    $clone->{OUTFILE} = $clone->{PATH} . '/' . $clone->{FILE} ;
302
303    # Handle TOCLEAN environment used for included resource cleaning
304    $clone->toclean(split(/;/,$clone->{'TOCLEAN'}))
305        if ( exists($clone->{'TOCLEAN'}) and $clone->{'TOCLEAN'} );
306
307    # Set E-Service files to clean if present
308    $self->toclean( $clone->{XML_A2P}, $clone->{XML_A2P}.'.stderr',
309         $clone->{XML_CONTENT}, $clone->{PDFFILE} )
310            if (exists($clone->{XML_A2P}));
311
312    # Add folder
313    $self->todelete($clone->{PATH});
314
315    # Also add A2PJob path to delete if not still added, and the Lock file
316    # created by converter
317    $self->todelete(
318        $SHMDIR . '/' . $self->{ID}, $SHMDIR . '/' . $self->{ID} . '.LCK' );
319
320    # Force to do PDF for archivage, just in case it is used with print
321    # and DO_PDF is not set
322    $clone->{DO_PDF} = 'yes' if ( $clone->do_arch and ! $clone->do_pdf );
323
324    # And reset my used answer, keep clone info
325    $self->{ANSWER} = "" ;
326    $self->{CLONES}->[$index] = $clone->{ID} ;
327
328    # Keep a ref to clone
329    $self->{CLONES_OBJ}->{$clone->{ID}} = $clone ;
330
331    &Debug("Job " . $self->{ID} . " cloned to " . $clone->{ID});
332    map { $clone->jobdebug("{$_}='$clone->{$_}'") }
333        qw( ID A2PJOB STEP OUTFILE PATH FILE COPIES );
334
335    $clone->jobinfo( "Processing AFP JOB '$clone->{ID}-$clone->{JOBNAME}'"
336        .($self->getClientRef?" with a2p v" . A2P_RPM_VERSION : "") );
337
338    &TIMESTAT('NEW_JOB');
339    return bless $clone , $class ;
340}
341
342sub error {
343    my $self  = shift ;
344    my $err   = shift ;
345    my $msg   = shift || "" ;
346
347    if (defined($err)) {
348        my ($package, $filename, $line) = caller;
349        $self->{ERROR} = $err ? $err : 2 ;
350
351        unless (exists($self->{STEPERROR}) and exists($self->{INFOERROR})) {
352            $self->{STEPERROR} = $self->{STEP}
353                unless (exists($self->{STEPERROR}));
354
355            # Update job state only on the first error
356            my $status = $msg ? { STATUS => 'ABTERM', ABTERM => $msg } : {} ;
357            # Extract ABTERM information from message
358            $self->{INFOERROR} = $status->{INFOS} = $1
359                if ( ! exists($self->{INFOERROR})
360                and $msg =~ /^ABTERM:\s+(.*)$/ );
361            $status->{STATUS} = 'KO' if ($self->geta2pjob and $msg);
362            $self->jobstatus( 'A', $status )
363                or &Info("Can't set job error status at step " . $self->{STEP});
364            my $parent = $self->a2pobj ;
365            if ( $parent and $self->{INFOERROR} and ! $parent->{INFOERROR} ) {
366                $parent->{INFOERROR} = $self->{INFOERROR} ;
367                $parent->jobstatus( 'A', $status )
368                    or &Info("Can't set job error status on parent status");
369            }
370        }
371
372        push @{$self->{ERRORS}} , $msg if $msg ;
373
374        my $error = "Error $self->{ERROR} set on Job " . $self->getid() .
375            " at step $self->{STEP}, from L.$line in $package" .
376            ( $msg ? ": $msg" : "" );
377
378        &Error($error);
379        push @{$self->{CLIENTINFO}} , $error if ($self->{CLIENTREF});
380
381        # Update a2pjob to stop our sequence
382        if ( $AGREGATE_PRINT and $err > 700 and my $a2pjob = $self->a2pobj ) {
383            $a2pjob->{$self->getdestid() . '-ERROR'} = 1 ;
384        }
385
386        # Stop any more processing
387        map { $self->{$_} = "no" }
388            qw(DO_PDF DO_PCL DO_PS DO_LPR DO_VLPR DO_ARCH DO_ESERVICE);
389    }
390    return $self->{ERROR} ;
391}
392
393sub setconversionerrorcleaning {
394    # Just update files and folders to clean in shared memory
395    my $self  = shift ;
396
397    my @files = glob( "$self->{JOBDIR}/*" );
398    $self->jobdebug("Setting to clean @files");
399    while (@files) {
400        my $file = shift @files ;
401
402        if (-d $file) {
403            $self->todelete($file);
404            my @newfiles = glob( "$file/*" ) ;
405            $self->jobdebug("Setting to clean @newfiles");
406            push @files, @newfiles ;
407
408        } else {
409            $self->toclean($file);
410        }
411    }
412}
413
414sub badagregation {
415    my $self  = shift ;
416    return 0 unless $AGREGATE_PRINT ;
417    my $a2pjob = $self->a2pobj ;
418    return 0 unless ( $a2pjob );
419    my $key = $self->getdestid() . '-ERROR' ;
420    return ( defined($a2pjob->{$key}) and $a2pjob->{$key} );
421}
422
423sub geterrors {
424    return defined($_[0]->{ERRORS}) ? @{$_[0]->{ERRORS}} : () ;
425}
426
427sub getsteperror {
428    return $_[0]->{STEPERROR} ;
429}
430
431sub start_ms {
432    my $self  = shift ;
433    $self->{START} = time ;
434    $self->{STEPDONE} = 0 ;
435
436    # Update status only at step higher than 2 as jobstatus is initialized
437    # only at step 2 and directly from afpds2tex.pm
438    if ( $self->{STEP} > 2 ) {
439        my $step = $self->{STEP} + 1 ;
440        # Update job state in spool
441        $self->jobstatus( '_', { STATUS=>"RUNNING" })
442            or &Info("Can't set job status at step $step");
443    }
444
445    1 ;
446}
447
448sub get_ms {
449    return  ( time - $_[0]->{START} ) * 1000 ;
450}
451
452sub get_delay {
453    return  sprintf("%.1f ms", ( time - $_[0]->{BIRTH} ) * 1000 );
454}
455
456sub stop_ms {
457    $_[0]->jobinfo("Processed in " . sprintf("%.1f ms",$_[0]->get_ms()) );
458}
459
460sub getpurgetry {
461    return $_[0]->{PURGETRYOUT} -- ;
462}
463
464sub isstep {
465    return $_[0]->{STEP} == $_[1] ;
466}
467
468sub getstep {
469    return $_[0]->{STEP} ;
470}
471
472sub getid {
473    return $_[0]->{ID} ;
474}
475
476sub getindex {
477    return $_[0]->{INDEX} ;
478}
479
480sub getdestid {
481    # DESTID is not defined when just archiving
482    return defined($_[0]->{DESTID}) ? $_[0]->{DESTID} : "" ;
483}
484
485sub getjobname {
486    # JOBNAME is only defined for cloned job
487    return defined($_[0]->{JOBNAME}) ? $_[0]->{JOBNAME} : "" ;
488}
489
490sub printer {
491    $_[0]->{LPROPT} =~ /-P(\S*)/ if (defined($_[0]->{LPROPT}));
492    return defined($1) ? $1 : "oups... none" ;
493}
494
495sub vprinter {
496    $_[0]->{VLPROPT} =~ /-P(\S*)/ if (defined($_[0]->{VLPROPT}));
497    return defined($1) ? $1 : "oups... none" ;
498}
499
500sub getfile {
501    return $_[0]->{FILE} ;
502}
503
504sub getfilestart {
505    return $_[0]->{STARTPOSFILE} || 0 ;
506}
507
508sub toconverter {
509    my $self = shift ;
510    my $startpoint = $self->getfilestart ? ':' . $self->getfilestart : '' ;
511    return $self->request( $self->getfile . $startpoint ) ;
512}
513
514sub getstatistics {
515    my $self  = shift ;
516    my @stats = ( $self->getid(), $self->getdestid() ) ;
517    if ($self->geta2pjob()) {
518        # Return stats of a clone
519        push @stats, $self->getstate == DONE ? "OK" : "KO", "" ;
520
521    } else {
522        # Return stats of an A2P job
523        push @stats, "", $self->getstate == DONE ? "OK" : "KO" ;
524    }
525    push @stats, scalar(@{$self->{ERRORS}}), $self->get_delay, $LOCKID ;
526
527    # Compute job real timing but check it is not concerned by a drift between
528    # clock on NFS server (if used) and local clock
529    if (defined($self->{MTIME})) {
530        my $time = time ;
531        if ($time > $self->{MTIME}) {
532            my $timing = time - $self->{MTIME} ;
533            push @stats, sprintf("%.1f s", $timing );
534            my $index = int(int($timing)/10) ;
535            &UPSTAT('STATISTICS-TIMING-'.$index.'0-'.(++$index).'0s');
536
537        } else {
538            &Info("Can't compute job timing as it seems newer than now");
539            push @stats, "BADCLOCK" ;
540            &UPSTAT('BAD-STATISTICS-TIMING');
541        }
542    }
543
544    return @stats ;
545}
546
547sub getstate {
548    # After cleanning we count total number of errors
549    return ( $_[0]->isstep(11) and defined($_[0]->{CLEAN_CMD}) )?
550        ( grep { $_ != DONE } @{$_[0]->{CLEAN_CMD}} or DONE ) : $_[0]->{STATE} ;
551}
552
553sub getClientRef {
554    return $_[0]->{CLIENTREF} ;
555}
556
557sub unsetClientRef {
558    $_[0]->{CLIENTREF} = 0 ;
559    1 ;
560}
561
562sub getanswer {
563    return $_[0]->{ANSWER} ;
564}
565
566sub geta2pjob {
567    return $_[0]->{A2PJOB} ;
568}
569
570sub a2pobj {
571    my $self = shift;
572    return defined($self->{PARENT}) ? $self->{PARENT} : 0 ;
573}
574
575sub nomorejob {
576    return $_[0]->{JOBSTODO} ? 0 : 1 ;
577}
578
579sub getclone {
580    my $self = shift;
581    my $id   = shift;
582    return defined($self->{CLONES_OBJ}->{$id}) ?
583        $self->{CLONES_OBJ}->{$id} : 0 ;
584}
585
586sub getallclones {
587    my $self = shift;
588    return () unless (defined($self->{CLONES}));
589
590    # Returns every clones finished or not
591    return map { ref($_) ? $$_ : $_ } grep { defined } @{$self->{CLONES}} ;
592}
593
594sub getclones {
595    my $self = shift;
596    return () unless (defined($self->{CLONES}));
597
598    # Returns only not finished clones
599    return grep { defined and ! ref($_) } @{$self->{CLONES}} ;
600}
601
602sub getfinishedclones {
603    my $self = shift ;
604    return () unless (defined($self->{CLONES}));
605
606    # Returns finished clones
607    # When not finished, the ref is empty so it not selected, but when one is
608    # is finished, it is replaced by a scalar ref to the clone ID
609    return map { $$_ } grep { defined and ref($_) } @{$self->{CLONES}} ;
610}
611
612sub get2delete {
613    my $self = shift;
614    return $self->getfromlist('DELETE');
615}
616
617sub get2clean {
618    my $self = shift;
619    return $self->getfromlist('CLEAN');
620}
621
622sub get2move {
623    my $self = shift;
624    return $self->getfromlist('MOVE');
625}
626
627sub getfromlist {
628    my $self = shift ;
629    $self->{$_[0].'HASH'} = {} unless (defined($self->{$_[0].'HASH'}));
630    return @{$self->{$_[0]}} = keys(%{$self->{$_[0].'HASH'}});
631}
632
633sub addtomyarray {
634    my $self = shift ;
635    my $key  = shift ;
636    map { $self->{$key.'HASH'}->{$_} = 1 } @_ ;
637}
638
639sub todelete {
640    my $self = shift ;
641    $self->addtomyarray('DELETE',@_);
642}
643
644sub toclean {
645    my $self = shift ;
646    $self->addtomyarray('CLEAN',@_);
647}
648
649sub tomove {
650    my $self = shift ;
651    $self->addtomyarray('MOVE',@_);
652}
653
654sub do_move_cmd {
655    my $self = shift ;
656    # Return move commands list size if still passed in move_files_cmd member
657    return scalar(@{$self->{MOVE_CMDS}}) if (defined($self->{MOVE_CMDS}));
658
659    # Then should check if we need to move file
660    return $self->{FILE2MOVE} if ( $self->{FILE2MOVE} );
661
662    # To avoid keeping previous step status
663    $self->{STATE} = DONE ;
664
665    $self->{FILE2MOVE} = grep { -e $_ and -f $_ } $self->get2move ;
666    return $self->{FILE2MOVE} ;
667}
668
669sub move_files_cmd {
670    my $self = shift ;
671
672    # Return cached move command
673    return shift(@{$self->{MOVE_CMDS}}) if (defined($self->{MOVE_CMDS}));
674
675    if ( ! -d $self->{JOBDIR} ) {
676        $self->error(8,"Job dir not set, won't move anything");
677        return undef ;
678    }
679
680    my $dest = $self->error ? $ERRORSPOOL : $DONESPOOL ;
681    my $output = $self->{JOBDIR} . "/mv_commands.output" ;
682    $self->toclean( $output );
683
684    # Cached move commands
685    @{$self->{MOVE_CMDS}} = map {
686        $self->request( "mv -f $_ $dest >>$output 2>&1" ) }
687            ( grep { -e $_ and -f $_ } $self->get2move );
688
689    # Keep commands number to initialize step 11 progression
690    $self->{NB_CMDS} = scalar(@{$self->{MOVE_CMDS}});
691
692    return shift(@{$self->{MOVE_CMDS}}) ;
693}
694
695sub setstep {
696    return $_[0]->{STEP} = $_[1] ;
697}
698
699sub setfile {
700    return $_[0]->{FILE} = $_[1] ;
701}
702
703sub setstartpos {
704    return $_[0]->{STARTPOSFILE} = $_[1] ;
705}
706
707sub setjobdir {
708    my $self  = shift ;
709
710    return if ( $self->{JOBDIR} and -d $self->{JOBDIR} );
711
712    # When must set this only one time
713    $self->{JOBDIR} = $_[0] ;
714    $self->jobdebug("Jobdir folder is set to " . $self->{JOBDIR});
715
716    # Don't forget to delete LCK file
717    $self->todelete($_[0], $_[0] . '.LCK');
718}
719
720sub setstate  {
721    my $self  = shift ;
722    my $state = shift ;
723
724    if ( $self->isstep(11) and defined($_[0]->{CLEAN_CMD}) ) {
725        # When cleaning, we can received a state DONE after a bad STATE so keep
726        push @{$self->{CLEAN_CMD}} , $state ;
727
728    } else {
729        $self->{STATE} = $state ;
730    }
731    $self->jobdebug("Setting state to " .
732        ( defined($means{$state}) ? $means{$state} : "'$state'" ));
733}
734
735sub jobdone {
736    my $self  = shift ;
737    my $clone = shift ;
738    -- $self->{JOBSTODO} ;
739
740    # Replace ID in list by a ref to ID to set it done
741    my $CLONE_ID = $clone->getid ;
742    $self->{CLONES}->[$clone->getindex] = \$CLONE_ID ;
743
744    # Keep clone info in parent
745    $self->mergeinfo( $CLONE_ID )
746        if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 0 );
747}
748
749sub clearjobsdone {
750    my $self  = shift ;
751
752    # Keep internal statistics which can be correlated to diagnostics tests
753    &UPSTAT('JOB-NBJOBS-'.$self->getallclones.'-'.
754        ($self->getstate == DONE ? "DONE" : "ERROR-".$self->error)) ;
755
756    # Deleting last references to clone objects
757    delete $self->{CLONES_OBJ} unless ($self->error);
758}
759
760sub stepnotdone {
761    return $_[0]->{STEPDONE} ? 0 : 1 ;
762}
763
764sub stepdone {
765    my $self = shift ;
766    my $ret  = 1 ;
767    my $step = $self->{STEP} ;
768
769    $self->{STEPDONE} = 1 ;
770
771    my $info = { STATUS => 'STEPDONE', INFOS => '' } ;
772    if ( $step == 10 and ! $self->geta2pjob ) {
773        # Step 10 finished for main job, about to do cleaning
774        $info->{INFOS} = 'Cleaning' ;
775
776    } elsif ( $step == 12 ) {
777        $info->{STATUS} = 'DONE' ;
778        $info->{INFOS}  = $self->cancelled ? 'Cancelled' : 'Stopped' ;
779    }
780
781    delete $info->{INFOS} if (exists($self->{STEPERROR}));
782
783    # Update status to STEPDONE for clone only before step 10
784    # Step 10 status is updated directly by Archiver or E-Service
785    $self->jobstatus( 'o', $info ) unless ( $self->geta2pjob and $step < 10 );
786
787    $ret or &Info("Can't set job done status at step $step");
788}
789
790sub stepskip {
791    my $self = shift ;
792
793    $self->nextstep(@_);
794}
795
796sub setanswer {
797    $_[0]->{ANSWER} = $_[1];
798    $_[0]->jobdebug("Received \"$_[1]\" answer");
799}
800
801sub is_not_abterm {
802    return defined($_[0]->{ALERTED}) ? 0 : 1 ;
803}
804
805sub jobdump {
806    my $Job = shift ;
807    return ( "
808
809############################# JOB DUMP ####################################
810Job $Job object dump:" , eval 'use Data::Dumper ; Dumper($Job)' ) ;
811}
812
813sub jobalert {
814    my $self = shift ;
815    return unless ( $self->error or $JOB_DUMP_ON_ERROR );
816    return if (defined($self->{ALERTED}));
817
818    my @Alerts = @_ ? @_ : ( "ABTERM: Job " . $self->getid ,
819        "ABTERM: Job $self->{ID} is in errors:",
820        $self->geterrors );
821
822    if ($self->{CLIENTREF}) {
823        push @{$self->{CLIENTINFO}} , @Alerts ;
824        &AlertError( @Alerts );
825
826    } else {
827        push @Alerts, $self->jobdump
828            if ($JOB_DUMP_ON_ERROR);
829
830        &AttachZipToAlertError($self->{ZIPFILE})
831            if (defined($self->{ZIPFILE}) and $JOIN_ZIP_ON_ERROR);
832        &Alert( @Alerts );
833    }
834
835    $self->{ALERTED} = 1 ;
836}
837
838sub keepinfo {
839    # We can keep last info on a timed keys hash to only keep most recent
840    my $self = shift ;
841    my $time = sprintf("%.3f",time);
842    $self->{KEEP_INFO}->{$time} =
843        [ map { $self->{ID} . '@step' . $self->{STEP} . ': ' . $_ } @{$_[0]} ];
844
845    while ( @{$self->{TIMED_INFO}} and @{$self->{TIMED_INFO}} > $MAX_BACKLOG ) {
846        my $timeshift = shift @{$self->{TIMED_INFO}} ;
847        delete $self->{KEEP_INFO}->{$timeshift} ;
848    }
849
850    push @{$self->{TIMED_INFO}}, $time ;
851}
852
853sub mergeinfo {
854&TIMESTAT('mergeinfo');
855
856    # Merge info from clone in parent: we can delete info in clone
857    # at the same time
858    my $self  = shift ;
859    my $clone = shift ;
860
861    # Clone can be deleted during unrecoverable error
862    return unless ($self->getclone($clone));
863
864    # Replace clone name by the object
865    my $clone = $self->getclone($clone) ;
866    my @time_imported = @{$clone->{TIMED_INFO}} ;
867    $clone->{TIMED_INFO} = [] ;
868    my $hashref = $clone->{KEEP_INFO} ;
869
870    foreach my $time ( @time_imported ) {
871        if (defined($self->{KEEP_INFO}->{$time})) {
872
873            # First check we are not getting a known info
874            unless ( $hashref->{$time} == $self->{KEEP_INFO}->{$time} ) {
875                push @{$self->{KEEP_INFO}->{$time}}, @{$hashref->{$time}};
876            }
877
878        } elsif ( $time > $self->{TIMED_INFO}->[0] ) {
879            shift @{$self->{TIMED_INFO}}
880                unless ( @{$self->{TIMED_INFO}} < $MAX_BACKLOG );
881
882            $self->{KEEP_INFO}->{$time} = $hashref->{$time} ;
883            if ( $time > $self->{TIMED_INFO}->[$#{$self->{TIMED_INFO}}] ) {
884                push @{$self->{TIMED_INFO}}, $time ;
885
886            } else {
887                # Here we need to insert so, just resort used keys... this could
888                # be time consuming ?
889                $self->{TIMED_INFO} = [
890                    sort(keys(%{$self->{KEEP_INFO}->{$time}}))
891                    ] ;
892            }
893        }
894        # Then erase the ref in clone
895        delete $hashref->{$time} ;
896    }
897
898    # Finally erase the keep_info hash ref in clone
899    delete $clone->{KEEP_INFO} ;
900
901&TIMESTAT('mergeinfo');
902}
903
904sub jobinfo {
905    my $self = shift ;
906    return unless (defined($_[0]));
907    $self->{LAST_INFO} = [ @_ ] ; # Just to keep a trace in dumped object
908
909    $self->keepinfo( \@_ )
910        if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 0 );
911
912    my $info = $self->{ID} .
913        ( $self->{STEP} ? ": Step " . $self->{STEP} : "" ) . ", " . $_[0] ;
914
915    if ( $self->{STEP} < 2 ) {
916        push @{$self->{INFO}}, $info ;
917
918    } else {
919        push @{$self->{CLIENTINFO}} , $info if ($self->{CLIENTREF});
920        &Info( $info );
921    }
922}
923
924sub releaseinfo {
925    # Don't release info if info is not interesting, but release if debugging
926    return if ( $NO_SYSLOG_DEBUG and $_[0]->{STATE} == NOMOREFILE );
927    &Info( @{$_[0]->{INFO}} );
928    push @{$_[0]->{CLIENTINFO}} , @{$_[0]->{INFO}} if ($_[0]->{CLIENTREF});
929    undef $_[0]->{INFO} ;
930}
931
932sub jobdebug {
933    my $self = shift ;
934    return unless @_ ;
935    $self->{LAST_DEBUG} = [ @_ ] ; # Just to keep a trace in dumped object
936
937    $self->keepinfo( \@_ )
938        if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 1 );
939
940    return if ( $NO_SYSLOG_DEBUG );
941
942    my @sub = caller(1);
943    my ( $sub ) = $sub[3] =~ /^.*::([^:]*)$/ ;
944    return if ( $sub and $NODEBUG_SUB_LIST =~ /$sub/ );
945
946    local $" = '' ;
947    &Debug($self->getid . ": Step $self->{STEP}, $sub, L.$sub[2], @_");
948}
949
950sub getClientInfo {
951    my $self = shift ;
952    # Return nothing unless is client request and at least one info is in buffer
953    return () unless ( $self->{CLIENTREF} and @{$self->{CLIENTINFO}} );
954
955    my @info = ( $self->{CLIENTREF} );
956    push @info , @{$self->{CLIENTINFO}} ;
957    @{$self->{CLIENTINFO}} = () ;
958    return @info ;
959}
960
961sub nextstep {
962    my $self = shift ;
963
964    ++ $self->{STEP} ;
965    $self->jobinfo($_[0]) if @_ ;
966}
967
968sub do_pdf {
969    return defined($_[0]->{DO_PDF})?
970        ( $_[0]->{DO_PDF}  =~ /^yes$/i ? 1 : 0 ) : 0 ;
971}
972
973sub do_ps {
974    return defined($_[0]->{DO_PS})?
975        ( $_[0]->{DO_PS}   =~ /^yes$/i ? 1 : 0 ) : 0 ;
976}
977
978# $PARALLELE_VALIDATION flag can be 0, 1 or 2
979# 0 => No validation
980# 1 => Validation duplication
981# 2 => Only validation
982sub do_pcl {
983    my $self = shift ;
984    if (defined($self->{DO_PCL})) {
985        return 1
986            if ( $self->{DO_PCL} =~ /^yes$/i and $PARALLELE_VALIDATION < 2 );
987    }
988    return 0 ;
989}
990
991sub do_vpcl {
992    my $self = shift ;
993    if (defined($self->{DO_PCL})) {
994        return 1 if ( $self->{DO_PCL} =~ /^yes$/i and $PARALLELE_VALIDATION );
995    }
996    return 0 ;
997}
998
999sub do_lpr {
1000    my $self = shift ;
1001    my $ref  = shift ;
1002    if ( defined($self->{DO_LPR}) and ! $DONT_PRINT
1003            and (defined($self->{DO_LPR_NOW}) or ! $AGREGATE_PRINT)) {
1004        if (defined($ref)) {
1005            # Checking sequence processing
1006            if ( $self->{DO_LPR} =~ /^yes$/i and $PARALLELE_VALIDATION < 2 ) {
1007
1008                return $self->{DO_LPR} = 1 unless $AGREGATE_PRINT ;
1009
1010                # Default to waiting sequence is ready
1011                $$ref = 1 ;
1012
1013                # We must wait until sequence is ready (essentially we are
1014                # knowing every thing about cloned jobs to set sequence
1015                # correctly)
1016                if ($self->sequence_ready()) {
1017                    # Check we can print now saving last check value as control
1018                    if ($self->{LAST_CHECK} = $self->{DO_LPR_NOW}) {
1019                        return $self->{DO_LPR} = 1 ;
1020
1021                    } else {
1022                        return 0 ;
1023                    }
1024
1025                } else {
1026                    return $self->{LAST_CHECK} = 0 ;
1027                }
1028
1029            } else {
1030                # No print required
1031                return $self->{DO_LPR} = 0 ;
1032            }
1033
1034        } else {
1035            # Checking step processing
1036            return $self->{DO_LPR} ;
1037        }
1038    }
1039    return $self->{LAST_DEFAULT} = 0 ;
1040}
1041
1042sub do_vlpr {
1043    my $self = shift ;
1044    my $ref  = shift ;
1045    if ( defined($self->{DO_VLPR}) and ! $DONT_PRINT
1046    and defined($self->{DO_VLPR_NOW})) {
1047        if (defined($ref)) {
1048            if ( $self->{DO_VLPR} =~ /^yes$/i and $PARALLELE_VALIDATION ) {
1049
1050                return $self->{DO_VLPR} = 1 unless $AGREGATE_PRINT ;
1051
1052                $$ref = 1 ;
1053                if ($self->sequence_ready()) {
1054                    if ($self->{LAST_CHECK} = $self->{DO_VLPR_NOW}) {
1055                        return $self->{DO_VLPR} = 1 ;
1056
1057                    } else {
1058                        return 0 ;
1059                    }
1060
1061                } else {
1062                    return $self->{LAST_CHECK} = 0 ;
1063                }
1064
1065            } else {
1066                return $self->{DO_VLPR} = 0 ;
1067            }
1068
1069        } else {
1070            return $self->{DO_VLPR} ;
1071        }
1072    }
1073    return 0 ;
1074}
1075
1076sub waiting {
1077    my $self = shift ;
1078    return @_ ? $self->{WAITING} = shift : $self->{WAITING} ;
1079}
1080
1081sub sequence_ready {
1082    # Set agregation count down to the total number of print with correction
1083    my $self = shift ;
1084    return 0 unless $AGREGATE_PRINT ;
1085
1086    # Returns checked value to avoid concurrencing that involves first job will
1087    # waiting in place of starting its own sequence
1088    if ( $self->{SEQREADY} ) {
1089        my $ready = 1 ;
1090        if (defined($self->{LAST_CHECK})) {
1091            $ready = $self->{LAST_CHECK} ;
1092            delete $self->{LAST_CHECK} ;
1093        }
1094        return $ready ;
1095    }
1096
1097    unless ( $self->geta2pjob() ) {
1098        my @count = grep { -d $_ } glob( $self->{JOBDIR} . "/AFP-*" );
1099        return $self->{AGREGATION_COUNT} = @count ;
1100    }
1101
1102    my $a2pjob ;
1103    return 0 unless ( $a2pjob = $self->a2pobj );
1104    # Return higher cache state
1105    return $self->{SEQREADY} = 1 if ( $a2pjob->{SEQREADY} );
1106
1107    # Here we must completly update the sequence arrays when we are
1108    # knowing every things of jobs
1109    return 0 unless (defined($a2pjob->{AGREGATION_COUNT}) and
1110        $a2pjob->{AGREGATION_COUNT} == $a2pjob->{JOBS} + $a2pjob->{SEQREMOVED});
1111
1112    # Here we are sure sequence arrays should be completed, but they can exist
1113    # with holes if more than one destid is used, we should come here only one
1114    # time, so don't forget to check every sequence dependant variables
1115    my $control = 0 ;
1116    foreach my $destid (keys(%{$a2pjob->{SEQUENCE}})) {
1117        @{$a2pjob->{SEQUENCE}->{$destid}} =
1118            grep { defined($_) and $_ } @{$a2pjob->{SEQUENCE}->{$destid}} ;
1119        $control += @{$a2pjob->{SEQUENCE}->{$destid}} ;
1120
1121        # Check current first clones in the sequences will start the sequence
1122        my $seqindex = $a2pjob->{LPRSEQ}->{$destid} ;
1123        my $cloneid = $a2pjob->{SEQUENCE}->{$destid}->[$seqindex] ;
1124        my $clone = $a2pjob->getclone($cloneid) ;
1125        $clone->{DO_LPR_NOW} = 1 ;
1126
1127        $seqindex = $a2pjob->{VLPRSEQ}->{$destid} ;
1128        $cloneid = $a2pjob->{SEQUENCE}->{$destid}->[$seqindex] ;
1129        $clone = $a2pjob->getclone($cloneid) ;
1130        $clone->{DO_VLPR_NOW} = 1 ;
1131    }
1132
1133    $self->error(846,"Can't compute the sequence for this job ")
1134        unless ( $control == $a2pjob->{JOBS} );
1135
1136    $a2pjob->{SEQREADY} = 1 ;
1137    $self->{SEQREADY} = 1 ;
1138    return 0 ;
1139    # Return 0 to force the Job to not be waiting, as the SEQREADY
1140    # is cached, it will be processed very soon
1141}
1142
1143sub next_is_waiting {
1144    my $self = shift ;
1145    my $next = $self->next_in_sequence ;
1146    return 0 unless $next ;
1147
1148    my $a2pjob ;
1149    return 0 unless ( $a2pjob = $self->a2pobj );
1150
1151    my $clone ;
1152    return 0 unless ( $clone = $a2pjob->getclone($next) );
1153    return $clone->{WAITING} ;
1154}
1155
1156sub remove_from_sequence_but_authorize_next {
1157    # Only called in case of error. We must adapt the authorization sequence
1158    # and if we must authorize next job in the sequence
1159    my $self = shift ;
1160
1161    # Really needed if a destid is defined
1162    my $destid = $self->getdestid
1163        or return 0 ;
1164
1165    my $a2pjob ;
1166    return 0 unless ( $a2pjob = $self->a2pobj );
1167
1168    # Check if this job is the next waited
1169    my $next = $self->{STEP} < 9 ?
1170        $a2pjob->{LPRSEQ}->{$destid} : $a2pjob->{VLPRSEQ}->{$destid} ;
1171    $self->jobdebug("Current next job in the sequence has the index $next.");
1172
1173    # Check which job is the next in the sequence
1174    my $ref = $a2pjob->{SEQUENCE}->{$destid} ;
1175    my ( $myid, $nextid ) = ( $self->getid, $ref->[$next] ) ;
1176
1177    # Remove this one from the sequence
1178    unless (defined($self->{ISSEQREMOVED})) {
1179        # Purging list from our id
1180        my $jobid = "" ;
1181        my @temp = () ;
1182        while ( @{$ref} ) {
1183            $jobid = pop @{$ref};
1184            last if ( $jobid eq $myid and $self->{ISSEQREMOVED} = 1 );
1185            unshift @temp , $jobid ;
1186        }
1187        push @{$ref}, @temp if @temp ;
1188
1189        # This job is removed and can't be counted later if sequence is still
1190        # not ready
1191        $a2pjob->{JOBS} -- ;
1192        $a2pjob->{SEQREMOVED} ++ ;
1193
1194        # Last check and message, just in case
1195        if ( $jobid eq $myid ) {
1196            $self->jobinfo("$myid removed from $destid print sequence");
1197
1198        } else {
1199            $self->error($self->getstep()*111,
1200                "Can't remove '$myid' from printing sequence ($jobid;@temp)");
1201        }
1202    }
1203
1204    # Return true to still authorize the next if we were the next expected
1205    return ( $myid eq $nextid ) ? 1 : 0 ;
1206}
1207
1208sub next_in_sequence {
1209    my $self = shift ;
1210    return 0 unless $AGREGATE_PRINT ;
1211    my $key  = $self->getid() . '-SEQNEXTID' ;
1212
1213    my $a2pjob ;
1214    return $self->{$key} = "" unless ( $a2pjob = $self->a2pobj );
1215
1216    # Return eventually cached value if not in error
1217    my $clone = $a2pjob->getclone($self->{$key});
1218    return $self->{$key}
1219        if (defined($self->{$key}) and $clone and ! $clone->error );
1220
1221    my $nextid = "" ;
1222    my $destid = $self->getdestid ;
1223    return $self->{$key} = "" unless $destid ;
1224
1225    my $next = $self->{STEP} < 9 ?
1226        $a2pjob->{LPRSEQ}->{$destid} : $a2pjob->{VLPRSEQ}->{$destid} ;
1227    $self->jobdebug("The next job in the sequence has the index $next.");
1228
1229    my $ref = $a2pjob->{SEQUENCE}->{$destid} ;
1230    if (defined($ref) and $next < @{$ref} ) {
1231        $nextid = $ref->[$next] ;
1232        $self->jobdebug("The job $next in the sequence is '$nextid'");
1233        # Get next id in sequence if it's still our
1234        if ( $self->getid =~ /^$nextid$/ ) {
1235            if ( ++$next < @{$ref} ) {
1236                $nextid = $ref->[$next] ;
1237            } else {
1238                $nextid = "" ;
1239            }
1240        }
1241    }
1242    $self->jobdebug($nextid?"The job after me is '$nextid'":"No job after me");
1243    return $self->{$key} = $nextid ;
1244}
1245
1246sub get_authorization_key {
1247    my $self = shift ;
1248    return $self->getid() . '-NEXT-AUTHORIZED-' . $self->{STEP} ;
1249}
1250
1251sub get_next_authorized {
1252    my $self = shift ;
1253    my $key  = $self->get_authorization_key ;
1254    return defined($self->{$key}) ? $self->{$key} : "" ;
1255}
1256
1257sub authorize_next_print {
1258    my $self = shift ;
1259    my $key  = $self->get_authorization_key ;
1260
1261    # We can only authorize one time
1262    return "" if (defined($self->{$key}));
1263
1264    # Nothing to authorize if destid is not set
1265    my $destid = $self->getdestid ;
1266    return $self->{$key} = "" unless $destid ;
1267
1268    my $a2pjob ;
1269    return $self->{$key} = "" unless ( $a2pjob = $self->a2pobj );
1270
1271    # Update sequence index
1272    my $next = $self->{STEP} < 9 ?
1273        ++ $a2pjob->{LPRSEQ}->{$destid}
1274        :
1275        ++ $a2pjob->{VLPRSEQ}->{$destid} ;
1276
1277    $self->jobdebug("Will authorize job $next in the sequence");
1278
1279    # Get next jobid in sequence to autorize unless at the end of sequence
1280    my $nextid = $self->next_in_sequence ;
1281    if ( $nextid ) {
1282        my $clone ;
1283        if ( $clone = $a2pjob->getclone($nextid) ) {
1284            $self->jobdebug("Authorizing '$nextid' to print");
1285            $clone->authorize_print($self->{STEP});
1286            # Return next id caching it for next call if still not cached
1287            return $self->{$key} = $nextid ;
1288
1289        } else {
1290            $self->error(9,"Can't authorize '$nextid' to print, no such job");
1291        }
1292
1293    } elsif (defined($a2pjob->{SEQUENCE}->{$destid})) {
1294        $self->jobdebug("No print to authorize as this is the end of sequence");
1295
1296    } else {
1297        $self->error(10,"No sequence found for destid '$destid'");
1298    }
1299
1300    return $self->{$key} = "" ;
1301}
1302
1303sub authorize_print {
1304    my $self = shift ;
1305    # We must be authorized at the same step from the previous job
1306    my $step = shift ;
1307    $self->jobdebug("Authorized to print at step $step");
1308    $self->{ $step < 9 ? 'DO_LPR_NOW' : 'DO_VLPR_NOW' } = 1 ;
1309}
1310
1311sub do_arch {
1312    my $self = shift ;
1313    my $test = defined($self->{DO_ARCH}) ?
1314        ( $self->{DO_ARCH} =~ /^yes$/i ? 1 : 0 ) : 0 ;
1315    $self->error(10,"ABTERM: Archivage requested but not activated in service")
1316        if ( $test and ! $ARCH_ENABLED );
1317    return $ARCH_ENABLED ? $test : 0 ;
1318}
1319
1320sub do_eservice {
1321    my $self = shift ;
1322    my $test = defined($self->{DO_ESERVICE}) ?
1323        ( $self->{DO_ESERVICE} =~ /^yes$/i ? 1 : 0 ) : 0 ;
1324
1325    if ( $test ) {
1326        if ( $ESERVICE_ENABLED ) {
1327            # At this stage we can return disabling DO_ARCH
1328            return $self->{DO_ARCH} = 'reset for e-service' ;
1329
1330        } else {
1331            $self->error( 10,
1332                "ABTERM: E-Service requested but not activated in service" );
1333        }
1334    }
1335    return 0 ;
1336}
1337
1338sub getPdfName {
1339    my $self = shift ;
1340    if ( defined($self->{PDFFILE}) and $self->{PDFFILE} ) {
1341        $self->{PDFFILE} =~ m|([^/]+)$| ;
1342        return $1 ;
1343    }
1344    return $LOCKID . '-' . $self->{ID} . '_' . $self->{JOBNAME} . '.pdf' ;
1345}
1346
1347sub pdf_cmd {
1348    my $self = shift ;
1349    my $output = $self->{ID} . "-pdf_cmd.output" ;
1350    $self->{PDFFILE} = $self->getPdfName ;
1351
1352    $self->todelete( $self->{OUTFILE} . ".aux" );
1353    $self->toclean(
1354        $self->{PATH} . "/" . $output , $self->{PATH} . "/missfont.log" ,
1355        $self->{OUTFILE} . ".pdf" ,
1356        $self->{OUTFILE} . ".log" );
1357    my $pdfname = $self->{PDFFILE} =~ /^$SHMDIR/ ?
1358        $self->{PDFFILE} : $self->{PATH} . "/" . $self->{PDFFILE} ;
1359    $DONTZIPPDF ? $self->tomove($pdfname) : $self->toclean($pdfname) ;
1360    push @{$self->{PDFS}}, $pdfname ;
1361
1362    return $self->request(
1363        "cd $self->{PATH} ; while [ -e '$self->{FILE}.tex.LCK' ] ; do " .
1364        "usleep $USLEEP ; done ; " .
1365        "LANG=C pdflatex --interaction batchmode $self->{FILE} >$output 2>&1");
1366}
1367
1368sub split_cmd {
1369    my $self = shift ;
1370
1371    # Avoid splitting without SPLIT_TRIGGER defined
1372    return undef
1373        unless (defined($self->{SPLIT_TRIGGER}) and $self->{SPLIT_TRIGGER} );
1374
1375    # Need to wait after all clones are initialized
1376    return 0 if ( $self->{MAX_CLONE_INDEX} - $self->getallclones );
1377
1378    &UPSTAT('SPLIT-CMD');
1379
1380    my $jobdir = $self->{JOBDIR} ;
1381    my $cmd = "cd $jobdir ; cat " ;
1382
1383    # We have some afp to agregate to a new file in spool, and we need this
1384    # list as an ordered list
1385    foreach my $job ( $self->getallclones ) {
1386        my $clone = $self->getclone($job) ;
1387        return $self->error( 90, "Can't split AFP with $job sub job")
1388            unless (defined($clone));
1389
1390        return $self->error( 91, "Can't split AFP without $job afp file")
1391            unless (exists($clone->{OUTFILE}) and $clone->{OUTFILE});
1392
1393        my $file = $clone->{OUTFILE} . '.afp' ;
1394        return $self->error( 92, "Can't split AFP without AFP $job extracted")
1395            unless ( -s $file );
1396
1397        # Get clone extracted .afp path relative to jobdir
1398        my ( $path ) = $file =~ m|$jobdir/(.*)$| ;
1399
1400        $cmd .= $path . " " ;
1401    }
1402
1403    # Now it is safe to forget this API for next call from JobManager
1404    delete $self->{SPLIT_TRIGGER} ;
1405
1406    # Now FILE would be the new one if still not set
1407    $self->{FILE} = $self->{SPLITTED_FILE} . '.' . $self->{SPLIT_TAG} ;
1408
1409    # Now add output file direction
1410    $cmd .= '>' . $AFPSPOOL . '/' . $self->{FILE} ;
1411
1412    # Get stderr if necessary
1413    $cmd .= ' 2>split_cmd.stderr' ;
1414    $self->toclean($jobdir . '/split_cmd.stderr');
1415
1416    my $req = $self->request($cmd);
1417    &MAXSTAT('SPLIT-CMD-REQ-SIZE',length($req));
1418
1419    return $req ;
1420}
1421
1422sub split_from {
1423    my $self = shift ;
1424    my $job  = shift ;
1425
1426    # Get next pos in the file for the next job
1427    my $pos = $job->{'SPLIT_FILE'} ;
1428
1429    # Set the same file as splitted job but with a startpoint
1430    $self->setanswer($job->getfile);
1431    $self->setstartpos($pos);
1432
1433    # Keep a copy of SPLIT_TAGS informations to avoid duplicated tags
1434    $self->{'SPLIT_TAGS'} = $job->{'SPLIT_TAGS'} ;
1435
1436    # Still set our TAG from previous TAG2 job, necessary for the last job
1437    $self->{'SPLIT_TAG'} = $job->{'SPLIT_TAG2'} ;
1438
1439    # Keep the original splitted file in mind
1440    $self->{'SPLITTED_FILE'} = $job->{'SPLITTED_FILE'} ;
1441
1442    # Still define SPLIT_TRIGGER for splitter command, especially for the
1443    # last splitted job
1444    $self->{'SPLIT_TRIGGER'} = 1 ;
1445}
1446
1447sub is_splitted {
1448    return exists($_[0]->{'SPLIT_TAG'}) ? 1 : 0 ;
1449}
1450
1451sub request {
1452    my $self = shift ;
1453    return $self->{LASTREQUEST} = &GetCom( comJOB , $self->{ID} , @_ );
1454}
1455
1456sub eservice_request {
1457    my $self = shift ;
1458    return $self->{ESERVICE_REQ} if (defined($self->{ESERVICE_REQ}));
1459
1460    $self->{ESERVICE_REQ} = $self->request(
1461            &GetCom( comFILE , $self->{E_SERVICE} , $self->{XML_A2P} ));
1462}
1463
1464sub eservice_name {
1465    return $_[0]->{E_SERVICE} || "" ;
1466}
1467
1468sub getpdffiles {
1469    return defined($_[0]->{PDFS})?@{$_[0]->{PDFS}}:() ;
1470}
1471
1472sub rename_pdf {
1473    my $self = shift ;
1474    return unless $self->{STATE} == DONE ;
1475    my $file = $self->{PDFFILE} =~ m|^/| ?
1476        $self->{PDFFILE} : "$self->{PATH}/$self->{PDFFILE}" ;
1477    rename "$self->{PATH}/$self->{FILE}.pdf", $file
1478        or $self->error(1,"Can't rename pdf file from '$self->{FILE}.pdf' to '"
1479        . $file . "': $!");
1480}
1481
1482sub dvi_cmd {
1483    my $self = shift ;
1484    my $output = $self->{ID} . "-latex_cmd.output" ;
1485
1486    # We must delete .aux file generated by pdflatex command
1487    unlink $self->{OUTFILE} . ".aux" if ( -e $self->{OUTFILE} . ".aux" );
1488
1489    $self->todelete( $self->{OUTFILE} . ".aux" );
1490    $self->toclean(
1491        $self->{PATH} . "/" . $output , $self->{PATH} . "/missfont.log" ,
1492        $self->{OUTFILE} . ".dvi" ,
1493        $self->{OUTFILE} . ".log" );
1494
1495    return $self->request(
1496        "cd $self->{PATH} ; while [ -e '$self->{FILE}.tex.LCK' ] ; do " .
1497        "usleep $USLEEP ; done ; " .
1498        "LANG=C latex --interaction batchmode $self->{FILE} >$output 2>&1");
1499}
1500
1501################################################################################
1502# Compute the command to produce PCL code
1503# 1. Update variables to specify which file to produce
1504# 2. Update list of files to clean in later step
1505# 3. Return the command to pass to an active backend
1506sub pcl_cmd {
1507    my $self = shift ;
1508    my $output = $self->{ID} . "-pcl_cmd.output" ;
1509    my $command = "cd '$self->{PATH}'; ( export LANG=C ;" ;
1510    # Update dvilj command options
1511    my $DVILJOPT = '-c' . $self->{COPIES} . ' ' . $self->{DVILJOPT} ;
1512
1513    if ( $ADDPCL_JOBNAME and $self->getjobname()
1514    and $self->{DVILJOPT} =~ /-J/) {
1515        my $jobname = $self->getjobname() ;
1516        $jobname =~ s/\s+/_/ ; # Check to keep no space in name
1517        $DVILJOPT =~ s/-J/-J$jobname/ ;
1518    }
1519
1520    if ( $ADDPCL_USERNAME and $self->getusername()
1521    and $self->{DVILJOPT} =~ /-U/) {
1522        my $username = $self->getusername() ;
1523        $username =~ s/\s+/_/ ; # Check to keep no space in name
1524        $DVILJOPT =~ s/-U/-U$username/ ;
1525    }
1526
1527    ###1
1528    $self->{PCLFILE}  = $self->{OUTFILE} . ".pcl";
1529    $self->{LPRFILE}  = $self->{PCLFILE} ;
1530    # At that time PCL validation file if the same than original printed
1531    # Later we will update it if dvilj command has different options
1532    $self->{VLPRFILE} = $self->{PCLFILE} ;
1533
1534    ###2
1535    $self->todelete( $self->{OUTFILE} . ".aux" );
1536    $self->toclean(
1537        $self->{PATH} . "/" . $output ,
1538        $self->{OUTFILE} . ".dvicopy" ,
1539        $self->{PCLFILE} , $self->{LPRFILE}, $self->{VLPRFILE} );
1540
1541    ###3
1542    return $self->request( $command .
1543        "if dvicopy $self->{FILE}.dvi $self->{FILE}.dvicopy ; then " .
1544            "$DVILJ -v $DVILJOPT -e$self->{PCLFILE} $self->{FILE}.dvicopy ;" .
1545        "else echo \"dvicopy error: \$?\" ; exit 1 ; fi ) >$output 2>&1" );
1546}
1547
1548################################################################################
1549# Call a function from AFPDS/PCL.pm that check PCL code if necessary
1550sub valid_pcl {
1551    return unless $_[0]->{STATE} == DONE ;
1552    $_[0]->{STATE} = 5 if (&validate_pcl5($_[0]->{PCLFILE}));
1553}
1554
1555################################################################################
1556# Compute the command to produce PCL code for validation process
1557# 1. Update variables to specify which file to produce
1558# 2. Update list of files to clean in later step
1559# 3. Return the command to pass to an active backend
1560sub vpcl_cmd {
1561    my $self = shift ;
1562
1563    # Return empty string if we can use PCL from the previous step
1564    return ""
1565        if ( $self->{VDVILJOPT} =~ /^$self->{DVILJOPT}$/ and $self->do_pcl );
1566
1567    my $output = $self->{ID} . "-vpcl_cmd.output" ;
1568    my $command = "cd '$self->{PATH}'; ( export LANG=C;" ;
1569    # Update dvilj command options
1570    my $DVILJOPT = '-c' . $self->{COPIES} . ' ' . $self->{VDVILJOPT} ;
1571
1572    if ( $ADDPCL_JOBNAME and $self->getjobname()
1573    and $self->{VDVILJOPT} =~ /-J/) {
1574        my $jobname = $self->getjobname() ;
1575        $jobname =~ s/\s+/_/ ; # Check to keep no space in name
1576        $DVILJOPT =~ s/-J/-J$jobname/ ;
1577    }
1578
1579    if ( $ADDPCL_USERNAME and $self->getusername()
1580    and $self->{VDVILJOPT} =~ /-U/) {
1581        my $username = $self->getusername() ;
1582        $username =~ s/\s+/_/ ; # Check to keep no space in name
1583        $DVILJOPT =~ s/-U/-U$username/ ;
1584    }
1585
1586    ###1
1587    $self->{VPCLFILE} = $self->{OUTFILE} . ".vpcl";
1588    $self->{VLPRFILE} = $self->{VPCLFILE} ;
1589
1590    ###2
1591    $self->toclean( $self->{PATH} . "/" . $output ,
1592        $self->{PATH} . "/" . $output , $self->{OUTFILE} . ".dvicopy" ,
1593        $self->{VPCLFILE} , $self->{VLPRFILE} );
1594
1595    ###3
1596    my $dvicmd = "$DVILJ -v $DVILJOPT -e$self->{VPCLFILE} " .
1597        $self->{FILE} . ".dvicopy" ;
1598    # Is dvicopy still passed on original latex output ?
1599    if ( -e "$self->{PATH}/$self->{FILE}.dvicopy" ) {
1600        $command .= $dvicmd
1601
1602    } else {
1603        $command .= "if dvicopy $self->{FILE}.dvi $self->{FILE}.dvicopy ;" .
1604            "then $dvicmd; else echo \"dvicopy error: \$?\" ; fi" ;
1605    }
1606    $command .= ") >$output 2>&1" ;
1607
1608    return $self->request( $command );
1609}
1610
1611################################################################################
1612# Call a function from AFPDS/PCL.pm that check PCL code if necessary
1613# Here for the validation process
1614sub valid_vpcl {
1615    return
1616        unless ( $_[0]->{STATE} == DONE
1617        and $_[0]->{PCLFILE} ne $_[0]->{VPCLFILE} ); # Still validated
1618    $_[0]->{STATE} = 5 if (&validate_pcl5($_[0]->{VPCLFILE}));
1619}
1620
1621sub ps_cmd {
1622    my $self = shift ;
1623    my $output = $self->{ID} . "-ps_cmd.output" ;
1624
1625    $self->{LPRFILE} = $self->{OUTFILE} . ".ps" ;
1626
1627    $self->toclean( $self->{PATH} . "/" . $output , $self->{LPRFILE} );
1628
1629    return $self->request( "cd $self->{PATH}; LANG=C " .
1630        "dvips -c $self->{COPIES} $self->{DVIPSOPT}" .
1631        " -o $self->{FILE}.ps $self->{FILE} " .
1632        " >$output 2>&1" );
1633}
1634
1635sub lpr_cmd {
1636    my $self = shift ;
1637    my $cmd ;
1638    my $output = $self->{PATH} . "/" . $self->{ID} . "-lpr_cmd.output" ;
1639
1640    # We not mark LPRFILE to clean has it has been marked to during PCL command
1641    $self->toclean( $output );
1642
1643    # Agregate print when required, then return empty string to delay command
1644    # in JobManager
1645    if ( $AGREGATE_PRINT and -d $self->{JOBDIR} ) {
1646        my $PCL5cluster = $self->{JOBDIR} .
1647            "/" . $self->getdestid . "-lpr-cluster" ;
1648
1649        # Add to be erased if still not created
1650        $self->todelete( $PCL5cluster ) unless ( -e $PCL5cluster );
1651
1652        $cmd = "cat $self->{LPRFILE} >>$PCL5cluster 2>>$output" ;
1653        $self->count_pcl5();
1654
1655        # Really lpr that job only if there's no other job in sequence
1656        unless ($self->next_in_sequence) {
1657            my $len = $self->get_pcl5_count ;
1658            my $PrintID = $self->geta2pjob . ( $len > 1 ? "-${len}_Jobs" : "" );
1659            $PrintID .= '-' . $self->{DESTID} ;
1660            $cmd .= " ; LANG=C lpr $self->{LPROPT} -J'$PrintID' $PCL5cluster" .
1661                " >>$output 2>&1" ;
1662        }
1663
1664    } else {
1665        my $PrintID = $self->geta2pjob . '-' . $self->{DESTID} ;
1666        $cmd = "LANG=C lpr $self->{LPROPT} -J'$PrintID' $self->{LPRFILE} " .
1667            ">>$output 2>&1" ;
1668    }
1669    return $self->request($cmd);
1670}
1671
1672sub vlpr_cmd {
1673    my $self = shift ;
1674    my $cmd ;
1675    my $output = $self->{PATH} . "/" . $self->{ID} . "-lpr_cmd.output" ;
1676
1677    # We not mark VLPRFILE to clean has it has been marked to during PCL command
1678    $self->toclean( $output );
1679
1680    # Agregate print when required, then return empty string to delay command
1681    # in JobManager
1682    if ( $AGREGATE_PRINT and -d $self->{JOBDIR} ) {
1683        my $PCL5cluster = $self->{JOBDIR} .
1684            "/" . $self->getdestid . "-vlpr-cluster" ;
1685
1686        # Add to be erased if still not created
1687        $self->todelete( $PCL5cluster ) unless ( -e $PCL5cluster );
1688
1689        $cmd = "cat $self->{VLPRFILE} >>$PCL5cluster 2>>$output" ;
1690        $self->count_pcl5();
1691
1692        # Really lpr that job only if there's no other job in sequence
1693        unless ($self->next_in_sequence) {
1694            my $len = $self->get_pcl5_count ;
1695            my $PrintID = $self->geta2pjob . ( $len > 1 ? "-${len}_Jobs" : "" );
1696            $PrintID .= '-' . $self->{DESTID} . '-validation' ;
1697            $cmd .= " ; LANG=C lpr $self->{VLPROPT} -J'$PrintID' $PCL5cluster "
1698                . ">>$output 2>&1" ;
1699        }
1700
1701    } else {
1702        my $PrintID = $self->geta2pjob . '-' . $self->{DESTID} . '-validation' ;
1703        $cmd = "LANG=C lpr $self->{VLPROPT} -J'$PrintID' $self->{VLPRFILE} " .
1704            ">>$output 2>&1" ;
1705    }
1706    return $self->request($cmd);
1707}
1708
1709sub count_pcl5 {
1710    my $self = shift ;
1711    my $destid = $self->getdestid ;
1712    return unless $destid ;
1713
1714    my $a2pjob ;
1715    return unless ( $a2pjob = $self->a2pobj );
1716
1717    my $key = $self->isstep(8) ? 'PCL5COUNT' : 'VPCL5COUNT' ;
1718    if (defined($a2pjob->{$key}->{$destid})) {
1719        $a2pjob->{$key}->{$destid} ++ ;
1720    } else {
1721        $a2pjob->{$key}->{$destid} = 1 ;
1722    }
1723}
1724
1725sub get_pcl5_count {
1726    my $self = shift ;
1727    my $destid = $self->getdestid ;
1728    return 0 unless $destid ;
1729
1730    my $a2pjob ;
1731    return 0 unless ( $a2pjob = $self->a2pobj );
1732
1733    return $a2pjob->{$self->isstep(8)?'PCL5COUNT':'VPCL5COUNT'}->{$destid} ;
1734}
1735
1736sub get_arch_file {
1737    my $self = shift ;
1738
1739    # Return cached value
1740    return $self->{ARCH_FILE} if (defined($self->{ARCH_FILE}));
1741
1742    my $current_arch_file = $self->{PATH} . "/" . $self->{FILE} . ".arch" ;
1743    $self->{ARCHFILE} = $self->getPdfName() ; # Get same base as PDF file
1744    $self->{ARCHFILE} =~ s/\.pdf$/.arch/ ; # replace .pdf extension with .arch
1745
1746    my $ok = 0 ;
1747    if ( -s $current_arch_file
1748    and ! -s $self->{PATH} . "/" . $self->{ARCHFILE} ) {
1749        # Rename arch file as expected by archivage thread
1750        rename $current_arch_file , $self->{PATH} . "/" . $self->{ARCHFILE}
1751            and $ok ++ ;
1752        $self->error( 10, "Can't rename arch file from '" . $current_arch_file .
1753            "' to '" . $self->{ARCHFILE} . "': $!") unless $ok ;
1754
1755    } elsif ( ! -s $self->{PATH} . "/" . $self->{ARCHFILE} ) {
1756        $self->error(10,"Required arch file to be renamed is empty")
1757            if ( -e $current_arch_file );
1758        $self->error(10,"Required arch file exists but is empty")
1759            if ( -e $self->{PATH} . "/" . $self->{ARCHFILE} );
1760        $self->error(10,"No required arch file exists");
1761    }
1762    return 0 unless $ok ;
1763
1764    # Clean arch file only if not debugging archivage
1765    my $archname = $self->{PATH} . "/" . $self->{ARCHFILE} ;
1766    $ARCH_DEBUG ? $self->tomove($archname,$archname . "_debug.txt")
1767        : $self->toclean($archname) ;
1768
1769    # Cache the request
1770    return $self->{ARCH_FILE} = $self->request( $archname );
1771}
1772
1773sub do_clean_cmd {
1774    my $self = shift ;
1775    &UPSTAT('CHECK_DO_CLEAN');
1776    # CLEAN_CMD not defined: we need to define it in clean_cmd
1777    # else check the next command is not 'DONE' number
1778    # Also no clean if we prefer PURGEFILES or no file is existing
1779    # as we don't clean folders
1780    return ( ! defined($self->{CLEAN_CMD})) ?
1781        (($PURGEFILES or ! grep { -e $_ } $self->get2clean)? 0 : 1 )
1782        :
1783        ( $self->{CLEAN_CMD}->[0] =~ /^\d+$/ ?
1784            ( $self->{CLEAN_CMD}->[0] == DONE ? 0 : 1 ) : 1 );
1785}
1786
1787sub clean_cmd {
1788    my $self = shift ;
1789    my ( $ZipFile , $index ) = ( "" , 0 );
1790
1791    # Return next cached command
1792    if (defined($self->{CLEAN_CMD})) {
1793        &UPSTAT('MOVE_CMDS');
1794        return shift @{$self->{CLEAN_CMD}} ;
1795    }
1796
1797    # First delete empty files
1798    map { ( unlink $_ and $self->jobdebug("'$_' file deleted as empty"))
1799             if ( -z $_ and -f $_ ) } $self->get2clean ;
1800
1801    my @ToClean = grep { -s $_ and -f $_ } $self->get2clean ;
1802    # Empty CLEAN array now to preserve memory on big jobs
1803    $self->{CLEAN} = [ ] ;
1804
1805    # Find a free zipfile name, should loop only one time to set ZipFile name
1806    while ( -e $ZipFile or ! $ZipFile ) {
1807        $ZipFile = ($self->{ERROR} ? $ERRORSPOOL : $DONESPOOL ) . "/" .
1808            $LOCKID . "-" . $self->{ID} . ($index++?"-$index":"") . ".zip" ;
1809    }
1810
1811    # Return zipfile name to client
1812    $self->jobinfo("ZIPFILE=$ZipFile") if ( $self->getClientRef );
1813
1814    # Keep ZIPFILE found if we need to attach it to an alert mail
1815    $self->{ZIPFILE} = $ZipFile ;
1816
1817    while ( @ToClean ) {
1818        my @files = () ;
1819        my $max = $MAXFILES_BY_ZIPCMD || 10 ;
1820        while ( $max -- and @ToClean ) {
1821            push @files, &GetCom( comFILE , shift @ToClean );
1822        }
1823
1824        push @{$self->{CLEAN_CMD}}, $self->request(
1825            &GetCom( comZIP , $ZipFile => @files ));
1826    }
1827
1828    # Keep debugging on commands
1829    foreach my $zipcmd ( @{$self->{CLEAN_CMD}} ) {
1830        $self->jobdebug("Have to do clean command using '$zipcmd' request");
1831    }
1832
1833    # Keep commands number to initialize step 11 progression
1834    $self->{NB_CMDS} += scalar(@{$self->{CLEAN_CMD}});
1835
1836    # Work around when nothing found to clean
1837    push @{$self->{CLEAN_CMD}}, "" unless (@{$self->{CLEAN_CMD}});
1838
1839    # Add DONE status to the end of list, it will be seen by do_clean_cmd
1840    push @{$self->{CLEAN_CMD}}, DONE ;
1841
1842    &UPSTAT('CLEAN_CMDS');
1843    return shift @{$self->{CLEAN_CMD}} ;
1844}
1845
1846sub clean_progress {
1847    # Give info each 30 sec when clean step is longer than 30 sec
1848    my $self = shift ;
1849    return unless ($self->{NB_CMDS});
1850    return unless ( $self->get_ms - $self->{NB_CMDS_CHECK} > 30000 );
1851    return unless (defined($self->{CLEAN_CMD})
1852        and ref($self->{CLEAN_CMD}) =~ /^ARRAY/i );
1853    return unless (defined($self->{MOVE_CMDS})
1854        and ref($self->{MOVE_CMDS}) =~ /^ARRAY/i );
1855
1856    $self->{NB_CMDS_UNIT} = 100 / $self->{NB_CMDS}
1857        unless ( $self->{NB_CMDS_UNIT} > 0 );
1858
1859    $self->{NB_CMDS_CHECK} = $self->get_ms ;
1860
1861    my $ratio = $self->{NB_CMDS_UNIT} * ( $self->{NB_CMDS}
1862        - scalar(@{$self->{MOVE_CMDS}})
1863        - scalar(grep { defined and $_ ne DONE } @{$self->{CLEAN_CMD}}) );
1864
1865    $self->jobinfo(sprintf("Cleanning done at %.1f%%, should finish in %d sec",
1866        $ratio ,
1867        ( $self->{NB_CMDS_CHECK}/1000 ) * ( 100 / $ratio - 1 ) ));
1868
1869    $self->jobstatus( '.', { 'STATUS' => sprintf("%d%%", $ratio ) } )
1870        or &Info("Can't set job progression status at step " . $self->{STEP});
1871}
1872
1873sub jobstatus {
1874    my $self = shift ;
1875    my $step_status = shift ;
1876    my $status = shift || {} ;
1877    my $jobid  = $self->geta2pjob ;
1878
1879    if ($jobid) {
1880        $status->{JID}  = $self->{ID} ;
1881        $status->{STEP} = $self->{STEP} ;
1882
1883    } else {
1884        $jobid = $self->getid ;
1885    }
1886
1887    return &a2pjobstate( $jobid, $self->{STEP}, $step_status, $status );
1888}
1889
1890sub a2pjob_progress_init {
1891    my $self = shift ;
1892    return unless ($self->{JOBS});
1893
1894    # 8 steps ( steps 3 to 10 ) can be done for each job
1895    my $nb_steps = $self->{JOBS} * 8 ;
1896    $self->{NB_STEPS_UNIT} = 100 / $nb_steps ;
1897
1898    # Many steps can still have been done before this initialization
1899    $self->{NB_STEPS_OFFSET} = $self->{JOBS} * -2 ;
1900    map { $self->{NB_STEPS_OFFSET} += $self->{CLONES_OBJ}->{$_}->{STEP} }
1901        $self->getclones ;
1902    $self->{NB_STEPS_OFFSET} += 10 * $self->getfinishedclones ;
1903    $self->{NB_STEPS_OFFSET} *= $self->{NB_STEPS_UNIT} ;
1904
1905    $self->{NB_STEPS_CHECK} = 0 ;
1906}
1907
1908sub a2pjob_progress {
1909    my $self = shift ;
1910    # Give info each 30 sec when main job is longer than 30 sec
1911    return unless ( $self->get_ms - $self->{NB_STEPS_CHECK} > 30000 );
1912
1913    $self->{NB_STEPS_CHECK} = $self->get_ms ;
1914
1915    # Step count is calculated from step 2
1916    my $ratio = $self->{JOBS} * -2 ;
1917    map { $ratio += $self->{CLONES_OBJ}->{$_}->{STEP} } $self->getclones ;
1918    $ratio += 10 * $self->getfinishedclones ;
1919    $ratio *= $self->{NB_STEPS_UNIT} ;
1920
1921    # Must check we don't divide by zero
1922    my $remain = ( $self->{NB_STEPS_CHECK} / 1000 ) *
1923            ( 100 / ( $ratio > $self->{NB_STEPS_OFFSET} ?
1924                $ratio - $self->{NB_STEPS_OFFSET} : 0.1 ) - 1 );
1925    $self->jobinfo(sprintf("Progression done at %.1f%%, should finish in %d sec"
1926        , $ratio , $remain ));
1927
1928    $self->jobstatus( '.', { STATUS => sprintf("%d%%", $ratio ) } )
1929        or &Info("Can't set job progression status at step " . $self->{STEP});
1930}
1931
1932my @todo_steps = (
1933    "",
1934    "",
1935    "",
1936    [ 'DO_PDF',                ], # Step 3
1937    [ 'DO_PS' , 'DO_PCL',      ], # Step 4, do dvi
1938    [ 'DO_PCL',                ], # Step 5 & 6
1939    [ 'DO_PCL',                ], #
1940    [ 'DO_PS' ,                ], # Step 7
1941    [ 'DO_LPR',                ], # Step 8 & 9
1942    [ 'DO_LPR',                ], #
1943    [ 'DO_ARCH', 'DO_ESERVICE' ], # Step 10
1944    );
1945
1946sub cancel {
1947    my $self = shift ;
1948    my $cancelled = 0 ;
1949
1950    # Cancel each job steps if still not at step 10
1951    if ( $self->getstep < 10 ) {
1952        foreach my $todo (grep { /^DO_/ } keys(%{$self})) {
1953            if ( $self->{$todo} =~ /^yes$/i ) {
1954                 $self->jobdebug("Cancelling $todo...");
1955                 $self->{$todo} = 'cancelled' ;
1956                 $cancelled ++ ;
1957            }
1958        }
1959
1960        return 0 unless ($cancelled);
1961    }
1962
1963    # To cancel a job we need also to disable steps of each not finished subjobs
1964    foreach my $job ( $self->getclones ) {
1965        my $clone = $self->getclone($job) ;
1966        my $step = $clone->getstep ;
1967        my $this = 0 ;
1968        while ( ++$step < 10 ) {
1969            my @todo = @{$todo_steps[$step]} ;
1970            my @steps_todo = grep { $clone->{$_} =~ /^yes|cancelled$/i } @todo ;
1971            next unless @steps_todo ;
1972            $clone->jobinfo("Cancelling @steps_todo at step $step");
1973            map { $clone->{$_} = 'cancelled' } @steps_todo ;
1974            $cancelled ++ ;
1975            $this ++ ;
1976        }
1977        $clone->jobinfo("Nothing cancelled") unless ($this);
1978    }
1979
1980    return 0 unless ($cancelled);
1981
1982    # Keep the cancel status
1983    $self->cancelled(scalar(localtime(time)));
1984
1985    # Must return ourself if communications are pending
1986    return $self ;
1987}
1988
1989sub cancelled {
1990    my $self = shift ;
1991    $self->{CANCELLED} = shift if @_ ;
1992    return exists($self->{CANCELLED}) ? 1 : 0 ;
1993}
1994
1995sub canpurge {
1996    my $self = shift ;
1997    return $self->{CANPURGE} if defined($self->{CANPURGE});
1998    $self->{CANPURGE} = 1 ;
1999}
2000
2001sub cannotpurge {
2002    my $self = shift ;
2003    return ! $self->{CANPURGE} if defined($self->{CANPURGE});
2004    $self->{CANPURGE} = 0 ;
2005}
2006
2007sub purge {
2008    my $self = shift ;
2009    # Return cache value if still purged
2010    return $self->{PURGE} if $self->{PURGE};
2011    &UPSTAT('DO-PURGE');
2012    return $self->{PURGE} = 1 if $self->cannotpurge ;
2013
2014    # Update files to purge when required
2015    $self->todelete($self->get2clean) if $PURGEFILES ;
2016
2017    my %todel = map { $_ => -e $_ ? 1 : 0 } $self->get2delete ;
2018    my @todel = grep { $todel{$_} } keys(%todel);
2019    my $limit = @todel ;
2020
2021    local $" = ', ' ;
2022    &Debug("Deleting @todel") if $ADVANCED_DEBUGGING ;
2023
2024    # Delete folders recursively if necessary
2025    while ( grep { $todel{$_} } keys(%todel) and $limit -- ) {
2026        foreach my $file ( keys(%todel) ) {
2027            $! = 0 ;
2028            if ( $todel{$file} and -e $file ) {
2029                if ( -d $file ) {
2030                    $self->jobdebug("Deleting '$file' folder")
2031                        if $ADVANCED_DEBUGGING ;
2032                    unless ( rmdir $file ) {
2033                        $self->jobinfo("Failed to delete '$file' folder: $!")
2034                            unless $limit ;
2035                        next ;
2036                    }
2037
2038                } elsif ( -f $file ) {
2039                    &Debug("Deleting '$file' file") if $ADVANCED_DEBUGGING ;
2040                    unless ( unlink $file ) {
2041                        $self->jobinfo("Failed to delete '$file': $!")
2042                            unless $limit ;
2043                    }
2044                }
2045            }
2046            $todel{$_} = 0 ;
2047        }
2048    }
2049
2050    @todel = grep { $todel{$_} } keys(%todel) ;
2051    if (@todel) {
2052        if ($ADVANCED_DEBUGGING) {
2053            my %listing = () ;
2054            # What to delete is probably a folder
2055            foreach my $folder (@todel) {
2056                map { $listing{$_} = 1 } glob( "$folder/*" ) ;
2057            }
2058            my @listing = keys( %listing );
2059            &Debug("Job not cleaned, still not been removed: @todel");
2060            &Debug("Job not cleaned, found in folders: @listing")
2061                if @listing ;
2062        }
2063
2064        return $self->{PURGE} = 0 ;
2065
2066    } else {
2067        return $self->{PURGE} = 1 ;
2068    }
2069}
2070
2071sub freeparent {
2072    my $self = shift ;
2073
2074    # To help freeing memory
2075    $self->{PARENT} = undef ;
2076}
2077
2078sub cleanjob {
2079    my $self = shift ;
2080    $self->{AGE} = sprintf("%.2f seconds", time - $self->{BIRTH});
2081    undef $self->{CLEANHASH} ;
2082    undef $self->{DELETEHASH} ;
2083    undef $self->{MOVEHASH} ;
2084    undef $self->{CLEAN} ;
2085    undef $self->{DELETE} ;
2086    undef $self->{MOVE} ;
2087}
2088
2089sub DESTROY {
2090    delete $uniqid{$_[0]->{ID}} ;
2091    $_[0]->jobdebug("Freeing memory");
2092}
2093
2094&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
2095
20961;
Note: See TracBrowser for help on using the repository browser.