# # Copyright (c) 2004-2007 - Consultas, PKG.fr # # This file is part of A2P. # # A2P is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # A2P is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with A2P; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # # $Id: Job.pm 3 2007-10-18 16:20:19Z guillaume $ # # Class to implement job object to be tramsmitted between threads # package A2P::Job; use strict; use A2P::Globals ; use A2P::Syslog; use AFPDS::PCL; use Time::HiRes qw( time gettimeofday tv_interval ); use A2P::Com qw( GetCom comJOB comZIP comFILE ); use A2P::Tools qw( ShortID ); use A2P::Syslog 'AttachZipToAlertError' ; use A2P::JobStatus 'a2pjobstate' ; BEGIN { our $VERSION = sprintf "%s", q$Rev: 1180 $ =~ /(\d[0-9.]+)\s+/ ; } our $VERSION ; my %uniqid = () ; sub new { my $class = shift ; my $time = time ; # time is here the Time::HiRes 'time' version my @Date = localtime($time); my $DayTick = ($time - int($time - ( $Date[0] + $Date[1]*60 + $Date[2]*3600 ))) * 193 ; my $self = { ERROR => 0 , STEP => 0 , JOBS => 0 , START => time , FILE => "" , STATE => 0 , A2PJOB => "" , PURGE => 0 , PURGETRYOUT => 10 , JOBDIR => "" , CANPURGE => undef , MOVE_CMDS => undef, ALERTED => undef, ANSWER => "" , ERRORS => [] , SEQREADY => 0 , CLIENTREF => 0 , NB_CMDS => 0 , FILE2MOVE => 0 , NB_CMDS_CHECK => 0 , STEPDONE=> 0 , NB_CMDS_UNIT=> 0 , SEQREMOVED => 0 , BIRTH => time , JOBDIR => "undefined", API_REV => "a2p v".A2P_RPM_VERSION." (".__PACKAGE__." v$VERSION)" }; @{$self->{DELETE}} = () ; # List of files to delete without checking them @{$self->{CLEAN}} = () ; # List of files to check and keep if not empty @{$self->{PDFS}} = () ; # List of generated PDF files @{$self->{MOVE}} = () ; # List of files to move @{$self->{INFO}} = () ; # Keep some info until they are useful $self->{KEEP_INFO} = {} ; # Keep some info for KEEP_DYNAMIC_JOB_LOG option $self->{TIMED_INFO}= [] ; $self->{CLONES} = [] ; # List of clones as indexed list # Initializes print sequence %{$self->{SEQUENCE}} = () ; %{$self->{LPRSEQ}} = () ; %{$self->{VLPRSEQ}} = () ; # Construct an ID for that job with : # - 1 char for the year: A -> 2005, B -> 2006, etc... # - 3 digits for the year day : 001 to 365 # - 1 '-' separator char # - 6 hex digits for a time since midnigh (in ~ 1/193 of sec or ~5.2 ms) # - 1 '-' separator char # - 4 chars to keep a short human friendly identifier if ( @_ ) { $self->{ID} = shift ; $self->{CLIENTREF} = shift ; $self->{CLIENTINFO} = [ ] ; # We must check if job is still running before starting it again if (defined($uniqid{$self->{ID}})) { &Warn("Aborting attempt to restart $self->{ID} running job"); return 0 ; } } else { my $retries = 100 ; # Paranoid just in case my $baseid = sprintf("%c%03D-%06X-", $Date[5]-40 , $Date[7] , $DayTick); my $nameid = '' ; while ((! $nameid or defined($uniqid{$baseid.$nameid})) and $retries ) { $nameid = &ShortID ; $retries -- ; } $self->{ID} = $baseid . $nameid ; } # Set uniqueness information $uniqid{$self->{ID}} = 1 ; &Debug("new Job object v$VERSION created with ID=" . $self->{ID} . ( $self->{CLIENTREF} ? " for " . $self->{CLIENTREF} : "" )); return bless $self , $class ; } sub newjob { &TIMESTAT('NEW_JOB'); my $self = shift ; my $class = ref($self); my %clone = %{$self} ; my $clone = bless \%clone , $class ; # Be sure to not resplit again delete $clone->{'SPLIT_FILE'} if ($self->is_splitted()); # Compute environment calculated by ControlRecord.pm and given as answer # conversion map { my ( $key , $value ); eval q|$clone->{| . $key . q|} = | . ( $value =~ /^\d+$/ ? $value : qq|'$value'| ) if ( ( $key , $value ) = m|(.*)$|i ) } split( '' , $self->getanswer ); # Handle split event for JobManager to do the job if (exists($clone->{'SPLIT_FILE'})) { $self->{'SPLIT_TAG'} = $clone->{'SPLIT_TAG'} ; $self->{'SPLIT_TAG2'} = $clone->{'SPLIT_TAG2'} ; my ( $prevpos , $nextpos ) = $clone->{'SPLIT_FILE'} =~ /^(\d+):(\d+)$/ ; $self->{'SPLIT_FILE'} = $nextpos ; # Count original AFP with split events &UPSTAT('SPLITTED_AFP') unless ($prevpos); # Defined the trigger for the splitter command $self->{'SPLIT_TRIGGER'} = 1 ; # Reset step status $self->setanswer(''); # Save the splitted file at the split only ( $self->{'SPLITTED_FILE'} ) = $self->{'FILE'} =~ m|$LOCKID/[^/]*$| ? $self->{'FILE'} =~ m|($LOCKID/[^/]*)$| : $self->{'FILE'} =~ m|([^/]*)$| unless (defined($self->{'SPLITTED_FILE'})) ; my $count_format = '%02d' ; # Save tags list and control last one was not used before if (defined($self->{'SPLIT_TAGS'})) { # Control case where TAG are identical (as in auto-split) if ( $self->{'SPLIT_TAG'} eq $self->{'SPLIT_TAG2'} ) { my $count = scalar(keys(%{$self->{'SPLIT_TAGS'}})) ; $self->{'SPLIT_TAG2'} .= sprintf( $count_format, $count ) ; } # Replace TAG in case it was previously updated $self->{'SPLIT_TAG'} = $self->{'SPLIT_TAGS'}->{$prevpos} if (exists($self->{'SPLIT_TAGS'}->{$prevpos})); # Control TAG2 has not still been set my @tags = values(%{$self->{'SPLIT_TAGS'}}) ; my ( $tag, $ctrl, $iter ) = ( $self->{'SPLIT_TAG2'}, 2, 0 ) ; while ( grep { /^$tag$/ } @tags ) { $tag = $self->{'SPLIT_TAG2'} . '.' . &ShortID($ctrl) ; $ctrl += 2 unless ( ++$iter % 100 ); } # Save uniq tag $self->{'SPLIT_TAGS'}->{$nextpos} = $self->{'SPLIT_TAG2'} = $tag ; } else { # Control case where TAG are identical (as in auto-split) if ( $self->{'SPLIT_TAG'} eq $self->{'SPLIT_TAG2'} ) { $self->{'SPLIT_TAG'} .= sprintf( $count_format, 0 ) ; $self->{'SPLIT_TAG2'} .= sprintf( $count_format, 1 ) ; } # Initialize known tags list $self->{'SPLIT_TAGS'} = { $prevpos => $self->{'SPLIT_TAG'}, $nextpos => $self->{'SPLIT_TAG2'} } ; # We should also link on AFP name for the first splitted status my $newafp = $self->{'AFPNAME'} . '.' . $self->{'SPLIT_TAG'} ; $self->jobstatus( 'o', { LINKEDAFP => $self->{'AFPNAME'}, AFP => $newafp } ) or &Info("Can't initialize '$newafp' status"); } &TIMESTAT('NEW_JOB'); return undef ; } &UPSTAT('NEW_JOB'); # Keep AFPNAME only on A2P job on the first sub job $self->{'AFPNAME'} = $clone->{'AFPNAME'} unless (exists($self->{'AFPNAME'})); delete $clone->{'AFPNAME'} ; # This counter is not the real jobs index in AFP file as com don't guaranty # the com from Converter comes here in the right order $self->{JOBS} ++ ; $self->{JOBSTODO} ++ ; # OUTFILE is set from environment returned by conversion ( $clone->{PATH} , $clone->{FILE} ) = $clone->{OUTFILE} =~ m|^(.*)/([^/]*)$| ; # Set index to the real number of this job my ( $index ) = $clone->{PATH} =~ /AFP-(\d+)$/ ; # Keep this index to control splitting event keeping the maximum value $self->{MAX_CLONE_INDEX} = $index unless ( defined($self->{MAX_CLONE_INDEX}) and $index < $self->{MAX_CLONE_INDEX} ); # Initialize my clone ( $clone->{ID}, $clone->{ANSWER}, $clone->{STATE}, $clone->{ERROR}, $clone->{ERRORS}, $clone->{A2PJOB}, $clone->{PARENT}, $clone->{INDEX} ) = ( $self->{ID} . "-" . $index, "", 0, 0, [], $self->{ID}, $self, $index ); # Undef some unused ref in clone undef $clone->{CLONES} ; undef $clone->{CLONES_OBJ} ; # Update print sequence when agregating my $destid = $clone->getdestid ; if ( $destid and $AGREGATE_PRINT ) { $self->{SEQUENCE}->{$destid}->[$index-1] = $clone->{ID} ; $self->jobdebug("Job '$clone->{ID}' is the " . scalar(@{$self->{SEQUENCE}->{$destid}}) . " job found for the '" . $destid . "' sequence"); $self->{LPRSEQ}->{$destid} = 0 unless (defined($self->{LPRSEQ}->{$destid})); $self->{VLPRSEQ}->{$destid} = 0 unless (defined($self->{VLPRSEQ}->{$destid})); # Decide now if next print is this clone (yes for the first one and # previous clone is still printed after a long conversion or first one # for a new destid) my $next = $self->{SEQUENCE}->{$destid}->[$self->{LPRSEQ}->{$destid}] ; $clone->{DO_LPR_NOW} = ($next =~ /^$clone->{ID}$/)? 1 : 0 ; $next = $self->{SEQUENCE}->{$destid}->[$self->{VLPRSEQ}->{$destid}] ; $clone->{DO_VLPR_NOW} = ($next =~ /^$clone->{ID}$/)? 1 : 0 ; } # Update filename with clone ID to identify file in zip file and avoid # zipping error $clone->{FILE} = $clone->{ID} . '-' . $clone->{FILE} ; # rename files created by afpds2tex foreach my $ext ( 'tex' , 'arch' , 'trayone' , 'traytwo', 'afp' ) { my ( $orig , $dest ) = ( $clone->{OUTFILE} . '.' . $ext , $clone->{PATH} . '/' . $clone->{FILE} . '.' . $ext ); if ( -e $orig ) { if ( $ext =~ /tray/ ) { link $orig , $dest or $clone->error(1,"Can't link '$orig' to '$dest': $!"); $self->todelete($orig); } else { rename $orig , $dest or $clone->error(1,"Can't rename '$orig': $!"); } } $clone->jobdebug("$ext file renamed to '$clone->{FILE}.$ext'") if ( -e $dest ); # Set files to be cleaned $self->toclean($dest); } $clone->{OUTFILE} = $clone->{PATH} . '/' . $clone->{FILE} ; # Handle TOCLEAN environment used for included resource cleaning $clone->toclean(split(/;/,$clone->{'TOCLEAN'})) if ( exists($clone->{'TOCLEAN'}) and $clone->{'TOCLEAN'} ); # Set E-Service files to clean if present $self->toclean( $clone->{XML_A2P}, $clone->{XML_A2P}.'.stderr', $clone->{XML_CONTENT}, $clone->{PDFFILE} ) if (exists($clone->{XML_A2P})); # Add folder $self->todelete($clone->{PATH}); # Also add A2PJob path to delete if not still added, and the Lock file # created by converter $self->todelete( $SHMDIR . '/' . $self->{ID}, $SHMDIR . '/' . $self->{ID} . '.LCK' ); # Force to do PDF for archivage, just in case it is used with print # and DO_PDF is not set $clone->{DO_PDF} = 'yes' if ( $clone->do_arch and ! $clone->do_pdf ); # And reset my used answer, keep clone info $self->{ANSWER} = "" ; $self->{CLONES}->[$index] = $clone->{ID} ; # Keep a ref to clone $self->{CLONES_OBJ}->{$clone->{ID}} = $clone ; &Debug("Job " . $self->{ID} . " cloned to " . $clone->{ID}); map { $clone->jobdebug("{$_}='$clone->{$_}'") } qw( ID A2PJOB STEP OUTFILE PATH FILE COPIES ); $clone->jobinfo( "Processing AFP JOB '$clone->{ID}-$clone->{JOBNAME}'" .($self->getClientRef?" with a2p v" . A2P_RPM_VERSION : "") ); &TIMESTAT('NEW_JOB'); return bless $clone , $class ; } sub error { my $self = shift ; my $err = shift ; my $msg = shift || "" ; if (defined($err)) { my ($package, $filename, $line) = caller; $self->{ERROR} = $err ? $err : 2 ; unless (exists($self->{STEPERROR}) and exists($self->{INFOERROR})) { $self->{STEPERROR} = $self->{STEP} unless (exists($self->{STEPERROR})); # Update job state only on the first error my $status = $msg ? { STATUS => 'ABTERM', ABTERM => $msg } : {} ; # Extract ABTERM information from message $self->{INFOERROR} = $status->{INFOS} = $1 if ( ! exists($self->{INFOERROR}) and $msg =~ /^ABTERM:\s+(.*)$/ ); $status->{STATUS} = 'KO' if ($self->geta2pjob and $msg); $self->jobstatus( 'A', $status ) or &Info("Can't set job error status at step " . $self->{STEP}); my $parent = $self->a2pobj ; if ( $parent and $self->{INFOERROR} and ! $parent->{INFOERROR} ) { $parent->{INFOERROR} = $self->{INFOERROR} ; $parent->jobstatus( 'A', $status ) or &Info("Can't set job error status on parent status"); } } push @{$self->{ERRORS}} , $msg if $msg ; my $error = "Error $self->{ERROR} set on Job " . $self->getid() . " at step $self->{STEP}, from L.$line in $package" . ( $msg ? ": $msg" : "" ); &Error($error); push @{$self->{CLIENTINFO}} , $error if ($self->{CLIENTREF}); # Update a2pjob to stop our sequence if ( $AGREGATE_PRINT and $err > 700 and my $a2pjob = $self->a2pobj ) { $a2pjob->{$self->getdestid() . '-ERROR'} = 1 ; } # Stop any more processing map { $self->{$_} = "no" } qw(DO_PDF DO_PCL DO_PS DO_LPR DO_VLPR DO_ARCH DO_ESERVICE); } return $self->{ERROR} ; } sub setconversionerrorcleaning { # Just update files and folders to clean in shared memory my $self = shift ; my @files = glob( "$self->{JOBDIR}/*" ); $self->jobdebug("Setting to clean @files"); while (@files) { my $file = shift @files ; if (-d $file) { $self->todelete($file); my @newfiles = glob( "$file/*" ) ; $self->jobdebug("Setting to clean @newfiles"); push @files, @newfiles ; } else { $self->toclean($file); } } } sub badagregation { my $self = shift ; return 0 unless $AGREGATE_PRINT ; my $a2pjob = $self->a2pobj ; return 0 unless ( $a2pjob ); my $key = $self->getdestid() . '-ERROR' ; return ( defined($a2pjob->{$key}) and $a2pjob->{$key} ); } sub geterrors { return defined($_[0]->{ERRORS}) ? @{$_[0]->{ERRORS}} : () ; } sub getsteperror { return $_[0]->{STEPERROR} ; } sub start_ms { my $self = shift ; $self->{START} = time ; $self->{STEPDONE} = 0 ; # Update status only at step higher than 2 as jobstatus is initialized # only at step 2 and directly from afpds2tex.pm if ( $self->{STEP} > 2 ) { my $step = $self->{STEP} + 1 ; # Update job state in spool $self->jobstatus( '_', { STATUS=>"RUNNING" }) or &Info("Can't set job status at step $step"); } 1 ; } sub get_ms { return ( time - $_[0]->{START} ) * 1000 ; } sub get_delay { return sprintf("%.1f ms", ( time - $_[0]->{BIRTH} ) * 1000 ); } sub stop_ms { $_[0]->jobinfo("Processed in " . sprintf("%.1f ms",$_[0]->get_ms()) ); } sub getpurgetry { return $_[0]->{PURGETRYOUT} -- ; } sub isstep { return $_[0]->{STEP} == $_[1] ; } sub getstep { return $_[0]->{STEP} ; } sub getid { return $_[0]->{ID} ; } sub getindex { return $_[0]->{INDEX} ; } sub getdestid { # DESTID is not defined when just archiving return defined($_[0]->{DESTID}) ? $_[0]->{DESTID} : "" ; } sub getjobname { # JOBNAME is only defined for cloned job return defined($_[0]->{JOBNAME}) ? $_[0]->{JOBNAME} : "" ; } sub printer { $_[0]->{LPROPT} =~ /-P(\S*)/ if (defined($_[0]->{LPROPT})); return defined($1) ? $1 : "oups... none" ; } sub vprinter { $_[0]->{VLPROPT} =~ /-P(\S*)/ if (defined($_[0]->{VLPROPT})); return defined($1) ? $1 : "oups... none" ; } sub getfile { return $_[0]->{FILE} ; } sub getfilestart { return $_[0]->{STARTPOSFILE} || 0 ; } sub toconverter { my $self = shift ; my $startpoint = $self->getfilestart ? ':' . $self->getfilestart : '' ; return $self->request( $self->getfile . $startpoint ) ; } sub getstatistics { my $self = shift ; my @stats = ( $self->getid(), $self->getdestid() ) ; if ($self->geta2pjob()) { # Return stats of a clone push @stats, $self->getstate == DONE ? "OK" : "KO", "" ; } else { # Return stats of an A2P job push @stats, "", $self->getstate == DONE ? "OK" : "KO" ; } push @stats, scalar(@{$self->{ERRORS}}), $self->get_delay, $LOCKID ; # Compute job real timing but check it is not concerned by a drift between # clock on NFS server (if used) and local clock if (defined($self->{MTIME})) { my $time = time ; if ($time > $self->{MTIME}) { my $timing = time - $self->{MTIME} ; push @stats, sprintf("%.1f s", $timing ); my $index = int(int($timing)/10) ; &UPSTAT('STATISTICS-TIMING-'.$index.'0-'.(++$index).'0s'); } else { &Info("Can't compute job timing as it seems newer than now"); push @stats, "BADCLOCK" ; &UPSTAT('BAD-STATISTICS-TIMING'); } } return @stats ; } sub getstate { # After cleanning we count total number of errors return ( $_[0]->isstep(11) and defined($_[0]->{CLEAN_CMD}) )? ( grep { $_ != DONE } @{$_[0]->{CLEAN_CMD}} or DONE ) : $_[0]->{STATE} ; } sub getClientRef { return $_[0]->{CLIENTREF} ; } sub unsetClientRef { $_[0]->{CLIENTREF} = 0 ; 1 ; } sub getanswer { return $_[0]->{ANSWER} ; } sub geta2pjob { return $_[0]->{A2PJOB} ; } sub a2pobj { my $self = shift; return defined($self->{PARENT}) ? $self->{PARENT} : 0 ; } sub nomorejob { return $_[0]->{JOBSTODO} ? 0 : 1 ; } sub getclone { my $self = shift; my $id = shift; return defined($self->{CLONES_OBJ}->{$id}) ? $self->{CLONES_OBJ}->{$id} : 0 ; } sub getallclones { my $self = shift; return () unless (defined($self->{CLONES})); # Returns every clones finished or not return map { ref($_) ? $$_ : $_ } grep { defined } @{$self->{CLONES}} ; } sub getclones { my $self = shift; return () unless (defined($self->{CLONES})); # Returns only not finished clones return grep { defined and ! ref($_) } @{$self->{CLONES}} ; } sub getfinishedclones { my $self = shift ; return () unless (defined($self->{CLONES})); # Returns finished clones # When not finished, the ref is empty so it not selected, but when one is # is finished, it is replaced by a scalar ref to the clone ID return map { $$_ } grep { defined and ref($_) } @{$self->{CLONES}} ; } sub get2delete { my $self = shift; return $self->getfromlist('DELETE'); } sub get2clean { my $self = shift; return $self->getfromlist('CLEAN'); } sub get2move { my $self = shift; return $self->getfromlist('MOVE'); } sub getfromlist { my $self = shift ; $self->{$_[0].'HASH'} = {} unless (defined($self->{$_[0].'HASH'})); return @{$self->{$_[0]}} = keys(%{$self->{$_[0].'HASH'}}); } sub addtomyarray { my $self = shift ; my $key = shift ; map { $self->{$key.'HASH'}->{$_} = 1 } @_ ; } sub todelete { my $self = shift ; $self->addtomyarray('DELETE',@_); } sub toclean { my $self = shift ; $self->addtomyarray('CLEAN',@_); } sub tomove { my $self = shift ; $self->addtomyarray('MOVE',@_); } sub do_move_cmd { my $self = shift ; # Return move commands list size if still passed in move_files_cmd member return scalar(@{$self->{MOVE_CMDS}}) if (defined($self->{MOVE_CMDS})); # Then should check if we need to move file return $self->{FILE2MOVE} if ( $self->{FILE2MOVE} ); # To avoid keeping previous step status $self->{STATE} = DONE ; $self->{FILE2MOVE} = grep { -e $_ and -f $_ } $self->get2move ; return $self->{FILE2MOVE} ; } sub move_files_cmd { my $self = shift ; # Return cached move command return shift(@{$self->{MOVE_CMDS}}) if (defined($self->{MOVE_CMDS})); if ( ! -d $self->{JOBDIR} ) { $self->error(8,"Job dir not set, won't move anything"); return undef ; } my $dest = $self->error ? $ERRORSPOOL : $DONESPOOL ; my $output = $self->{JOBDIR} . "/mv_commands.output" ; $self->toclean( $output ); # Cached move commands @{$self->{MOVE_CMDS}} = map { $self->request( "mv -f $_ $dest >>$output 2>&1" ) } ( grep { -e $_ and -f $_ } $self->get2move ); # Keep commands number to initialize step 11 progression $self->{NB_CMDS} = scalar(@{$self->{MOVE_CMDS}}); return shift(@{$self->{MOVE_CMDS}}) ; } sub setstep { return $_[0]->{STEP} = $_[1] ; } sub setfile { return $_[0]->{FILE} = $_[1] ; } sub setstartpos { return $_[0]->{STARTPOSFILE} = $_[1] ; } sub setjobdir { my $self = shift ; return if ( $self->{JOBDIR} and -d $self->{JOBDIR} ); # When must set this only one time $self->{JOBDIR} = $_[0] ; $self->jobdebug("Jobdir folder is set to " . $self->{JOBDIR}); # Don't forget to delete LCK file $self->todelete($_[0], $_[0] . '.LCK'); } sub setstate { my $self = shift ; my $state = shift ; if ( $self->isstep(11) and defined($_[0]->{CLEAN_CMD}) ) { # When cleaning, we can received a state DONE after a bad STATE so keep push @{$self->{CLEAN_CMD}} , $state ; } else { $self->{STATE} = $state ; } $self->jobdebug("Setting state to " . ( defined($means{$state}) ? $means{$state} : "'$state'" )); } sub jobdone { my $self = shift ; my $clone = shift ; -- $self->{JOBSTODO} ; # Replace ID in list by a ref to ID to set it done my $CLONE_ID = $clone->getid ; $self->{CLONES}->[$clone->getindex] = \$CLONE_ID ; # Keep clone info in parent $self->mergeinfo( $CLONE_ID ) if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 0 ); } sub clearjobsdone { my $self = shift ; # Keep internal statistics which can be correlated to diagnostics tests &UPSTAT('JOB-NBJOBS-'.$self->getallclones.'-'. ($self->getstate == DONE ? "DONE" : "ERROR-".$self->error)) ; # Deleting last references to clone objects delete $self->{CLONES_OBJ} unless ($self->error); } sub stepnotdone { return $_[0]->{STEPDONE} ? 0 : 1 ; } sub stepdone { my $self = shift ; my $ret = 1 ; my $step = $self->{STEP} ; $self->{STEPDONE} = 1 ; my $info = { STATUS => 'STEPDONE', INFOS => '' } ; if ( $step == 10 and ! $self->geta2pjob ) { # Step 10 finished for main job, about to do cleaning $info->{INFOS} = 'Cleaning' ; } elsif ( $step == 12 ) { $info->{STATUS} = 'DONE' ; $info->{INFOS} = $self->cancelled ? 'Cancelled' : 'Stopped' ; } delete $info->{INFOS} if (exists($self->{STEPERROR})); # Update status to STEPDONE for clone only before step 10 # Step 10 status is updated directly by Archiver or E-Service $self->jobstatus( 'o', $info ) unless ( $self->geta2pjob and $step < 10 ); $ret or &Info("Can't set job done status at step $step"); } sub stepskip { my $self = shift ; $self->nextstep(@_); } sub setanswer { $_[0]->{ANSWER} = $_[1]; $_[0]->jobdebug("Received \"$_[1]\" answer"); } sub is_not_abterm { return defined($_[0]->{ALERTED}) ? 0 : 1 ; } sub jobdump { my $Job = shift ; return ( " ############################# JOB DUMP #################################### Job $Job object dump:" , eval 'use Data::Dumper ; Dumper($Job)' ) ; } sub jobalert { my $self = shift ; return unless ( $self->error or $JOB_DUMP_ON_ERROR ); return if (defined($self->{ALERTED})); my @Alerts = @_ ? @_ : ( "ABTERM: Job " . $self->getid , "ABTERM: Job $self->{ID} is in errors:", $self->geterrors ); if ($self->{CLIENTREF}) { push @{$self->{CLIENTINFO}} , @Alerts ; &AlertError( @Alerts ); } else { push @Alerts, $self->jobdump if ($JOB_DUMP_ON_ERROR); &AttachZipToAlertError($self->{ZIPFILE}) if (defined($self->{ZIPFILE}) and $JOIN_ZIP_ON_ERROR); &Alert( @Alerts ); } $self->{ALERTED} = 1 ; } sub keepinfo { # We can keep last info on a timed keys hash to only keep most recent my $self = shift ; my $time = sprintf("%.3f",time); $self->{KEEP_INFO}->{$time} = [ map { $self->{ID} . '@step' . $self->{STEP} . ': ' . $_ } @{$_[0]} ]; while ( @{$self->{TIMED_INFO}} and @{$self->{TIMED_INFO}} > $MAX_BACKLOG ) { my $timeshift = shift @{$self->{TIMED_INFO}} ; delete $self->{KEEP_INFO}->{$timeshift} ; } push @{$self->{TIMED_INFO}}, $time ; } sub mergeinfo { &TIMESTAT('mergeinfo'); # Merge info from clone in parent: we can delete info in clone # at the same time my $self = shift ; my $clone = shift ; # Clone can be deleted during unrecoverable error return unless ($self->getclone($clone)); # Replace clone name by the object my $clone = $self->getclone($clone) ; my @time_imported = @{$clone->{TIMED_INFO}} ; $clone->{TIMED_INFO} = [] ; my $hashref = $clone->{KEEP_INFO} ; foreach my $time ( @time_imported ) { if (defined($self->{KEEP_INFO}->{$time})) { # First check we are not getting a known info unless ( $hashref->{$time} == $self->{KEEP_INFO}->{$time} ) { push @{$self->{KEEP_INFO}->{$time}}, @{$hashref->{$time}}; } } elsif ( $time > $self->{TIMED_INFO}->[0] ) { shift @{$self->{TIMED_INFO}} unless ( @{$self->{TIMED_INFO}} < $MAX_BACKLOG ); $self->{KEEP_INFO}->{$time} = $hashref->{$time} ; if ( $time > $self->{TIMED_INFO}->[$#{$self->{TIMED_INFO}}] ) { push @{$self->{TIMED_INFO}}, $time ; } else { # Here we need to insert so, just resort used keys... this could # be time consuming ? $self->{TIMED_INFO} = [ sort(keys(%{$self->{KEEP_INFO}->{$time}})) ] ; } } # Then erase the ref in clone delete $hashref->{$time} ; } # Finally erase the keep_info hash ref in clone delete $clone->{KEEP_INFO} ; &TIMESTAT('mergeinfo'); } sub jobinfo { my $self = shift ; return unless (defined($_[0])); $self->{LAST_INFO} = [ @_ ] ; # Just to keep a trace in dumped object $self->keepinfo( \@_ ) if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 0 ); my $info = $self->{ID} . ( $self->{STEP} ? ": Step " . $self->{STEP} : "" ) . ", " . $_[0] ; if ( $self->{STEP} < 2 ) { push @{$self->{INFO}}, $info ; } else { push @{$self->{CLIENTINFO}} , $info if ($self->{CLIENTREF}); &Info( $info ); } } sub releaseinfo { # Don't release info if info is not interesting, but release if debugging return if ( $NO_SYSLOG_DEBUG and $_[0]->{STATE} == NOMOREFILE ); &Info( @{$_[0]->{INFO}} ); push @{$_[0]->{CLIENTINFO}} , @{$_[0]->{INFO}} if ($_[0]->{CLIENTREF}); undef $_[0]->{INFO} ; } sub jobdebug { my $self = shift ; return unless @_ ; $self->{LAST_DEBUG} = [ @_ ] ; # Just to keep a trace in dumped object $self->keepinfo( \@_ ) if ( $MAX_BACKLOG and $KEEP_DYNAMIC_JOB_LOG > 1 ); return if ( $NO_SYSLOG_DEBUG ); my @sub = caller(1); my ( $sub ) = $sub[3] =~ /^.*::([^:]*)$/ ; return if ( $sub and $NODEBUG_SUB_LIST =~ /$sub/ ); local $" = '' ; &Debug($self->getid . ": Step $self->{STEP}, $sub, L.$sub[2], @_"); } sub getClientInfo { my $self = shift ; # Return nothing unless is client request and at least one info is in buffer return () unless ( $self->{CLIENTREF} and @{$self->{CLIENTINFO}} ); my @info = ( $self->{CLIENTREF} ); push @info , @{$self->{CLIENTINFO}} ; @{$self->{CLIENTINFO}} = () ; return @info ; } sub nextstep { my $self = shift ; ++ $self->{STEP} ; $self->jobinfo($_[0]) if @_ ; } sub do_pdf { return defined($_[0]->{DO_PDF})? ( $_[0]->{DO_PDF} =~ /^yes$/i ? 1 : 0 ) : 0 ; } sub do_ps { return defined($_[0]->{DO_PS})? ( $_[0]->{DO_PS} =~ /^yes$/i ? 1 : 0 ) : 0 ; } # $PARALLELE_VALIDATION flag can be 0, 1 or 2 # 0 => No validation # 1 => Validation duplication # 2 => Only validation sub do_pcl { my $self = shift ; if (defined($self->{DO_PCL})) { return 1 if ( $self->{DO_PCL} =~ /^yes$/i and $PARALLELE_VALIDATION < 2 ); } return 0 ; } sub do_vpcl { my $self = shift ; if (defined($self->{DO_PCL})) { return 1 if ( $self->{DO_PCL} =~ /^yes$/i and $PARALLELE_VALIDATION ); } return 0 ; } sub do_lpr { my $self = shift ; my $ref = shift ; if ( defined($self->{DO_LPR}) and ! $DONT_PRINT and (defined($self->{DO_LPR_NOW}) or ! $AGREGATE_PRINT)) { if (defined($ref)) { # Checking sequence processing if ( $self->{DO_LPR} =~ /^yes$/i and $PARALLELE_VALIDATION < 2 ) { return $self->{DO_LPR} = 1 unless $AGREGATE_PRINT ; # Default to waiting sequence is ready $$ref = 1 ; # We must wait until sequence is ready (essentially we are # knowing every thing about cloned jobs to set sequence # correctly) if ($self->sequence_ready()) { # Check we can print now saving last check value as control if ($self->{LAST_CHECK} = $self->{DO_LPR_NOW}) { return $self->{DO_LPR} = 1 ; } else { return 0 ; } } else { return $self->{LAST_CHECK} = 0 ; } } else { # No print required return $self->{DO_LPR} = 0 ; } } else { # Checking step processing return $self->{DO_LPR} ; } } return $self->{LAST_DEFAULT} = 0 ; } sub do_vlpr { my $self = shift ; my $ref = shift ; if ( defined($self->{DO_VLPR}) and ! $DONT_PRINT and defined($self->{DO_VLPR_NOW})) { if (defined($ref)) { if ( $self->{DO_VLPR} =~ /^yes$/i and $PARALLELE_VALIDATION ) { return $self->{DO_VLPR} = 1 unless $AGREGATE_PRINT ; $$ref = 1 ; if ($self->sequence_ready()) { if ($self->{LAST_CHECK} = $self->{DO_VLPR_NOW}) { return $self->{DO_VLPR} = 1 ; } else { return 0 ; } } else { return $self->{LAST_CHECK} = 0 ; } } else { return $self->{DO_VLPR} = 0 ; } } else { return $self->{DO_VLPR} ; } } return 0 ; } sub waiting { my $self = shift ; return @_ ? $self->{WAITING} = shift : $self->{WAITING} ; } sub sequence_ready { # Set agregation count down to the total number of print with correction my $self = shift ; return 0 unless $AGREGATE_PRINT ; # Returns checked value to avoid concurrencing that involves first job will # waiting in place of starting its own sequence if ( $self->{SEQREADY} ) { my $ready = 1 ; if (defined($self->{LAST_CHECK})) { $ready = $self->{LAST_CHECK} ; delete $self->{LAST_CHECK} ; } return $ready ; } unless ( $self->geta2pjob() ) { my @count = grep { -d $_ } glob( $self->{JOBDIR} . "/AFP-*" ); return $self->{AGREGATION_COUNT} = @count ; } my $a2pjob ; return 0 unless ( $a2pjob = $self->a2pobj ); # Return higher cache state return $self->{SEQREADY} = 1 if ( $a2pjob->{SEQREADY} ); # Here we must completly update the sequence arrays when we are # knowing every things of jobs return 0 unless (defined($a2pjob->{AGREGATION_COUNT}) and $a2pjob->{AGREGATION_COUNT} == $a2pjob->{JOBS} + $a2pjob->{SEQREMOVED}); # Here we are sure sequence arrays should be completed, but they can exist # with holes if more than one destid is used, we should come here only one # time, so don't forget to check every sequence dependant variables my $control = 0 ; foreach my $destid (keys(%{$a2pjob->{SEQUENCE}})) { @{$a2pjob->{SEQUENCE}->{$destid}} = grep { defined($_) and $_ } @{$a2pjob->{SEQUENCE}->{$destid}} ; $control += @{$a2pjob->{SEQUENCE}->{$destid}} ; # Check current first clones in the sequences will start the sequence my $seqindex = $a2pjob->{LPRSEQ}->{$destid} ; my $cloneid = $a2pjob->{SEQUENCE}->{$destid}->[$seqindex] ; my $clone = $a2pjob->getclone($cloneid) ; $clone->{DO_LPR_NOW} = 1 ; $seqindex = $a2pjob->{VLPRSEQ}->{$destid} ; $cloneid = $a2pjob->{SEQUENCE}->{$destid}->[$seqindex] ; $clone = $a2pjob->getclone($cloneid) ; $clone->{DO_VLPR_NOW} = 1 ; } $self->error(846,"Can't compute the sequence for this job ") unless ( $control == $a2pjob->{JOBS} ); $a2pjob->{SEQREADY} = 1 ; $self->{SEQREADY} = 1 ; return 0 ; # Return 0 to force the Job to not be waiting, as the SEQREADY # is cached, it will be processed very soon } sub next_is_waiting { my $self = shift ; my $next = $self->next_in_sequence ; return 0 unless $next ; my $a2pjob ; return 0 unless ( $a2pjob = $self->a2pobj ); my $clone ; return 0 unless ( $clone = $a2pjob->getclone($next) ); return $clone->{WAITING} ; } sub remove_from_sequence_but_authorize_next { # Only called in case of error. We must adapt the authorization sequence # and if we must authorize next job in the sequence my $self = shift ; # Really needed if a destid is defined my $destid = $self->getdestid or return 0 ; my $a2pjob ; return 0 unless ( $a2pjob = $self->a2pobj ); # Check if this job is the next waited my $next = $self->{STEP} < 9 ? $a2pjob->{LPRSEQ}->{$destid} : $a2pjob->{VLPRSEQ}->{$destid} ; $self->jobdebug("Current next job in the sequence has the index $next."); # Check which job is the next in the sequence my $ref = $a2pjob->{SEQUENCE}->{$destid} ; my ( $myid, $nextid ) = ( $self->getid, $ref->[$next] ) ; # Remove this one from the sequence unless (defined($self->{ISSEQREMOVED})) { # Purging list from our id my $jobid = "" ; my @temp = () ; while ( @{$ref} ) { $jobid = pop @{$ref}; last if ( $jobid eq $myid and $self->{ISSEQREMOVED} = 1 ); unshift @temp , $jobid ; } push @{$ref}, @temp if @temp ; # This job is removed and can't be counted later if sequence is still # not ready $a2pjob->{JOBS} -- ; $a2pjob->{SEQREMOVED} ++ ; # Last check and message, just in case if ( $jobid eq $myid ) { $self->jobinfo("$myid removed from $destid print sequence"); } else { $self->error($self->getstep()*111, "Can't remove '$myid' from printing sequence ($jobid;@temp)"); } } # Return true to still authorize the next if we were the next expected return ( $myid eq $nextid ) ? 1 : 0 ; } sub next_in_sequence { my $self = shift ; return 0 unless $AGREGATE_PRINT ; my $key = $self->getid() . '-SEQNEXTID' ; my $a2pjob ; return $self->{$key} = "" unless ( $a2pjob = $self->a2pobj ); # Return eventually cached value if not in error my $clone = $a2pjob->getclone($self->{$key}); return $self->{$key} if (defined($self->{$key}) and $clone and ! $clone->error ); my $nextid = "" ; my $destid = $self->getdestid ; return $self->{$key} = "" unless $destid ; my $next = $self->{STEP} < 9 ? $a2pjob->{LPRSEQ}->{$destid} : $a2pjob->{VLPRSEQ}->{$destid} ; $self->jobdebug("The next job in the sequence has the index $next."); my $ref = $a2pjob->{SEQUENCE}->{$destid} ; if (defined($ref) and $next < @{$ref} ) { $nextid = $ref->[$next] ; $self->jobdebug("The job $next in the sequence is '$nextid'"); # Get next id in sequence if it's still our if ( $self->getid =~ /^$nextid$/ ) { if ( ++$next < @{$ref} ) { $nextid = $ref->[$next] ; } else { $nextid = "" ; } } } $self->jobdebug($nextid?"The job after me is '$nextid'":"No job after me"); return $self->{$key} = $nextid ; } sub get_authorization_key { my $self = shift ; return $self->getid() . '-NEXT-AUTHORIZED-' . $self->{STEP} ; } sub get_next_authorized { my $self = shift ; my $key = $self->get_authorization_key ; return defined($self->{$key}) ? $self->{$key} : "" ; } sub authorize_next_print { my $self = shift ; my $key = $self->get_authorization_key ; # We can only authorize one time return "" if (defined($self->{$key})); # Nothing to authorize if destid is not set my $destid = $self->getdestid ; return $self->{$key} = "" unless $destid ; my $a2pjob ; return $self->{$key} = "" unless ( $a2pjob = $self->a2pobj ); # Update sequence index my $next = $self->{STEP} < 9 ? ++ $a2pjob->{LPRSEQ}->{$destid} : ++ $a2pjob->{VLPRSEQ}->{$destid} ; $self->jobdebug("Will authorize job $next in the sequence"); # Get next jobid in sequence to autorize unless at the end of sequence my $nextid = $self->next_in_sequence ; if ( $nextid ) { my $clone ; if ( $clone = $a2pjob->getclone($nextid) ) { $self->jobdebug("Authorizing '$nextid' to print"); $clone->authorize_print($self->{STEP}); # Return next id caching it for next call if still not cached return $self->{$key} = $nextid ; } else { $self->error(9,"Can't authorize '$nextid' to print, no such job"); } } elsif (defined($a2pjob->{SEQUENCE}->{$destid})) { $self->jobdebug("No print to authorize as this is the end of sequence"); } else { $self->error(10,"No sequence found for destid '$destid'"); } return $self->{$key} = "" ; } sub authorize_print { my $self = shift ; # We must be authorized at the same step from the previous job my $step = shift ; $self->jobdebug("Authorized to print at step $step"); $self->{ $step < 9 ? 'DO_LPR_NOW' : 'DO_VLPR_NOW' } = 1 ; } sub do_arch { my $self = shift ; my $test = defined($self->{DO_ARCH}) ? ( $self->{DO_ARCH} =~ /^yes$/i ? 1 : 0 ) : 0 ; $self->error(10,"ABTERM: Archivage requested but not activated in service") if ( $test and ! $ARCH_ENABLED ); return $ARCH_ENABLED ? $test : 0 ; } sub do_eservice { my $self = shift ; my $test = defined($self->{DO_ESERVICE}) ? ( $self->{DO_ESERVICE} =~ /^yes$/i ? 1 : 0 ) : 0 ; if ( $test ) { if ( $ESERVICE_ENABLED ) { # At this stage we can return disabling DO_ARCH return $self->{DO_ARCH} = 'reset for e-service' ; } else { $self->error( 10, "ABTERM: E-Service requested but not activated in service" ); } } return 0 ; } sub getPdfName { my $self = shift ; if ( defined($self->{PDFFILE}) and $self->{PDFFILE} ) { $self->{PDFFILE} =~ m|([^/]+)$| ; return $1 ; } return $LOCKID . '-' . $self->{ID} . '_' . $self->{JOBNAME} . '.pdf' ; } sub pdf_cmd { my $self = shift ; my $output = $self->{ID} . "-pdf_cmd.output" ; $self->{PDFFILE} = $self->getPdfName ; $self->todelete( $self->{OUTFILE} . ".aux" ); $self->toclean( $self->{PATH} . "/" . $output , $self->{PATH} . "/missfont.log" , $self->{OUTFILE} . ".pdf" , $self->{OUTFILE} . ".log" ); my $pdfname = $self->{PDFFILE} =~ /^$SHMDIR/ ? $self->{PDFFILE} : $self->{PATH} . "/" . $self->{PDFFILE} ; $DONTZIPPDF ? $self->tomove($pdfname) : $self->toclean($pdfname) ; push @{$self->{PDFS}}, $pdfname ; return $self->request( "cd $self->{PATH} ; while [ -e '$self->{FILE}.tex.LCK' ] ; do " . "usleep $USLEEP ; done ; " . "LANG=C pdflatex --interaction batchmode $self->{FILE} >$output 2>&1"); } sub split_cmd { my $self = shift ; # Avoid splitting without SPLIT_TRIGGER defined return undef unless (defined($self->{SPLIT_TRIGGER}) and $self->{SPLIT_TRIGGER} ); # Need to wait after all clones are initialized return 0 if ( $self->{MAX_CLONE_INDEX} - $self->getallclones ); &UPSTAT('SPLIT-CMD'); my $jobdir = $self->{JOBDIR} ; my $cmd = "cd $jobdir ; cat " ; # We have some afp to agregate to a new file in spool, and we need this # list as an ordered list foreach my $job ( $self->getallclones ) { my $clone = $self->getclone($job) ; return $self->error( 90, "Can't split AFP with $job sub job") unless (defined($clone)); return $self->error( 91, "Can't split AFP without $job afp file") unless (exists($clone->{OUTFILE}) and $clone->{OUTFILE}); my $file = $clone->{OUTFILE} . '.afp' ; return $self->error( 92, "Can't split AFP without AFP $job extracted") unless ( -s $file ); # Get clone extracted .afp path relative to jobdir my ( $path ) = $file =~ m|$jobdir/(.*)$| ; $cmd .= $path . " " ; } # Now it is safe to forget this API for next call from JobManager delete $self->{SPLIT_TRIGGER} ; # Now FILE would be the new one if still not set $self->{FILE} = $self->{SPLITTED_FILE} . '.' . $self->{SPLIT_TAG} ; # Now add output file direction $cmd .= '>' . $AFPSPOOL . '/' . $self->{FILE} ; # Get stderr if necessary $cmd .= ' 2>split_cmd.stderr' ; $self->toclean($jobdir . '/split_cmd.stderr'); my $req = $self->request($cmd); &MAXSTAT('SPLIT-CMD-REQ-SIZE',length($req)); return $req ; } sub split_from { my $self = shift ; my $job = shift ; # Get next pos in the file for the next job my $pos = $job->{'SPLIT_FILE'} ; # Set the same file as splitted job but with a startpoint $self->setanswer($job->getfile); $self->setstartpos($pos); # Keep a copy of SPLIT_TAGS informations to avoid duplicated tags $self->{'SPLIT_TAGS'} = $job->{'SPLIT_TAGS'} ; # Still set our TAG from previous TAG2 job, necessary for the last job $self->{'SPLIT_TAG'} = $job->{'SPLIT_TAG2'} ; # Keep the original splitted file in mind $self->{'SPLITTED_FILE'} = $job->{'SPLITTED_FILE'} ; # Still define SPLIT_TRIGGER for splitter command, especially for the # last splitted job $self->{'SPLIT_TRIGGER'} = 1 ; } sub is_splitted { return exists($_[0]->{'SPLIT_TAG'}) ? 1 : 0 ; } sub request { my $self = shift ; return $self->{LASTREQUEST} = &GetCom( comJOB , $self->{ID} , @_ ); } sub eservice_request { my $self = shift ; return $self->{ESERVICE_REQ} if (defined($self->{ESERVICE_REQ})); $self->{ESERVICE_REQ} = $self->request( &GetCom( comFILE , $self->{E_SERVICE} , $self->{XML_A2P} )); } sub eservice_name { return $_[0]->{E_SERVICE} || "" ; } sub getpdffiles { return defined($_[0]->{PDFS})?@{$_[0]->{PDFS}}:() ; } sub rename_pdf { my $self = shift ; return unless $self->{STATE} == DONE ; my $file = $self->{PDFFILE} =~ m|^/| ? $self->{PDFFILE} : "$self->{PATH}/$self->{PDFFILE}" ; rename "$self->{PATH}/$self->{FILE}.pdf", $file or $self->error(1,"Can't rename pdf file from '$self->{FILE}.pdf' to '" . $file . "': $!"); } sub dvi_cmd { my $self = shift ; my $output = $self->{ID} . "-latex_cmd.output" ; # We must delete .aux file generated by pdflatex command unlink $self->{OUTFILE} . ".aux" if ( -e $self->{OUTFILE} . ".aux" ); $self->todelete( $self->{OUTFILE} . ".aux" ); $self->toclean( $self->{PATH} . "/" . $output , $self->{PATH} . "/missfont.log" , $self->{OUTFILE} . ".dvi" , $self->{OUTFILE} . ".log" ); return $self->request( "cd $self->{PATH} ; while [ -e '$self->{FILE}.tex.LCK' ] ; do " . "usleep $USLEEP ; done ; " . "LANG=C latex --interaction batchmode $self->{FILE} >$output 2>&1"); } ################################################################################ # Compute the command to produce PCL code # 1. Update variables to specify which file to produce # 2. Update list of files to clean in later step # 3. Return the command to pass to an active backend sub pcl_cmd { my $self = shift ; my $output = $self->{ID} . "-pcl_cmd.output" ; my $command = "cd '$self->{PATH}'; ( export LANG=C ;" ; # Update dvilj command options my $DVILJOPT = '-c' . $self->{COPIES} . ' ' . $self->{DVILJOPT} ; if ( $ADDPCL_JOBNAME and $self->getjobname() and $self->{DVILJOPT} =~ /-J/) { my $jobname = $self->getjobname() ; $jobname =~ s/\s+/_/ ; # Check to keep no space in name $DVILJOPT =~ s/-J/-J$jobname/ ; } if ( $ADDPCL_USERNAME and $self->getusername() and $self->{DVILJOPT} =~ /-U/) { my $username = $self->getusername() ; $username =~ s/\s+/_/ ; # Check to keep no space in name $DVILJOPT =~ s/-U/-U$username/ ; } ###1 $self->{PCLFILE} = $self->{OUTFILE} . ".pcl"; $self->{LPRFILE} = $self->{PCLFILE} ; # At that time PCL validation file if the same than original printed # Later we will update it if dvilj command has different options $self->{VLPRFILE} = $self->{PCLFILE} ; ###2 $self->todelete( $self->{OUTFILE} . ".aux" ); $self->toclean( $self->{PATH} . "/" . $output , $self->{OUTFILE} . ".dvicopy" , $self->{PCLFILE} , $self->{LPRFILE}, $self->{VLPRFILE} ); ###3 return $self->request( $command . "if dvicopy $self->{FILE}.dvi $self->{FILE}.dvicopy ; then " . "$DVILJ -v $DVILJOPT -e$self->{PCLFILE} $self->{FILE}.dvicopy ;" . "else echo \"dvicopy error: \$?\" ; exit 1 ; fi ) >$output 2>&1" ); } ################################################################################ # Call a function from AFPDS/PCL.pm that check PCL code if necessary sub valid_pcl { return unless $_[0]->{STATE} == DONE ; $_[0]->{STATE} = 5 if (&validate_pcl5($_[0]->{PCLFILE})); } ################################################################################ # Compute the command to produce PCL code for validation process # 1. Update variables to specify which file to produce # 2. Update list of files to clean in later step # 3. Return the command to pass to an active backend sub vpcl_cmd { my $self = shift ; # Return empty string if we can use PCL from the previous step return "" if ( $self->{VDVILJOPT} =~ /^$self->{DVILJOPT}$/ and $self->do_pcl ); my $output = $self->{ID} . "-vpcl_cmd.output" ; my $command = "cd '$self->{PATH}'; ( export LANG=C;" ; # Update dvilj command options my $DVILJOPT = '-c' . $self->{COPIES} . ' ' . $self->{VDVILJOPT} ; if ( $ADDPCL_JOBNAME and $self->getjobname() and $self->{VDVILJOPT} =~ /-J/) { my $jobname = $self->getjobname() ; $jobname =~ s/\s+/_/ ; # Check to keep no space in name $DVILJOPT =~ s/-J/-J$jobname/ ; } if ( $ADDPCL_USERNAME and $self->getusername() and $self->{VDVILJOPT} =~ /-U/) { my $username = $self->getusername() ; $username =~ s/\s+/_/ ; # Check to keep no space in name $DVILJOPT =~ s/-U/-U$username/ ; } ###1 $self->{VPCLFILE} = $self->{OUTFILE} . ".vpcl"; $self->{VLPRFILE} = $self->{VPCLFILE} ; ###2 $self->toclean( $self->{PATH} . "/" . $output , $self->{PATH} . "/" . $output , $self->{OUTFILE} . ".dvicopy" , $self->{VPCLFILE} , $self->{VLPRFILE} ); ###3 my $dvicmd = "$DVILJ -v $DVILJOPT -e$self->{VPCLFILE} " . $self->{FILE} . ".dvicopy" ; # Is dvicopy still passed on original latex output ? if ( -e "$self->{PATH}/$self->{FILE}.dvicopy" ) { $command .= $dvicmd } else { $command .= "if dvicopy $self->{FILE}.dvi $self->{FILE}.dvicopy ;" . "then $dvicmd; else echo \"dvicopy error: \$?\" ; fi" ; } $command .= ") >$output 2>&1" ; return $self->request( $command ); } ################################################################################ # Call a function from AFPDS/PCL.pm that check PCL code if necessary # Here for the validation process sub valid_vpcl { return unless ( $_[0]->{STATE} == DONE and $_[0]->{PCLFILE} ne $_[0]->{VPCLFILE} ); # Still validated $_[0]->{STATE} = 5 if (&validate_pcl5($_[0]->{VPCLFILE})); } sub ps_cmd { my $self = shift ; my $output = $self->{ID} . "-ps_cmd.output" ; $self->{LPRFILE} = $self->{OUTFILE} . ".ps" ; $self->toclean( $self->{PATH} . "/" . $output , $self->{LPRFILE} ); return $self->request( "cd $self->{PATH}; LANG=C " . "dvips -c $self->{COPIES} $self->{DVIPSOPT}" . " -o $self->{FILE}.ps $self->{FILE} " . " >$output 2>&1" ); } sub lpr_cmd { my $self = shift ; my $cmd ; my $output = $self->{PATH} . "/" . $self->{ID} . "-lpr_cmd.output" ; # We not mark LPRFILE to clean has it has been marked to during PCL command $self->toclean( $output ); # Agregate print when required, then return empty string to delay command # in JobManager if ( $AGREGATE_PRINT and -d $self->{JOBDIR} ) { my $PCL5cluster = $self->{JOBDIR} . "/" . $self->getdestid . "-lpr-cluster" ; # Add to be erased if still not created $self->todelete( $PCL5cluster ) unless ( -e $PCL5cluster ); $cmd = "cat $self->{LPRFILE} >>$PCL5cluster 2>>$output" ; $self->count_pcl5(); # Really lpr that job only if there's no other job in sequence unless ($self->next_in_sequence) { my $len = $self->get_pcl5_count ; my $PrintID = $self->geta2pjob . ( $len > 1 ? "-${len}_Jobs" : "" ); $PrintID .= '-' . $self->{DESTID} ; $cmd .= " ; LANG=C lpr $self->{LPROPT} -J'$PrintID' $PCL5cluster" . " >>$output 2>&1" ; } } else { my $PrintID = $self->geta2pjob . '-' . $self->{DESTID} ; $cmd = "LANG=C lpr $self->{LPROPT} -J'$PrintID' $self->{LPRFILE} " . ">>$output 2>&1" ; } return $self->request($cmd); } sub vlpr_cmd { my $self = shift ; my $cmd ; my $output = $self->{PATH} . "/" . $self->{ID} . "-lpr_cmd.output" ; # We not mark VLPRFILE to clean has it has been marked to during PCL command $self->toclean( $output ); # Agregate print when required, then return empty string to delay command # in JobManager if ( $AGREGATE_PRINT and -d $self->{JOBDIR} ) { my $PCL5cluster = $self->{JOBDIR} . "/" . $self->getdestid . "-vlpr-cluster" ; # Add to be erased if still not created $self->todelete( $PCL5cluster ) unless ( -e $PCL5cluster ); $cmd = "cat $self->{VLPRFILE} >>$PCL5cluster 2>>$output" ; $self->count_pcl5(); # Really lpr that job only if there's no other job in sequence unless ($self->next_in_sequence) { my $len = $self->get_pcl5_count ; my $PrintID = $self->geta2pjob . ( $len > 1 ? "-${len}_Jobs" : "" ); $PrintID .= '-' . $self->{DESTID} . '-validation' ; $cmd .= " ; LANG=C lpr $self->{VLPROPT} -J'$PrintID' $PCL5cluster " . ">>$output 2>&1" ; } } else { my $PrintID = $self->geta2pjob . '-' . $self->{DESTID} . '-validation' ; $cmd = "LANG=C lpr $self->{VLPROPT} -J'$PrintID' $self->{VLPRFILE} " . ">>$output 2>&1" ; } return $self->request($cmd); } sub count_pcl5 { my $self = shift ; my $destid = $self->getdestid ; return unless $destid ; my $a2pjob ; return unless ( $a2pjob = $self->a2pobj ); my $key = $self->isstep(8) ? 'PCL5COUNT' : 'VPCL5COUNT' ; if (defined($a2pjob->{$key}->{$destid})) { $a2pjob->{$key}->{$destid} ++ ; } else { $a2pjob->{$key}->{$destid} = 1 ; } } sub get_pcl5_count { my $self = shift ; my $destid = $self->getdestid ; return 0 unless $destid ; my $a2pjob ; return 0 unless ( $a2pjob = $self->a2pobj ); return $a2pjob->{$self->isstep(8)?'PCL5COUNT':'VPCL5COUNT'}->{$destid} ; } sub get_arch_file { my $self = shift ; # Return cached value return $self->{ARCH_FILE} if (defined($self->{ARCH_FILE})); my $current_arch_file = $self->{PATH} . "/" . $self->{FILE} . ".arch" ; $self->{ARCHFILE} = $self->getPdfName() ; # Get same base as PDF file $self->{ARCHFILE} =~ s/\.pdf$/.arch/ ; # replace .pdf extension with .arch my $ok = 0 ; if ( -s $current_arch_file and ! -s $self->{PATH} . "/" . $self->{ARCHFILE} ) { # Rename arch file as expected by archivage thread rename $current_arch_file , $self->{PATH} . "/" . $self->{ARCHFILE} and $ok ++ ; $self->error( 10, "Can't rename arch file from '" . $current_arch_file . "' to '" . $self->{ARCHFILE} . "': $!") unless $ok ; } elsif ( ! -s $self->{PATH} . "/" . $self->{ARCHFILE} ) { $self->error(10,"Required arch file to be renamed is empty") if ( -e $current_arch_file ); $self->error(10,"Required arch file exists but is empty") if ( -e $self->{PATH} . "/" . $self->{ARCHFILE} ); $self->error(10,"No required arch file exists"); } return 0 unless $ok ; # Clean arch file only if not debugging archivage my $archname = $self->{PATH} . "/" . $self->{ARCHFILE} ; $ARCH_DEBUG ? $self->tomove($archname,$archname . "_debug.txt") : $self->toclean($archname) ; # Cache the request return $self->{ARCH_FILE} = $self->request( $archname ); } sub do_clean_cmd { my $self = shift ; &UPSTAT('CHECK_DO_CLEAN'); # CLEAN_CMD not defined: we need to define it in clean_cmd # else check the next command is not 'DONE' number # Also no clean if we prefer PURGEFILES or no file is existing # as we don't clean folders return ( ! defined($self->{CLEAN_CMD})) ? (($PURGEFILES or ! grep { -e $_ } $self->get2clean)? 0 : 1 ) : ( $self->{CLEAN_CMD}->[0] =~ /^\d+$/ ? ( $self->{CLEAN_CMD}->[0] == DONE ? 0 : 1 ) : 1 ); } sub clean_cmd { my $self = shift ; my ( $ZipFile , $index ) = ( "" , 0 ); # Return next cached command if (defined($self->{CLEAN_CMD})) { &UPSTAT('MOVE_CMDS'); return shift @{$self->{CLEAN_CMD}} ; } # First delete empty files map { ( unlink $_ and $self->jobdebug("'$_' file deleted as empty")) if ( -z $_ and -f $_ ) } $self->get2clean ; my @ToClean = grep { -s $_ and -f $_ } $self->get2clean ; # Empty CLEAN array now to preserve memory on big jobs $self->{CLEAN} = [ ] ; # Find a free zipfile name, should loop only one time to set ZipFile name while ( -e $ZipFile or ! $ZipFile ) { $ZipFile = ($self->{ERROR} ? $ERRORSPOOL : $DONESPOOL ) . "/" . $LOCKID . "-" . $self->{ID} . ($index++?"-$index":"") . ".zip" ; } # Return zipfile name to client $self->jobinfo("ZIPFILE=$ZipFile") if ( $self->getClientRef ); # Keep ZIPFILE found if we need to attach it to an alert mail $self->{ZIPFILE} = $ZipFile ; while ( @ToClean ) { my @files = () ; my $max = $MAXFILES_BY_ZIPCMD || 10 ; while ( $max -- and @ToClean ) { push @files, &GetCom( comFILE , shift @ToClean ); } push @{$self->{CLEAN_CMD}}, $self->request( &GetCom( comZIP , $ZipFile => @files )); } # Keep debugging on commands foreach my $zipcmd ( @{$self->{CLEAN_CMD}} ) { $self->jobdebug("Have to do clean command using '$zipcmd' request"); } # Keep commands number to initialize step 11 progression $self->{NB_CMDS} += scalar(@{$self->{CLEAN_CMD}}); # Work around when nothing found to clean push @{$self->{CLEAN_CMD}}, "" unless (@{$self->{CLEAN_CMD}}); # Add DONE status to the end of list, it will be seen by do_clean_cmd push @{$self->{CLEAN_CMD}}, DONE ; &UPSTAT('CLEAN_CMDS'); return shift @{$self->{CLEAN_CMD}} ; } sub clean_progress { # Give info each 30 sec when clean step is longer than 30 sec my $self = shift ; return unless ($self->{NB_CMDS}); return unless ( $self->get_ms - $self->{NB_CMDS_CHECK} > 30000 ); return unless (defined($self->{CLEAN_CMD}) and ref($self->{CLEAN_CMD}) =~ /^ARRAY/i ); return unless (defined($self->{MOVE_CMDS}) and ref($self->{MOVE_CMDS}) =~ /^ARRAY/i ); $self->{NB_CMDS_UNIT} = 100 / $self->{NB_CMDS} unless ( $self->{NB_CMDS_UNIT} > 0 ); $self->{NB_CMDS_CHECK} = $self->get_ms ; my $ratio = $self->{NB_CMDS_UNIT} * ( $self->{NB_CMDS} - scalar(@{$self->{MOVE_CMDS}}) - scalar(grep { defined and $_ ne DONE } @{$self->{CLEAN_CMD}}) ); $self->jobinfo(sprintf("Cleanning done at %.1f%%, should finish in %d sec", $ratio , ( $self->{NB_CMDS_CHECK}/1000 ) * ( 100 / $ratio - 1 ) )); $self->jobstatus( '.', { 'STATUS' => sprintf("%d%%", $ratio ) } ) or &Info("Can't set job progression status at step " . $self->{STEP}); } sub jobstatus { my $self = shift ; my $step_status = shift ; my $status = shift || {} ; my $jobid = $self->geta2pjob ; if ($jobid) { $status->{JID} = $self->{ID} ; $status->{STEP} = $self->{STEP} ; } else { $jobid = $self->getid ; } return &a2pjobstate( $jobid, $self->{STEP}, $step_status, $status ); } sub a2pjob_progress_init { my $self = shift ; return unless ($self->{JOBS}); # 8 steps ( steps 3 to 10 ) can be done for each job my $nb_steps = $self->{JOBS} * 8 ; $self->{NB_STEPS_UNIT} = 100 / $nb_steps ; # Many steps can still have been done before this initialization $self->{NB_STEPS_OFFSET} = $self->{JOBS} * -2 ; map { $self->{NB_STEPS_OFFSET} += $self->{CLONES_OBJ}->{$_}->{STEP} } $self->getclones ; $self->{NB_STEPS_OFFSET} += 10 * $self->getfinishedclones ; $self->{NB_STEPS_OFFSET} *= $self->{NB_STEPS_UNIT} ; $self->{NB_STEPS_CHECK} = 0 ; } sub a2pjob_progress { my $self = shift ; # Give info each 30 sec when main job is longer than 30 sec return unless ( $self->get_ms - $self->{NB_STEPS_CHECK} > 30000 ); $self->{NB_STEPS_CHECK} = $self->get_ms ; # Step count is calculated from step 2 my $ratio = $self->{JOBS} * -2 ; map { $ratio += $self->{CLONES_OBJ}->{$_}->{STEP} } $self->getclones ; $ratio += 10 * $self->getfinishedclones ; $ratio *= $self->{NB_STEPS_UNIT} ; # Must check we don't divide by zero my $remain = ( $self->{NB_STEPS_CHECK} / 1000 ) * ( 100 / ( $ratio > $self->{NB_STEPS_OFFSET} ? $ratio - $self->{NB_STEPS_OFFSET} : 0.1 ) - 1 ); $self->jobinfo(sprintf("Progression done at %.1f%%, should finish in %d sec" , $ratio , $remain )); $self->jobstatus( '.', { STATUS => sprintf("%d%%", $ratio ) } ) or &Info("Can't set job progression status at step " . $self->{STEP}); } my @todo_steps = ( "", "", "", [ 'DO_PDF', ], # Step 3 [ 'DO_PS' , 'DO_PCL', ], # Step 4, do dvi [ 'DO_PCL', ], # Step 5 & 6 [ 'DO_PCL', ], # [ 'DO_PS' , ], # Step 7 [ 'DO_LPR', ], # Step 8 & 9 [ 'DO_LPR', ], # [ 'DO_ARCH', 'DO_ESERVICE' ], # Step 10 ); sub cancel { my $self = shift ; my $cancelled = 0 ; # Cancel each job steps if still not at step 10 if ( $self->getstep < 10 ) { foreach my $todo (grep { /^DO_/ } keys(%{$self})) { if ( $self->{$todo} =~ /^yes$/i ) { $self->jobdebug("Cancelling $todo..."); $self->{$todo} = 'cancelled' ; $cancelled ++ ; } } return 0 unless ($cancelled); } # To cancel a job we need also to disable steps of each not finished subjobs foreach my $job ( $self->getclones ) { my $clone = $self->getclone($job) ; my $step = $clone->getstep ; my $this = 0 ; while ( ++$step < 10 ) { my @todo = @{$todo_steps[$step]} ; my @steps_todo = grep { $clone->{$_} =~ /^yes|cancelled$/i } @todo ; next unless @steps_todo ; $clone->jobinfo("Cancelling @steps_todo at step $step"); map { $clone->{$_} = 'cancelled' } @steps_todo ; $cancelled ++ ; $this ++ ; } $clone->jobinfo("Nothing cancelled") unless ($this); } return 0 unless ($cancelled); # Keep the cancel status $self->cancelled(scalar(localtime(time))); # Must return ourself if communications are pending return $self ; } sub cancelled { my $self = shift ; $self->{CANCELLED} = shift if @_ ; return exists($self->{CANCELLED}) ? 1 : 0 ; } sub canpurge { my $self = shift ; return $self->{CANPURGE} if defined($self->{CANPURGE}); $self->{CANPURGE} = 1 ; } sub cannotpurge { my $self = shift ; return ! $self->{CANPURGE} if defined($self->{CANPURGE}); $self->{CANPURGE} = 0 ; } sub purge { my $self = shift ; # Return cache value if still purged return $self->{PURGE} if $self->{PURGE}; &UPSTAT('DO-PURGE'); return $self->{PURGE} = 1 if $self->cannotpurge ; # Update files to purge when required $self->todelete($self->get2clean) if $PURGEFILES ; my %todel = map { $_ => -e $_ ? 1 : 0 } $self->get2delete ; my @todel = grep { $todel{$_} } keys(%todel); my $limit = @todel ; local $" = ', ' ; &Debug("Deleting @todel") if $ADVANCED_DEBUGGING ; # Delete folders recursively if necessary while ( grep { $todel{$_} } keys(%todel) and $limit -- ) { foreach my $file ( keys(%todel) ) { $! = 0 ; if ( $todel{$file} and -e $file ) { if ( -d $file ) { $self->jobdebug("Deleting '$file' folder") if $ADVANCED_DEBUGGING ; unless ( rmdir $file ) { $self->jobinfo("Failed to delete '$file' folder: $!") unless $limit ; next ; } } elsif ( -f $file ) { &Debug("Deleting '$file' file") if $ADVANCED_DEBUGGING ; unless ( unlink $file ) { $self->jobinfo("Failed to delete '$file': $!") unless $limit ; } } } $todel{$_} = 0 ; } } @todel = grep { $todel{$_} } keys(%todel) ; if (@todel) { if ($ADVANCED_DEBUGGING) { my %listing = () ; # What to delete is probably a folder foreach my $folder (@todel) { map { $listing{$_} = 1 } glob( "$folder/*" ) ; } my @listing = keys( %listing ); &Debug("Job not cleaned, still not been removed: @todel"); &Debug("Job not cleaned, found in folders: @listing") if @listing ; } return $self->{PURGE} = 0 ; } else { return $self->{PURGE} = 1 ; } } sub freeparent { my $self = shift ; # To help freeing memory $self->{PARENT} = undef ; } sub cleanjob { my $self = shift ; $self->{AGE} = sprintf("%.2f seconds", time - $self->{BIRTH}); undef $self->{CLEANHASH} ; undef $self->{DELETEHASH} ; undef $self->{MOVEHASH} ; undef $self->{CLEAN} ; undef $self->{DELETE} ; undef $self->{MOVE} ; } sub DESTROY { delete $uniqid{$_[0]->{ID}} ; $_[0]->jobdebug("Freeing memory"); } &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); 1;