1package SWF::Parser; 2 3use strict; 4use vars qw($VERSION); 5 6$VERSION = '0.11'; 7 8use SWF::BinStream; 9use Carp; 10 11sub new { 12 my $class = shift; 13 my %param = @_; 14 my $self = { _tag => {}, 15 _version => 5, 16 _aborted => 0, 17 }; 18 $self->{_header_callback} = 19 $param{'header-callback'} 20 || $param{'header_callback'} 21 || (sub {0}); 22 $self->{_tag_callback} = 23 $param{'tag-callback'} 24 || $param{'tag_callback'} 25 || (sub {0}); 26 $self->{_header} = {} unless $param{header} and $param{header} =~ /^no(?:ne)?$/; 27 $self->{_stream}=$param{'stream'}||(SWF::BinStream::Read->new('', sub{ die "The stream ran short by $_[0] bytes."})); 28 29 30 bless $self, $class; 31} 32 33sub parse { 34 my ($self, $data) = @_; 35 my $stream = $self->{_stream}; 36 37 if ($self->{_aborted}) { 38 carp 'The SWF parser has been aborted'; 39 return $self; 40 } 41 42# unless (defined $data) { 43# if (my $bytes=$stream->Length) { 44# carp "Data remains $bytes bytes in the stream."; 45# } 46# return $self; 47# } 48 $stream->add_stream($data); 49 eval {{ 50 unless (exists $self->{_header}) { 51 $self->parsetag while !$self->{_aborted} and $stream->Length; 52 } else { 53 $self->parseheader; 54 redo if !$self->{_aborted} and $stream->Length; 55 } 56 }}; 57 if ($@) { 58 return $self if ($@=~/^The stream ran short by/); 59 die $@; 60 } 61 $self; 62} 63 64sub parse_file { 65 my($self, $file) = @_; 66 no strict 'refs'; # so that a symbol ref as $file works 67 local(*F); 68 unless (ref($file) || $file =~ /^\*[\w:]+$/) { 69 # Assume $file is a filename 70 open(F, $file) || die "Can't open $file: $!"; 71 $file = *F; 72 } 73 binmode($file); 74 my $chunk = ''; 75 while(!$self->{_aborted} and read($file, $chunk, 4096)) { 76 $self->parse($chunk); 77 } 78 close($file); 79 $self->eof unless $self->{_aborted}; 80} 81 82sub eof 83{ 84 shift->parse(undef); 85} 86 87sub parseheader { 88 my $self = shift; 89 my $stream = $self->{_stream}; 90 my $header = $self->{_header}; 91 92 unless (exists $header->{signature}) { 93 my $h = $header->{signature} = $stream->get_string(3); 94 Carp::confess "This is not SWF stream " if ($h ne 'CWS' and $h ne 'FWS'); 95 } 96 $stream->Version($header->{version} = $self->{_version} = $stream->get_UI8) unless exists $header->{version}; 97 $header->{filelen} = $stream->get_UI32 unless exists $header->{filelen}; 98 $stream->add_codec('Zlib') if ($header->{signature} eq 'CWS'); 99 $header->{nbits} = $stream->get_bits(5) unless exists $header->{nbits}; 100 my $nbits = $header->{nbits}; 101 $header->{xmin} = $stream->get_sbits($nbits) unless exists $header->{xmin}; 102 $header->{xmax} = $stream->get_sbits($nbits) unless exists $header->{xmax}; 103 $header->{ymin} = $stream->get_sbits($nbits) unless exists $header->{ymin}; 104 $header->{ymax} = $stream->get_sbits($nbits) unless exists $header->{ymax}; 105 $header->{rate} = $stream->get_UI16 / 256 unless exists $header->{rate}; 106 $header->{count} = $stream->get_UI16 unless exists $header->{count}; 107 108 $self->{_header_callback}->($self, @{$header}{qw(signature version filelen xmin ymin xmax ymax rate count)}); 109 delete $self->{_header}; 110} 111 112sub parsetag { 113 my $self = shift; 114 my $tag = $self->{_tag}; 115 my $stream = $self->{_stream}; 116 $tag->{header}=$stream->get_UI16 unless exists $tag->{header}; 117 unless (exists $tag->{length}) { 118 my $length = ($tag->{header} & 0x3f); 119 $length=$stream->get_UI32 if ($length == 0x3f); 120 $tag->{length}=$length; 121 } 122 unless (exists $tag->{data}) { 123 $stream->_require($tag->{length}); 124 $tag->{data} = $stream; 125 $tag->{_next_pos} = $stream->tell + $tag->{length}; 126 } 127 eval { 128 $self->{_tag_callback}->($self, $tag->{header} >> 6, $tag->{length}, $tag->{data}); 129 }; 130 if ($@) { 131 Carp::confess 'Short!' if ($@=~/^The stream ran short by/); 132 die $@; 133 } 134 my $offset = $tag->{_next_pos} - $stream->tell; 135 Carp::confess 'Short!' if $offset < 0; 136 $stream->get_string($offset) if $offset > 0; 137 $self->{_tag}={}; 138} 139 140sub abort { 141 shift->{_aborted} = 1; 142} 143 1441; 145 146__END__ 147 148=head1 NAME 149 150SWF::Parser - Parse SWF file. 151 152=head1 SYNOPSIS 153 154 use SWF::Parser; 155 156 $parser = SWF::Parser->new( 'header-callback' => \&header, 'tag-callback' => \&tag); 157 # parse binary data 158 $parser->parse( $data ); 159 # or parse SWF file 160 $parser->parse_file( 'flash.swf' ); 161 162=head1 DESCRIPTION 163 164I<SWF::Parser> module provides a parser for SWF (Macromedia Flash(R)) 165file. It splits SWF into a header and tags and calls user subroutines. 166 167=head2 METHODS 168 169=over 4 170 171=item SWF::Parser->new( 'header-callback' => \&headersub, 'tag-callback' => \&tagsub [, stream => $stream, header => 'no']) 172 173Creates a parser. 174The parser calls user subroutines when find SWF header and tags. 175You can set I<SWF::BinStream::Read> object as the read stream. 176If not, internal stream is used. 177If you want to parse a tag block without SWF header, set header => 'no'. 178 179=item &headersub( $self, $signature, $version, $length, $xmin, $ymin, $xmax, $ymax, $framerate, $framecount ) 180 181You should define a I<header-callback> subroutine in your script. 182It is called with the following arguments: 183 184 $self: Parser object itself. 185 $signature: 'FWS' for normal SWF and 'CWS' for compressed SWF. 186 $version: SWF version No. 187 $length: File length. 188 $xmin, $ymin, $xmax, $ymax: 189 Boundary rectangle size of frames, ($xmin,$ymin)-($xmax, $ymax), in TWIPS(1/20 pixels). 190 $framerate: The number of frames per seconds. 191 $framecount: Total number of frames in the SWF. 192 193=item &tagsub( $self, $tagno, $length, $datastream ) 194 195You should define a I<tag-callback> subroutine in your script. 196It is called with the following arguments: 197 198 $self: Parser object itself. 199 $tagno: The ID number of the tag. 200 $length: Length of tag. 201 $datastream: The SWF::BinStream::Read object that can be read the rest of tag data. 202 203 204=item $parser->parse( $data ) 205 206parses the data block as a SWF. 207Can be called multiple times. 208 209=item $parser->parse_file( $file ); 210 211parses a SWF file. 212The argument can be a filename or an already opened file handle. 213 214=item $parser->parseheader; 215 216parses a SWF header and calls I<&headersub>. 217You don't need to call this method specifically because 218this method is usually called from I<parse> method. 219 220=item $parser->parsetag; 221 222parses SWF tags and calls I<&tagsub>. 223You don't need to call this method specifically because 224this method is usually called from I<parse> method. 225 226=item $parser->abort; 227 228tells the parser to abort parsing. 229 230=back 231 232=head1 COPYRIGHT 233 234Copyright 2000 Yasuhiro Sasama (ySas), <ysas@nmt.ne.jp> 235 236This library is free software; you can redistribute it 237and/or modify it under the same terms as Perl itself. 238 239=head1 SEE ALSO 240 241L<SWF::BinStream>, L<SWF::Element> 242 243SWF file format specification from Macromedia. 244 245 246=cut 247