Cleaned up demos, various build fixes

[urisagit/Stem.git] / lib / Stem / Packet.pm

#  File: Stem/Packet.pm

#  This file is part of Stem.
#  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.

#  Stem 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.

#  Stem 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 Stem; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#  For a license to use the Stem under conditions other than those
#  described here, to purchase support for this software, or to purchase a
#  commercial warranty contract, please contact Stem Systems at:

#       Stem Systems, Inc.		781-643-7504
#  	79 Everett St.			info@stemsystems.com
#  	Arlington, MA 02474
#  	USA

package Stem::Packet ;

use strict ;

use Stem::Class ;
use Stem::Codec ;

my $attr_spec = [

	{
		'name'		=> 'codec',
		'env'		=> 'packet_codec',
		'default'	=> 'Data::Dumper',
		'help'		=> <<HELP,
This is the name of the Codec:: subclass that will be used in this cell
HELP
	},
	{
		'name'		=> 'object',
		'type'		=> 'object',
		'help'		=> <<HELP,
If an object is passed in, the filter will use it for callbacks
HELP
	},
	{
		'name'		=> 'packet_method',
		'default'	=> 'packet_out',
		'help'		=> <<HELP,
This method is called on the object when a packet has encoded from
internal data
HELP
	},

	{
		'name'		=> 'data_method',
		'default'	=> 'packet_data',
		'help'		=> <<HELP,
This method is called on the object when a packet has been decoded
from external data
HELP
	},

] ;


###########
# This POD section is autoegenerated. Any edits to it will be lost.

=head2 Constructor Attributes for Class Stem::Packet

=over 4


=item * Attribute - B<codec>

=over 4


=item Description:
This is the name of the Codec:: subclass that will be used in this cell


=item It B<defaults> to: Storable
Unknown attribute env

=back

=item * Attribute - B<object>

=over 4


=item Description:
If an object is passed in, the filter will use it for callbacks


=item Its B<type> is: object

=back

=item * Attribute - B<packet_method>

=over 4


=item Description:
This method is called on the object when a packet has encoded from
internal data


=item It B<defaults> to: packet_out

=back

=item * Attribute - B<data_method>

=over 4


=item Description:
This method is called on the object when a packet has been decoded
from external data


=item It B<defaults> to: packet_data

=back

=back

=cut

# End of autogenerated POD
###########

sub new {

	my( $class ) = shift ;


	my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
	return $self unless ref $self ;

# 	my @codec_args = exists( $self->{codec} ) ?
# 			( codec => $self->{codec} ) : () ;

#print "NEW PACKET CODEC $self->{codec}\n" ;

	my $codec_obj = Stem::Codec->new( codec => $self->{codec} ) ;
	return $codec_obj unless ref $codec_obj ;
	$self->{'codec_obj'} = $codec_obj ;

#print "CODEC OBJ [$codec_obj]\n" ;

	return $self ;
}

my $END_MARK = "\012#END\012" ;
my $end_mark_len = length $END_MARK ;


sub to_packet {

	my $self = shift ;

	return unless @_ ;
#use Data::Dumper ;
#print Dumper $_[0] ;

	my $codec_text = $self->{'codec_obj'}->encode( $_[0] ) ;

#print Dumper $codec_text ;
	my $size = length( ${$codec_text} ) ;

# wrap the packet text with a size/codec/end pair of lines

	my $packet_text = "#$size:$self->{'codec'}\012${$codec_text}$END_MARK" ;

#print "PACKET TEXT [$packet_text]\n" ;

	$self->_callback( 'packet_method', \$packet_text ) ;
	return \$packet_text ;
}

sub to_data {

	my( $self, $input ) = @_ ;

#print "IN DATA [$input]\n" ;
	my $buf_ref = \$self->{'buffer'} ;

	${$buf_ref} .= ( ref $input eq 'SCALAR' ) ? ${$input} : $input 
		if defined $input ;

	my $codec = $self->{'codec'} ;

	while( 1 ) {

		unless ( $self->{'packet_len'} ) {

# grab the packet_len if we can from the header line

			return unless ${$buf_ref} =~
				s/\A#(\d+):$self->{'codec'}\012// ;

			$self->{'packet_len'} = $1 ;
		}

		my $packet_len = $self->{'packet_len'} || 0 ;

#print "PACKET_LEN [$packet_len]\n" ;

# see if we have a full packet with end line

#print "IN BUF [${$buf_ref}]\n" ;

		return if length( ${$buf_ref} ) < $packet_len ;

# old regex method was limited to 64k bytes in a packet
#		return unless ${$buf_ref} =~ s/^(.{$packet_len})$END_MARK//s ;

		return unless
		substr( ${$buf_ref}, $packet_len, $end_mark_len ) eq $END_MARK ;

# grab the packet data and end marker and delete it from the buffer
		my $packet = substr( ${$buf_ref}, 0,
				     $packet_len + $end_mark_len, '' ) ;

# delete the end marker from the packet

		substr( $packet, $packet_len, $end_mark_len, '' ) ;

#print "IN PACKET [$packet]\n" ;

		my $decoded_data = $self->{'codec_obj'}->decode( $packet ) ;

#use Data::Dumper ;
#print "DECODED: ", Dumper( $decoded_data ) ;

		$self->{'packet_len'} = 0 ;

#local( $SIG{'__WARN__'} ) = sub {} ;

		next if $self->_callback( 'data_method', $decoded_data ) ;
		return( $decoded_data ) ;
	}
}

sub _callback {

	my ( $self, $method_attr, @data ) = @_ ;

	my $obj = $self->{'object'} or return ;
	my $method = $self->{$method_attr} ;
	my $code = $obj->can( $method ) or return ;

	$obj->$code( @data ) ;

	return 1 ;
}

1 ;