File Coverage

blib/lib/SWF/Parser.pm

Criterion	Covered	Total	%
statement	86	96	89.5
branch	29	58	50.0
condition	11	25	44.0
subroutine	11	15	73.3
pod	6	7	85.7
total	143	201	71.1

package SWF::Parser;

use strict;
use vars qw($VERSION);

$VERSION = '0.11';

use SWF::BinStream;
use Carp;

sub new {
    my $class = shift;
    my %param = @_;
    my $self = { _tag             => {},
		 _version         => 5,
		 _aborted         => 0,
	     };
    $self->{_header_callback} =
       $param{'header-callback'}
    || $param{'header_callback'}
    || (sub {0});
    $self->{_tag_callback} =
       $param{'tag-callback'}
    || $param{'tag_callback'}
    || (sub {0});
    $self->{_header} = {} unless $param{header} and $param{header} =~ /^no(?:ne)?$/;
    $self->{_stream}=$param{'stream'}||(SWF::BinStream::Read->new('', sub{ die "The stream ran short by $_[0] bytes."}));


    bless $self, $class;
}

sub parse {
    my ($self, $data) = @_;
    my $stream = $self->{_stream};

    if ($self->{_aborted}) {
	carp 'The SWF parser has been aborted';
	return $self;
    }

#    unless (defined $data) {
#	if (my $bytes=$stream->Length) {
#	    carp "Data remains $bytes bytes in the stream.";
#	}
#	return $self;
#    }
    $stream->add_stream($data);
    eval {{
	unless (exists $self->{_header}) {
	    $self->parsetag while !$self->{_aborted} and $stream->Length;
	} else {
	    $self->parseheader;
	    redo if !$self->{_aborted} and $stream->Length;
	}
    }};
    if ($@) {
	return $self if ($@=~/^The stream ran short by/);
	die $@;
    }
    $self;
}

sub parse_file {
    my($self, $file) = @_;
    no strict 'refs';  # so that a symbol ref as $file works
    local(*F);
    unless (ref($file) || $file =~ /^\*[\w:]+$/) {
	# Assume $file is a filename
	open(F, $file) || die "Can't open $file: $!";
	$file = *F;
    }
    binmode($file);
    my $chunk = '';
    while(!$self->{_aborted} and read($file, $chunk, 4096)) {
	$self->parse($chunk);
    }
    close($file);
    $self->eof unless $self->{_aborted};
}

sub eof
{
    shift->parse(undef);
}

sub parseheader {
    my $self = shift;
    my $stream = $self->{_stream};
    my $header = $self->{_header};

    unless (exists $header->{signature}) {
	my $h = $header->{signature} = $stream->get_string(3);
	Carp::confess "This is not SWF stream " if ($h ne 'CWS' and $h ne 'FWS');
    }
    $stream->Version($header->{version} = $self->{_version} = $stream->get_UI8) unless exists $header->{version};
    $header->{filelen} = $stream->get_UI32 unless exists $header->{filelen};
    $stream->add_codec('Zlib') if ($header->{signature} eq 'CWS');
    $header->{nbits} = $stream->get_bits(5) unless exists $header->{nbits};
    my $nbits = $header->{nbits};
    $header->{xmin} = $stream->get_sbits($nbits) unless exists $header->{xmin};
    $header->{xmax} = $stream->get_sbits($nbits) unless exists $header->{xmax};
    $header->{ymin} = $stream->get_sbits($nbits) unless exists $header->{ymin};
    $header->{ymax} = $stream->get_sbits($nbits) unless exists $header->{ymax};
    $header->{rate} = $stream->get_UI16 / 256 unless exists $header->{rate};
    $header->{count} = $stream->get_UI16 unless exists $header->{count};

    $self->{_header_callback}->($self, @{$header}{qw(signature version filelen xmin ymin xmax ymax rate count)});
    delete $self->{_header};
}

sub parsetag {
    my $self = shift;
    my $tag = $self->{_tag};
    my $stream = $self->{_stream};
    $tag->{header}=$stream->get_UI16 unless exists $tag->{header};
    unless (exists $tag->{length}) {
	my $length = ($tag->{header} & 0x3f);
	$length=$stream->get_UI32 if ($length == 0x3f);
	$tag->{length}=$length;
    }
    unless (exists $tag->{data}) {
	$stream->_require($tag->{length});
	$tag->{data} = $stream;
	$tag->{_next_pos} = $stream->tell + $tag->{length};
    }
    eval {
	$self->{_tag_callback}->($self, $tag->{header} >> 6, $tag->{length}, $tag->{data});
    };
    if ($@) {
	Carp::confess 'Short!' if ($@=~/^The stream ran short by/);
	die $@;
    }
    my $offset = $tag->{_next_pos} - $stream->tell;
    Carp::confess 'Short!' if $offset < 0;
    $stream->get_string($offset) if $offset > 0;
    $self->{_tag}={};
}

sub abort {
    shift->{_aborted} = 1;
}

1;

__END__