Current Path : /usr/local/lib/perl5/site_perl/5.8.9/Data/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/local/lib/perl5/site_perl/5.8.9/Data/Buffer.pm |
# $Id: Buffer.pm,v 1.9 2001/07/28 06:36:50 btrott Exp $ package Data::Buffer; use strict; use vars qw( $VERSION ); $VERSION = '0.04'; sub new { my $class = shift; my %arg = @_; bless { buf => "", offset => 0, template => "" }, $class; } sub new_with_init { my $class = shift; my $buf = $class->new; $buf->append($_) for @_; $buf; } sub extract { my $buf = shift; my($nbytes) = @_; my $new = ref($buf)->new; $new->append( $buf->get_bytes($nbytes) ); $new; } sub empty { my $buf = shift; $buf->{buf} = ""; $buf->{offset} = 0; $buf->{template} = ""; } sub set_offset { $_[0]->{offset} = $_[1] } sub reset_offset { $_[0]->set_offset(0) } sub insert_template { my $buf = shift; $buf->bytes(0, 0, $buf->{template} . chr(0)); } sub append { my $buf = shift; $buf->{buf} .= $_[0]; } sub bytes { my $buf = shift; my($off, $len, $rep) = @_; $off ||= 0; $len = length $buf->{buf} unless defined $len; return defined $rep ? substr($buf->{buf}, $off, $len, $rep) : substr($buf->{buf}, $off, $len); } sub length { length $_[0]->{buf} } sub offset { $_[0]->{offset} } sub template { $_[0]->{template} } sub dump { my $buf = shift; my @r; for my $c (split //, $buf->bytes(@_)) { push @r, sprintf "%02x", ord $c; push @r, "\n" unless @r % 24; } join ' ', @r } sub get_all { my $buf = shift; my($tmpl, $data) = $buf->{buf} =~ /^([NYaCn\d]+)\0(.+)$/s or die "Buffer $buf does not appear to contain a template"; my $b = __PACKAGE__->new; $b->append($data); my @tmpl = split //, $tmpl; my @data; while (@tmpl) { my $el = shift @tmpl; if ($el eq "N") { next if $tmpl[0] eq "Y"; ## Peek ahead: is it a string? push @data, $b->get_int32; } elsif ($el eq "n") { push @data, $b->get_int16; } elsif ($el eq "C") { push @data, $b->get_int8; } elsif ($el eq "a") { my $len = shift @tmpl; push @data, $b->get_char for 1..$len; } elsif ($el eq "Y") { push @data, $b->get_str; } else { die "Unrecognized template token: $el"; } } @data; } sub get_int8 { my $buf = shift; my $off = defined $_[0] ? shift : $buf->{offset}; $buf->{offset} += 1; unpack "C", $buf->bytes($off, 1); } sub put_int8 { my $buf = shift; $buf->{buf} .= pack "C", $_[0]; $buf->{template} .= "C"; } sub get_int16 { my $buf = shift; my $off = defined $_[0] ? shift : $buf->{offset}; $buf->{offset} += 2; unpack "n", $buf->bytes($off, 2); } sub put_int16 { my $buf = shift; $buf->{buf} .= pack "n", $_[0]; $buf->{template} .= "n"; } sub get_int32 { my $buf = shift; my $off = defined $_[0] ? shift : $buf->{offset}; $buf->{offset} += 4; unpack "N", $buf->bytes($off, 4); } sub put_int32 { my $buf = shift; $buf->{buf} .= pack "N", $_[0]; $buf->{template} .= "N"; } sub get_char { my $buf = shift; my $off = defined $_[0] ? shift : $buf->{offset}; $buf->{offset}++; $buf->bytes($off, 1); } sub put_char { my $buf = shift; $buf->{buf} .= $_[0]; $buf->{template} .= "a" . CORE::length($_[0]); } sub get_bytes { my $buf = shift; my($nbytes) = @_; my $d = $buf->bytes($buf->{offset}, $nbytes); $buf->{offset} += $nbytes; $d; } sub put_bytes { my $buf = shift; my($str, $nbytes) = @_; $buf->{buf} .= $nbytes ? substr($str, 0, $nbytes) : $str; $buf->{template} .= "a" . ($nbytes ? $nbytes : CORE::length($str)); } *put_chars = \&put_char; sub get_str { my $buf = shift; my $off = defined $_[0] ? shift : $buf->{offset}; my $len = $buf->get_int32; $buf->{offset} += $len; $buf->bytes($off+4, $len); } sub put_str { my $buf = shift; my $str = shift; $str = "" unless defined $str; $buf->put_int32(CORE::length($str)); $buf->{buf} .= $str; $buf->{template} .= "Y"; } 1; __END__ =head1 NAME Data::Buffer - Read/write buffer class =head1 SYNOPSIS use Data::Buffer; my $buffer = Data::Buffer->new; ## Add a 32-bit integer. $buffer->put_int32(10932930); ## Get it back. my $int = $buffer->get_int32; =head1 DESCRIPTION I<Data::Buffer> implements a low-level binary buffer in which you can get and put integers, strings, and other data. Internally the implementation is based on C<pack> and C<unpack>, such that I<Data::Buffer> is really a layer on top of those built-in functions. All of the I<get_*> and I<put_*> methods respect the internal offset state in the buffer object. This means that you should read data out of the buffer in the same order that you put it in. For example: $buf->put_int16(24); $buf->put_int32(1233455); $buf->put_int16(99); $buf->get_int16; # 24 $buf->get_int32; # 1233455 $buf->get_int16; # 99 Of course, this assumes that you I<know> the order of the data items in the buffer. If your setup is such that your sending and receiving processes won't necessarily know what's inside the buffers they receive, take a look at the I<TEMPLATE USAGE> section. =head1 USAGE =head2 Data::Buffer->new Creates a new buffer object and returns it. The buffer is initially empty. This method takes no arguments. =head2 Data::Buffer->new_with_init(@strs) Creates a new buffer object and appends to it each of the octet strings in I<@strs>. Returns the new buffer object. =head2 $buffer->get_int8 Returns the next 8-bit integer from the buffer (which is really just the ASCII code for the next character/byte in the buffer). =head2 $buffer->put_int8 Appends an 8-bit integer to the buffer (which is really just the character corresponding to that integer, in ASCII). =head2 $buffer->get_int16 Returns the next 16-bit integer from the buffer. =head2 $buffer->put_int16($integer) Appends a 16-bit integer to the buffer. =head2 $buffer->get_int32 Returns the next 32-bit integer from the buffer. =head2 $buffer->put_int32($integer) Appends a 32-bit integer to the buffer. =head2 $buffer->get_char More appropriately called I<get_byte>, perhaps, this returns the next byte from the buffer. =head2 $buffer->put_char($bytes) Appends a byte (or a sequence of bytes) to the buffer. There is no restriction on the length of the byte string I<$bytes>; if it makes you uncomfortable to call I<put_char> to put multiple bytes, you can instead call this method as I<put_chars>. It's the same thing. =head2 $buffer->get_bytes($n) Grabs I<$n> bytes from the buffer, where I<$n> is a positive integer. Increments the internal offset state by I<$n>. =head2 $buffer->put_bytes($bytes [, $n ]) Appends a sequence of bytes to the buffer; if I<$n> is unspecified, appends the entire length of I<$bytes>. Otherwise appends only the first I<$n> bytes of I<$bytes>. =head2 $buffer->get_str Returns the next "string" from the buffer. A string here is represented as the length of the string (a 32-bit integer) followed by the string itself. =head2 $buffer->put_str($string) Appends a string (32-bit integer length and the string itself) to the buffer. =head2 $buffer->extract($n) Extracts the next I<$n> bytes from the buffer I<$buffer>, increments the offset state in I<$buffer>, and returns a new buffer object containing the extracted bytes. =head1 TEMPLATE USAGE Generally when you use I<Data::Buffer> it's to communicate with another process (perhaps a C program) that bundles up its data into binary buffers. In those cases, it's very likely that the data will be in some well-known order in the buffer: in other words, it might be documented that a certain C program creates a buffer containing: =over 4 =item * an int8 =item * a string =item * an int32 =back In this case, you would presumably know about the order of the data in the buffer, and you could extract it accordingly: $buffer->get_int8; $buffer->get_str; $buffer->get_int32; In other cases, however, there may not be a well-defined order of data items in the buffer. This might be the case if you're inventing your own protocol, and you want your binary buffers to "know" about their contents. In this case, you'll want to use the templating features of I<Data::Buffer>. When you use the I<put_> methods to place data in a buffer, I<Data::Buffer> keeps track of the types of data that you're inserting in a template description of the buffer. This template contains all of the information necessary for a process to receive a buffer and extract the data in the buffer without knowledge of the order of the items. To use this feature, simply use the I<insert_template> method after you've filled your buffer to completion. For example: my $buffer = Data::Buffer->new; $buffer->put_str("foo"); $buffer->put_int32(9999); $buffer->insert_template; ## Ship off the buffer to another process. The receiving process should then invoke the I<get_all> method on the buffer to extract all of the data: my $buffer = Data::Buffer->new; $buffer->append( $received_buffer_data ); my @data = $buffer->get_all; @data will now contain two elements: C<"foo"> and C<9999>. =head1 LOW-LEVEL METHODS =head2 $buffer->append($bytes) Appends raw data I<$bytes> to the end of the in-memory buffer. Generally you don't need to use this method unless you're initializing an empty buffer, because when you need to add data to a buffer you should generally use one of the I<put_*> methods. =head2 $buffer->empty Empties out the buffer object. =head2 $buffer->bytes([ $offset [, $length [, $replacement ]]]) Behaves exactly like the I<substr> built-in function, except on the buffer I<$buffer>. Given no arguments, I<bytes> returns the entire buffer; given one argument I<$offset>, returns everything from that position to the end of the string; given I<$offset> and I<$length>, returns the segment of the buffer starting at I<$offset> and consisting of I<$length> bytes; and given all three arguments, replaces that segment with I<$replacement>. This is a very low-level method, and you generally won't need to use it. Also be warned that you should not intermix use of this method with use of the I<get_*> and I<put_*> methods; the latter classes of methods maintain internal state of the buffer offset where arguments will be gotten from and put, respectively. The I<bytes> method gives no thought to this internal offset state. =head2 $buffer->length Returns the length of the buffer object. =head2 $buffer->offset Returns the internal offset state. If you insist on intermixing calls to I<bytes> with calls to the I<get_*> and I<put_*> methods, you'll probably want to use this method to get some status on that internal offset. =head2 $buffer->set_offset($offset) Sets the internal offset state to I<$offset>. =head2 $buffer->reset_offset Sets the internal offset state to 0. =head2 $buffer->dump(@args) Returns a hex dump of the buffer. The dump is of the I<entire> buffer I<$buffer>; in other words, I<dump> doesn't respect the internal offset pointer. I<@args> is passed directly through to the I<bytes> method, which means that you can supply arguments to emulate support of the internal offset: my $dump = $buffer->dump($buffer->offset); =head2 $buffer->insert_padding A helper method: pads out the buffer so that the length of the transferred packet will be evenly divisible by 8, which is a requirement of the SSH protocol. =head1 AUTHOR & COPYRIGHTS Benjamin Trott, ben@rhumba.pair.com Except where otherwise noted, Data::Buffer is Copyright 2001 Benjamin Trott. All rights reserved. Data::Buffer is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut