1# Copyright (C) 2005-2009 Quentin Sculo <squentin@free.fr>
2#
3# This file is part of Gmusicbrowser.
4# Gmusicbrowser is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License version 3, as
6# published by the Free Software Foundation
7
8#http://xiph.org/vorbis/doc/framing.html
9#http://xiph.org/vorbis/doc/v-comment.html
10
11package Tag::OGG;
12
13use strict;
14use warnings;
15use Encode qw(decode encode);
16use MIME::Base64;
17
18use constant
19{ PACKET_INFO	 => 1,
20  PACKET_COMMENT => 3,
21  PACKET_SETUP	 => 5,
22};
23
24my @crc_lookup;
25my $digestcrc;
26INIT
27{ eval
28  {	require Digest::CRC;
29	$digestcrc=Digest::CRC->new(width=>32, init=>0, xorout=>0, poly=>0x04C11DB7, refin=>0, refout=>0);
30	warn "oggheader.pm : using Digest::CRC\n" if $::debug;
31  };
32  if ($@)
33  { warn "oggheader.pm : Digest::CRC not found, using slow pure-perl replacement.\n" if $::debug;
34    @crc_lookup=
35 (0x00000000,0x04c11db7,0x09823b6e,0x0d4326d9,
36  0x130476dc,0x17c56b6b,0x1a864db2,0x1e475005,
37  0x2608edb8,0x22c9f00f,0x2f8ad6d6,0x2b4bcb61,
38  0x350c9b64,0x31cd86d3,0x3c8ea00a,0x384fbdbd,
39  0x4c11db70,0x48d0c6c7,0x4593e01e,0x4152fda9,
40  0x5f15adac,0x5bd4b01b,0x569796c2,0x52568b75,
41  0x6a1936c8,0x6ed82b7f,0x639b0da6,0x675a1011,
42  0x791d4014,0x7ddc5da3,0x709f7b7a,0x745e66cd,
43  0x9823b6e0,0x9ce2ab57,0x91a18d8e,0x95609039,
44  0x8b27c03c,0x8fe6dd8b,0x82a5fb52,0x8664e6e5,
45  0xbe2b5b58,0xbaea46ef,0xb7a96036,0xb3687d81,
46  0xad2f2d84,0xa9ee3033,0xa4ad16ea,0xa06c0b5d,
47  0xd4326d90,0xd0f37027,0xddb056fe,0xd9714b49,
48  0xc7361b4c,0xc3f706fb,0xceb42022,0xca753d95,
49  0xf23a8028,0xf6fb9d9f,0xfbb8bb46,0xff79a6f1,
50  0xe13ef6f4,0xe5ffeb43,0xe8bccd9a,0xec7dd02d,
51  0x34867077,0x30476dc0,0x3d044b19,0x39c556ae,
52  0x278206ab,0x23431b1c,0x2e003dc5,0x2ac12072,
53  0x128e9dcf,0x164f8078,0x1b0ca6a1,0x1fcdbb16,
54  0x018aeb13,0x054bf6a4,0x0808d07d,0x0cc9cdca,
55  0x7897ab07,0x7c56b6b0,0x71159069,0x75d48dde,
56  0x6b93dddb,0x6f52c06c,0x6211e6b5,0x66d0fb02,
57  0x5e9f46bf,0x5a5e5b08,0x571d7dd1,0x53dc6066,
58  0x4d9b3063,0x495a2dd4,0x44190b0d,0x40d816ba,
59  0xaca5c697,0xa864db20,0xa527fdf9,0xa1e6e04e,
60  0xbfa1b04b,0xbb60adfc,0xb6238b25,0xb2e29692,
61  0x8aad2b2f,0x8e6c3698,0x832f1041,0x87ee0df6,
62  0x99a95df3,0x9d684044,0x902b669d,0x94ea7b2a,
63  0xe0b41de7,0xe4750050,0xe9362689,0xedf73b3e,
64  0xf3b06b3b,0xf771768c,0xfa325055,0xfef34de2,
65  0xc6bcf05f,0xc27dede8,0xcf3ecb31,0xcbffd686,
66  0xd5b88683,0xd1799b34,0xdc3abded,0xd8fba05a,
67  0x690ce0ee,0x6dcdfd59,0x608edb80,0x644fc637,
68  0x7a089632,0x7ec98b85,0x738aad5c,0x774bb0eb,
69  0x4f040d56,0x4bc510e1,0x46863638,0x42472b8f,
70  0x5c007b8a,0x58c1663d,0x558240e4,0x51435d53,
71  0x251d3b9e,0x21dc2629,0x2c9f00f0,0x285e1d47,
72  0x36194d42,0x32d850f5,0x3f9b762c,0x3b5a6b9b,
73  0x0315d626,0x07d4cb91,0x0a97ed48,0x0e56f0ff,
74  0x1011a0fa,0x14d0bd4d,0x19939b94,0x1d528623,
75  0xf12f560e,0xf5ee4bb9,0xf8ad6d60,0xfc6c70d7,
76  0xe22b20d2,0xe6ea3d65,0xeba91bbc,0xef68060b,
77  0xd727bbb6,0xd3e6a601,0xdea580d8,0xda649d6f,
78  0xc423cd6a,0xc0e2d0dd,0xcda1f604,0xc960ebb3,
79  0xbd3e8d7e,0xb9ff90c9,0xb4bcb610,0xb07daba7,
80  0xae3afba2,0xaafbe615,0xa7b8c0cc,0xa379dd7b,
81  0x9b3660c6,0x9ff77d71,0x92b45ba8,0x9675461f,
82  0x8832161a,0x8cf30bad,0x81b02d74,0x857130c3,
83  0x5d8a9099,0x594b8d2e,0x5408abf7,0x50c9b640,
84  0x4e8ee645,0x4a4ffbf2,0x470cdd2b,0x43cdc09c,
85  0x7b827d21,0x7f436096,0x7200464f,0x76c15bf8,
86  0x68860bfd,0x6c47164a,0x61043093,0x65c52d24,
87  0x119b4be9,0x155a565e,0x18197087,0x1cd86d30,
88  0x029f3d35,0x065e2082,0x0b1d065b,0x0fdc1bec,
89  0x3793a651,0x3352bbe6,0x3e119d3f,0x3ad08088,
90  0x2497d08d,0x2056cd3a,0x2d15ebe3,0x29d4f654,
91  0xc5a92679,0xc1683bce,0xcc2b1d17,0xc8ea00a0,
92  0xd6ad50a5,0xd26c4d12,0xdf2f6bcb,0xdbee767c,
93  0xe3a1cbc1,0xe760d676,0xea23f0af,0xeee2ed18,
94  0xf0a5bd1d,0xf464a0aa,0xf9278673,0xfde69bc4,
95  0x89b8fd09,0x8d79e0be,0x803ac667,0x84fbdbd0,
96  0x9abc8bd5,0x9e7d9662,0x933eb0bb,0x97ffad0c,
97  0xafb010b1,0xab710d06,0xa6322bdf,0xa2f33668,
98  0xbcb4666d,0xb8757bda,0xb5365d03,0xb1f740b4
99 );}
100}
101
102#hash fields :
103# filename
104# fileHandle
105# serial	serial number (binary 4 bytes)
106# seg_table	segmentation table of last read page
107# granule	granule of last read page
108# info		-> hash containing : version channels rate bitrate_upper bitrate_nominal bitrate_lower seconds
109# comments	-> hash of arrays (lowercase keys)
110# CommentsOrder -> list of keys (mixed-case keys)
111# commentpack_size
112# vorbis_string
113# stream_vers
114# end
115
116
117sub new
118{   my ($class,$file)=@_;
119    my $self=bless {}, $class;
120
121    # check that the file exists
122    unless (-e $file)
123    {	warn "File '$file' does not exist.\n";
124	return undef;
125    }
126    $self->{filename} = $file;
127    $self->_open or return undef;
128
129    {
130    	$self->{info}=_ReadInfo($self);
131    	last unless $self->{info};
132
133	$self->{comments}=_ReadComments($self);
134    	last unless $self->{comments};
135
136	$self->{end}=_skip_to_last_page($self);
137    	_read_packet($self,0) unless $self->{end};
138	warn "file truncated or corrupted.\n" unless $self->{end};
139
140	#calulate length
141	last unless $self->{info}{rate};# && $self->{end};
142	my @granule=unpack 'C*',$self->{granule};
143	my $l=0;
144	$l=$l*256+$_ for reverse @granule;
145	$self->{info}{seconds}=my$s=$l/$self->{info}{rate};
146    }
147
148    $self->_close;
149    unless ($self->{info} && $self->{comments})
150    {	warn "error, can't read file or not a valid ogg file\n";
151	return undef;
152    }
153    return $self;
154}
155
156sub _open
157{	my $self=shift;
158	my $file=$self->{filename};
159	open my$fh,'<',$file or warn "can't open $file : $!\n" and return undef;
160	binmode $fh;
161	$self->{fileHandle} = $fh;
162	$self->{seg_table} = [];
163	return $fh;
164}
165sub _openw
166{	my ($self,$tmp)=@_;
167	my $file=$self->{filename};
168	my $m='+<';
169	if ($tmp) {$file.='.TEMP';$m='>';}
170	my $fh;
171	until (open $fh,$m,$file)
172	{	my $err="Error opening '$file' for writing :\n$!";
173		warn $err."\n";
174		return undef unless $self->{errorsub} && $self->{errorsub}($!,'openwrite',$file) eq 'retry';
175	}
176	binmode $fh;
177	unless ($tmp)
178	{ $self->{fileHandle} = $fh;
179	  $self->{seg_table} = [];
180	}
181	return $fh;
182}
183
184sub _close
185{	my $self=shift;
186	$self->{seg_table} = undef;
187	close delete($self->{fileHandle});
188}
189
190sub write_file
191{	my $self=shift;
192	my $newcom_packref=_PackComments($self);
193	#warn "old size $self->{commentpack_size}, need : ".length($$newcom_packref)."\n";
194	if ( $self->{commentpack_size} >= length $$newcom_packref)
195	{	warn "in place editing.\n";
196		my $left=length $$newcom_packref;
197		my $offset2=0;
198		my $fh=$self->_openw or return;
199		_read_packet($self,PACKET_INFO);	#skip first page
200		while ($left)
201		{ my $pos=tell $fh;
202		  my ($pageref,$offset,$size)=_ReadPage($self);
203		  seek $fh,$pos,0;
204		  if ($left<$size) {$size=$left; $left=0;}
205		  else		   {$left-=$size}
206		  substr $$pageref,$offset,$size,substr($$newcom_packref,$offset2,$size);
207		  $offset2+=$size;
208		  _recompute_page_crc($pageref);
209		  print $fh $$pageref or warn $!;
210		}
211		$self->_close;
212		return;
213	}
214	my $INfh=$self->_open or return;
215	my $OUTfh=$self->_openw(1) or return;	#open .TEMP file
216
217	my $version=chr $self->{stream_vers};
218	my $serial=$self->{serial};
219	my $pageref=_ReadPage($self);		#read the first page
220	die unless $pageref;	#FIXME check serial, OggS ...
221	print $OUTfh $$pageref or warn $!;		#write the first page unmodified
222	my $pagenb=1;
223
224	#skip the comment packet in the original file
225	die unless _read_packet($self,PACKET_COMMENT);
226
227	#concatenate newly generated comment packet and setup packet from the original file in $data, and compute the segments in @segments
228	my $data;
229	my @segments;
230	for my $packref ( $newcom_packref , _read_packet($self,PACKET_SETUP) )
231	{	$data.=$$packref;
232		my $size=length $$packref;
233		push @segments, (255)x int($size/255), $size%255;
234	}
235
236	#separate $data in pages and write them
237	my $data_offset=0;
238	my $continued=0;
239	{	my $size=0;
240		my $segments;
241		my $nbseg=0;
242		my $seg;
243		while ($size<4096)		# make page of max 4095+255 bytes
244		{	last unless @segments;
245			$seg=shift @segments;
246			$size+=$seg;
247			$segments.=chr $seg;
248			$nbseg++;
249		}
250		#warn unpack('C*',$segments),"\n";
251		#warn "$size ",length($data)-$data_offset,"\n";
252		warn "writing page $pagenb\n" if $::debug;
253		my $page=pack('a4aa x8 a4 V x4 C','OggS',$version,$continued,$serial,$pagenb++,$nbseg).$segments.substr($data,$data_offset,$size);
254		_recompute_page_crc(\$page);
255		print $OUTfh $page or warn $!;
256		$data_offset+=$size;
257		$continued=($seg==255)? "\x01" : "\x00";
258		redo if @segments;
259	}
260
261
262	# copy AUDIO data
263
264	my $pos=tell $INfh; read $INfh,$data,27; seek $INfh,$pos,0;
265	#warn "first audio data on page ".unpack('x18V',$data)."\n";
266	# fast raw copy by 1M chunks if page numbers haven't changed
267	if ( substr($data,0,4) eq 'OggS' && unpack('x18V',$data) eq $pagenb)
268		{ my $buffer;
269		  print $OUTfh $buffer  or warn $! while read $INfh,$buffer,1048576;
270		}
271
272	# __SLOW__ copy if page number must be changed -> and crc recomputed
273	else
274	{	warn "must recompute crc for the whole file, this may take a while (install Digest::CRC to make it fast) ...\n" unless $digestcrc;
275		while (my $pageref=_ReadPage($self))	# read each page
276		{	substr $$pageref,18,4,pack('V',$pagenb++); #replace page number
277			_recompute_page_crc($pageref);	#recompute crc
278			print $OUTfh $$pageref or warn $!;	#write page
279		}
280	}
281
282	$self->_close;
283	close $OUTfh;
284	warn "replacing old file with new file.\n";
285	unlink $self->{filename} && rename $self->{filename}.'.TEMP',$self->{filename};
286	%$self=(); #destroy the object to make sure it is not reused as many of its data are now invalid
287	return 1;
288}
289
290sub _ReadPage
291{	my $self=shift;
292	my $fh=$self->{fileHandle};
293	my $page;
294	my $r=read $fh,$page,27;			#read page header
295	return undef unless $r==27 && substr($page,0,4) eq 'OggS';
296	my $segments=vec $page,26,8;
297	$r=read $fh,$page,$segments,27;		#read segment table
298	return undef unless $r==$segments;
299	my $size;
300	#$size+=ord substr($page,$_,1) for (27..$segments+26);
301	$size+=vec($page,$_,8) for (27..$segments+26);
302	$r=read $fh,$page,$size,27+$segments;	#read page data
303	return undef unless $r==$size;
304	return wantarray ? (\$page,27+$segments,$size) : \$page;
305}
306
307sub _ReadInfo
308{	my $self=shift;
309	#$self->{startaudio}=0;
310	# 1) [vorbis_version] = read 32 bits as unsigned integer
311	# 2) [audio_channels] = read 8 bit integer as unsigned
312	# 3) [audio_sample_rate] = read 32 bits as unsigned integer
313	# 4) [bitrate_maximum] = read 32 bits as signed integer
314	# 5) [bitrate_nominal] = read 32 bits as signed integer
315	# 6) [bitrate_minimum] = read 32 bits as signed integer
316	# 7) [blocksize_0] = 2 exponent (read 4 bits as unsigned integer)
317	# 8) [blocksize_1] = 2 exponent (read 4 bits as unsigned integer)
318	# 9) [framing_flag] = read one bit
319	if ( my $packref=_read_packet($self,PACKET_INFO) )
320	{	my %info;
321		@info{qw/version channels rate bitrate_upper bitrate_nominal bitrate_lower/}= unpack 'x7 VCV V3 C',$$packref;
322		return \%info;
323	}
324	else
325	{	warn "Can't read info\n";
326		return undef;
327	}
328}
329
330sub _ReadComments
331{	my $self=$_[0];
332	if ( my $packref= _read_packet($self,PACKET_COMMENT) )
333	{	$self->{commentpack_size}=length $$packref;
334		my ($vstring,@comlist)=eval { unpack 'x7 V/a V/(V/a)',$$packref; };
335		if ($@) { warn "Comments corrupted\n"; return undef; }
336		# Comments vendor strings I have found
337		# 'Xiph.Org libVorbis I 20030909' : 1.0.1
338		# 'Xiph.Org libVorbis I 20020717' : 1.0 release of libvorbis
339		# 'Xiphophorus libVorbis I 200xxxxx' : 1.0_beta1 to 1.0_rc3
340		# 'AO; aoTuV b3 [20041120] (based on Xiph.Org's libVorbis)'
341		$self->{vorbis_string}=$vstring;
342		if ($::debug && $vstring!~m/^Xiph.* libVorbis I (\d{8})/)
343		 { warn "unknown comments vendor string : $vstring\n"; }
344		my %comments;
345		my @order;
346		$self->{CommentsOrder}=\@order;
347		for my $kv (@comlist)
348		{	unless ($kv=~m/^([^=]+)=(.*)$/s) { warn "comment invalid - skipped\n"; next; }
349			my $key=$1;
350			my $val=decode('utf-8', $2);
351			#warn "$key = $val\n";
352			push @{ $comments{lc$key} },$val;
353			push @order, $key;
354		}
355		if (my $covers=$comments{coverart})	#upgrade old embedded pictures format to metadata_block_picture
356		{	@order= grep !m/^coverart/i, @order;
357			for my $i (0..$#$covers)
358			{	my $data= $comments{"coverart"}[$i];
359				next unless $data;
360				my @val= ( map( $comments{"coverart$_"}[$i], qw/mime type description/ ), decode_base64($data) );
361				push @{$comments{metadata_block_picture}}, \@val;
362				push @order, 'METADATA_BLOCK_PICTURE';
363			}
364			delete $comments{"coverart$_"} for qw/mime type description/,'';
365		}
366		return \%comments;
367	}
368	else
369	{	warn "Can't find comments\n";
370		return undef;
371	}
372}
373sub _PackComments
374{	my $self=$_[0];
375	my @comments;
376	my %count;
377	for my $key ( @{$self->{CommentsOrder}} )
378	{	my $nb=$count{lc$key}++ || 0;
379		my $val=$self->{comments}{lc$key}[$nb];
380		next unless defined $val;
381		$key=encode('ascii',$key);
382		$key=~tr/\x20-\x7D/?/c; $key=~tr/=/?/; #replace characters that are not allowed by '?'
383		if (uc$key eq 'METADATA_BLOCK_PICTURE' && ref $val)
384		{	$val= Tag::Flac::_PackPicture($val);
385			$val= encode_base64($$val);
386		}
387		push @comments,$key.'='.encode('utf8',$val);
388	}
389	my $packet=pack 'Ca6 V/a* V (V/a*)*',PACKET_COMMENT,'vorbis',$self->{vorbis_string},scalar @comments, @comments;
390	$packet.="\x01"; #framing_flag
391	return \$packet;
392}
393
394sub edit
395{	my ($self,$key,$nb,$val)=@_;
396	$nb||=0;
397	my $aref=$self->{comments}{lc$key};
398	return unless $aref &&  @$aref >=$nb;
399	$aref->[$nb]= $val;
400	return 1;
401}
402sub add
403{	my ($self,$key,$val)=@_;
404	push @{ $self->{comments}{lc$key} }, $val;
405	push @{$self->{CommentsOrder}}, $key;
406	return 1;
407}
408sub insert	#same as add but put it first (of its kind)
409{	my ($self,$key,$val)=@_;
410	unshift @{ $self->{comments}{lc$key} }, $val;
411	push @{$self->{CommentsOrder}}, $key;
412	return 1;
413}
414
415sub remove_all
416{	my ($self,$key)=@_;
417	return undef unless defined $key;
418	$key=lc$key;
419	$_=undef for @{ $self->{comments}{$key} };
420	return 1;
421}
422
423sub get_keys
424{	keys %{ $_[0]{comments} };
425}
426sub get_values
427{	my ($self,$key)=($_[0],lc$_[1]);
428	my $v= $self->{comments}{$key};
429	return () unless $v;
430	if ($key eq 'metadata_block_picture')
431	{	for my $val (@$v)
432		{	next if ref $val or !defined $val;
433			my $dec=decode_base64($val);
434			$val= $dec ? Tag::Flac::_ReadPicture(\$dec) : undef;
435		}
436	}
437	return grep defined, @$v;
438}
439
440sub remove
441{	my ($self,$key,$nb)=@_;
442	return undef unless defined $key and $nb=~m/^\d*$/;
443	$nb||=0;
444	$key=lc$key;
445	my $val=$self->{comments}{$key}[$nb];
446	unless (defined $val) {warn "comment to delete not found\n"; return undef; }
447	$self->{comments}{$key}[$nb]=undef;
448	return 1;
449}
450
451sub _read_packet
452{	my $self=shift;
453	my $wantedtype=shift; #wanted type, 0 to read all packets until eof
454	my $fh=$self->{fileHandle};
455	my $packet;
456	do
457	{ my $lpacket=0;
458	  my $seg_table=$self->{seg_table};
459	  my $lastseg;
460	  until ($lastseg)
461	  {	my $size;
462		unless ( @$seg_table ) { _read_page_header($self) || return undef }
463		while (defined( my $byte=shift @$seg_table ))
464		{	$size+=$byte;
465			unless ($byte==255) { $lastseg=1; last; }
466		}
467		next unless $size;
468		my $read=read $fh,$packet,$size,$lpacket;
469		return undef unless $size==$read;
470		$lpacket+=$read;
471	  }
472
473	} until ($wantedtype || $self->{end});
474	my ($type,$vorbis)=unpack 'Ca6',$packet;
475	warn "read packet : $type $vorbis length=".length($packet)."\n" if $::debug;
476	if ( $type==$wantedtype && $vorbis eq 'vorbis')	{ return \$packet; }
477	else { return undef; }
478}
479
480sub _read_page_header
481{	my $self=shift;
482	my $fh=$self->{fileHandle};
483	my $buf;
484	my $r=read $fh,$buf,27;
485	return 0 unless $r==27;
486	#http://www.xiph.org/ogg/vorbis/doc/framing.html
487	# 'OggS' 4 bytes	capture_pattern			0
488	# 0x00	 1 byte		stream_structure_version	1
489	#	 1 byte		header_type_flag		2
490	#	 8 bytes	absolute granule position	3
491	#	 4 bytes	stream serial number		4
492	#	 4 bytes	page sequence no		5
493	#	 4 bytes	page checksum			6
494	#	 1 byte		page_segments			7
495	#
496	#warn "OggS : ".join(' ',unpack('a4CC a8 VVVC',$buf))."\n";
497	my ($captpat,$ver,$flags,$granule,$sn,$nbseg)=unpack 'a4CC a8 a4 x8 C',$buf;
498	return undef unless $captpat eq 'OggS' and $ver eq 0;
499	if ($self->{serial} && $self->{serial} ne $sn) {warn "corrupted page : serial number doesn't match\n";return undef}
500	$self->{end}=$flags & 4;
501	$self->{serial}=$sn;
502	$self->{stream_vers}=$ver;
503	$self->{granule}=$granule;
504	return undef unless read($fh,$buf,$nbseg)==$nbseg;
505	@{ $self->{seg_table} }=unpack 'C*',$buf;
506	#warn " seg_table: ".join(' ',@{ $self->{seg_table} })."\n";
507	return 1;
508}
509
510sub _recompute_page_crc
511{ my $pageref=$_[0];
512
513  #warn 'old crc : ',unpack('V',substr($$pageref,22,4)),"\n";
514  substr $$pageref,22,4,"\x00\x00\x00\x00";
515  my $crc=0;
516  if ($digestcrc) { $digestcrc->add($$pageref); $crc=$digestcrc->digest; }
517  else			# pure-perl : SLOW
518  {	 #$crc=($crc<<8)^vec($crc_lookup, ($crc>>24)^vec($$pageref,$_,8) ,32); # a bit slower
519	 #$crc=($crc<<8)^$crc_lookup[ ($crc>>24)^vec($$pageref,$_,8) ] #doesn't work if perl use 64bits
520	 $crc=(($crc<<8)&0xffffffff)^$crc_lookup[ ($crc>>24)^vec($$pageref,$_,8) ]
521  	for (0 .. length($$pageref)-1);
522  }
523  #warn "new crc : $crc\n";
524  substr $$pageref,22,4,pack('V',$crc);
525}
526
527sub _skip_to_last_page
528{	my $self=shift;
529	my $fh=$self->{fileHandle};
530	my $pos=tell $fh;
531	seek $fh,-10000,2;
532	read $fh,my$buf,10000;
533	my $sn=$self->{serial};
534	my $granule;
535	while ($buf=~m/OggS\x00(.)(.{8})(.{4})/gs)
536	{	#@_=unpack "a4CC a8 VVVC",$1;
537		next unless $sn eq $3;	#check serial number
538		$granule=$2 unless $2 eq "\xff\xff\xff\xff\xff\xff\xff\xff"; #granule==-1 => no packets finish on this page
539		next unless vec $1,2,1;	#last page of logical bitstream
540		last unless defined $granule;
541		# found last page -> save granule
542		$self->{granule}=$granule;
543		return 1;
544	}
545	#didn't find last page
546	seek $fh,$pos,0;
547	return 0;
548}
549
5501;
551