source: A2P/a2p/AFPDS/PCL.pm

Last change on this file was 3, checked in by guillaume, 17 years ago
  • AUTHORS: Ajout des différents contributeurs
  • COPYING: Ajout de la licence GPL v3
  • a2p: Préparation des sources pour leur publication sous GPL
  • Property svn:keywords set to Id
File size: 3.2 KB
Line 
1#
2# Copyright (c) 2004-2007 - Consultas, PKG.fr
3#
4# This file is part of A2P.
5#
6# A2P is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version.
10#
11# A2P is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with A2P; if not, write to the Free Software
18# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19#
20# $Id: PCL.pm 3 2007-10-18 16:20:19Z guillaume $
21#
22
23package AFPDS::PCL;
24
25use strict;
26use integer;
27use File::stat;
28use A2P::Globals;
29use A2P::Syslog;
30
31BEGIN {
32    use Exporter ();
33    our ( $VERSION , @ISA , @EXPORT );
34
35    $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
36
37    @ISA = qw(Exporter);
38    @EXPORT = qw(&validate_pcl5);
39}
40our $VERSION ;
41
42# Sub used to strip PCL5 file generated by dvijl command from
43# some problematic values
44sub validate_pcl5 {
45    my $file = shift;
46    my $len = 20 ;
47    my $esc = chr(27);
48
49    if ($USE_PCLCMD) {
50        &Debug("No PCL5 validation needed as using dvipcl5 command");
51        return 0;
52    }
53
54    if (!defined($file)) {
55        &Error("No file to validate");
56        return 2 ;
57    }
58
59    if (!length($file) or !( -e $file and -f $file and -s $file)) {
60        &Error("Not a valid file name to validate");
61        return 3 ;
62    }
63
64    &Debug("Validating '$file' PCL file");
65
66    # Get size of file
67    my $stat = stat($file);
68    my $size = $stat->size;
69
70    # Opening files for reading
71    open( PCL5, "+<", "$file" )
72        or &Error("Can't open $file: $!"), return 1;
73
74    # Read file in binary mode
75    binmode(PCL5)
76        or &Error("Can't process $file in binary mode, $!"), return 1;
77
78    # Seek to $len bytes from the end of file
79    seek PCL5, -$len , 2
80        or &Error("Unable to seek to the end of $file, $!"), return 1;
81
82    my $buffer = "";
83    read(PCL5,$buffer,$len)
84        or &Error("Unable to read the end of $file, $!"), return 1;
85
86    # Go back to $len bytes from the end of file
87    seek PCL5, -$len , 2
88        or &Error("Unable to seek from the end of $file after able to read the end, $!"), return 1;
89
90    &Error("Bad length read at the end of file"), return 1 if (length($buffer)!=$len);
91
92    my $end = $esc . "E" . $esc . "%-12345X";
93
94    # Strip manual feed request
95    my $manualfeed = $esc . "&l2H" ;
96    $buffer =~ s/$manualfeed\x{0C}?$end/$end/ ;
97
98    # Strip eventually any duplicated page feed, can arised after stripping a manual feed request
99    $buffer =~ s/\x{0C}\x{0C}/\x{0C}/g ;
100
101    if (length($buffer) < $len) {
102        &Debug("$file has been changed after PCL5 validation, updating it");
103        print PCL5 $buffer ;
104        truncate PCL5 , $size - $len + length($buffer)
105            or &Error("Unable to truncate $file after update, $!"), return 1;
106    }
107
108    # Close file
109    close(PCL5)
110        or &Error("Close failed on $file after update, $!"), return 1;
111
112    return 0;
113}
114
115&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
116
1171;
Note: See TracBrowser for help on using the repository browser.