tools/vorbiscomm.pm

   1 #############################################################################
   2 # This is
   3 # http://search.cpan.org/~amolloy/Ogg-Vorbis-Header-PurePerl-0.07/PurePerl.pm
   4 # written by Andrew Molloy
   5 # Code under GNU GENERAL PUBLIC LICENCE v2
   6 # $Id$
   7 #############################################################################
   8
   9 package vorbiscomm;
  10
  11 use 5.005;
  12 use strict;
  13 use warnings;
  14
  15 use Fcntl qw/SEEK_END/;
  16
  17 our $VERSION = '0.07';
  18
  19 sub new
  20 {
  21     my $class = shift;
  22     my $file = shift;
  23
  24     return load($class, $file);
  25 }
  26
  27 sub load
  28 {
  29     my $class    = shift;
  30     my $file     = shift;
  31     my $from_new = shift;
  32     my %data;
  33     my $self;
  34
  35     # there must be a better way...
  36     if ($class eq 'vorbiscomm')
  37     {
  38         $self = bless \%data, $class;
  39     }
  40     else
  41     {
  42         $self = $class;
  43     }
  44
  45     if ($self->{'FILE_LOADED'})
  46     {
  47         return $self;
  48     }
  49
  50     $self->{'FILE_LOADED'} = 1;
  51
  52     # check that the file exists and is readable
  53     unless ( -e $file && -r _ )
  54     {
  55         warn "File does not exist or cannot be read.";
  56         # file does not exist, can't do anything
  57         return undef;
  58     }
  59     # open up the file
  60     open FILE, $file;
  61     # make sure dos-type systems can handle it...
  62     binmode FILE;
  63
  64     $data{'filename'} = $file;
  65     $data{'fileHandle'} = \*FILE;
  66
  67     if (_init(\%data)) {
  68         _loadInfo(\%data);
  69         _loadComments(\%data);
  70         _calculateTrackLength(\%data);
  71     }
  72
  73     close FILE;
  74
  75     return $self;
  76 }
  77
  78 sub info
  79 {
  80     my $self = shift;
  81     my $key = shift;
  82
  83     # if the user did not supply a key, return the entire hash
  84     unless ($key)
  85     {
  86         return $self->{'INFO'};
  87     }
  88
  89     # otherwise, return the value for the given key
  90     return $self->{'INFO'}{lc $key};
  91 }
  92
  93 sub comment_tags
  94 {
  95     my $self = shift;
  96
  97     if ( $self && $self->{'COMMENT_KEYS'} ) {
  98         return @{$self->{'COMMENT_KEYS'}};
  99     }
 100
 101     return undef;
 102 }
 103
 104 sub comment
 105 {
 106     my $self = shift;
 107     my $key = shift;
 108
 109     # if the user supplied key does not exist, return undef
 110     unless($self->{'COMMENTS'}{lc $key})
 111     {
 112         return undef;
 113     }
 114
 115     return @{$self->{'COMMENTS'}{lc $key}};
 116 }
 117
 118 sub add_comments
 119 {
 120     warn "Ogg::Vorbis::Header::PurePerl add_comments() unimplemented.";
 121 }
 122
 123 sub edit_comment
 124 {
 125     warn "Ogg::Vorbis::Header::PurePerl edit_comment() unimplemented.";
 126 }
 127
 128 sub delete_comment
 129 {
 130     warn "Ogg::Vorbis::Header::PurePerl delete_comment() unimplemented.";
 131 }
 132
 133 sub clear_comments
 134 {
 135     warn "Ogg::Vorbis::Header::PurePerl clear_comments() unimplemented.";
 136 }
 137
 138 sub path
 139 {
 140     my $self = shift;
 141
 142     return $self->{'fileName'};
 143 }
 144
 145 sub write_vorbis
 146 {
 147     warn "Ogg::Vorbis::Header::PurePerl write_vorbis unimplemented.";
 148 }
 149
 150 # "private" methods
 151
 152 sub _init
 153 {
 154     my $data = shift;
 155     my $fh = $data->{'fileHandle'};
 156     my $byteCount = 0;
 157
 158     # check the header to make sure this is actually an Ogg-Vorbis file
 159     $byteCount = _checkHeader($data);
 160
 161     unless($byteCount)
 162     {
 163         # if it's not, we can't do anything
 164         return undef;
 165     }
 166
 167     $data->{'startInfoHeader'} = $byteCount;
 168     return 1; # Success
 169 }
 170
 171 sub _checkHeader
 172 {
 173     my $data = shift;
 174     my $fh = $data->{'fileHandle'};
 175     my $buffer;
 176     my $pageSegCount;
 177     my $byteCount = 0; # stores how far into the file we've read,
 178                        # so later reads into the file can skip right
 179                        # past all of the header stuff
 180
 181     # check that the first four bytes are 'OggS'
 182     read($fh, $buffer, 4);
 183     if ($buffer ne 'OggS')
 184     {
 185         warn "This is not an Ogg bitstream (no OggS header).";
 186         return undef;
 187     }
 188     $byteCount += 4;
 189
 190     # check the stream structure version (1 byte, should be 0x00)
 191     read($fh, $buffer, 1);
 192     if (ord($buffer) != 0x00)
 193     {
 194         warn "This is not an Ogg bitstream (invalid structure version).";
 195         return undef;
 196     }
 197     $byteCount += 1;
 198
 199     # check the header type flag
 200     # This is a bitfield, so technically we should check all of the bits
 201     # that could potentially be set. However, the only value this should
 202     # possibly have at the beginning of a proper Ogg-Vorbis file is 0x02,
 203     # so we just check for that. If it's not that, we go on anyway, but
 204     # give a warning (this behavior may (should?) be modified in the future.
 205     read($fh, $buffer, 1);
 206     if (ord($buffer) != 0x02)
 207     {
 208         warn "Invalid header type flag (trying to go ahead anyway).";
 209     }
 210     $byteCount += 1;
 211
 212     # skip to the page_segments count
 213     read($fh, $buffer, 20);
 214     $byteCount += 20;
 215     # we do nothing with this data
 216
 217     # read the number of page segments
 218     read($fh, $buffer, 1);
 219     $pageSegCount = ord($buffer);
 220     $byteCount += 1;
 221
 222     # read $pageSegCount bytes, then throw 'em out
 223     read($fh, $buffer, $pageSegCount);
 224     $byteCount += $pageSegCount;
 225
 226     # check packet type. Should be 0x01 (for indentification header)
 227     read($fh, $buffer, 1);
 228     if (ord($buffer) != 0x01)
 229     {
 230         warn "Wrong vorbis header type, giving up.";
 231         return undef;
 232     }
 233     $byteCount += 1;
 234
 235     # check that the packet identifies itself as 'vorbis'
 236     read($fh, $buffer, 6);
 237     if ($buffer ne 'vorbis')
 238     {
 239         warn "This does not appear to be a vorbis stream, giving up.";
 240         return undef;
 241     }
 242     $byteCount += 6;
 243
 244     # at this point, we assume the bitstream is valid
 245     return $byteCount;
 246 }
 247
 248 sub _loadInfo
 249 {
 250     my $data = shift;
 251     my $start = $data->{'startInfoHeader'};
 252     my $fh = $data->{'fileHandle'};
 253     my $buffer;
 254     my $byteCount = $start;
 255     my %info;
 256
 257     seek $fh, $start, 0;
 258
 259     # read the vorbis version
 260     read($fh, $buffer, 4);
 261     $info{'version'} = _decodeInt($buffer);
 262     $byteCount += 4;
 263
 264     # read the number of audio channels
 265     read($fh, $buffer, 1);
 266     $info{'channels'} = ord($buffer);
 267     $byteCount += 1;
 268
 269     # read the sample rate
 270     read($fh, $buffer, 4);
 271     $info{'rate'} = _decodeInt($buffer);
 272     $byteCount += 4;
 273
 274     # read the bitrate maximum
 275     read($fh, $buffer, 4);
 276     $info{'bitrate_upper'} = _decodeInt($buffer);
 277     $byteCount += 4;
 278
 279     # read the bitrate nominal
 280     read($fh, $buffer, 4);
 281     $info{'bitrate_nominal'} = _decodeInt($buffer);
 282     $byteCount += 4;
 283
 284     # read the bitrate minimal
 285     read($fh, $buffer, 4);
 286     $info{'bitrate_lower'} = _decodeInt($buffer);
 287     $byteCount += 4;
 288
 289     # read the blocksize_0 and blocksize_1
 290     read($fh, $buffer, 1);
 291     # these are each 4 bit fields, whose actual value is 2 to the power
 292     # of the value of the field
 293     $info{'blocksize_0'} = 2 << ((ord($buffer) & 0xF0) >> 4);
 294     $info{'blocksize_1'} = 2 << (ord($buffer) & 0x0F);
 295     $byteCount += 1;
 296
 297     # read the framing_flag
 298     read($fh, $buffer, 1);
 299     $info{'framing_flag'} = ord($buffer);
 300     $byteCount += 1;
 301
 302     # bitrate_window is -1 in the current version of vorbisfile
 303     $info{'bitrate_window'} = -1;
 304
 305     $data->{'startCommentHeader'} = $byteCount;
 306
 307     $data->{'INFO'} = \%info;
 308 }
 309
 310 sub _loadComments
 311 {
 312     my $data = shift;
 313     my $fh = $data->{'fileHandle'};
 314     my $start = $data->{'startCommentHeader'};
 315     my $buffer;
 316     my $page_segments;
 317     my $vendor_length;
 318     my $user_comment_count;
 319     my $byteCount = $start;
 320     my %comments;
 321
 322     seek $fh, $start, 0;
 323
 324     # check that the first four bytes are 'OggS'
 325     read($fh, $buffer, 4);
 326     if ($buffer ne 'OggS')
 327     {
 328         warn "No comment header?";
 329         return undef;
 330     }
 331     $byteCount += 4;
 332
 333     # skip over next ten bytes
 334     read($fh, $buffer, 10);
 335     $byteCount += 10;
 336
 337     # read the stream serial number
 338     read($fh, $buffer, 4);
 339     push @{$data->{'commentSerialNumber'}}, _decodeInt($buffer);
 340     $byteCount += 4;
 341
 342     # read the page sequence number (should be 0x01)
 343     read($fh, $buffer, 4);
 344     if (_decodeInt($buffer) != 0x01)
 345     {
 346         warn "Comment header page sequence number is not 0x01: " +
 347             _decodeInt($buffer);
 348         warn "Going to keep going anyway.";
 349     }
 350     $byteCount += 4;
 351
 352     # and ignore the page checksum for now
 353     read($fh, $buffer, 4);
 354     $byteCount += 4;
 355
 356     # get the number of entries in the segment_table...
 357     read($fh, $buffer, 1);
 358     $page_segments = _decodeInt($buffer);
 359     $byteCount += 1;
 360     # then skip on past it
 361     read($fh, $buffer, $page_segments);
 362     $byteCount += $page_segments;
 363
 364     # check the header type (should be 0x03)
 365     read($fh, $buffer, 1);
 366     if (ord($buffer) != 0x03)
 367     {
 368         warn "Wrong header type: " . ord($buffer);
 369     }
 370     $byteCount += 1;
 371
 372     # now we should see 'vorbis'
 373     read($fh, $buffer, 6);
 374     if ($buffer ne 'vorbis')
 375     {
 376         warn "Missing comment header. Should have found 'vorbis', found " .
 377             $buffer;
 378     }
 379     $byteCount += 6;
 380
 381     # get the vendor length
 382     read($fh, $buffer, 4);
 383     $vendor_length = _decodeInt($buffer);
 384     $byteCount += 4;
 385
 386     # read in the vendor
 387     read($fh, $buffer, $vendor_length);
 388     $comments{'vendor'} = $buffer;
 389     $byteCount += $vendor_length;
 390
 391     # read in the number of user comments
 392     read($fh, $buffer, 4);
 393     $user_comment_count = _decodeInt($buffer);
 394     $byteCount += 4;
 395
 396     $data->{'COMMENT_KEYS'} = [];
 397
 398     # finally, read the comments
 399     for (my $i = 0; $i < $user_comment_count; $i++)
 400     {
 401         # first read the length
 402         read($fh, $buffer, 4);
 403         my $comment_length = _decodeInt($buffer);
 404         $byteCount += 4;
 405
 406         # then the comment itself
 407         read($fh, $buffer, $comment_length);
 408         $byteCount += $comment_length;
 409
 410         my ($key) = $buffer =~ /^([^=]+)/;
 411         my ($value) = $buffer =~ /=(.*)$/;
 412
 413         push @{$comments{lc $key}}, $value;
 414         push @{$data->{'COMMENT_KEYS'}}, lc $key;
 415     }
 416
 417     # read past the framing_bit
 418     read($fh, $buffer, 1);
 419     $byteCount += 1;
 420
 421     $data->{'INFO'}{'offset'} = $byteCount;
 422
 423     $data->{'COMMENTS'} = \%comments;
 424
 425     # Now find the offset of the first page
 426     # with audio data.
 427     while(_findPage($fh))
 428     {
 429         $byteCount = tell($fh) - 4;
 430
 431         # version flag
 432         read($fh, $buffer, 1);
 433         if (ord($buffer) != 0x00)
 434         {
 435             warn "Invalid stream structure version: " .
 436                 sprintf("%x", ord($buffer));
 437             return;
 438         }
 439
 440         # header type flag
 441         read($fh, $buffer, 1);
 442         # Audio data starts as a fresh packet on a new page, so
 443         # if header_type is odd it's not a fresh packet
 444         next if ( ord($buffer) % 2 );
 445
 446         # skip past granule position, stream_serial_number,
 447         # page_sequence_number, and crc
 448         read($fh, $buffer, 20);
 449
 450         # page_segments
 451         read($fh, $buffer, 1);
 452         my $page_segments = ord($buffer);
 453
 454         # skip past the segment table
 455         read($fh, $buffer, $page_segments);
 456
 457         # read packet_type byte
 458         read($fh, $buffer, 1);
 459
 460         # Not an audio packet. All audio packet numbers are even
 461         next if ( ord($buffer) % 2 );
 462
 463         # Found the first audio packet
 464         last;
 465     }
 466
 467     $data->{'INFO'}{'audio_offset'} = $byteCount;
 468 }
 469
 470 sub _calculateTrackLength
 471 {
 472     my $data = shift;
 473     my $fh = $data->{'fileHandle'};
 474     my $buffer;
 475     my $pageSize;
 476     my $granule_position;
 477
 478     seek($fh,-8500,SEEK_END);  # that magic number is from vorbisfile.c
 479     # in the constant CHUNKSIZE, which comes
 480     # with the comment /* a shade over 8k;
 481     # anyone using pages well over 8k gets
 482     # what they deserve */
 483
 484     # we just keep looking through the headers until we get to the last one
 485     # (there might be a couple of blocks here)
 486     while(_findPage($fh))
 487     {
 488         # stream structure version - must be 0x00
 489         read($fh, $buffer, 1);
 490         if (ord($buffer) != 0x00)
 491         {
 492             warn "Invalid stream structure version: " .
 493                 sprintf("%x", ord($buffer));
 494             return;
 495         }
 496
 497         # header type flag
 498         read($fh, $buffer, 1);
 499         # we should check this, but for now we'll just ignore it
 500
 501         # absolute granule position - this is what we need!
 502         read($fh, $buffer, 8);
 503         $granule_position = _decodeInt($buffer);
 504
 505         # skip past stream_serial_number, page_sequence_number, and crc
 506         read($fh, $buffer, 12);
 507
 508         # page_segments
 509         read($fh, $buffer, 1);
 510         my $page_segments = ord($buffer);
 511
 512         # reset pageSize
 513         $pageSize = 0;
 514
 515         # calculate approx. page size
 516         for (my $i = 0; $i < $page_segments; $i++)
 517         {
 518             read($fh, $buffer, 1);
 519             $pageSize += ord($buffer);
 520         }
 521
 522         seek $fh, $pageSize, 1;
 523     }
 524
 525     $data->{'INFO'}{'length'} =
 526         int($granule_position / $data->{'INFO'}{'rate'});
 527 }
 528
 529 sub _findPage
 530 {
 531     # search forward in the file for the 'OggS' page header
 532     my $fh = shift;
 533     my $char;
 534     my $curStr = '';
 535
 536     while (read($fh, $char, 1))
 537     {
 538         $curStr = $char . $curStr;
 539         $curStr = substr($curStr, 0, 4);
 540
 541         # we are actually looking for the string 'SggO' because we
 542         # tack character on to our test string backwards, to make
 543         # trimming it to 4 characters easier.
 544         if ($curStr eq 'SggO')
 545         {
 546             return 1;
 547         }
 548     }
 549
 550     return undef;
 551 }
 552
 553 sub _decodeInt
 554 {
 555     my $bytes = shift;
 556     my $num = 0;
 557     my @byteList = split //, $bytes;
 558     my $numBytes = @byteList;
 559     my $mult = 1;
 560
 561     for (my $i = 0; $i < $numBytes; $i ++)
 562     {
 563         $num += ord($byteList[$i]) * $mult;
 564         $mult *= 256;
 565     }
 566
 567     return $num;
 568 }
 569
 570 sub _decodeInt5Bit
 571 {
 572     my $byte = ord(shift);
 573
 574     $byte = $byte & 0xF8; # clear out the bottm 3 bits
 575     $byte = $byte >> 3; # and shifted down to where it belongs
 576
 577     return $byte;
 578 }
 579
 580 sub _decodeInt4Bit
 581 {
 582     my $byte = ord(shift);
 583
 584     $byte = $byte & 0xFC; # clear out the bottm 4 bits
 585     $byte = $byte >> 4; # and shifted down to where it belongs
 586
 587     return $byte;
 588 }
 589
 590 sub _ilog
 591 {
 592     my $x = shift;
 593     my $ret = 0;
 594
 595     unless ($x > 0)
 596     {
 597         return 0;
 598     }
 599
 600     while ($x > 0)
 601     {
 602         $ret++;
 603         $x = $x >> 1;
 604     }
 605
 606     return $ret;
 607 }
 608
 609 1;
 610 __DATA__
 611
 612 =head1 NAME
 613
 614 Ogg::Vorbis::Header::PurePerl - An object-oriented interface to Ogg Vorbis
 615 information and comment fields, implemented entirely in Perl.  Intended to be
 616 a drop in replacement for Ogg::Vobis::Header.
 617
 618 Unlike Ogg::Vorbis::Header, this module will go ahead and fill in all of the
 619 information fields as soon as you construct the object.  In other words,
 620 the C<new> and C<load> constructors have identical behavior.
 621
 622 =head1 SYNOPSIS
 623
 624         use Ogg::Vorbis::Header::PurePerl;
 625         my $ogg = Ogg::Vorbis::Header::PurePerl->new("song.ogg");
 626         while (my ($k, $v) = each %{$ogg->info}) {
 627                 print "$k: $v\n";
 628         }
 629         foreach my $com ($ogg->comment_tags) {
 630                 print "$com: $_\n" foreach $ogg->comment($com);
 631         }
 632
 633 =head1 DESCRIPTION
 634
 635 This module is intended to be a drop in replacement for Ogg::Vorbis::Header,
 636 implemented entirely in Perl.  It provides an object-oriented interface to
 637 Ogg Vorbis information and comment fields.  (NOTE: This module currently
 638 supports only read operations).
 639
 640 =head1 CONSTRUCTORS
 641
 642 =head2 C<new ($filename)>
 643
 644 Opens an Ogg Vorbis file, ensuring that it exists and is actually an
 645 Ogg Vorbis stream.  This method does not actually read any of the
 646 information or comment fields, and closes the file immediately.
 647
 648 =head2 C<load ([$filename])>
 649
 650 Opens an Ogg Vorbis file, ensuring that it exists and is actually an
 651 Ogg Vorbis stream, then loads the information and comment fields.  This
 652 method can also be used without a filename to load the information
 653 and fields of an already constructed instance.
 654
 655 =head1 INSTANCE METHODS
 656
 657 =head2 C<info ([$key])>
 658
 659 Returns a hashref containing information about the Ogg Vorbis file from
 660 the file's information header.  Hash fields are: version, channels, rate,
 661 bitrate_upper, bitrate_nominal, bitrate_lower, bitrate_window, and length.
 662 The bitrate_window value is not currently used by the vorbis codec, and
 663 will always be -1.
 664
 665 The optional parameter, key, allows you to retrieve a single value from
 666 the object's hash.  Returns C<undef> if the key is not found.
 667
 668 =head2 C<comment_tags ()>
 669
 670 Returns an array containing the key values for the comment fields.
 671 These values can then be passed to C<comment> to retrieve their values.
 672
 673 =head2 C<comment ($key)>
 674
 675 Returns an array of comment values associated with the given key.
 676
 677 =head2 C<add_comments ($key, $value, [$key, $value, ...])>
 678
 679 Unimplemented.
 680
 681 =head2 C<edit_comment ($key, $value, [$num])>
 682
 683 Unimplemented.
 684
 685 =head2 C<delete_comment ($key, [$num])>
 686
 687 Unimplemented.
 688
 689 =head2 C<clear_comments ([@keys])>
 690
 691 Unimplemented.
 692
 693 =head2 C<write_vorbis ()>
 694
 695 Unimplemented.
 696
 697 =head2 C<path ()>
 698
 699 Returns the path/filename of the file the object represents.
 700
 701 =head1 NOTE
 702
 703 This is ALPHA SOFTWARE.  It may very well be very broken.  Do not use it in
 704 a production environment.  You have been warned.
 705
 706 =head1 ACKNOWLEDGEMENTS
 707
 708 Dave Brown <cpan@dagbrown.com> made this module significantly faster
 709 at calculating the length of ogg files.
 710
 711 Robert Moser II <rlmoser@earthlink.net> fixed a problem with files that
 712 have no comments.
 713
 714 =head1 AUTHOR
 715
 716 Andrew Molloy E<lt>amolloy@kaizolabs.comE<gt>
 717
 718 =head1 COPYRIGHT
 719
 720 Copyright (c) 2003, Andrew Molloy.  All Rights Reserved.
 721
 722 This program is free software; you can redistribute it and/or modify it
 723 under the terms of the GNU General Public License as published by the
 724 Free Software Foundation; either version 2 of the License, or (at
 725 your option) any later version.  A copy of this license is included
 726 with this module (LICENSE.GPL).
 727
 728 =head1 SEE ALSO
 729
 730 L<Ogg::Vorbis::Header>, L<Ogg::Vorbis::Decoder>
 731
 732 =cut