source: A2P/a2p/AFPDS/afpds2tex.pm @ 5

Last change on this file since 5 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: 35.8 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: afpds2tex.pm 3 2007-10-18 16:20:19Z g $
21#
22
23package AFPDS::afpds2tex;
24
25use strict ;
26use Encode 'from_to' ;
27use Time::HiRes qw( gettimeofday tv_interval usleep );
28use File::stat ;
29use A2P::Globals ;
30use A2P::Syslog ;
31use A2P::Common ;
32use A2P::Com    qw( GetCom comINF comREQ comFILE );
33use A2P::Tools  qw( debugbuffer compute mychomp myreadline ) ;
34use AFPDS::Flux ;
35use AFPDS::ControlRecord ;
36use A2P::XML ;
37use A2P::JobStatus 'a2pjobstate' ;
38
39BEGIN {
40    our $VERSION = sprintf "%s", q$Rev: 1023 $ =~ /([0-9.]+)\s+/ ;
41}
42our $VERSION ;
43
44# Files handles & generation flag
45my ( $TexFile, $ArchFile, $AfpFile, $LCKNAME, $AFPDSFILE );
46my $GenFlag = 0 ;
47my $ErrFlag = 0 ;
48my $AfpName = "";
49my $Job     = "";
50my $self    = 0 ;
51my $file    = 0 ;
52my $mtime   = 0 ;
53
54# @skip will be used to continue an afp job when an error occurs on a sub job
55# It should be reset to () at each new job
56my @skip = () ;
57
58my $RateTimer = [] ;
59my $afpbuffer = "" ;
60
61my $min_conv_time = 0 ;
62
63sub _job_tag {
64    return $Job ? "$Job".($file?"-$file":"").": " : ""
65}
66
67# Function to open TeX file and his shell environment file for writing
68sub OpenFiles {
69    my $filename = $_[1] ;
70
71    open($TexFile, ">$filename.tex")
72        or &Abort(107, "$filename.tex",  "$!"), return 0;
73
74    $LCKNAME = "$filename.tex.LCK" ;
75    open(LCK, ">$LCKNAME")
76        or &Abort(107, $LCKNAME,  "$!"), return 0;
77
78    open($ArchFile, ">$filename.arch")
79        or &Abort(107, "$filename.arch", "$!"), return 0;
80
81    return 1 unless ( $PARALLELE_VALIDATION or $KEEP_AFPJOB );
82
83    open($AfpFile,  ">$filename.afp")
84        or &Abort(107, "$filename.afp" , "$!"), return 0;
85
86    return 1 ;
87}
88
89# Function to close TeX file and his shell environment file
90sub CloseFiles {
91    close($TexFile)  if (defined($TexFile));
92    close($ArchFile) if (defined($ArchFile));
93    close($AfpFile)  if (defined($AfpFile));
94    if (defined($LCKNAME) and -e $LCKNAME) {
95        close(LCK);
96        unlink $LCKNAME ;
97    }
98    $GenFlag = 0 ;
99}
100
101# Arguments:
102# 1 - The texname to process
103# 2 - AFPDS file to process
104sub ConvertFile {
105       $self      = shift ;
106    my $texbase   = shift ;
107    my $afpdsfile = shift ;
108       $Job       = shift ; # Current job name for queueing announcement
109    my $startpos  = shift || 0 ; # The start position in AFP file for splitting
110
111    # Forget any previous status
112    $ErrFlag = 0 ;
113    @skip = () ;
114
115    # Same computation as in SpoolManager module
116    ( $AfpName ) = $afpdsfile =~ $AFPNAME_REGEX ;
117    &Debug("Afpname set to '$AfpName' from Texbase '$afpdsfile'");
118
119    # First job state update in spool
120    &a2pjobstate( $Job , 2 , '.', { JOBID => $Job } )
121         or &Info("Can't initialize job status at step 2 with JOBID $Job");
122
123    $afpdsfile = $AFPSPOOL . '/' . $afpdsfile
124        unless ( -e $afpdsfile );
125
126    # Provided texbase must not be an existing folder
127    return &Abort( 119, $texbase) if ( -d $texbase );
128
129    # Create texbase as folder
130    mkdir $texbase , 0775
131        or return &Abort( 106, $texbase, "$!");
132
133    # Here, texbase will be a folder to delete, so inform JobManager of it
134    $self->Return( $Job , $texbase );
135
136    # Opening files for reading
137    open($AFPDSFILE, "<", "$afpdsfile")
138        or return &Abort( 107, $afpdsfile, "$!");
139
140    # Read AFPDS files in binary mode
141    binmode($AFPDSFILE)
142        or return &Abort( 108, $afpdsfile, "$!");
143
144    &Debug("Starting AFPDS conversion of $afpdsfile to $texbase folder");
145
146    ############################################################################
147    # Check if records are terminated by CR-LF:
148    # search for pattern 0x0D0A in the last 10 chars of afpds file
149    ############################################################################
150    my ( $readmode , $buffer , $EOF , $inXML ) = ( 0 , "" , 0 , 0 ) ;
151    {
152        my ( $EOL , $offset ) = ( 0 , 9 );
153
154        # 1. Check file contents greater than 7 chars, or this is probably
155        #    a corrupted file
156        seek $AFPDSFILE , 0 , 2 ;
157        return &Abort(124, $afpdsfile) if ( tell($AFPDSFILE) <= 7 );
158
159        # 2. Load the last 10 chars in the buffer
160        seek $AFPDSFILE , -10 , 2 ;
161        return &Abort(109, $afpdsfile, "$!")
162            if ( read($AFPDSFILE , $buffer , 10) != 10);
163
164        # 3. Scan loaded buffer for 0x0D0A string starting from offset 8
165        #    in the buffer
166        while ( $offset-- > 0 ) {
167            $EOL = &compute( \$buffer , $offset , 2 );
168            $readmode += 2 , last if ( $EOL == 0x0D0A );
169        }
170
171        &Debug(sprintf(
172            "Readmode is $readmode as found CRLF=0x%04x at offset %d",
173            $EOL,$offset));
174
175        # Keep End of File information
176        $EOF = tell($AFPDSFILE);
177    }
178
179    # Get file time creation
180    my $stat = stat($afpdsfile);
181    $mtime = $stat->mtime() ;
182
183    ############################################################################
184    # Rewind file to startpos (beginning by default)
185    seek $AFPDSFILE , $startpos , 0 ;
186
187    ############################################################################
188    #
189    # Read the AFPDS file
190    #
191    ############################################################################
192    my ( $long , $char , $cctrl , $tmp , $maxrepeat );
193    $file = 1 ;
194    $afpbuffer = "" ;
195
196    # Timer to get a chrono on the current conversion
197    $RateTimer = [ &gettimeofday() ] ;
198
199    # Set minimum conversion time (used for big jobs to limit convertion rate)
200    $min_conv_time = $USLEEP ;
201    # MAX_CONV_RATE is a maximum sub-job number to generate by seconds
202    $min_conv_time = 1_000_000 / $MAX_CONV_RATE
203        if ($MAX_CONV_RATE);
204
205    # Set chrono to return progression status when required
206    my @StartTime = &gettimeofday();
207    my $tv_timing = $CONV_STATUS_TIMING ;
208
209    $buffer = getc( $AFPDSFILE ) ;
210    while ( defined( $buffer ) and ! eof($AFPDSFILE) ) {
211
212        # Update afpbuffer
213        $afpbuffer .= $buffer ;
214
215        #  Manage the 0x5A char
216        if ( ord( $buffer ) == 0x5A and ! $inXML ) {
217
218            #  Read the field length
219            read $AFPDSFILE , $buffer , 8 ;
220            $long = &compute( \$buffer , 0 , 2 ) ;
221
222            # Update afpbuffer
223            $afpbuffer .= $buffer ;
224
225            # Keep preamble for debugging
226            my $preamble = $buffer ;
227
228            # Abort if field is too short
229            &Abort(114,$long) if ( $long < 8 );
230
231            # Compute other attributes
232
233            # cf doc IBM AFP - programming guide and line data ref - 54438842
234            my $ident    = &compute( \$buffer , 2 , 3 ) ;
235            my $flag     = &compute( \$buffer , 5 , 1 ) ;
236            my $reserved = &compute( \$buffer , 6 , 2 ) ;
237
238            # In case file is line delimited, then $readmode = 2, so we
239            # need to check and found 2 more chars to be CRLF
240            $long -= 8 - $readmode ;
241
242            &Debug(sprintf("Long is %d, Ident is 0x%x and Flag is 0x%x",
243                $long, $ident, $flag ));
244
245            if ( $long > 0 ) {
246                # Read the value of $ident
247                read $AFPDSFILE , $buffer , $long ;
248
249                # Update afpbuffer
250                $afpbuffer .= $buffer ;
251
252                # Some lines are full filled with spaces...
253                if ( $readmode > 0 ) {
254                    # The value should end with 0x0D0A,
255                    # else read until end of line...
256                    $tmp = &compute( \$buffer , -2 , 2 );
257                    if ( $tmp != 0x0D0A ) {
258
259                        # Read till the real end of line
260                        my $plus = &myreadline( \*$AFPDSFILE , \$buffer );
261
262                        # Update afpbuffer
263                        $afpbuffer .= substr($buffer,-$plus) if $plus ;
264
265                        $long += $plus ;
266
267                        # Definitive check
268                        $tmp = &compute( \$buffer , -2 , 2 );
269                         if ( $tmp != 0x0D0A ) {
270                            &debugbuffer( $preamble . $buffer );
271                             &Abort(110,$tmp);
272                        }
273                    }
274
275                    $long -= &mychomp( \$buffer, 'keep spaces' ) ;
276                }
277
278                # Check we read as byte as we need
279                if ( length($buffer) != $long ) {
280                    &debugbuffer($preamble . $buffer);
281                    &Abort(111,length($buffer),$long);
282                }
283
284            } else {
285                # Reset the buffer if nothing has been needed to read
286                $buffer = "" ;
287            }
288
289            if (defined($self->{AFPDS})) {
290                &debugbuffer( $preamble . $buffer );
291
292                my @params = ( $ident, $flag, $reserved, $long, $buffer,
293                    $texbase );
294                # Don't try to analyse 5A record if @skip is not empty
295                &Abort( 200, $self->{AFPDS}->geterror() )
296                    if ( ! @skip and $self->{AFPDS}->got5Achar(@params) < 0 );
297
298            } else {
299                # Rise abort if we got 0x5A AFP record without AFPDS Flux
300                # Object initialization
301                &Abort(3);
302            }
303
304            # Check got5Achar didn't rise an error
305            &Abort( 118, $ident, $flag, $reserved, $long,
306                join('',map { sprintf("%X",$_) } split(//,$buffer) ))
307                    unless (defined($self->{AFPDS}));
308
309        ########################################################################
310        ##  Manage the 0x7B char '#' for C930 control record (or RC)          ##
311        ########################################################################
312        } elsif ( ord( $buffer ) == 0x7B or $inXML ) {
313
314            my ( $begin , $Type ) = ( $buffer , "" );
315            read( $AFPDSFILE , $Type , 3 ) ;
316
317            # And check this is really a numbered RC
318            read( $AFPDSFILE , $buffer , 1 ) ;
319
320            # Update begin to later update afpbuffer
321            my $rawtype = $Type . $buffer ;
322
323            # Must found another '#' as format validation if not in XML reading
324            &Abort(112,$Type)
325                unless ( $inXML or ord( $buffer ) == 0x7B );
326
327            &from_to( $Type , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
328
329            my $afpds = $self->{AFPDS} ;
330
331            # Generate a print if still after the first print analysis
332            if ( ! $inXML and $GenFlag
333            and ( $Type eq '001' or $Type eq '100' )) {
334                if (defined($afpds)) {
335                    &Debug("File#${file}: Start TeX file generation");
336
337                    # Output this TeX file or rise an ABTERM
338                    unless ( @skip or &generateTeX ) {
339                        &Abort(103, $file, defined($self->{RC}->{$Type}) ?
340                            $self->{RC}->{$Type}->getoutfile()
341                            :
342                            "with undefined '$Type' RC"
343                            );
344                    }
345
346                    # Increment file index
347                    $file ++ ;
348
349                } else {
350                    # Abort if AFPDS object has vanished
351                    &Abort(4) ;
352                }
353            }
354
355            # Initialise a new AFPDS flux only on record Type 001 or 100
356            if (! $inXML and ( $Type eq '001' or $Type eq '100' )) {
357                &UPSTAT('GETNEWJOB');
358
359                # Reset skipping array to try another document
360                if (@skip) {
361                    # Starting new job after ABTERM
362                    &Abort(500,$file); # Warn we are trying to start a new job
363                    @skip = () ;
364                }
365
366                # Destroy last afpds object if needed and create new one
367                delete $self->{AFPDS} if (defined($afpds));
368                undef $afpds ;
369
370                &Debug("Initializing AFPDS objects");
371                $afpds = new AFPDS::Flux( $afpdsfile , $self , $Job );
372
373                # And don't forget to keep a copy
374                $self->{AFPDS} = $afpds ;
375            }
376
377            # Update job index in flux in case it has changed
378            $afpds->setjobindex( $file );
379
380            # Still check AFPDS Flux object exists
381            &Abort(117,$Type) unless (defined($afpds));
382
383            my $RC ;
384            my ( $tA , $tB ) = ( ord($begin) == 0x7B , ord($buffer) == 0x7B ) ;
385
386            # Continue last not sized RC unless it is the stop one
387            if ( $inXML and
388                (( $inXML eq '200' and ! ( $Type eq '201' and $tA and $tB )) or
389                ( $inXML eq '201' and ! ( $Type eq '202'  and $tA and $tB ))))
390            {
391                &Debug("In XML $inXML: Type would be '" . ( $tA ? '#' : '.' ) .
392                    $Type . ( $tB ? '#' : '.' ) . "'");
393
394                # Still reading an XML, seek to beginning of line to avoid
395                # missing an EOL if the begin string
396                seek $AFPDSFILE, -5 , 1 ;
397
398                # Type has been saved in inXML
399                $Type = $inXML ;
400
401                # Get last created RC
402                $RC = $self->{RC}->{$Type} ;
403
404            } else {
405                # Update afpbuffer
406                $afpbuffer .= $rawtype ;
407
408                # Destroy last control record if needed and create new one
409                delete $self->{RC}->{$Type} if (defined($self->{RC}->{$Type}));
410
411                # Get new RC object
412                $RC = new AFPDS::ControlRecord( $Type,$texbase,$AfpName,$file );
413
414                &Debug("Found a control record type '$Type'");
415            }
416
417            # Check object creation
418            &Abort(115, $file, $Type , $texbase ) unless (defined($RC));
419
420            $buffer = "" ;
421
422            # Initialization should return the length of the record control
423            # Else it should return 0 to stop reading as record type is unknown
424            $tmp = defined($RC) ? $RC->get_required_size() + $readmode : 0 ;
425            &Abort(113,$tmp,$Type) unless ($tmp);
426
427            # Read now ControlRecord and analyse it
428            if ( $tmp > 0 and read( $AFPDSFILE, $buffer, $tmp ) == $tmp ) {
429
430                &debugbuffer($buffer);
431                &Abort(300,$Type,$RC->geterror())
432                    if ( defined($RC) and $RC->init( $buffer ) < 0 );
433
434                # Check initialization is done
435                &Abort( 116, $Type, sprintf( "%02X" x length($buffer),
436                    map { ord } split( //, $buffer ) ) )
437                        unless (defined($RC));
438
439                # Set job_tag for this RC library
440                $RC->job_tag($Job);
441
442                # Check if we have reached a afpds splitting event
443                if ( ! @skip and $RC->can_split_job() ) {
444                    # Compute the pos in file for the next job to convert
445                    my $pos = tell($AFPDSFILE) - length($afpbuffer)
446                         - length($buffer);
447
448                    # Get a tag
449                    my @split_tags = $RC->get_split_tags ;
450
451                    # Set this job is the last of a split event
452                    $afpds->updateEnv( {
453                        # Set SPLIT_FILE with first position in file and length
454                        SPLIT_FILE  => $startpos . ':' . $pos,
455                        SPLIT_TAG   => $split_tags[0],
456                        SPLIT_TAG2  => $split_tags[1]
457                        } );
458
459                    # Skip the rest to leave as a splitting event
460                    push @skip, 'splitted' ;
461
462                    # Finish that job
463                    last ;
464                }
465
466                if ( ! @skip and ($Type eq '001' or $Type eq '100')) {
467
468                    my $pagedef = $RC->getpagedef() ;
469
470                    &UPSTAT('USEPAGEDEF_' . $pagedef );
471
472                    # Load the perl Library for the PAGEDEF only on record
473                    # Type 001 or 100
474                    my $loadlib = "perllib::p1" . lc( $pagedef );
475
476                    # Abort if we won't be able to load perl module
477                    if ($pagedef) {
478                        &Abort(104,$pagedef,$loadlib)
479                            unless ( grep {
480                                -s $_ . '/perllib/p1' . lc( $pagedef ) . '.pm'
481                            } @INC );
482
483                    } else {
484                        &Abort(6);
485                    }
486
487                    unless (@skip) {
488                        &Debug("Loading library with '$loadlib' evaluation");
489                        eval "use " . $loadlib ;
490
491                        $afpds->setpagedef(   $pagedef );
492                        $afpds->setpclcond(   $RC->ispcloutput() );
493                        $afpds->setformdef(   $RC->getformdef()  );
494                        $afpds->setoutfile(   $RC->getoutfile()  );
495                        $afpds->setTRCforTeX( $RC->getTRCforTeX());
496
497                        &Debug("Perl library loaded");
498                    }
499
500                    # Close previous file handles if it's not the first job
501                    $self->CloseFiles if ($GenFlag);
502                    $GenFlag = $self->OpenFiles( $RC->getoutfile() );
503                }
504
505                unless (@skip) {
506                    # Env is updated in Flux and will be returned to JobManager
507                    # when completly analysed
508                    $afpds->updateEnv( $RC->getenv() );
509
510                    # Update ArchFile with RECORD content when necessary
511                    local $\ = "\n" ;
512                    print $ArchFile $RC->getRecord
513                        if (defined($ArchFile) and $RC->getRecord());
514
515                    # Keep a record copy in our RC hash
516                    $self->{RC}->{$Type} = $RC ;
517                }
518
519            # Handle not sized Control Record type 200-202
520            } elsif ($tmp < 0 and $Type =~ /^20[0-2]$/) {
521
522                my $line = "" ;
523                # Read till the end of line
524                &myreadline( \*$AFPDSFILE , \$line );
525
526                # Update afpbuffer (first char always added at loop begining)
527                $afpbuffer .= substr($line,($inXML and $Type eq '201')?1:0) ;
528
529                &mychomp( \$line );
530
531                # Check record
532                if ( $Type eq '202' ) {
533                    # Stopping an input
534
535                    # Forget any information just behind RC 202 string
536                    if ($line !~ /^$/) {
537                        &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
538                            if ($DO_CONVERT);
539                        &Info(_job_tag."RC 202 tagged with '$line'");
540                    }
541
542                    # Check last record 100 to set the PDF name and service flag
543                    &Abort(120, $Type , 100)
544                        unless (defined($self->{RC}->{100}));
545
546                    # Check last record 200 to get the working folder
547                    &Abort(120, $Type , 200)
548                        unless (defined($self->{RC}->{200}));
549
550                    # Check base directory availability for pdf file
551                    my $base = @skip ? undef : $self->{RC}->{100}->getbase ;
552                    &Abort(122, $base)
553                        unless ( defined($base) and $base and -d $base );
554
555                    my $outbase = $base . '/' . $LOCKID . '_' . $Job ;
556                    my $env = {
557                        'PDFFILE'     => $outbase . "-$file.pdf",
558                        'XML_A2P'     => $outbase . "_a2p-$file.xml",
559                        'XML_CONTENT' => $outbase . "_service-$file.xml"
560                    } ;
561
562                    # Update a2p xml attributs before saving
563                    my @attribut = ( pdf => $env->{PDFFILE} );
564                    unless (@skip) {
565                        $self->{RC}->{200}->set_a2p_attribut(@attribut)
566                            or &Abort(123 , @attribut);
567                    }
568
569                    @attribut = ( file => $env->{XML_CONTENT} );
570                    unless (@skip) {
571                        $self->{RC}->{200}->set_a2p_attribut(@attribut)
572                            or &Abort(123 , @attribut);
573                    }
574
575                    # Save A2P xml
576                    unless (@skip) {
577                        $self->{RC}->{200}->save_a2pxml_file($env->{XML_A2P})
578                            or &Abort(121 , 200, $env->{XML_A2P});
579                    }
580
581                    # Check last record 201 to save the content
582                    &Abort(120, $Type , 201)
583                        unless (defined($self->{RC}->{201}));
584
585                    # Save RC 201 content
586                    unless (@skip) {
587                        my $content = $env->{XML_CONTENT} ;
588                        $self->{RC}->{201}->save_a2pxml_file($content)
589                            or &Abort( 121 , 201, $content );
590                    }
591
592                    # Tag Flux as e-service and not arch
593                    &Debug("Updating env to handle content and a2p xml files");
594                    $afpds->updateEnv( $env )
595                        unless (@skip);
596
597                    &Debug("Service is ready to handle E-Service request");
598                    # Release inXML flag
599                    $inXML = 0 ;
600
601                } elsif ( $Type eq '201' ) {
602                    if ($inXML) {
603
604                        &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
605                            if ($CONVERT_CONTENT_FILE and $DO_CONVERT);
606
607                        # Add EOL to line
608                        $line .= "\n" ;
609
610                        # Add the complete line to content
611                        $RC->addcontentref( \$line ) unless (@skip);
612                        &Debug("Added '$line' to content file");
613
614                    } else {
615                        # Forget any information just behind RC 201 string
616                        if ($line !~ /^$/) {
617                            &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
618                                if ($DO_CONVERT);
619                            &Info(_job_tag."RC 201 tagged with '$line'");
620                        }
621
622                        # Flag we are inXML handling
623                        $inXML = $Type ;
624                    }
625
626                } elsif ( $Type eq '200' ) {
627                    # Check last record 100 to get the working folder
628                    &Abort(120, $Type , 100)
629                        unless (defined($self->{RC}->{100}));
630
631                    unless (@skip) {
632                        my $basefile = $self->{RC}->{100}->getoutfile() ;
633
634                        # Update
635                        $line = $begin . $line if $inXML ;
636                        &from_to( $line , $FROM_CONVERT , $TO_CONVERT )
637                            if ($DO_CONVERT);
638
639                        $RC->seta2pxml( $line , $basefile );
640
641                        # Tag Flux as e-service
642                        unless ($inXML) {
643                            &Debug("Updating env with expected values");
644                            $afpds->updateEnv( {
645                                DO_ESERVICE => 'yes',
646                                DO_PDF      => 'yes',
647                            } );
648                        }
649
650                        # Flag we are inXML handling if not complete and valid
651                        $inXML = $RC->a2pxml_is_valid() || $Type ;
652
653                        # Remark: service name '200' is an error as prohibited
654                        #         (checked in XML.pm)
655                        if ($inXML and $inXML ne $Type) {
656                            &Debug("Updating env with requested service");
657                            $afpds->updateEnv( {
658                                E_SERVICE => $inXML
659                            } );
660
661                            # Release inXML flag
662                            $inXML = 0 ;
663                        }
664                    }
665                }
666
667                # Keep a record copy in our RC hash
668                $self->{RC}->{$Type} = $RC unless (@skip);
669
670            } else {
671                # Bad length read for that record
672                &debugbuffer($buffer);
673                &Abort(102,$Type);
674            }
675
676            # Update afpbuffer
677            $afpbuffer .= $buffer ;
678
679        # End of ControlRecord management
680
681        } else {
682            # This is a standard line, first char is the control char
683            $cctrl = $buffer ;
684            &from_to( $cctrl , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
685            &Debug("Found standard line with control char <$cctrl>");
686
687            # The next char is used to select TRC font
688            read( $AFPDSFILE , $char , 1 );
689
690            # Update afpbuffer
691            $afpbuffer .= $char ;
692
693            # Check AFPDS Flux is defined
694            if (defined($self->{AFPDS})) {
695
696                # ErFo001 Fix: Select TRC font
697                $self->{AFPDS}->selectTRCfont( ord($char) )
698                    unless (@skip);
699
700                # Read the rest of the line
701                $buffer = "";
702                $long = &myreadline( \*$AFPDSFILE , \$buffer );
703
704                # Update afpbuffer
705                $afpbuffer .= $buffer ;
706
707                $tmp = &compute( \$buffer , -2 , 2 );
708                if ( $tmp != 0x0D0A ) { # Buffer must end with 0x0D0A
709                    &debugbuffer( $buffer );
710                    &Abort(101,$tmp);
711                }
712
713            } else {
714                &Abort(5);
715            }
716
717            &mychomp( \$buffer );
718            $long = length( $buffer ) ;
719
720            &from_to( $buffer , $FROM_CONVERT , $TO_CONVERT ) if ($DO_CONVERT);
721
722            # Compute the new AFP line
723            $self->{AFPDS}->afpline( $cctrl , $buffer )
724                unless (@skip);
725        }
726
727        my $currentpos  = tell($AFPDSFILE) ;
728        my $currenttime = &tv_interval(\@StartTime) ;
729
730        # Return convertion status after required timing
731        if ( $currenttime >= $tv_timing ) {
732            my $fileratio = $currentpos/$EOF ;
733
734            # Compute convertion ratio
735            my $ratio = sprintf("%d",$fileratio*100);
736
737            # Compute termination estimation
738            my $remain = sprintf("%.1f",$currenttime/$fileratio-$currenttime);
739            &Debug("Convertion done at $ratio%, should finish in $remain s");
740
741            # Return information to JobManager
742            $self->Return( $Job => &GetCom( comINF ,
743                'AFP2TeX Conversion status' =>
744                    "$ratio% done, $remain sec remaining" ));
745
746            # Update job state in spool
747            &a2pjobstate( $Job, 2, '.' , { STATUS => $ratio.'%' })
748                or &Info("Can't update status conversion progress to $ratio%");
749
750            # Update next timing report
751            $tv_timing += $CONV_STATUS_TIMING ;
752        }
753
754        &Debug("Loop at AFPDS file off-set " . sprintf("%Xh",$currentpos) .
755            ($inXML?" in not sized RC '$inXML'":""));
756
757        $buffer = getc( $AFPDSFILE ) ;
758
759    } # End while read file
760
761    &Debug("File#" . $file . ": Last TeX file generation");
762
763    # Output last converted TeX file
764    &Abort(2) unless ( @skip or &generateTeX );
765
766    # Keep stats on conversion rate
767    my $tv_interval = &tv_interval($RateTimer) ;
768    &MAXSTAT('CONV-RATE',int( 100 * $file / $tv_interval ) / 100)
769        if ($tv_interval);
770
771ABORTED_FILE:
772    # Freeing objects
773    delete $self->{AFPDS}
774        if (defined($self->{AFPDS}) and ! $self->{AFPDS}->issplitted());
775    delete $self->{RC} if (  defined($self->{RC}) );
776
777    # Reset vars
778    $file = 0 ;
779
780    return $ErrFlag ? &End($ErrFlag) : &End(0, "Conversion done" );
781}
782
783my ( $conv_time , $conv_count ) = ( 0, 0 );
784sub generateTeX {
785    my $afpds = $self->{AFPDS} ;
786
787    # Check few things on RC
788    # At least a RC 001 or a RC 100 must have been provided
789    return &Error(_job_tag."No RC 001 or RC 100 defined")
790        unless (defined($self->{RC}->{'001'}) or defined($self->{RC}->{'100'}));
791    # If a RC 200 has been provided, we must also have a RC 201 and a RC 202
792    return &Error(_job_tag."Found wrong combination of record 200-202")
793        if (defined($self->{RC}->{'200'}) and
794        $self->{RC}->{'200'}->a2pxml_is_valid and
795        !(defined($self->{RC}->{'201'}) and defined($self->{RC}->{'202'})));
796
797    # Output the convertex TeX file
798    return &Error(_job_tag."Error while generating TeX file")
799        unless ($afpds->gentex( $TexFile ));
800
801    # Output to AfpFile and check TeX convertion rate
802    if (defined($afpbuffer) and length($afpbuffer)) {
803
804        # 1. Output to AfpFile
805        if (eof($AFPDSFILE)) {
806            print $AfpFile $afpbuffer if (defined($AfpFile));
807
808        } else {
809            # Output AfpFile without the last char '#'
810            print $AfpFile substr($afpbuffer,0,-1)
811                if (defined($AfpFile));
812
813            # And reset afpbuffer with only char '#' ( in ebcdic)
814            $afpbuffer = chr(0x7B);
815        }
816
817        # 2. Wait a little to match required TeX convertion rate
818        #    essentially on big job
819        if ( $MAX_CONV_RATE and $file > $MAX_CONV_RATE ) {
820            my $prev_conv_time = $conv_time ; # Default to zero
821
822            # Still sleep a little if we can
823            if ( $conv_time ) {
824                &MAXSTAT('CONV-RATE-PRE-SLEEP-TIME',$conv_time);
825                usleep $conv_time  ;
826            }
827
828            # Get the delay since the beginning of that conversion
829            $conv_time = &tv_interval($RateTimer) * 1_000_000 ;
830
831            # min_conv_time is the time by conversion to reach computed before
832            # each conversion start
833            my $diff = $conv_time - $file * $min_conv_time ;
834            my $count = $file > $conv_count ? $file - $conv_count : 1 ;
835            if ( $diff < 0 ) {
836                # Get the time we should have sleep to reach max_conv_rate
837                my $usleep = abs($diff) ;
838
839                # Really not sleep if time to sleep is too short
840                unless ( $usleep < $USLEEP ) {
841                    &UPSTAT('CONV-RATE-SLEEPING');
842                    &MAXSTAT('CONV-RATE-SLEEP-TIME',$usleep);
843                    &Debug("Waiting $usleep ms to lower speed as " .
844                        $MAX_CONV_RATE . " Max conversion rate was reached");
845                    usleep $usleep ;
846                }
847                $conv_time = $usleep / $count ;
848
849            } elsif ($prev_conv_time) {
850                &UPSTAT('CONV-RATE-SLEPT-TOO-MUCH');
851                # diff is the excess time we have slept
852                my $correction = $count > 0 ? $diff / $count : 0 ;
853
854                # Always reset $conv_time to keep the sleep next time
855                if ( $correction > 0 and $correction < $prev_conv_time
856                and $conv_time > $USLEEP ) {
857                    # Adjust conv_time to sleep less next time
858                    $conv_time = $prev_conv_time - $correction ;
859
860                } else {
861                    $conv_time = $prev_conv_time ;
862                }
863            }
864
865            # Remember conversion count
866            $conv_count = $file ;
867        }
868    }
869
870    # Return the job environment to JobManager
871    &Debug("File#" . $file . ": Shell env file generation");
872
873    # Set MTIME job env to file mtime
874    $afpds->updateEnv( { MTIME => $mtime } );
875
876    # Announce last job to master thread
877    $self->Return( $Job , $afpds->getEnv() );
878
879    # And keep some stats
880    $self->KeepStats( $Job, $afpds->getstat() );
881
882    # Update job state in spool
883    &a2pjobstate( $Job, 2, 'o' )
884        or &Info(_job_tag."Can't update status to step 2 done");
885
886    # Return true
887    1 ;
888}
889
890
891################################################################################
892sub End {
893    # End jobs here as it closes properly any opened file
894    my $ret  = shift || 0 ;
895    my $msg  = shift || "";
896
897    if (defined($msg)) {
898        $ret and $msg ? &Error($msg) : &Debug($msg) ;
899    }
900
901    # Now clean everything
902    &Debug("Closing files");
903
904    &CloseFiles();
905    close($AFPDSFILE) if (defined($AFPDSFILE));
906
907    return $ErrFlag ? $ErrFlag : $ret ;
908}
909
910our $AbortMessages = {
911    0   => "Unknown error",
912    1   => "Last TeX file not generated",
913    2   => "Can't generate TeX file",
914    3   => "Can't handle RC 5A without AFPDS flux defined",
915    4   => "Expected defined AFPDS flux here",
916    5   => "Can't processing standard AFP line without AFPDS Flux defined",
917    6   => "Can't load PAGEDEF as it isn't defined",
918    100 => "Can't use not defined '%s' controlrecord",
919    101 => "Found AFPDS text line with bad end of line <0x%04X>",
920    102 => "Unknown control record '%s'",
921    103 => "File#%s: Bad TeX file generation for print %s",
922    104 => "Unable to load PAGEDEF %s as Perl module %s not found",
923    105 => "freed error number",
924    106 => "Can't create %s folder: %s",
925    107 => "Can't open %s: %s",
926    108 => "Can't process %s in binary mode: %s",
927    109 => "Can't read last 10 chars of %s: %s",
928    110 => "Found AFPDS Field with bad end of line <0x%04X>",
929    111 => "Found AFPDS Field with bad length: %s vs %s",
930    112 => "Bad control record type format found for record type '%s'",
931    113 => "Bad control record length (%s) for record type '%s'",
932    114 => "Got bad AFPDS format as RC 5A is too short (%s < 8)",
933    115 => "Can't create RC object %d of type '%s' with TEXBASE '%s'",
934    116 => "Can't initialize RC type '%s' with buffer '%s'",
935    117 => "Can't use RC type '%s' on with no AFPDS Flux defined",
936    118 => "AFP error on RC 5A with ident %6X, flag %08b, reserved 0x%04X, ".
937           "long %d and buffer %s",
938    119 => "Can't use existing folder '%s' to compute AFPDS file",
939    120 => "Can't use RC type %d without previously defined RC type %d",
940    121 => "Can't save XML content for RC type %d in %s",
941    122 => "Folder '%s' not available",
942    123 => "Can't update '%s' attribut with value '%s' in A2P XML",
943    124 => "File '%s' is too short or corrupted",
944    200 => "Got RC 5A error %d, %s",
945    300 => "Got RC #%s# init error %d, %s",
946    500 => "trying to convert job %d after errors"
947};
948
949my @AbortErrors = (
950    0, 2, 3, 4, 5, 106, 107, 108, 109, 119, 122
951    );
952
953# Must be called with number identifying message and then abort processing
954sub Abort {
955    $ErrFlag = shift || 0 ;
956
957    unless ( defined($skip[$ErrFlag]) and $skip[$ErrFlag]++ ) {
958        @AbortTime = &gettimeofday();
959
960        my $file_offset = sprintf("AFPDS file off-set %Xh",tell($AFPDSFILE)) ;
961
962        my @ERR = $ErrFlag >= 500 ?
963            () : ( _job_tag . "Aborting at $file_offset" ) ;
964        my $msg = $ErrFlag >= 500 ? $file_offset.": " : "" ;
965        $msg .= _job_tag . $AbortMessages->{$ErrFlag} ;
966
967        my $ABTERM = $ErrFlag < 100 ?
968            $msg." (Err$ErrFlag)" : sprintf( $msg." (Err%d)" , @_, $ErrFlag ) ;
969
970        # Still return the ABTERM message to JobManager
971        $self->Return( $Job => &GetCom( comINF , 'ABTERM '.$ErrFlag, $ABTERM ));
972
973        push @ERR, $ABTERM ;
974        $ErrFlag < 500 ? &Error( @ERR ) : &Warn( @ERR );
975
976        # Return information to JobManager
977        map { $self->Return( $Job => &GetCom( comINF , 'ERROR' , $_ )) } @ERR ;
978
979        # Update status for afpjob
980        map { &a2pjobstate( $Job, 2, 'A', { ABTERM => "$_" } ) } @ERR ;
981
982        # Keep the ABTERM on the current JID if really started
983        if ( $file ) {
984            # Update status for subjob designed by JID key in %Infos
985            my $Infos = { JID => $Job . "-" . $file } ;
986            $Infos->{STATUS} = 'ABTERM' if ( $ErrFlag < 500 );
987            map {
988                $Infos->{ERRORS} = "$_" ;
989                &a2pjobstate( $Job, 2, 'A', $Infos );
990            } @ERR
991        }
992    }
993
994    if (grep { $_ == $ErrFlag } @AbortErrors) {
995        goto ABORTED_FILE ;
996
997    } else {
998        # Don't Abort file conversion to try next sub jobs
999        return $ErrFlag ;
1000    }
1001}
1002
1003END {
1004    if ($ErrFlag and @AbortTime) {
1005        my $time = sprintf("%.2f sec",&tv_interval(\@AbortTime));
1006        &Error("Last conversion aborted $time ago with $ErrFlag abort number");
1007    }
1008}
1009
1010&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
1011
10121;
Note: See TracBrowser for help on using the repository browser.