3 # This file is part of Stem.
4 # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
6 # Stem is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # Stem is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with Stem; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 # For a license to use the Stem under conditions other than those
21 # described here, to purchase support for this software, or to purchase a
22 # commercial warranty contract, please contact Stem Systems at:
24 # Stem Systems, Inc. 781-643-7504
25 # 79 Everett St. info@stemsystems.com
29 package Stem::Packet ;
40 'env' => 'packet_codec',
41 'default' => 'Data::Dumper',
43 This is the name of the Codec:: subclass that will be used in this cell
50 If an object is passed in, the filter will use it for callbacks
54 'name' => 'packet_method',
55 'default' => 'packet_out',
57 This method is called on the object when a packet has encoded from
63 'name' => 'data_method',
64 'default' => 'packet_data',
66 This method is called on the object when a packet has been decoded
75 # This POD section is autoegenerated. Any edits to it will be lost.
77 =head2 Constructor Attributes for Class Stem::Packet
82 =item * Attribute - B<codec>
88 This is the name of the Codec:: subclass that will be used in this cell
91 =item It B<defaults> to: Storable
96 =item * Attribute - B<object>
102 If an object is passed in, the filter will use it for callbacks
105 =item Its B<type> is: object
109 =item * Attribute - B<packet_method>
115 This method is called on the object when a packet has encoded from
119 =item It B<defaults> to: packet_out
123 =item * Attribute - B<data_method>
129 This method is called on the object when a packet has been decoded
133 =item It B<defaults> to: packet_data
141 # End of autogenerated POD
146 my( $class ) = shift ;
149 my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
150 return $self unless ref $self ;
152 # my @codec_args = exists( $self->{codec} ) ?
153 # ( codec => $self->{codec} ) : () ;
155 #print "NEW PACKET CODEC $self->{codec}\n" ;
157 my $codec_obj = Stem::Codec->new( codec => $self->{codec} ) ;
158 return $codec_obj unless ref $codec_obj ;
159 $self->{'codec_obj'} = $codec_obj ;
161 #print "CODEC OBJ [$codec_obj]\n" ;
166 my $END_MARK = "\012#END\012" ;
167 my $end_mark_len = length $END_MARK ;
176 #print Dumper $_[0] ;
178 my $codec_text = $self->{'codec_obj'}->encode( $_[0] ) ;
180 #print Dumper $codec_text ;
181 my $size = length( ${$codec_text} ) ;
183 # wrap the packet text with a size/codec/end pair of lines
185 my $packet_text = "#$size:$self->{'codec'}\012${$codec_text}$END_MARK" ;
187 #print "PACKET TEXT [$packet_text]\n" ;
189 $self->_callback( 'packet_method', \$packet_text ) ;
190 return \$packet_text ;
195 my( $self, $input ) = @_ ;
197 #print "IN DATA [$input]\n" ;
198 my $buf_ref = \$self->{'buffer'} ;
200 ${$buf_ref} .= ( ref $input eq 'SCALAR' ) ? ${$input} : $input
203 my $codec = $self->{'codec'} ;
207 unless ( $self->{'packet_len'} ) {
209 # grab the packet_len if we can from the header line
211 return unless ${$buf_ref} =~
212 s/\A#(\d+):$self->{'codec'}\012// ;
214 $self->{'packet_len'} = $1 ;
217 my $packet_len = $self->{'packet_len'} || 0 ;
219 #print "PACKET_LEN [$packet_len]\n" ;
221 # see if we have a full packet with end line
223 #print "IN BUF [${$buf_ref}]\n" ;
225 return if length( ${$buf_ref} ) < $packet_len ;
227 # old regex method was limited to 64k bytes in a packet
228 # return unless ${$buf_ref} =~ s/^(.{$packet_len})$END_MARK//s ;
231 substr( ${$buf_ref}, $packet_len, $end_mark_len ) eq $END_MARK ;
233 # grab the packet data and end marker and delete it from the buffer
234 my $packet = substr( ${$buf_ref}, 0,
235 $packet_len + $end_mark_len, '' ) ;
237 # delete the end marker from the packet
239 substr( $packet, $packet_len, $end_mark_len, '' ) ;
241 #print "IN PACKET [$packet]\n" ;
243 my $decoded_data = $self->{'codec_obj'}->decode( $packet ) ;
246 #print "DECODED: ", Dumper( $decoded_data ) ;
248 $self->{'packet_len'} = 0 ;
250 #local( $SIG{'__WARN__'} ) = sub {} ;
252 next if $self->_callback( 'data_method', $decoded_data ) ;
253 return( $decoded_data ) ;
259 my ( $self, $method_attr, @data ) = @_ ;
261 my $obj = $self->{'object'} or return ;
262 my $method = $self->{$method_attr} ;
263 my $code = $obj->can( $method ) or return ;
265 $obj->$code( @data ) ;