source: A2P/a2p/AFPDS/ControlRecord.pm @ 12

Last change on this file since 12 was 3, checked in by guillaume, 18 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: 23.1 KB
RevLine 
[3]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: ControlRecord.pm 3 2007-10-18 16:20:19Z guillaume $
21#
22# Class to implement Control Record Object object
23
24package AFPDS::ControlRecord;
25
26use strict;
27use Encode 'from_to';
28use A2P::XML ;
29use A2P::Globals ;
30use A2P::Syslog ;
31use A2P::Tools qw( mychomp ShortID ) ;
32use AFPDS::ControlRecordDef ;
33
34BEGIN {
35    our $VERSION = sprintf "%s", q$Rev: 934 $ =~ /(\d[0-9.]+)\s+/ ;
36}
37our $VERSION ;
38
39# Variables exported from AFPDS::ControlRecordDef module :
40# %RCDEF
41# %SIZE
42
43# Splitter control
44my $LastSplitControl = undef ;
45
46sub new {
47    &Debug("new AFPDS::ControlRecord v$VERSION");
48    my $class = shift ;
49
50    # Default is to generate a PDF file and valid for archivage
51    my $self = {
52        TYPE    =>  shift , TEXBASE   =>  shift , AFPNAME  =>  shift ,
53        AFPNUM  =>  shift , ISPRINT   =>  0     , ERROR    =>  []
54    };
55
56    # Set some other defaults
57    map { $self->{$_} = "" } qw(
58        DO_PDF DO_LPR  DO_PS    DVILJOPT JOBNAME   LPROPT DVIPSOPT
59        DO_PCL DO_VLPR DO_ARCH VDVILJOPT OUTFILE  VLPROPT
60        );
61
62    if ( !defined( $RCDEF{$self->{TYPE}} ) ) {
63        &Error("Unknown Control Record type '$self->{TYPE}'");
64        return undef ;
65    }
66
67    if ($SIZE{$self->{TYPE}}>0)  {
68        &Debug("ControlRecord type '$self->{TYPE}' should be max " .
69            $SIZE{$self->{TYPE}} . " bytes long with header (5 bytes)");
70
71    } elsif ($SIZE{$self->{TYPE}}<0)  {
72        &Debug("ControlRecord type '$self->{TYPE}' is a not sized RC");
73    }
74
75    # Reset known tags if we are starting a new job
76    if ( $self->{AFPNUM} == 1 ) {
77        &Debug("First ControlRecord for a new job, resetting control");
78        $LastSplitControl = undef ;
79    }
80
81    return bless $self , $class ;
82}
83
84my $job_tag = "" ;
85sub job_tag {
86    my $self = shift ;
87    return @_ ? $job_tag = "$_[0]: " : $job_tag ;
88}
89
90sub init {
91    my $self = shift ;
92    $self->{BUFFER} = shift ;
93    &mychomp( \$self->{BUFFER} );
94
95    &Debug("Initializing new Record type '$self->{TYPE}'");
96
97    my $CurrentRCSize = length($self->{BUFFER}) + 5 ;
98    &Debug("Type = $self->{TYPE}, RCLength = " . $CurrentRCSize );
99
100    # Initialize any value defined in 'new' member replacing the
101    # definition array reference by the real value
102    for my $key ( keys(%{$RCDEF{$self->{TYPE}}}) ) {
103        # Check if key is a splitter code
104        if ( $key =~ /^__A2P_SPLITTER__$/ ) {
105            &Debug("Type = $self->{TYPE}, RC{$key} : splitter loaded");
106            $self->{$key} = $RCDEF{$self->{TYPE}}->{$key} ;
107            next ;
108        }
109
110        my ( $pos , $size ) = @{$RCDEF{$self->{TYPE}}->{$key}} ;
111
112        # Only handle RC size if it's a sized defined RC
113        if (defined($size) and $size>0) {
114            &Debug("Extracting value @ $pos + $size");
115            $self->{$key} = $self->value( $pos , $size );
116
117            return $self->ABTERM( 301,
118                "Can't read $key value at pos $pos, $size long" )
119                unless (defined($self->{$key}));
120
121            &Debug("Type = $self->{TYPE}, RC{$key} = '$self->{$key}'");
122        }
123    }
124
125    if ( $self->{TYPE} =~ /^(100|001)$/ ) {
126        # Control record 001 or 100 specific initialization
127
128        # Update specific values
129        $self->{ISPRINT} = $self->{TYPE} =~ /^100$/ ? 0 : 1 ;
130
131        # We force DO_PDF to 'yes' if not a print as we have no info on it
132        # DO_ARCH will be updated only if a RC 101 is also provided
133        if ( $self->{TYPE} =~ /^100$/ ) {
134            $self->{DO_PDF}  = 'yes' ;
135            $self->{DO_ARCH} =  'no' ;
136        }
137
138        # Strip spaces at end of values
139        $self->{PAGEDEF} =~ s/\s+$// ;
140        $self->{FORMDEF} =~ s/\s+$// ;
141        $self->{CHARS}   =~ s/\s+$// ;
142        $self->{FLASH}   =~ s/\s+$// if ($self->{ISPRINT});
143        $self->{DESTID}  =~ s/\s+$// if ($self->{ISPRINT});
144        $self->{DOCNAME} =  $self->{IMPDOCA} . $self->{IMPDOCN} ;
145
146        # This should be help to link linux job to mainframe job
147        $self->{JOBNAME} = $self->{AFPNAME} . '-' . $self->{UTISTE3} . '_' .
148            $self->{UTIPRJ} . $self->{DOCNAME} . '-AFP' . $self->{AFPNUM};
149
150        $self->{TEXBASE} .= '/AFP-' . $self->{AFPNUM} ;
151
152        # Here make a folder for TEXBASE or rise an ABTERM
153        return $self->ABTERM( 302,
154            "Can't create " . $self->{TEXBASE} . " folder: $!" )
155            unless ( mkdir $self->{TEXBASE} , 0775 );
156
157        # OUTFILE is a critical value for all threads
158        $self->{OUTFILE} = $self->{TEXBASE} . '/' .
159            ( $self->{TYPE} =~ /^100$/ ? 'archive' : 'print' ) ;
160
161        if ($self->{ISPRINT}) {
162            # Force DESTID if required in conf
163            if ($FORCE_DESTID) {
164                &Debug("Force Destination '$self->{DESTID}' to $FORCE_DESTID");
165                $self->{DESTID} = $FORCE_DESTID ;
166            }
167
168            # Read Destination configuration file to set needed options
169            my $xml = $self->getxml();
170            return $self->ABTERM( 303,
171                "Can' get an XML object to handle DESTID conf" )
172                unless (defined($xml));
173
174            # Leave if DestId file does not exist
175            return $self->ABTERM( 304, "'$DESTIDFILE' XML conf doesn't exist" )
176                unless ( -e $DESTIDFILE );
177
178            &Debug("Parsing XML configuration file '$DESTIDFILE'");
179            return $self->ABTERM( 305, "Can't read DESTID conf" )
180                unless ( $xml->parse_file( $DESTIDFILE ) eq $DESTIDFILE );
181
182            # This selectDestId API selects a node on which we will 'get' values
183            return $self->ABTERM( 306,
184                "No printer configuration found for DestID '$self->{DESTID}'")
185                unless ($xml->selectDestId($self->{DESTID}) eq $self->{DESTID});
186
187            &Debug("'$self->{DESTID}' printer configuration selected");
188            $self->{DO_PCL}    = $xml->get( 'PCL'  );
189            $self->{DO_PS}     = $xml->get( 'PS'   );
190            $self->{DO_LPR}    = $xml->get( 'LPR'  );
191            $self->{DO_VLPR}   = $xml->get( 'VLPR' );
192            $self->{DO_PDF}    = $xml->get( 'PDF'  );
193            $self->{DO_ARCH}   = $xml->get( 'ARCH' );
194            $self->{DVILJOPT}  = $xml->get( 'DVILJOptions' );
195            $self->{DVIPSOPT}  = $xml->get( 'DVIPSOptions' );
196            $self->{LPROPT}    = $xml->get( 'LPROptions'   );
197            $self->{VLPROPT}   = $xml->get( 'VLPROptions'  );
198            $self->{VDVILJOPT} = $xml->get( 'VDVILJOptions' );
199
200            # Check also if we should check to adapt document or not
201            my $can_do_correction = $xml->get( 'ByDocumentCorrection' ) ;
202
203            # Set default from service configuration if not defined
204            $can_do_correction = $DOCUMENTS_CORRECTION_ENABLED
205                unless (defined($can_do_correction)
206                and $can_do_correction =~ /^\d+$/);
207
208            # Is correction forced by service configuration ?
209            $can_do_correction ++
210                if ($DOCUMENTS_CORRECTION_ENABLED > 1 );
211
212            # Reset to default 'no' if a value is not defined
213            map { $self->{$_} = "no" } grep { ! defined($self->{$_}) } qw(
214                    DO_PCL DO_PS DO_PDF DO_LPR DO_VLPR
215                    );
216
217            # Reset to default "(nothing)" if a value is not defined
218            map { $self->{$_} = "" } grep { ! defined($self->{$_}) } qw(
219                    DVILJOPT DVIPSOPT LPROPT VLPROPT VDVILJOPT
220                    );
221
222            &Debug("'$self->{DESTID}' configuration read");
223
224            my $hasconf = 1 ;
225            # Forced in service configuration
226            if ($DONT_PRINT) {
227                &Info(job_tag."Printing disabled in conf");
228                $self->{DO_LPR}  = 'no' ;
229                $self->{DO_VLPR} = 'no' ;
230
231            } elsif ( $hasconf = $self->getdocsconf($self->{DOCNAME})
232            and $can_do_correction ) {
233                &Debug("Have a correction for document " . $self->{DOCNAME} .
234                    " to apply");
235                # If a correction is defined for the current document, we need
236                # to update DVILJOptions and VDVILJOptions
237                $self->fixdviljconf($self->{DOCNAME});
238
239            } elsif ($hasconf eq $self->{DOCNAME} and ! $can_do_correction) {
240                &Info(job_tag."'$self->{DOCNAME}' Document corrections " .
241                    "discarded for this DestID");
242
243            } elsif (!$hasconf) {
244                &Debug("No correction for '$self->{DOCNAME}' Document in conf");
245            }
246
247            ################################
248            # Bin/tray support
249            ################################
250            # Extract values
251            $self->{DVILJOPT}  =~ /\-T1=(\d+).*\-T2=(\d+)/ ;
252            my ( $TA , $TB ) = ( $1 , $2 );
253            $self->{VDVILJOPT}  =~ /\-T1=(\d+).*\-T2=(\d+)/ ;
254            my ( $VTA , $VTB ) = ( $1 , $2 );
255
256            # Set to default auto-select value 7 if not defined
257            my $not_defined = 0;
258            map { $$_ = 7 , $not_defined++ if (!defined($$_)) }
259                (\$TA,\$TB,\$VTA,\$VTB);
260            &Debug("Bin selection  A=$TA,  B=$TB");
261            &Debug("Bin selection VA=$VTA, VB=$VTB)");
262            &Info(job_tag."Found $not_defined not defined Bin-Tray selection")
263                if $not_defined ;
264
265            # Compute PCL5 command for bin/tray selection in file
266            # if not supported by dvi2pcl command
267            if (! $USE_PCLCMD) {
268                # Prepare PCL5 command files for insertion if needed
269                open(TRAYA, ">$self->{OUTFILE}.trayone")
270                    or &Error("Can't open $self->{OUTFILE}.trayone :$!");
271                print TRAYA  chr(27) . "&l" .  $TA . "H"
272                    if (defined(fileno( TRAYA)));
273                close(TRAYA);
274
275                open(TRAYB, ">$self->{OUTFILE}.traytwo")
276                    or &Error("Can't open $self->{OUTFILE}.traytwo :$!");
277                print TRAYB  chr(27) . "&l" .  $TB . "H"
278                    if (defined(fileno( TRAYB)));
279                close(TRAYB);
280
281                if ( $TA != $VTA ) {
282                    open(VTRAYA, ">$self->{OUTFILE}.vtrayone")
283                        or &Error("Can't open $self->{OUTFILE}.vtrayone :$!");
284                    print VTRAYA chr(27) . "&l" .  $VTA . "H"
285                        if (defined(fileno(VTRAYA)));
286                    close(VTRAYA);
287                }
288
289                if ( $TB != $VTB ) {
290                    open(VTRAYB, ">$self->{OUTFILE}.vtraytwo")
291                        or &Error("Can't open $self->{OUTFILE}.vtraytwo :$!");
292                    print VTRAYB chr(27) . "&l" .  $VTB . "H"
293                        if (defined(fileno(VTRAYB)));
294                    close(VTRAYB);
295                }
296
297                # Strip DVIJLOptions from any Tray/bin definition...
298                $self->{DVILJOPT}  =~ s/\-T.*// ;
299                $self->{VDVILJOPT} =~ s/\-T.*// ;
300            }
301
302        } #endif $self->{ISPRINT}
303
304    } elsif ( $self->{TYPE} =~ /^101$/ ) {
305        # We could only transmit job to archiver when we have found a 101 record
306        ( $self->{DO_PDF} , $self->{DO_ARCH} ) = ( 'yes' , 'yes' );
307    }
308    &Debug("Initialization done");
309}
310
311sub can_split_job {
312    my $self = shift ;
313    return 0 unless $ENABLE_SPLITTER ;
314
315    # Control auto-splitter first
316    return 1 if ( $AUTO_SPLIT_MAX and $self->{AFPNUM} > $AUTO_SPLIT_MAX );
317
318    return 0 unless (defined($self->{__A2P_SPLITTER__}));
319
320    my $splitter = $self->{__A2P_SPLITTER__} ;
321    my $control = &$splitter( $self );
322
323    if (defined($LastSplitControl)) {
324        # Just compare if the value returned by splitter has changed
325        unless ( $control =~ /^$LastSplitControl$/ ) {
326            &Info(job_tag."Splitting AFPDS between jobs for " .
327                $LastSplitControl . " and " . $control );
328
329            # Keep last control as tag if desired
330            $self->{SPLIT_TAGS} = [ $LastSplitControl, $control ] ;
331            $LastSplitControl = $control;
332
333            &UPSTAT('SPLIT_EVENT');
334
335            return 1 ;
336        }
337
338    } else {
339        # First time just initialize the control handler
340        $self->{SPLIT_TAGS} = [ $LastSplitControl = $control ] ;
341    }
342
343    # Return false by default
344    return 0
345}
346
347sub get_split_tags {
348    my $self = shift ;
349
350    # Clean RC initialization to avoid agregation conflicts
351    rmdir $self->{TEXBASE} ;
352
353    # Try to return uniq tags list or return a tag couple which must be
354    # automatically updated in JobManager
355    return (defined($self->{SPLIT_TAGS}) and @{$self->{SPLIT_TAGS}} > 1 ) ?
356        @{$self->{SPLIT_TAGS}} : ( 'PART', 'PART' );
357}
358
359my $XMLCONF ;
360sub getxml {
361    my $self = shift ;
362
363    # Get cached A2P::XML object as it is used here to only read Destid conf
364    return $XMLCONF
365        if (defined($XMLCONF) and ref($XMLCONF) =~ /^A2P::XML$/ );
366
367    &Debug("Creating new XML object to handle DESTID configuration");
368    return $XMLCONF = new A2P::XML ;
369}
370
371my $DOCSCONF ;
372sub getdocsconf {
373    my $self = shift ;
374    my $doc  = shift ;
375
376    unless ( -e $DOCSFILE ) {
377        &Info(job_tag."'$DOCSFILE' Documents corrections configuration " .
378            "not found, skipping");
379        return 0 ;
380    }
381
382    unless (defined($doc) and $doc) {
383        &Warn("No document specified while checking documents configuration");
384        return 0 ;
385    }
386
387    # Get cached A2P::XML object as it is used here to only read documents conf
388    unless (defined($DOCSCONF) and ref($DOCSCONF) =~ /^A2P::XML$/ ) {
389        &Debug("Creating new XML object to handle DOCUMENTS configuration");
390        $DOCSCONF = new A2P::XML ;
391    }
392
393    &Debug("Parsing XML configuration file '$DOCSFILE'");
394    unless ( $DOCSCONF->parse_file( $DOCSFILE ) eq $DOCSFILE ) {
395        &Warn("Can't read $DOCSFILE documents conf, won't apply correction");
396        return 0 ;
397    }
398
399    unless( $DOCSCONF->selectDocument($doc) eq $doc ) {
400        &Debug("Document '$doc' not defined in documents table");
401        return 0 ;
402    }
403
404    return $doc ;
405}
406
407sub fixdviljconf {
408    my $self = shift ;
409    my $doc  = shift ;
410
411    unless (defined($doc) and $doc) {
412        &Warn("No document specified while updating print");
413        return 0 ;
414    }
415
416    # Check target to know what to update, by default 1 -> update all
417    my $target = $DOCSCONF->getAttribute('target');
418    $target = 1 unless (defined($target) and $target =~ /^[0-2]$/);
419
420    my @toupdate = $target<2 ? ( 'DVILJOPT' ) : () ;
421    push @toupdate, 'VDVILJOPT' if ($target>0);
422
423    # Check to update magnication (or scaling)
424    my $scale = $DOCSCONF->getAttribute('scale');
425    if (defined($scale) and $scale !~ /^(100%|1000)$/ and $scale =~ /^(\d+)/) {
426        my ( $rawscale ) = $scale =~ /^(\d+)/ ;
427        # If we have a rate, we need to set magnication toward 1000 as 100%
428        $rawscale *= 10 if ($scale =~ /%/);
429
430        &Debug("Adjusting scaling with '$scale' value (raw=$rawscale)");
431
432        $self->{DVILJOPT}  .= ' -m#' . $rawscale if ($target<2);
433        $self->{VDVILJOPT} .= ' -m#' . $rawscale if ($target>0);
434
435    } else {
436        &Debug("No scaling defined for document '$doc'");
437    }
438
439    # Check to update mode
440    my $mode = $DOCSCONF->getAttribute('mode');
441    $mode = 1 unless (defined($mode) and $mode =~ /^[0-2]$/);
442    foreach my $option ( @toupdate ) {
443        &Debug("Trying to update mode in '$option' options");
444        if ( $mode == 0 and $self->{$option} =~ /-O\d\s*/ ) {
445            # For mode normal, we just need to erase any -O option
446            &Debug("Setting mode Normal on '$option' options");
447            $self->{$option} =~ s/-O\d\s*// ;
448
449        } elsif ($mode == 1 and $self->{$option} !~ /-O1\s*/ ) {
450            &Debug("Setting mode Advanced on '$option' options");
451            $self->{$option} =~ s/-O\d\s*/-O1 / ;
452            $self->{$option} .= " -O1" unless ($self->{$option} =~ /-O1\s*/);
453
454        } elsif ($mode == 2 and $self->{$option} !~ /-O2\s*/ ) {
455            &Debug("Setting mode Advanced on '$option' options");
456            $self->{$option} =~ s/-O\d\s*/-O2 / ;
457            $self->{$option} .= " -O2" unless ($self->{$option} =~ /-O2\s*/);
458        }
459    }
460
461    my @offset = ( $DOCSCONF->getAttribute('x') , $DOCSCONF->getAttribute('y'));
462    if (@offset and defined($offset[0]) and defined($offset[1]) and
463        $offset[0] =~ /^[0-9.+-]+$/ and $offset[1] =~ /^[0-9.+-]+$/ and
464        ($offset[0] or $offset[1]))
465    {
466        # Apply corrections
467        foreach my $option ( @toupdate ) {
468            &Debug("Trying to update off-set in '$option' options");
469
470            # Apply X correction
471            if ( $offset[0] and $self->{$option} =~ /-x([0-9.+-]+)/ ) {
472                my $new = $offset[0] + $1 ;
473                &Debug("Updating $1 x off-set with $new on '$option' options");
474                $self->{$option} =~ s/-x([0-9.+-]+)/-x$new/ ;
475
476            } elsif ($offset[0]) {
477                &Debug("Setting x off-set to $offset[0] on '$option' options");
478                $self->{$option} .= ' -x' . $offset[0] ;
479
480            } else {
481                &Debug("No x-offset update required on '$option' options");
482            }
483
484            # Apply Y correction
485            if ($offset[1] and $self->{$option} =~ /-y([0-9.+-]+)/) {
486                my $new = $offset[1] + $1 ;
487                &Debug("Updating $1 y off-set with $new on '$option' options");
488                $self->{$option} =~ s/-y([0-9.+-]+)/-y$new/ ;
489
490            } elsif ($offset[1]) {
491                &Debug("Setting y off-set to $offset[1] on '$option' options");
492                $self->{$option} .= ' -y' . $offset[1] ;
493
494            } else {
495                &Debug("No y-offset update required on '$option' options");
496            }
497        }
498
499    } else {
500        &Debug("No offset correction defined for document '$doc'");
501    }
502}
503
504sub save_a2pxml_file {    # RC 200/201
505    my $self = shift ;
506    my $file = shift || "" ;
507    my ( $ret , $msg ) = ( 0 , "No content saved" );
508
509    open XML, ">$file"
510        or return &Error("Can't open '$file' XML file for writing: $!");
511
512    if ( $self->{TYPE} =~ /^200$/ and defined($self->{XML})) {
513        $ret = print XML $self->{XML}->toString ;
514
515    } elsif ( $self->{TYPE} =~ /^201$/ ) {
516        $ret = print XML map { $$_ } @{$self->{LINES}} ;
517
518    } else {
519        $msg = "No content to save" ;
520    }
521
522    close(XML);
523
524    return $ret ?
525        $ret : &Error( $msg . " for Control Record type '$self->{TYPE}'" ) ;
526}
527
528sub set_a2p_attribut {  # RC 200
529    my $self  = shift ;
530    my $name  = shift || "" ;
531    my $value = shift || "" ;
532
533    return 0 unless (defined($self->{XML}) and $name and $value);
534
535    return $self->{XML}->set_a2p_attribut( $name , $value );
536}
537
538sub seta2pxml {        # RC 200
539    my $self = shift ;
540    my $line = shift || "" ;
541    my $file = shift || "" ;
542
543    &Warn("Overiding still different defined output file for A2P XML content")
544        if ( $self->{OUTFILE} and $self->{OUTFILE} !~ /^$file$/ );
545
546    # Keep base filename
547    $self->{OUTFILE} = $file ;
548
549    my $XML ;
550    if (defined($self->{XML})) {
551        $XML = $self->{XML} ;
552
553        &Debug("Concatenate XML with '$line'");
554        $XML->concatenate($line . "\n");
555
556    } else {
557        &Debug("Creating new XML with '$line'");
558        $XML = new A2P::XML(\$line);
559    }
560
561    $self->{XML} = $XML ;
562}
563
564sub addcontentref {      # RC 201
565    my $self = shift ;
566
567    if (defined($self->{LINES})) {
568        push @{$self->{LINES}}, @_ ;
569
570    } else {
571        $self->{LINES} = [ @_ ] ;
572    }
573}
574
575sub a2pxml_is_valid {    # RC 200
576    my $self = shift ;
577    return 0 unless (defined($self->{XML}));
578
579    # Check <a2p /> is valid and save the name it returns as e-service name
580    return $self->{'E-SERVICE'} = $self->{XML}->isA2P_eService() ;
581}
582
583sub ABTERM {
584    my $self = shift ;
585    @{$self->{ERROR}} = @_ ;
586    &Error($self->{ERROR}->[1]);
587    return - $self->{ERROR}->[0] ;
588}
589
590sub getbase {
591    return $_[0]->{TEXBASE} ;
592}
593
594sub geterror {
595    return @{$_[0]->{ERROR}} ;
596}
597
598sub value {
599    my ( $self , $pos , $len ) = @_ ;
600    # Index 0 in buffer is the Pos 6 of the control record specification
601    $pos -= 6 ;
602    my $buf = substr( $self->{BUFFER} , $pos , $len ) ;
603    &from_to( $buf , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
604    return $buf ;
605}
606
607sub getRecord {
608    # Return only the Record for record type 100, 101, 102 & 103
609    return
610        $_[0]->{TYPE} < 100 ? "" : '#' . $_[0]->{TYPE} . '#' . $_[0]->{RECORD} ;
611}
612
613sub getenv {
614    my $self = shift ;
615
616    my $RCENV = {} ;
617
618    map {
619            if ( defined($self->{$_})? $self->{$_} : 0 ) {
620                $RCENV->{$_} = $self->{$_} ;
621                &Debug("Returning RCENV->$_: '$RCENV->{$_}'");
622            }
623        } qw(
624            OUTFILE  JOBNAME   COPIES   FORM    DESTID  IMPCLAS  DOCNAME
625            FLASH    CHARS     PAGEDEF  FORMDEF HOLD    PRIORITY BURST
626            DO_PDF   DO_ARCH   AFPNAME  DO_PCL  DO_PS   DO_LPR   DO_VLPR
627            DVILJOPT VDVILJOPT DVIPSOPT LPROPT  VLPROPT BIN      VBIN
628            );
629
630    # Return ISPRINT for statistics
631    if ( defined($self->{ISPRINT})) {
632        $RCENV->{ISPRINT} =  $self->{ISPRINT} ;
633        &Debug("Returning RCENV->ISPRINT: '$RCENV->{ISPRINT}'");
634    }
635
636    return $RCENV ;
637}
638
639sub getTRCforTeX {
640    my $self = shift ;
641    my ( $FONT , $font , $TeXCode , $i ) = ( "" , "" , "" , 0 ) ;
642
643    while ( $i < length($self->{CHARS}) ) {
644        $FONT = substr( $self->{CHARS} , $i , 4 );
645        ( $font = $FONT ) =~ tr/a-z0-9/A-Za-j/ ;
646
647        $TeXCode .= "\\let\\FONtTrc" . chr( 65 + ( $i >> 2 ) ) . "=\\Font" .
648                    $font . "% TRC{" . eval( $i >> 2 ) . "} set to $FONT\n";
649        $i += 4 ;
650    }
651    return $TeXCode ;
652}
653
654sub get_required_size {
655    my $self = shift ;
656    # Index 0 in buffer is the Pos 6 of the control record specification
657    # so we must substract 5 to requested size
658    return $SIZE{$self->{TYPE}} - 5 ;
659}
660
661sub getoutfile {
662    my $self = shift ;
663    &Debug("OUTFILE value = $self->{OUTFILE}");
664    return $self->{OUTFILE} ;
665}
666
667sub getpagedef {
668    my $self = shift ;
669    &Debug("PAGEDEF value = $self->{PAGEDEF}");
670    return $self->{PAGEDEF} ;
671}
672
673sub getformdef {
674    my $self = shift ;
675    &Debug("FORMDEF value = $self->{FORMDEF}");
676    return $self->{FORMDEF} ;
677}
678
679sub ispcloutput {
680    my $self = shift ;
681    return 0 if (!defined($self->{ISPRINT}) or !defined($self->{DO_PCL}));
682    return $self->{ISPRINT} ? ( $self->{DO_PCL} =~ /^yes$/i ? 1 : 0 ) : 0 ;
683}
684
685sub DESTROY {
686    my $self = shift;
687    my @err  = @{$self->{ERROR}} ;
688
689    # Free arrays memory
690    map { $self->{$_} = () if (ref($self->{$_}) eq 'ARRAY' ) } keys(%{$self});
691
692    if (@err) {
693        &UPSTAT('GET-RC-ERROR');
694        &UPSTAT('GET-RC-ERROR-' . $err[0] );
695        &Debug("ControlRecord object $self->{JOBNAME} destroyed with error #" .
696            $err[0]);
697
698    } else {
699        &UPSTAT('GOT-GOOD-RC');
700        &Debug("ControlRecord object $self->{JOBNAME} destroyed");
701    }
702}
703
704&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
705
7061;
Note: See TracBrowser for help on using the repository browser.