# # 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: IPS.pm 3 2007-10-18 16:20:19Z root $ # # Class to export Include Page Segment members # # cf ref #1, p. 99 # package AFPDS::MODCA::IPS ; 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 { 0xD3AF5F } 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 ; &UPSTAT('GETSEGMENT'); &Debug("Found IPS as LOGO"); # Check buffer size return ( 251, "Found too short IPS object (" . $self->{LONG} . "<14)" ) if ( $self->{LONG} < 14 ); &Warn("Found IPS Field value with triplets (" . $self->{LONG} . ">14)") if ( $self->{LONG} > 14 ); # Check FLUX is a Flux object return ( 251, "IPS needs to be used with Flux object" ) unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ ); return () ; } sub create { my $self = shift ; my $flux = $self->{FLUX} ; my ( $landscape, $rotation ) = $flux->orientations ; my $logoline = '' ; if ( $landscape != $rotation ) { $flux->updateFlux( { ROTSEGMENT=> $landscape } ); $logoline = "\\def\\ROTSEGMENT{" . $landscape . "}%\n" ; } # Set logoname my $logoname = substr( $self->{BUFFER}, 0, 8 ); $logoname = $self->convert( $logoname ); return ( 252, "Invalid logoname found" ) unless $logoname ; $logoname = uc( $logoname ); &UPSTAT('USESEGMENT_' . $logoname); # Set segname for TeX/LaTeX coding my $segname = $logoname ; $segname =~ y/0-9/a-j/ ; my $logox = $self->get_from_buffer( 8, 3 ); my $logoy = $self->get_from_buffer( 11, 3 ); my ( $xtex, $ytex ) = ( '', '' ); unless ( $logox == 0xFFFFFF ) { # This is a signed number $logox -= 0x1000000 if ( $logox > 0x7FFFFF ); # Check and set X off-set return ( 222, "Found bad IPS X-value ($logox)" ) if ( $logox < -32768 or $logox > 32767 ); # X off-set as TeX code $xtex = sprintf( "%d\\Xunit" , $logox ) ; } unless ( $logoy == 0xFFFFFF ) { # This is a signed number $logoy -= 0x1000000 if ( $logoy > 0x7FFFFF ); # Check and set Y off-set return ( 223, "Found bad IPS Y-value ($logoy)" ) if ( $logoy < -32768 or $logoy > 32767 ); # Y off-set as TeX code $ytex = sprintf( "%d\\Yunit" , $logoy ) ; } # If LOGOPATH is not used, then SEGMENT would be find in TeX env my $segpath = $LOGOPATH ? $LOGOPATH . "/" : "" ; # Add SEGMENT to logo list $flux->addsegpath( $segpath, $logoname ); # Keep information on this valid segment after adding its path $flux->updateFlux( { LOGOs => { $logoname => 1 } } ); # Finish Tex/LaTeX code and add it to logo list $logoline .= "\\SEGMENT{" . $xtex . "}{" . $ytex . "}{\\" ; $logoline .= "Rotated" if $landscape ; $logoline .= "Segment" . $segname . "}% Logo: $logoname @ $logox x $logoy" ; $flux->newlogo( $logoline ); unless ($NO_SYSLOG_DEBUG) { # Just to protect '%' from printf interpretation in syslog... $logoline =~ s/%/%%/g ; &Debug("new logo line '$logoline'"); } return () ; } &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); ( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;