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