File Coverage

blib/lib/Data/AMF/IO.pm

Criterion	Covered	Total	%
statement	28	77	36.3
branch	7	22	31.8
condition			n/a
subroutine	9	22	40.9
pod	19	19	100.0
total	63	140	45.0

package Data::AMF::IO;
use Any::Moose;

require bytes;

use constant ENDIAN => unpack('S', pack('C2', 0, 1)) == 1 ? 'BIG' : 'LITTLE';

has data => (
    is      => 'rw',
    isa     => 'Str',
    default => sub { '' },
    lazy    => 1,
);

has pos => (
    is      => 'rw',
    isa     => 'Int',
    default => sub { 0 },
    lazy    => 1,
);

has refs => (
    is      => 'rw',
    isa     => 'ArrayRef',
    default => sub { [] },
    lazy    => 1,
);

no Any::Moose;

sub read {
    my ($self, $len) = @_;

    if ($len + $self->pos > bytes::length($self->data) ) {
        return;
    }

    my $data = substr $self->data, $self->pos, $len;
    $self->pos( $self->pos + $len );

    $data;
}

sub read_u8 {
    my $self = shift;

    my $data = $self->read(1);
    return unless defined $data;

    unpack('C', $data);
}

sub read_u16 {
    my $self = shift;

    my $data = $self->read(2);
    return unless defined $data;

    unpack('n', $data);
}

sub read_s16 {
    my $self = shift;

    my $data = $self->read(2);
    return unless defined $data;

    return unpack('s>', $data) if $] >= 5.009002;
    return unpack('s', $data)  if ENDIAN eq 'BIG';
    return unpack('s', swap($data));
}

sub read_u24 {
    my $self = shift;

    my $data = $self->read(3);
    return unpack('N', "\0$data");
}

sub read_u32 {
    my $self = shift;

    my $data = $self->read(4);
    unpack('N', $data);
}

sub read_double {
    my $self = shift;

    my $data = $self->read(8);

    return unpack('d>', $data) if $] >= 5.009002;
    return unpack('d', $data)  if ENDIAN eq 'BIG';
    return unpack('d', swap($data));
}

sub read_utf8 {
    my $self = shift;

    my $len = $self->read_u16;
    return unless defined $len;

    $self->read($len);
}

sub read_utf8_long {
    my $self = shift;

    my $len = $self->read_u32;
    return unless defined $len;

    $self->read($len);
}

sub swap {
    join '', reverse split '', $_[0];
}

sub write {
    my ($self, $data) = @_;
    $self->{data} .= $data;
}

sub write_u8 {
    my ($self, $data) = @_;
    $self->write( pack('C', $data) );
}

sub write_u16 {
    my ($self, $data) = @_;
    $self->write( pack('n', $data) );
}

sub write_s16 {
    my ($self, $data) = @_;

    return $self->write( pack('s>', $data) ) if $] >= 5.009002;
    return $self->write( pack('s', $data) )  if ENDIAN eq 'BIG';
    return $self->write( swap pack('s', $data) );
}

sub write_u24 {
    my ($self, $data) = @_;

    $data = pack('N', $data);
    $data = substr $data, 1, 3;

    $self->write($data);
}

sub write_u32 {
    my ($self, $data) = @_;
    $self->write( pack('N', $data) );
}

sub write_double {
    my ($self, $data) = @_;

    return $self->write( pack('d>', $data) ) if $] >= 5.009002;
    return $self->write( pack('d', $data) )  if ENDIAN eq 'BIG';
    return $self->write( swap pack('d', $data) );
}

sub write_utf8 {
    my ($self, $data) = @_;

    my $len = bytes::length($data);

    $self->write_u16($len);
    $self->write($data);
}

sub write_utf8_long {
    my ($self, $data) = @_;

    my $len = bytes::length($data);

    $self->write_u32($len);
    $self->write($data);
}

__PACKAGE__->meta->make_immutable;

__END__