source: A2P/a2p/AFPDS/MODCA/IDM.pm @ 5

#
# 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: IDM.pm 3 2007-10-18 16:20:19Z g $
#
# 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+)$/ ;