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