—

              
package SWF::BinStream;
use strict;
use vars qw($VERSION);
$VERSION="0.071";
##
package SWF::BinStream::Read;
use Carp;
use Data::TemporaryBag;
sub new {
    my ($class, $initialdata, $shortsub, $version) = @_;
    bless { '_bits'     =>'',
            '_stream'   =>Data::TemporaryBag->new($initialdata),
            '_shortsub' =>$shortsub||sub{0},
            '_pos'      => 0,
            '_codec' => [],
            '_version' => $version||5,
          }, $class;
}
sub Version {
    shift->{_version};
}
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->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) = @_;
    $self->flush_bits() unless $fNoFlush;
    $self->_require($bytes);
    $self->{'_pos'}+=$bytes;
    $self->{'_stream'}->substr(0, $bytes, '');
}
sub _GetNum {
    my ($self, $bytes, $template)=@_;
    unpack $template, $self->get_string($bytes);
}
sub get_UI8 {
    $_[0]->_GetNum(1, 'C');
}
sub get_SI8 {
    $_[0]->_GetNum(1, 'c');
}
sub get_UI16 {
    $_[0]->_GetNum(2, 'v');
}
sub get_SI16 {
    my $w = $_[0]->get_UI16();
    $w -= (1<<16) if $w>(1<<15);
    $w;
}
sub get_UI32 {
    $_[0]->_GetNum(4, 'V');
}
sub get_SI32 {
    my $ww = $_[0]->get_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 = $self->get_bits($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,
            '_framecount' => 0,
          }, $class;
}
sub Version {
    shift->{_version};
}
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;
    $a||=0;
    return int($a+0.5*($a<=>0));
}
sub _SetNum {
    my ($self, $num, $template) = @_;
    $self->set_string(pack($template, _round($num)));
}
sub set_UI8 {
    $_[0]->_SetNum($_[1], 'C');
}
sub set_SI8 {
    $_[0]->_SetNum($_[1], 'c');
}
sub set_UI16 {
    $_[0]->_SetNum($_[1], 'v');
}
*set_SI16 = \&set_UI16;
#sub set_SI16 {
#    my ($self, $num) = @_;
#    $num += (1<<16) if $num<0;
#    $self->set_UI16($num);
#}
sub set_UI32 {
    $_[0]->_SetNum($_[1], 'V');
}
*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__
HideShow 281 lines of Pod
=head1 NAME
SWF::BinStream - Read and write binary stream.
=head1 SYNOPSIS
  use SWF::BinStream;
  $read_stream = SWF::BinStream::Read->new($binary_data, \&adddata);
  $byte = $read_stream->get_UI8;
  $signedbyte = $read_stream->get_SI8;
  $string = $read_stream->get_string($length);
  $bits = $read_stream->get_bits($bitlength);
  ....
  sub adddata {
      if ($nextdata) {
          shift->add_stream($nextdata);
      } else {
          die "The stream ran short ";
      }
  }
  $write_stream = SWF::BinStream::Write->new;
  $write_stream->set_UI8($byte);
  $write_stream->set_SI8($signedbyte);
  $write_stream->set_string($string);
  $write_stream->set_bits($bits, $bitlength);
  $binary_data=$write_stream->flush_stream;
  ....
=head1 DESCRIPTION
I<SWF::BinStream> module provides a binary byte and bit data stream.
It can handle bit-compressed data such as SWF file.
=head2 SWF::BinStream::Read
Provides a read stream. Add the binary data to the stream, and you 
get byte and bit data. The stream calls a user subroutine when the 
stream data runs short.
I<get_UI16>, I<get_SI16>, I<get_UI32>, and I<get_SI32> get a number
in VAX byte order from the stream.
I<get_bits> and I<get_sbits> get the bits from MSB to LSB.
I<get_UI*>, I<get_SI*>, and I<get_string> skip the remaining bits in 
the current byte and read data from the next byte.
If you want to skip remaining bits manually, use I<flush_bits>.
=head2 METHODS
=over 4
=item SWF::BinStream::Read->new( [ $initialdata, \&callback_in_short, $version ] )
Creates a read stream. It takes three optional arguments. The first arg 
is a binary string to set as initial data of the stream. The second is
a reference of a subroutine which is called when the stream data runs
short.  The subroutine is called with two ARGS, the first is I<$stream>
itself, and the second is how many bytes wanted.  
The third arg is SWF version number.  Default is 5.  It is necessary to
set proper version because some SWF tags change their structure by the 
version number. 
=item $stream->Version
returns SWF version number of the stream.
=item $stream->add_codec( $codec_name )
Adds stream decoder.
Decoder 'Zlib' is only available now.
=item $stream->add_stream( $binary_data )
Adds binary data to the stream.
=item $stream->Length
Returns how many bytes remain in the stream.
=item $stream->tell
Returns how many bytes have been read from the stream.
=item $stream->get_string( $num )
Returns $num bytes as a string.
=item $stream->get_UI8
Returns an unsigned byte number.
=item $stream->get_SI8
Returns a signed byte number.
=item $stream->get_UI16
Returns an unsigned word (2 bytes) number.
=item $stream->get_SI16
Returns a signed word (2 bytes) number.
=item $stream->get_UI32
Returns an unsigned double word (4 bytes) number.
=item $stream->get_SI32
Returns a signed double word (4 bytes) number.
=item $stream->get_bits( $num )
Returns the $num bit unsigned number.
=item $stream->get_sbits( $num )
Returns the $num bit signed number.
=item $stream->flush_bits
Skips the rest bits in the byte and aligned read pointer to the next byte.
It does not anything when the read pointer already byte-aligned.
=back
=head2 SWF::BinStream::Write
Provides a write stream. Write byte and bit data, then get the stream
data as binary string using I<flush_stream>. I<autoflush> requests to
the stream to automatically flush the stream and call a user subroutine.
I<set_UI16>, I<set_SI16>, I<set_UI32>, and I<set_SI32> write a number in 
VAX byte order to the stream.
I<set_bits> and I<set_sbits> write the bits from MSB to LSB.
I<set_UI*>, I<set_SI*>, and I<set_string> set the rest bits in the last 
byte to 0 and write data to the next byte boundary.
If you want to write bit data and align the write pointer to byte boundary,
use I<flush_bits>.
=head2 METHODS
=over 4
=item SWF::BinStream::Write->new( [$version] )
Creates a write stream.
One optional argument is SWF version number.  Default is 5.
It is necessary to set proper version because some SWF tags change 
their structure by the version number. 
=item $stream->Version
returns SWF version number of the stream.
=item $stream->add_codec( $codec_name )
Adds stream encoder.
Encoder 'Zlib' is only available now.
=item $stream->autoflush( $size, \&callback_when_flush )
Requests to the stream to automatically flush the stream and call sub
with the stream data when the stream size becomes larger than I<$size> bytes.
=item $stream->flush_stream( [$size] )
Flushes the stream and returns the stream data. Call with I<$size>,
it returns I<$size> bytes from the stream. When call without arg or
with larger I<$size> than the stream data size, it returns all data
including the last bit data ( by calling I<flush_bits> internally).
=item $stream->flush_bits
Sets the rest bits in the last byte to 0, and aligns write pointer 
to the next byte boundary.
=item $stream->Length
Returns how many bytes remain in the stream.
=item $stream->tell
Returns how many bytes have written.
=item $stream->mark( [$key, [$obj]] )
Keeps current I<tell> number with $key and $obj.
When called without $obj, it returns I<tell> number associated
with $key and a list of I<tell> number and object in scalar and 
list context, respectively.
When called without any parameter, it returns mark list
( KEY1, [ TELL_NUMBER1, OBJ1 ], KEY2, [...).
=item $stream->sub_stream
Creates temporaly sub stream. When I<flush_stream> the sub stream, 
it's data and marks are written to the parent stream and the sub 
stream is freed.
Ex. write various length of data following it's length.
  $sub_stream=$parent_stream->sub_stream;
  write_data($sub_stream);
  $parent_stream->set_UI32($sub_stream->Length);
  $sub_stream->flush_stream;
=item $stream->set_string( $str )
Writes string to the stream.
=item $stream->set_UI8( $num )
Writes I<$num> as an unsigned byte.
=item $stream->set_SI8( $num )
Writes I<$num> as a signed byte.
=item $stream->set_UI16( $num )
Writes I<$num> as an unsigned word.
=item $stream->set_SI16( $num )
Writes I<$num> as a signed word.
=item $stream->set_UI32( $num )
Writes I<$num> as an unsigned double word.
=item $stream->set_SI32( $num )
Writes I<$num> as an unsigned double word.
=item $stream->set_bits( $num, $nbits )
Write I<$num> as I<$nbits> length unsigned bit data.
=item $stream->set_sbits( $num, $nbits )
Write I<$num> as I<$nbits> length signed bit data.
=item $stream->set_bits_list( $nbitsbit, @list )
Makes I<@list> as unsigned bit data list.
It writes the maximal bit length of each I<@list> (I<nbits>) as
I<$nbitsbit> length unsigned bit data, and then writes each I<@list>
number as I<nbits> length unsigned bit data.
=item $stream->set_sbits_list( $nbitsbit, @list )
Makes I<@list> as signed bit data list.
It writes the maximal bit length of each I<@list> (I<nbits>) as
I<$nbitsbit> length unsigned bit data, and then writes each I<@list>
number as I<nbits>-length signed bit data.
=back
=head2 UTILITY FUNCTIONS
=over 4
=item &SWF::BinStream::Write::get_maxbits_of_bits_list( @list )
=item &SWF::BinStream::Write::get_maxbits_of_sbits_list( @list )
Gets the necessary and sufficient bit length to represent the values of 
I<@list>.  -_bits_list is for unsigned values, and -_sbits_list is for signed.
=back
=head1 COPYRIGHT
Copyright 2000 Yasuhiro Sasama (ySas), <ysas@nmt.ne.jp>
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
=cut