#
# 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 g $
#
# 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 <a2p /> 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;
