# # 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 Begin Object Container members # # cf ref #2, p. 129 # package AFPDS::MODCA::BOC ; use strict ; use A2P::Globals ; use A2P::Syslog ; use AFPDS::MODCA::Common ; BEGIN { our $VERSION = sprintf "%s", q$Rev: 1030 $ =~ /([0-9.]+)\s+/ ; } our $VERSION ; our @ISA = ("AFPDS::MODCA"); our $IDENTS ; sub _ID { 0xD3A892 } sub _supported_triplets { return [ 0x10, # Mandatory object classification ], [ # TODO support needed for next # 0x01, # Coded charset GID # 0x02, # FQN # 0x57, # object byte extent # 0x62, # local timestamp # 0x65, # comment # 0x72, # universal timestamp ]; } 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 BOC as new integrated resource"); &UPSTAT('GET-RESOURCE'); # Check minimal buffer size return ( 251, "BOC is malformed as too short (" . $self->{LONG} . "<9)" ) if ( $self->{LONG} < 9 ); # Check FLUX is a Flux object return ( 251, "BOC needs to be used with Flux object" ) unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ ); return () ; } sub create { my $self = shift ; my $flux = $self->{FLUX} ; # Set resource name my $resname = substr( $self->{BUFFER}, 0, 8 ); $resname = $self->convert( $resname ); return ( 252, "Invalid resource name found" ) unless $resname ; # Set resource name as member as it can be later overrided by X'02' triplet $self->name( $resname ); # Analyse now authorized triplets as it is mandatory my @err = $self->check_triplets(substr( $self->{BUFFER}, 8 )); return @err if @err ; my $struct = $self->{STRUCT} || 0 ; return ( 253, "Unexpected '$struct' structure found for BOC object" ) unless ( $struct == 0xDC00 ); my $class = $self->{CLASS} || 0 ; return ( 253, "Unexpected '$class' class found for BOC object" ) unless ( $class == 0x01 ); # Add an empty buffer to the resource object $self->{RESOURCE_BUFFER} = "" ; # Set a new resource in flux object $flux->set_resource($self) unless @err ; return @err ; } sub teximage { my $self = shift ; my $reso = shift || 240 ; # Affect image if the first argument is defined $self->{TEXIMAGE}->{$reso} = shift if ( @_ and defined($_[0]) ); return ( exists($self->{TEXIMAGE}) and exists($self->{TEXIMAGE}->{$reso}) )? $self->{TEXIMAGE}->{$reso} : '' ; } sub DESTROY { my $self = shift; # Output resource if not retrieved by inclusion and in DEBUG mode if ( $ADVANCED_DEBUGGING or ! exists($self->{TEXIMAGE}) and ref($self->{FLUX}) =~ /^AFPDS::Flux/ ) { my $flux = $self->{FLUX} ; my $file = $flux->getoutbase . '_' . $self->name ; $file .= '.' . lc($self->{FORMAT}) if (exists($self->{FORMAT})); $flux->toclean( $file ); if ( open( OBJ, '>', $file ) ) { binmode(OBJ); print OBJ $self->{RESOURCE_BUFFER} ; close(OBJ); } } } &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); ( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;