# # 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: ControlRecordDef.pm 3 2007-10-18 16:20:19Z root $ # # Module to initialize Control Record definitions package AFPDS::ControlRecordDef; use strict; use A2P::Globals ; use A2P::Syslog ; BEGIN { use Exporter (); our ( $VERSION , @ISA , @EXPORT ); $VERSION = sprintf "%s", q$Rev: 717 $ =~ /(\d[0-9.]+)\s+/ ; @ISA = qw(Exporter); @EXPORT = qw( %RCDEF %SIZE ); } our $VERSION ; # Exported Variables our %RCDEF = () ; our %SIZE = () ; #======================================================================= # initialisation code - stuff the DATA into the RCDEF hash #======================================================================= my $T = "" ; my $index = 0 ; my %data = (); &Debug("Loading RCDEF..."); while () { chomp ; next if /^\s*$/ ; # Skip empty lines next if /^#/ ; # Skip comment line my ( $rec , $tag , $comment ) = /^\s*(\w+)\s+=>\s+(.*)\s*#\s+(\w+.*)\s*$/i ; die "Bad line $_ found in Record Control definitions" unless (defined($rec)); if ( $rec =~ /^type$/i ) { ( $tag ) = $tag =~ /^(\w+)/ ; &Debug("Loading new Record Control definition type '$tag'"); $T = "$tag" ; $index = 1 ; next ; } elsif ( $rec =~ /^__SPLIT__$/i and $tag =~ /^\s*$/i ) { my $name = $1 ; &Debug("Loading afpds splitter '$name' with RC type $tag"); my $splitter = "" ; while (my $line = ) { last if ( $line =~ /^\s*<\/code>\s*$/ ); $splitter .= $line ; } &Debug("Loaded splitter is ".length($splitter)." long"); my $code = eval( "sub { $splitter }" ); die "Can't load '$name' splitter with invalid code\n" unless (defined($code) and ref($code) =~ /^CODE$/); $RCDEF{$T}->{'__A2P_SPLITTER__'} = $code ; &Debug("Splitter $name loaded"); next ; } die "No Record Control type defined for line $_" unless ( $T ); # Extract now the pos and the id my ( $pos, $id ) = $tag =~ /^Pos:\s+([-+0-9*]+)\s+:\s+(\w+)\s*$/i ; die "Bad format in $_ line found in Record Control type $T definition with". "'$tag' field definition" unless ( $rec and $pos and $id and $comment ); #&Debug("Type=$T ; Index=$index ; Rec=$rec ; Pos=$pos ; Id=$id ; Comment=<$comment>"); $data{$T}->[$index++] = [ $rec => $pos ]; } close(DATA); &Debug("Analysing RCDEF..."); foreach $T (keys(%data)) { my ( $key , $pos , $curpos , $size ) = ( "" , 0 , 0 , 0 ); $index = 1 ; while (defined($data{$T}->[$index])) { ( $key , $pos ) = @{$data{$T}->[$index++]} ; if ( $pos =~ /-/ ) { # First position must be in x-y style ( $curpos , $size ) = split( "-" , $pos ); die "Bad POS format in Control Record def ($index)" unless (defined($curpos) and defined($size)); $size -= $curpos - 1 if ( $size ne '*' ); die "Bad SIZE $size found in Control Record def ($index)" unless ( $size > 0 or $size eq '*'); } elsif ( $pos =~ /\+(\d+)/ ) { $size = $1 ; die "Bad $pos size definition found in Control Record def ($index)" unless $size ; } else { die "$pos is not a POS definition in Control Record def ($index)"; } #&Debug("T$T: RC{$key} def = pos $curpos ( $size long )"); if ( $size eq '*' ) { $RCDEF{$T}->{$key} = [ $curpos , -1 ]; $SIZE{$T} = -1 ; } else { $RCDEF{$T}->{$key} = [ $curpos , $size ]; $curpos += $size ; $SIZE{$T} = $curpos - 1 if ( !defined($SIZE{$T}) or $SIZE{$T} < $curpos - 1 ); } } #&Debug("RC type $T is $SIZE{$T} bytes long"); } &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); 1; __DATA__ ################################################################################ TYPE => 001 # RC001 UTIPRJ => Pos: 6-7 : UTIPRJ # Code projet 'RS' UTISTE3 => Pos: +3 : UTISTE3 # Code société 'P10' UTICPR => Pos: +3 : UTICPR # Centre de profit '036' IMPDOCA => Pos: +2 : IMPDOCA # Code application '20' IMPDOCN => Pos: +2 : IMPDOCN # Numéro de document '01' TRTDAT => Pos: +8 : TRTDAT # Date de formatage 'yyyymmdd' IMPHEU => Pos: +7 : IMPHEU # Heure de formatage 'hhmmssc' COPIES => Pos: +3 : IMPCOPN # Number of copies to add FORM => Pos: +4 : IMPFORN # Sheet number (Numéro de formulaire) DESTID => Pos: +8 : IMPLU # printer (Terminal ID) IMPCLAS => Pos: +1 : IMPCLAS # printing class BURST => Pos: +1 : IMPBURS # burst FLASH => Pos: +4 : IMPFLAS # flash CHARS => Pos: +16 : IMPCHAR # chars (4x4 pos.) PAGEDEF => Pos: +6 : IMPPAGD # PageDef FORMDEF => Pos: +6 : IMPPAGD # Formdef HOLD => Pos: +1 : IMPHOLD # hold PRIORITY => Pos: +2 : IMPPRIO # priority __SPLIT__ => # Perl code to split AFPDS # We just want to split AFPDS when DESTID has changed, so just return it my $RC = shift ; return $RC->{DESTID} ; ################################################################################ TYPE => 100 # RC100 UTIPRJ => Pos: 6-7 : UTIPRJ # Code projet 'RS' UTISTE3 => Pos: +3 : UTISTE3 # Code société 'P10' UTICPR => Pos: +3 : UTICPR # Centre de profit '036' IMPDOCA => Pos: +2 : IMPDOCA # Code application '20' IMPDOCN => Pos: +2 : IMPDOCN # Numéro de document '01' TRTDAT => Pos: +8 : TRTDAT # Date de formatage 'yyyymmdd' IMPHEU => Pos: +7 : IMPHEU # Heure de formatage 'hhmmssc' CHARS => Pos: +16 : IMPCHAR # chars (4x4 pos.) PAGEDEF => Pos: +6 : IMPPAGD # PageDef FORMDEF => Pos: +6 : IMPPAGD # Formdef RECORD => Pos: 6-60 : RECORD # To put in Arch file ################################################################################ TYPE => 101 # RC101 RECORD => Pos: 6-114 : RECORD # brut transcrit ################################################################################ TYPE => 102 # RC102 RECORD => Pos: 6-135 : RECORD # brut transcrit ################################################################################ TYPE => 103 # RC103 RECORD => Pos: 6-35 : RECORD # brut transcrit ################################################################################ ################### Control Record in 200-299 are not sized ################### ################### But need a RECORD definition ################### ################################################################################ TYPE => 200 # RC200 RECORD => Pos: 6-* : XML # as ################################################################################ TYPE => 201 # RC201 RECORD => Pos: 6-* : START # empty start record ################################################################################ TYPE => 202 # RC202 RECORD => Pos: 6-* : STOP # empty stop record ################################################################################