source: A2P/a2p/AFPDS/PCL.pm

#
# 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: PCL.pm 3 2007-10-18 16:20:19Z guillaume $
#

package AFPDS::PCL;

use strict;
use integer;
use File::stat;
use A2P::Globals;
use A2P::Syslog;

BEGIN {
    use Exporter ();
    our ( $VERSION , @ISA , @EXPORT );

    $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;

    @ISA = qw(Exporter);
    @EXPORT = qw(&validate_pcl5);
}
our $VERSION ;

# Sub used to strip PCL5 file generated by dvijl command from
# some problematic values
sub validate_pcl5 {
    my $file = shift;
    my $len = 20 ;
    my $esc = chr(27);

    if ($USE_PCLCMD) {
        &Debug("No PCL5 validation needed as using dvipcl5 command");
        return 0;
    }

    if (!defined($file)) {
        &Error("No file to validate");
        return 2 ;
    }

    if (!length($file) or !( -e $file and -f $file and -s $file)) {
        &Error("Not a valid file name to validate");
        return 3 ;
    }

    &Debug("Validating '$file' PCL file");

    # Get size of file
    my $stat = stat($file);
    my $size = $stat->size;

    # Opening files for reading
    open( PCL5, "+<", "$file" )
        or &Error("Can't open $file: $!"), return 1;

    # Read file in binary mode
    binmode(PCL5)
        or &Error("Can't process $file in binary mode, $!"), return 1;

    # Seek to $len bytes from the end of file
    seek PCL5, -$len , 2
        or &Error("Unable to seek to the end of $file, $!"), return 1;

    my $buffer = "";
    read(PCL5,$buffer,$len)
        or &Error("Unable to read the end of $file, $!"), return 1;

    # Go back to $len bytes from the end of file
    seek PCL5, -$len , 2
        or &Error("Unable to seek from the end of $file after able to read the end, $!"), return 1;

    &Error("Bad length read at the end of file"), return 1 if (length($buffer)!=$len);

    my $end = $esc . "E" . $esc . "%-12345X";

    # Strip manual feed request
    my $manualfeed = $esc . "&l2H" ;
    $buffer =~ s/$manualfeed\x{0C}?$end/$end/ ;

    # Strip eventually any duplicated page feed, can arised after stripping a manual feed request
    $buffer =~ s/\x{0C}\x{0C}/\x{0C}/g ;

    if (length($buffer) < $len) {
        &Debug("$file has been changed after PCL5 validation, updating it");
        print PCL5 $buffer ;
        truncate PCL5 , $size - $len + length($buffer)
            or &Error("Unable to truncate $file after update, $!"), return 1;
    }

    # Close file
    close(PCL5)
        or &Error("Close failed on $file after update, $!"), return 1;

    return 0;
}

&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");

1;