File Coverage

blib/lib/Data/Buffer.pm

Criterion	Covered	Total	%
statement	107	108	99.0
branch	25	36	69.4
condition	2	2	100.0
subroutine	28	28	100.0
pod	23	26	88.4
total	185	200	92.5

# $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__