# # 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$ # # Class to export Invoke Data Map (PAGEFORMAT) members # # cf ref #1, p. 91 # package AFPDS::MODCA::IDM ; use strict ; use A2P::Globals ; use A2P::Syslog ; use AFPDS::MODCA::Common ; BEGIN { our $VERSION = sprintf "%s", q$Rev: 1007 $ =~ /([0-9.]+)\s+/ ; } our $VERSION ; our @ISA = ("AFPDS::MODCA"); our $IDENTS ; sub _ID { 0xD3ABCA } sub new { my $class = shift ; &Debug("new " . __PACKAGE__ . " v$VERSION object"); my $self = { FLUX => 0, # Associated flux IDENT => _ID, # MO:DCA identity FLAG => 0, # MO:DCA flags RESERVED => 0, # MO:DCA reserved LONG => 0, # MO:DCA buffer length BUFFER => '' # MO:DCA content buffer }; return bless $self , $class ; } sub validate { my $self = shift ; &Debug("Found IDM as PAGEFORMAT"); &UPSTAT('GETPAGEFORMAT'); # Check buffer size if ( $self->{LONG} != 8 ) { &Warn("Found IDM Field value with bad length (" . $self->{LONG} . "), keeping only the first 8 chars"); $self->{BUFFER} = substr( $self->{BUFFER} , 0 , 8 ); } # Check FLUX is a Flux object return ( 251, "IDM needs to be used with Flux object" ) unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ ); # Check PAGEDEF is selected return ( 251, "Can't set PAGEFORMAT withou PAGEDEF selected" ) unless ( $self->{FLUX}->pagedef ); return () ; } sub create { my $self = shift ; my $flux = $self->{FLUX} ; # Convert buffer my $pageformat = $self->convert ; # Keep information on this use for statistics $flux->{PAGEFORMATs}->{$pageformat} = 1 ; &UPSTAT('USEPAGEFORMAT_' . $pageformat); # Load the corresponding Perl module and return my $PageFormatSub = "perllib::p1" . lc( $flux->pagedef ) . "::PAGEFORMAT" ; my $libload = $PageFormatSub . '( "' . $pageformat . '", @{$flux->{PrintLineTab}} )'; # Before trying to load, we must check sub is available return ( 202, "No PageFormat available with PAGEDEF " . $flux->pagedef ) unless (ref( eval '\&' . $PageFormatSub ) =~ /^CODE/ ); my ( $IfLandScape , $PageFormat ) = eval( $libload ); return ( 203, "Can't load '$pageformat' Pageformat from 'P1" . $flux->pagedef . "' Pagedef" ) unless (defined($PageFormat)); &UPSTAT('GETLANDSCAPEPAGE') if $IfLandScape ; $flux->updateFlux( { PAGEFORMAT => $PageFormat, LANDSCAPE => $IfLandScape, # This force a new page with the next newline StartNewPage => 1, # This force PTCA to be stored in logo array until newline is called LINE => 0, # Only used in logging CurrentPAGEFORMAT => $pageformat } ); # Protect '%' from printf interpretation in syslog debugging $PageFormat =~ s/%/%%/g ; &Debug("PageFormat loaded: eval( $libload ) = $IfLandScape , $PageFormat"); return () ; } &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); ( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;