# # 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: ControlRecord.pm 3 2007-10-18 16:20:19Z guillaume $ # # Class to implement Control Record Object object package AFPDS::ControlRecord; use strict; use Encode 'from_to'; use A2P::XML ; use A2P::Globals ; use A2P::Syslog ; use A2P::Tools qw( mychomp ShortID ) ; use AFPDS::ControlRecordDef ; BEGIN { our $VERSION = sprintf "%s", q$Rev: 934 $ =~ /(\d[0-9.]+)\s+/ ; } our $VERSION ; # Variables exported from AFPDS::ControlRecordDef module : # %RCDEF # %SIZE # Splitter control my $LastSplitControl = undef ; sub new { &Debug("new AFPDS::ControlRecord v$VERSION"); my $class = shift ; # Default is to generate a PDF file and valid for archivage my $self = { TYPE => shift , TEXBASE => shift , AFPNAME => shift , AFPNUM => shift , ISPRINT => 0 , ERROR => [] }; # Set some other defaults map { $self->{$_} = "" } qw( DO_PDF DO_LPR DO_PS DVILJOPT JOBNAME LPROPT DVIPSOPT DO_PCL DO_VLPR DO_ARCH VDVILJOPT OUTFILE VLPROPT ); if ( !defined( $RCDEF{$self->{TYPE}} ) ) { &Error("Unknown Control Record type '$self->{TYPE}'"); return undef ; } if ($SIZE{$self->{TYPE}}>0) { &Debug("ControlRecord type '$self->{TYPE}' should be max " . $SIZE{$self->{TYPE}} . " bytes long with header (5 bytes)"); } elsif ($SIZE{$self->{TYPE}}<0) { &Debug("ControlRecord type '$self->{TYPE}' is a not sized RC"); } # Reset known tags if we are starting a new job if ( $self->{AFPNUM} == 1 ) { &Debug("First ControlRecord for a new job, resetting control"); $LastSplitControl = undef ; } return bless $self , $class ; } my $job_tag = "" ; sub job_tag { my $self = shift ; return @_ ? $job_tag = "$_[0]: " : $job_tag ; } sub init { my $self = shift ; $self->{BUFFER} = shift ; &mychomp( \$self->{BUFFER} ); &Debug("Initializing new Record type '$self->{TYPE}'"); my $CurrentRCSize = length($self->{BUFFER}) + 5 ; &Debug("Type = $self->{TYPE}, RCLength = " . $CurrentRCSize ); # Initialize any value defined in 'new' member replacing the # definition array reference by the real value for my $key ( keys(%{$RCDEF{$self->{TYPE}}}) ) { # Check if key is a splitter code if ( $key =~ /^__A2P_SPLITTER__$/ ) { &Debug("Type = $self->{TYPE}, RC{$key} : splitter loaded"); $self->{$key} = $RCDEF{$self->{TYPE}}->{$key} ; next ; } my ( $pos , $size ) = @{$RCDEF{$self->{TYPE}}->{$key}} ; # Only handle RC size if it's a sized defined RC if (defined($size) and $size>0) { &Debug("Extracting value @ $pos + $size"); $self->{$key} = $self->value( $pos , $size ); return $self->ABTERM( 301, "Can't read $key value at pos $pos, $size long" ) unless (defined($self->{$key})); &Debug("Type = $self->{TYPE}, RC{$key} = '$self->{$key}'"); } } if ( $self->{TYPE} =~ /^(100|001)$/ ) { # Control record 001 or 100 specific initialization # Update specific values $self->{ISPRINT} = $self->{TYPE} =~ /^100$/ ? 0 : 1 ; # We force DO_PDF to 'yes' if not a print as we have no info on it # DO_ARCH will be updated only if a RC 101 is also provided if ( $self->{TYPE} =~ /^100$/ ) { $self->{DO_PDF} = 'yes' ; $self->{DO_ARCH} = 'no' ; } # Strip spaces at end of values $self->{PAGEDEF} =~ s/\s+$// ; $self->{FORMDEF} =~ s/\s+$// ; $self->{CHARS} =~ s/\s+$// ; $self->{FLASH} =~ s/\s+$// if ($self->{ISPRINT}); $self->{DESTID} =~ s/\s+$// if ($self->{ISPRINT}); $self->{DOCNAME} = $self->{IMPDOCA} . $self->{IMPDOCN} ; # This should be help to link linux job to mainframe job $self->{JOBNAME} = $self->{AFPNAME} . '-' . $self->{UTISTE3} . '_' . $self->{UTIPRJ} . $self->{DOCNAME} . '-AFP' . $self->{AFPNUM}; $self->{TEXBASE} .= '/AFP-' . $self->{AFPNUM} ; # Here make a folder for TEXBASE or rise an ABTERM return $self->ABTERM( 302, "Can't create " . $self->{TEXBASE} . " folder: $!" ) unless ( mkdir $self->{TEXBASE} , 0775 ); # OUTFILE is a critical value for all threads $self->{OUTFILE} = $self->{TEXBASE} . '/' . ( $self->{TYPE} =~ /^100$/ ? 'archive' : 'print' ) ; if ($self->{ISPRINT}) { # Force DESTID if required in conf if ($FORCE_DESTID) { &Debug("Force Destination '$self->{DESTID}' to $FORCE_DESTID"); $self->{DESTID} = $FORCE_DESTID ; } # Read Destination configuration file to set needed options my $xml = $self->getxml(); return $self->ABTERM( 303, "Can' get an XML object to handle DESTID conf" ) unless (defined($xml)); # Leave if DestId file does not exist return $self->ABTERM( 304, "'$DESTIDFILE' XML conf doesn't exist" ) unless ( -e $DESTIDFILE ); &Debug("Parsing XML configuration file '$DESTIDFILE'"); return $self->ABTERM( 305, "Can't read DESTID conf" ) unless ( $xml->parse_file( $DESTIDFILE ) eq $DESTIDFILE ); # This selectDestId API selects a node on which we will 'get' values return $self->ABTERM( 306, "No printer configuration found for DestID '$self->{DESTID}'") unless ($xml->selectDestId($self->{DESTID}) eq $self->{DESTID}); &Debug("'$self->{DESTID}' printer configuration selected"); $self->{DO_PCL} = $xml->get( 'PCL' ); $self->{DO_PS} = $xml->get( 'PS' ); $self->{DO_LPR} = $xml->get( 'LPR' ); $self->{DO_VLPR} = $xml->get( 'VLPR' ); $self->{DO_PDF} = $xml->get( 'PDF' ); $self->{DO_ARCH} = $xml->get( 'ARCH' ); $self->{DVILJOPT} = $xml->get( 'DVILJOptions' ); $self->{DVIPSOPT} = $xml->get( 'DVIPSOptions' ); $self->{LPROPT} = $xml->get( 'LPROptions' ); $self->{VLPROPT} = $xml->get( 'VLPROptions' ); $self->{VDVILJOPT} = $xml->get( 'VDVILJOptions' ); # Check also if we should check to adapt document or not my $can_do_correction = $xml->get( 'ByDocumentCorrection' ) ; # Set default from service configuration if not defined $can_do_correction = $DOCUMENTS_CORRECTION_ENABLED unless (defined($can_do_correction) and $can_do_correction =~ /^\d+$/); # Is correction forced by service configuration ? $can_do_correction ++ if ($DOCUMENTS_CORRECTION_ENABLED > 1 ); # Reset to default 'no' if a value is not defined map { $self->{$_} = "no" } grep { ! defined($self->{$_}) } qw( DO_PCL DO_PS DO_PDF DO_LPR DO_VLPR ); # Reset to default "(nothing)" if a value is not defined map { $self->{$_} = "" } grep { ! defined($self->{$_}) } qw( DVILJOPT DVIPSOPT LPROPT VLPROPT VDVILJOPT ); &Debug("'$self->{DESTID}' configuration read"); my $hasconf = 1 ; # Forced in service configuration if ($DONT_PRINT) { &Info(job_tag."Printing disabled in conf"); $self->{DO_LPR} = 'no' ; $self->{DO_VLPR} = 'no' ; } elsif ( $hasconf = $self->getdocsconf($self->{DOCNAME}) and $can_do_correction ) { &Debug("Have a correction for document " . $self->{DOCNAME} . " to apply"); # If a correction is defined for the current document, we need # to update DVILJOptions and VDVILJOptions $self->fixdviljconf($self->{DOCNAME}); } elsif ($hasconf eq $self->{DOCNAME} and ! $can_do_correction) { &Info(job_tag."'$self->{DOCNAME}' Document corrections " . "discarded for this DestID"); } elsif (!$hasconf) { &Debug("No correction for '$self->{DOCNAME}' Document in conf"); } ################################ # Bin/tray support ################################ # Extract values $self->{DVILJOPT} =~ /\-T1=(\d+).*\-T2=(\d+)/ ; my ( $TA , $TB ) = ( $1 , $2 ); $self->{VDVILJOPT} =~ /\-T1=(\d+).*\-T2=(\d+)/ ; my ( $VTA , $VTB ) = ( $1 , $2 ); # Set to default auto-select value 7 if not defined my $not_defined = 0; map { $$_ = 7 , $not_defined++ if (!defined($$_)) } (\$TA,\$TB,\$VTA,\$VTB); &Debug("Bin selection A=$TA, B=$TB"); &Debug("Bin selection VA=$VTA, VB=$VTB)"); &Info(job_tag."Found $not_defined not defined Bin-Tray selection") if $not_defined ; # Compute PCL5 command for bin/tray selection in file # if not supported by dvi2pcl command if (! $USE_PCLCMD) { # Prepare PCL5 command files for insertion if needed open(TRAYA, ">$self->{OUTFILE}.trayone") or &Error("Can't open $self->{OUTFILE}.trayone :$!"); print TRAYA chr(27) . "&l" . $TA . "H" if (defined(fileno( TRAYA))); close(TRAYA); open(TRAYB, ">$self->{OUTFILE}.traytwo") or &Error("Can't open $self->{OUTFILE}.traytwo :$!"); print TRAYB chr(27) . "&l" . $TB . "H" if (defined(fileno( TRAYB))); close(TRAYB); if ( $TA != $VTA ) { open(VTRAYA, ">$self->{OUTFILE}.vtrayone") or &Error("Can't open $self->{OUTFILE}.vtrayone :$!"); print VTRAYA chr(27) . "&l" . $VTA . "H" if (defined(fileno(VTRAYA))); close(VTRAYA); } if ( $TB != $VTB ) { open(VTRAYB, ">$self->{OUTFILE}.vtraytwo") or &Error("Can't open $self->{OUTFILE}.vtraytwo :$!"); print VTRAYB chr(27) . "&l" . $VTB . "H" if (defined(fileno(VTRAYB))); close(VTRAYB); } # Strip DVIJLOptions from any Tray/bin definition... $self->{DVILJOPT} =~ s/\-T.*// ; $self->{VDVILJOPT} =~ s/\-T.*// ; } } #endif $self->{ISPRINT} } elsif ( $self->{TYPE} =~ /^101$/ ) { # We could only transmit job to archiver when we have found a 101 record ( $self->{DO_PDF} , $self->{DO_ARCH} ) = ( 'yes' , 'yes' ); } &Debug("Initialization done"); } sub can_split_job { my $self = shift ; return 0 unless $ENABLE_SPLITTER ; # Control auto-splitter first return 1 if ( $AUTO_SPLIT_MAX and $self->{AFPNUM} > $AUTO_SPLIT_MAX ); return 0 unless (defined($self->{__A2P_SPLITTER__})); my $splitter = $self->{__A2P_SPLITTER__} ; my $control = &$splitter( $self ); if (defined($LastSplitControl)) { # Just compare if the value returned by splitter has changed unless ( $control =~ /^$LastSplitControl$/ ) { &Info(job_tag."Splitting AFPDS between jobs for " . $LastSplitControl . " and " . $control ); # Keep last control as tag if desired $self->{SPLIT_TAGS} = [ $LastSplitControl, $control ] ; $LastSplitControl = $control; &UPSTAT('SPLIT_EVENT'); return 1 ; } } else { # First time just initialize the control handler $self->{SPLIT_TAGS} = [ $LastSplitControl = $control ] ; } # Return false by default return 0 } sub get_split_tags { my $self = shift ; # Clean RC initialization to avoid agregation conflicts rmdir $self->{TEXBASE} ; # Try to return uniq tags list or return a tag couple which must be # automatically updated in JobManager return (defined($self->{SPLIT_TAGS}) and @{$self->{SPLIT_TAGS}} > 1 ) ? @{$self->{SPLIT_TAGS}} : ( 'PART', 'PART' ); } my $XMLCONF ; sub getxml { my $self = shift ; # Get cached A2P::XML object as it is used here to only read Destid conf return $XMLCONF if (defined($XMLCONF) and ref($XMLCONF) =~ /^A2P::XML$/ ); &Debug("Creating new XML object to handle DESTID configuration"); return $XMLCONF = new A2P::XML ; } my $DOCSCONF ; sub getdocsconf { my $self = shift ; my $doc = shift ; unless ( -e $DOCSFILE ) { &Info(job_tag."'$DOCSFILE' Documents corrections configuration " . "not found, skipping"); return 0 ; } unless (defined($doc) and $doc) { &Warn("No document specified while checking documents configuration"); return 0 ; } # Get cached A2P::XML object as it is used here to only read documents conf unless (defined($DOCSCONF) and ref($DOCSCONF) =~ /^A2P::XML$/ ) { &Debug("Creating new XML object to handle DOCUMENTS configuration"); $DOCSCONF = new A2P::XML ; } &Debug("Parsing XML configuration file '$DOCSFILE'"); unless ( $DOCSCONF->parse_file( $DOCSFILE ) eq $DOCSFILE ) { &Warn("Can't read $DOCSFILE documents conf, won't apply correction"); return 0 ; } unless( $DOCSCONF->selectDocument($doc) eq $doc ) { &Debug("Document '$doc' not defined in documents table"); return 0 ; } return $doc ; } sub fixdviljconf { my $self = shift ; my $doc = shift ; unless (defined($doc) and $doc) { &Warn("No document specified while updating print"); return 0 ; } # Check target to know what to update, by default 1 -> update all my $target = $DOCSCONF->getAttribute('target'); $target = 1 unless (defined($target) and $target =~ /^[0-2]$/); my @toupdate = $target<2 ? ( 'DVILJOPT' ) : () ; push @toupdate, 'VDVILJOPT' if ($target>0); # Check to update magnication (or scaling) my $scale = $DOCSCONF->getAttribute('scale'); if (defined($scale) and $scale !~ /^(100%|1000)$/ and $scale =~ /^(\d+)/) { my ( $rawscale ) = $scale =~ /^(\d+)/ ; # If we have a rate, we need to set magnication toward 1000 as 100% $rawscale *= 10 if ($scale =~ /%/); &Debug("Adjusting scaling with '$scale' value (raw=$rawscale)"); $self->{DVILJOPT} .= ' -m#' . $rawscale if ($target<2); $self->{VDVILJOPT} .= ' -m#' . $rawscale if ($target>0); } else { &Debug("No scaling defined for document '$doc'"); } # Check to update mode my $mode = $DOCSCONF->getAttribute('mode'); $mode = 1 unless (defined($mode) and $mode =~ /^[0-2]$/); foreach my $option ( @toupdate ) { &Debug("Trying to update mode in '$option' options"); if ( $mode == 0 and $self->{$option} =~ /-O\d\s*/ ) { # For mode normal, we just need to erase any -O option &Debug("Setting mode Normal on '$option' options"); $self->{$option} =~ s/-O\d\s*// ; } elsif ($mode == 1 and $self->{$option} !~ /-O1\s*/ ) { &Debug("Setting mode Advanced on '$option' options"); $self->{$option} =~ s/-O\d\s*/-O1 / ; $self->{$option} .= " -O1" unless ($self->{$option} =~ /-O1\s*/); } elsif ($mode == 2 and $self->{$option} !~ /-O2\s*/ ) { &Debug("Setting mode Advanced on '$option' options"); $self->{$option} =~ s/-O\d\s*/-O2 / ; $self->{$option} .= " -O2" unless ($self->{$option} =~ /-O2\s*/); } } my @offset = ( $DOCSCONF->getAttribute('x') , $DOCSCONF->getAttribute('y')); if (@offset and defined($offset[0]) and defined($offset[1]) and $offset[0] =~ /^[0-9.+-]+$/ and $offset[1] =~ /^[0-9.+-]+$/ and ($offset[0] or $offset[1])) { # Apply corrections foreach my $option ( @toupdate ) { &Debug("Trying to update off-set in '$option' options"); # Apply X correction if ( $offset[0] and $self->{$option} =~ /-x([0-9.+-]+)/ ) { my $new = $offset[0] + $1 ; &Debug("Updating $1 x off-set with $new on '$option' options"); $self->{$option} =~ s/-x([0-9.+-]+)/-x$new/ ; } elsif ($offset[0]) { &Debug("Setting x off-set to $offset[0] on '$option' options"); $self->{$option} .= ' -x' . $offset[0] ; } else { &Debug("No x-offset update required on '$option' options"); } # Apply Y correction if ($offset[1] and $self->{$option} =~ /-y([0-9.+-]+)/) { my $new = $offset[1] + $1 ; &Debug("Updating $1 y off-set with $new on '$option' options"); $self->{$option} =~ s/-y([0-9.+-]+)/-y$new/ ; } elsif ($offset[1]) { &Debug("Setting y off-set to $offset[1] on '$option' options"); $self->{$option} .= ' -y' . $offset[1] ; } else { &Debug("No y-offset update required on '$option' options"); } } } else { &Debug("No offset correction defined for document '$doc'"); } } sub save_a2pxml_file { # RC 200/201 my $self = shift ; my $file = shift || "" ; my ( $ret , $msg ) = ( 0 , "No content saved" ); open XML, ">$file" or return &Error("Can't open '$file' XML file for writing: $!"); if ( $self->{TYPE} =~ /^200$/ and defined($self->{XML})) { $ret = print XML $self->{XML}->toString ; } elsif ( $self->{TYPE} =~ /^201$/ ) { $ret = print XML map { $$_ } @{$self->{LINES}} ; } else { $msg = "No content to save" ; } close(XML); return $ret ? $ret : &Error( $msg . " for Control Record type '$self->{TYPE}'" ) ; } sub set_a2p_attribut { # RC 200 my $self = shift ; my $name = shift || "" ; my $value = shift || "" ; return 0 unless (defined($self->{XML}) and $name and $value); return $self->{XML}->set_a2p_attribut( $name , $value ); } sub seta2pxml { # RC 200 my $self = shift ; my $line = shift || "" ; my $file = shift || "" ; &Warn("Overiding still different defined output file for A2P XML content") if ( $self->{OUTFILE} and $self->{OUTFILE} !~ /^$file$/ ); # Keep base filename $self->{OUTFILE} = $file ; my $XML ; if (defined($self->{XML})) { $XML = $self->{XML} ; &Debug("Concatenate XML with '$line'"); $XML->concatenate($line . "\n"); } else { &Debug("Creating new XML with '$line'"); $XML = new A2P::XML(\$line); } $self->{XML} = $XML ; } sub addcontentref { # RC 201 my $self = shift ; if (defined($self->{LINES})) { push @{$self->{LINES}}, @_ ; } else { $self->{LINES} = [ @_ ] ; } } sub a2pxml_is_valid { # RC 200 my $self = shift ; return 0 unless (defined($self->{XML})); # Check is valid and save the name it returns as e-service name return $self->{'E-SERVICE'} = $self->{XML}->isA2P_eService() ; } sub ABTERM { my $self = shift ; @{$self->{ERROR}} = @_ ; &Error($self->{ERROR}->[1]); return - $self->{ERROR}->[0] ; } sub getbase { return $_[0]->{TEXBASE} ; } sub geterror { return @{$_[0]->{ERROR}} ; } sub value { my ( $self , $pos , $len ) = @_ ; # Index 0 in buffer is the Pos 6 of the control record specification $pos -= 6 ; my $buf = substr( $self->{BUFFER} , $pos , $len ) ; &from_to( $buf , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT); return $buf ; } sub getRecord { # Return only the Record for record type 100, 101, 102 & 103 return $_[0]->{TYPE} < 100 ? "" : '#' . $_[0]->{TYPE} . '#' . $_[0]->{RECORD} ; } sub getenv { my $self = shift ; my $RCENV = {} ; map { if ( defined($self->{$_})? $self->{$_} : 0 ) { $RCENV->{$_} = $self->{$_} ; &Debug("Returning RCENV->$_: '$RCENV->{$_}'"); } } qw( OUTFILE JOBNAME COPIES FORM DESTID IMPCLAS DOCNAME FLASH CHARS PAGEDEF FORMDEF HOLD PRIORITY BURST DO_PDF DO_ARCH AFPNAME DO_PCL DO_PS DO_LPR DO_VLPR DVILJOPT VDVILJOPT DVIPSOPT LPROPT VLPROPT BIN VBIN ); # Return ISPRINT for statistics if ( defined($self->{ISPRINT})) { $RCENV->{ISPRINT} = $self->{ISPRINT} ; &Debug("Returning RCENV->ISPRINT: '$RCENV->{ISPRINT}'"); } return $RCENV ; } sub getTRCforTeX { my $self = shift ; my ( $FONT , $font , $TeXCode , $i ) = ( "" , "" , "" , 0 ) ; while ( $i < length($self->{CHARS}) ) { $FONT = substr( $self->{CHARS} , $i , 4 ); ( $font = $FONT ) =~ tr/a-z0-9/A-Za-j/ ; $TeXCode .= "\\let\\FONtTrc" . chr( 65 + ( $i >> 2 ) ) . "=\\Font" . $font . "% TRC{" . eval( $i >> 2 ) . "} set to $FONT\n"; $i += 4 ; } return $TeXCode ; } sub get_required_size { my $self = shift ; # Index 0 in buffer is the Pos 6 of the control record specification # so we must substract 5 to requested size return $SIZE{$self->{TYPE}} - 5 ; } sub getoutfile { my $self = shift ; &Debug("OUTFILE value = $self->{OUTFILE}"); return $self->{OUTFILE} ; } sub getpagedef { my $self = shift ; &Debug("PAGEDEF value = $self->{PAGEDEF}"); return $self->{PAGEDEF} ; } sub getformdef { my $self = shift ; &Debug("FORMDEF value = $self->{FORMDEF}"); return $self->{FORMDEF} ; } sub ispcloutput { my $self = shift ; return 0 if (!defined($self->{ISPRINT}) or !defined($self->{DO_PCL})); return $self->{ISPRINT} ? ( $self->{DO_PCL} =~ /^yes$/i ? 1 : 0 ) : 0 ; } sub DESTROY { my $self = shift; my @err = @{$self->{ERROR}} ; # Free arrays memory map { $self->{$_} = () if (ref($self->{$_}) eq 'ARRAY' ) } keys(%{$self}); if (@err) { &UPSTAT('GET-RC-ERROR'); &UPSTAT('GET-RC-ERROR-' . $err[0] ); &Debug("ControlRecord object $self->{JOBNAME} destroyed with error #" . $err[0]); } else { &UPSTAT('GOT-GOOD-RC'); &Debug("ControlRecord object $self->{JOBNAME} destroyed"); } } &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); 1;