File Coverage

blib/lib/SWF/BinStream.pm

Criterion	Covered	Total	%
statement	176	227	77.5
branch	41	72	56.9
condition	10	15	66.6
subroutine	44	62	70.9
pod			n/a
total	271	376	72.0

package SWF::BinStream;

use strict;
use vars qw($VERSION);

$VERSION="0.11";

##

package SWF::BinStream::Read;

use Carp;
use Data::TemporaryBag;


sub new {
    my ($class, $initialdata, $shortsub, $version) = @_;
    my $self = bless {
	    '_bits'  => '',
	    '_stream'   =>Data::TemporaryBag->new,
	    '_shortsub' =>$shortsub||sub{0},
	    '_pos'      => 0,
	    '_codec' => [],
	    '_version' => $version||5,
	    '_lock_version' => 0,
	  }, $class;
    $self->add_stream($initialdata) if $initialdata ne '';
    $self;
}

sub Version {
    my ($self, $ver) = @_;

    if (defined $ver) {
	croak "Can't change SWF version " if $self->{_lock_version};
	$self->{_version} = $ver;
    }
    $self->{_version};
}

sub _lock_version {
    shift->{_lock_version} = 1;
}

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

    for my $codec ( @{$self->{'_codec'}} ) {
	$data = $codec->decode($data);
    }
    $self->{'_stream'}->add($data);
}

sub _require {
    my ($self, $bytes) = @_;
    {
	my $len=$self->{'_stream'}->length;

	if ($len < $bytes) {
	    $self->{'_shortsub'}->($self, $bytes-$len) and redo;
	    croak "Stream ran short ";
	}
    }

}

sub Length {
    return $_[0]->{'_stream'}->length;
}

sub tell {$_[0]->{'_pos'}};

sub get_string {
    my ($self, $bytes, $fNoFlush) = @_;

    flush_bits($self) unless $fNoFlush;
    _require($self, $bytes);
    $self->{'_pos'}+=$bytes;
    $self->{'_stream'}->substr(0, $bytes, '');
}

sub lookahead_string {
    my ($self, $offset, $bytes) = @_;

    _require($self, $offset);
    $self->{'_stream'}->substr($offset, $bytes);
}

sub get_UI8 {
    unpack 'C', get_string(shift, 1);
}

sub lookahead_UI8 {
    unpack 'C', lookahead_string(@_[0, 1], 1);
}

sub get_SI8 {
    unpack 'c', get_string(shift, 1);
}

sub lookahead_SI8 {
    unpack 'c', lookahead_string(@_[0, 1], 1);
}

sub get_UI16 {
    unpack 'v', get_string(shift, 2);
}

sub lookahead_UI16 {
    unpack 'v', lookahead_string(@_[0, 1], 2);
}

sub get_SI16 {
    my $w = &get_UI16;
    $w -= (1<<16) if $w>=(1<<15);
    $w;
}

sub lookahead_SI16 {
    my $w = &lookahead_UI16;
    $w -= (1<<16) if $w>=(1<<15);
    $w;
}

sub get_UI32 {
    unpack 'V', get_string(shift, 4);
}

sub lookahead_UI32 {
    unpack 'V', lookahead_string(@_[0, 1], 4);
}

sub get_SI32 {
    my $ww = &get_UI32;
    $ww -= (2**32) if $ww>=(2**31);
    $ww;
}

sub lookahead_SI32 {
    my $ww = &lookahead_UI32;
    $ww -= (2**32) if $ww>=(2**31);
    $ww;
}

sub flush_bits {
    $_[0]->{'_bits'}='';
}

sub get_bits {
    my ($self, $bits) = @_;
    my $len = length($self->{'_bits'});

    if ( $len < $bits) {
	my $slen = (($bits - $len - 1) >>3) + 1;
	$self->{'_bits'}.=join '', unpack('B8' x $slen, $self->get_string($slen, 'NoFlush'));
    }
    unpack('N', pack('B32', '0' x (32-$bits).substr($self->{'_bits'}, 0, $bits, '')));
}

sub get_sbits {
    my ($self, $bits) = @_;

    my $b = &get_bits;
    $b -= (2**$bits) if $b>=(2**($bits-1));
    $b;
}

sub close {
    my $self = shift;

    for my $codec ( @{$self->{'_codec'}} ) {
	$codec->close;
    }
    $self->{'_stream'}->clear;
}


sub add_codec {
    my ($self, $codec) = @_;

    require "SWF/BinStream/Codec/${codec}.pm" or croak "Can't find codec '$codec'";

    my $m = "SWF::BinStream::Codec::${codec}::Read"->new or croak "Can't find codec '$codec' ";

    push @{$self->{'_codec'}}, $m;

    if (( my $old_stream = $self->{'_stream'})->length > 0) {
	my $new_stream = Data::TemporaryBag->new;

	while ($old_stream->length > 0) {
	    $new_stream->add($m->decode($old_stream->substr(0, 1024, '')));
	}
	$self->{'_stream'} = $new_stream;
    }
}

1;

package SWF::BinStream::Write;

use Carp;
use Data::TemporaryBag;

sub new {
    my ($class, $version) = @_;
    bless { '_bits'    => '',
	    '_stream'  => Data::TemporaryBag->new,
	    '_pos' => 0,
	    '_flushsize' => 0,
	    '_mark' => {},
	    '_codec' => [],
	    '_version' => $version || 5,
	    '_lock_version' => 0,
	    '_framecount' => 0,
	  }, $class;
}

sub Version {
    my ($self, $ver) = @_;

    if (defined $ver) {
	croak "Can't change SWF version " if $self->{_lock_version};
	$self->{_version} = $ver;
    }
    $self->{_version};
}

sub _lock_version {
    shift->{_lock_version} = 1;
}

sub autoflush {
    my ($self, $size, $flushsub)=@_;

    $self->{'_flushsize'}=$size;
    $self->{'_flushsub'}=$flushsub;
}

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

    for my $codec ( @{$self->{'_codec'}} ) {
	$data = $codec->encode($data);
    }
    return if $data eq '';

    $self->{'_stream'}->add($data);

    if ($self->{'_flushsize'}>0 and $self->{'_stream'}->length >= $self->{'_flushsize'}) {
	$self->flush_stream($self->{'_flushsize'});
    }
}

sub flush_stream {
    my ($self, $size)=@_;
    my $str;

    if ( !$size or $size>$self->Length ) {
	$self->flush_bits;
    }

    if ($size) {
	$str = $self->{'_stream'}->substr( 0, $size, '');
	$self->{'_pos'} += length($str);
    } else {
	$str=$self->{'_stream'}->value;
	$self->{'_pos'}+=length($str);
	$self->{'_stream'}=Data::TemporaryBag->new;
    }

    $self->{'_flushsub'}->($self, $str) if defined $self->{'_flushsub'};

    $str;
}

sub flush_bits {
    my $self = $_[0];
    my $bits = $self->{'_bits'};
    my $len  = length($bits);

    return if $len<=0;
    $self->{'_bits'}='';
    $self->_write_stream(pack('B8', $bits.('0'x(8-$len))));
}

sub Length {
    return $_[0]->{'_stream'}->length;
}

sub tell {
    my $self=shift;
    my $pos= $self->{'_pos'} + $self->Length;
    $pos++ if length($self->{'_bits'})>0;
    $pos;
}

sub mark {
    my ($self, $key, $obj)=@_;

    if (not defined $key) {
	return %{$self->{_mark}};
    } elsif (not defined $obj) {
	return wantarray ? $self->{_mark}{$key}[0] : @{$self->{_mark}{$key}};
    } else {
	push @{$self->{_mark}{$key}}, $self->tell, $obj;
    }
}

sub sub_stream {
    my $self=shift;
    my $sub_stream=SWF::BinStream::Write->new($self->Version);
    $sub_stream->{_parent}=$self;
    bless $sub_stream, 'SWF::BinStream::Write::SubStream';
}

sub set_string {
    my ($self, $str) = @_;

    $self->flush_bits;
    $self->_write_stream($str);
}

sub _round {
    my $a=shift;

    return 0 unless $a;
    return int($a+0.5*($a<=>0));
}

sub set_UI8 {
    $_[0]->set_string(pack('C', _round($_[1])));
}

sub set_SI8 {
    $_[0]->set_string(pack('c', _round($_[1])));
}

sub set_UI16 {
    $_[0]->set_string(pack('v', _round($_[1])));
}

*set_SI16 = \&set_UI16;

#sub set_SI16 {
#    my ($self, $num) = @_;
#    $num += (1<<16) if $num<0;
#    $self->set_UI16($num);
#}

sub set_UI32 {
    $_[0]->set_string(pack('V', _round($_[1])));
}

*set_SI32 = \&set_UI32;

#sub set_SI32 {
#    my ($self, $num) = @_;
#    $num += (2**32) if $num<0;
#    $self->set_UI32($num);
#}

sub set_bits {
    my ($self, $num, $nbits) = @_;
    return unless $nbits;
    $self->{'_bits'} .= substr(unpack('B*',pack('N', _round($num))), -$nbits);
    my $s = '';
    while (length($self->{'_bits'})>=8) {
	$s .= pack('B8', substr($self->{'_bits'}, 0,8, ''));
    }
    $self->{'_stream'}->add($s) if $s ne '';
}

sub set_sbits {
    my ($self, $num, $nbits) = @_;
    $num=_round($num);
    $num += (2**$nbits) if $num<0;
    $self->set_bits($num, $nbits);
}

sub set_bits_list {
    my ($self, $nbitsbit, @param) = @_;
    my $nbits=get_maxbits_of_bits_list(@param);
    my $i;

    $self->set_bits($nbits, $nbitsbit);
    foreach $i (@param) {
	$self->set_bits($i, $nbits);
    }
}

sub set_sbits_list {
    my ($self, $nbitsbit, @param) = @_;
    my $nbits=get_maxbits_of_sbits_list(@param);
    my $i;

    $self->set_bits($nbits, $nbitsbit);
    foreach $i (@param) {
	$self->set_sbits($i, $nbits);
    }
}

sub get_maxbits_of_bits_list {
    my (@param)=@_;
    my $max=shift;
    my $i;

    foreach $i(@param) {
	$max=$i if $max<$i;
    }
    $i = 0;
    $i++ while ($max >= 2**$i);
    return $i;
}

sub get_maxbits_of_sbits_list {
    my $z = 0;
    return (get_maxbits_of_bits_list(map{my $r=_round($_);$z ||= ($r!=0);($r<0)?(~$r):$r} @_)+$z);
}

sub close {
    my $self = shift;

    my $data = $self->flush_stream;
    my $rest = '';
    for my $codec ( @{$self->{'_codec'}} ) {
	$rest = $codec->close($rest);
    }
    $self->{'_flushsub'}->($self, $rest) if defined $self->{'_flushsub'};

    $data .= $rest;
    $data;
}

sub add_codec {
    my ($self, $codec) = @_;

    require "SWF/BinStream/Codec/${codec}.pm" or croak "Can't find codec '$codec'";

    my $m = "SWF::BinStream::Codec::${codec}::Write"->new or croak "Can't find codec '$codec'";

    push @{$self->{'_codec'}}, $m;
}

package SWF::BinStream::Write::SubStream;

use vars qw(@ISA);

@ISA=('SWF::BinStream::Write');

sub flush_stream {
    my $self = shift;
    my $p_tell = $self->{_parent}->tell;

    while ((my $data = $self->SUPER::flush_stream(1024)) ne '') {
	$self->{_parent}->set_string($data);
    }

    my @marks=$self->mark;
    while (@marks) {
	my $key = shift @marks;
	my $mark = shift @marks;
	$mark->[$_*2] += $p_tell for (0..@$mark/2-1);
	push @{$self->{_parent}->{_mark}{$key}}, @$mark;
    }
    undef $self;
}

sub autoflush {} # Ignore autoflush.
sub add_codec {warn "Can't add codec to the sub stream"}
*SWF::BinStream::Write::SubStream::close = \&flush_stream;

1;

__END__