Re-adding songdb.pl with support for tagcache. Works with mp3 and has partial support for ogg.
git-svn-id: svn://svn.rockbox.org/rockbox/trunk@10150 a1c6a512-1295-4272-9138-f99709370657
This commit is contained in:
Hardeep Sidhu
parent
71cf604d8d
commit
4e88de837e
3 changed files with 3364 additions and 0 deletions
2184
tools/mp3info.pm
Executable file
2184
tools/mp3info.pm
Executable file
File diff suppressed because it is too large
Load diff
448
tools/songdb.pl
Executable file
448
tools/songdb.pl
Executable file
|
|
@ -0,0 +1,448 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# Rockbox song database docs:
|
||||
# http://www.rockbox.org/twiki/bin/view/Main/TagCache
|
||||
#
|
||||
|
||||
use mp3info;
|
||||
use vorbiscomm;
|
||||
|
||||
# configuration settings
|
||||
my $db = "tagcache";
|
||||
my $dir;
|
||||
my $strip;
|
||||
my $add;
|
||||
my $verbose;
|
||||
my $help;
|
||||
my $dirisalbum;
|
||||
my $littleendian = 0;
|
||||
my $dbver = 0x54434804;
|
||||
|
||||
# file data
|
||||
my %entries;
|
||||
|
||||
while($ARGV[0]) {
|
||||
if($ARGV[0] eq "--path") {
|
||||
$dir = $ARGV[1];
|
||||
shift @ARGV;
|
||||
shift @ARGV;
|
||||
}
|
||||
elsif($ARGV[0] eq "--db") {
|
||||
$db = $ARGV[1];
|
||||
shift @ARGV;
|
||||
shift @ARGV;
|
||||
}
|
||||
elsif($ARGV[0] eq "--strip") {
|
||||
$strip = $ARGV[1];
|
||||
shift @ARGV;
|
||||
shift @ARGV;
|
||||
}
|
||||
elsif($ARGV[0] eq "--add") {
|
||||
$add = $ARGV[1];
|
||||
shift @ARGV;
|
||||
shift @ARGV;
|
||||
}
|
||||
elsif($ARGV[0] eq "--dirisalbum") {
|
||||
$dirisalbum = 1;
|
||||
shift @ARGV;
|
||||
}
|
||||
elsif($ARGV[0] eq "--littleendian") {
|
||||
$littleendian = 1;
|
||||
shift @ARGV;
|
||||
}
|
||||
elsif($ARGV[0] eq "--verbose") {
|
||||
$verbose = 1;
|
||||
shift @ARGV;
|
||||
}
|
||||
elsif($ARGV[0] eq "--help" or ($ARGV[0] eq "-h")) {
|
||||
$help = 1;
|
||||
shift @ARGV;
|
||||
}
|
||||
else {
|
||||
shift @ARGV;
|
||||
}
|
||||
}
|
||||
|
||||
if(! -d $dir or $help) {
|
||||
print "'$dir' is not a directory\n" if ($dir ne "" and ! -d $dir);
|
||||
print <<MOO
|
||||
|
||||
songdb --path <dir> [--db <file>] [--strip <path>] [--add <path>] [--dirisalbum] [--littleendian] [--verbose] [--help]
|
||||
|
||||
Options:
|
||||
|
||||
--path <dir> Where your music collection is found
|
||||
--db <file> Prefix for output files. Defaults to tagcache.
|
||||
--strip <path> Removes this string from the left of all file names
|
||||
--add <path> Adds this string to the left of all file names
|
||||
--dirisalbum Use dir name as album name if the album name is missing in the
|
||||
tags
|
||||
--littleendian Write out data as little endian (for simulator)
|
||||
--verbose Shows more details while working
|
||||
--help This text
|
||||
MOO
|
||||
;
|
||||
exit;
|
||||
}
|
||||
|
||||
sub get_oggtag {
|
||||
my $fn = shift;
|
||||
my %hash;
|
||||
|
||||
my $ogg = vorbiscomm->new($fn);
|
||||
|
||||
my $h= $ogg->load;
|
||||
|
||||
# Convert this format into the same format used by the id3 parser hash
|
||||
|
||||
foreach my $k ($ogg->comment_tags())
|
||||
{
|
||||
foreach my $cmmt ($ogg->comment($k))
|
||||
{
|
||||
my $n;
|
||||
if($k =~ /^artist$/i) {
|
||||
$n = 'ARTIST';
|
||||
}
|
||||
elsif($k =~ /^album$/i) {
|
||||
$n = 'ALBUM';
|
||||
}
|
||||
elsif($k =~ /^title$/i) {
|
||||
$n = 'TITLE';
|
||||
}
|
||||
$hash{$n}=$cmmt if($n);
|
||||
}
|
||||
}
|
||||
|
||||
return \%hash;
|
||||
}
|
||||
|
||||
sub get_ogginfo {
|
||||
my $fn = shift;
|
||||
my %hash;
|
||||
|
||||
my $ogg = vorbiscomm->new($fn);
|
||||
|
||||
my $h= $ogg->load;
|
||||
|
||||
return $ogg->{'INFO'};
|
||||
}
|
||||
|
||||
# return ALL directory entries in the given dir
|
||||
sub getdir {
|
||||
my ($dir) = @_;
|
||||
|
||||
$dir =~ s|/$|| if ($dir ne "/");
|
||||
|
||||
if (opendir(DIR, $dir)) {
|
||||
my @all = readdir(DIR);
|
||||
closedir DIR;
|
||||
return @all;
|
||||
}
|
||||
else {
|
||||
warn "can't opendir $dir: $!\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub extractmp3 {
|
||||
my ($dir, @files) = @_;
|
||||
my @mp3;
|
||||
for(@files) {
|
||||
if( (/\.mp[23]$/i || /\.ogg$/i) && -f "$dir/$_" ) {
|
||||
push @mp3, $_;
|
||||
}
|
||||
}
|
||||
return @mp3;
|
||||
}
|
||||
|
||||
sub extractdirs {
|
||||
my ($dir, @files) = @_;
|
||||
$dir =~ s|/$||;
|
||||
my @dirs;
|
||||
for(@files) {
|
||||
if( -d "$dir/$_" && ($_ !~ /^\.(|\.)$/)) {
|
||||
push @dirs, $_;
|
||||
}
|
||||
}
|
||||
return @dirs;
|
||||
}
|
||||
|
||||
sub singlefile {
|
||||
my ($file) = @_;
|
||||
my $hash;
|
||||
my $info;
|
||||
|
||||
if($file =~ /\.ogg$/i) {
|
||||
$hash = get_oggtag($file);
|
||||
$info = get_ogginfo($file);
|
||||
}
|
||||
else {
|
||||
$hash = get_mp3tag($file);
|
||||
$info = get_mp3info($file);
|
||||
if (defined $$info{'BITRATE'}) {
|
||||
$$hash{'BITRATE'} = $$info{'BITRATE'};
|
||||
}
|
||||
|
||||
if (defined $$info{'SECS'}) {
|
||||
$$hash{'SECS'} = $$info{'SECS'};
|
||||
}
|
||||
}
|
||||
|
||||
return $hash;
|
||||
}
|
||||
|
||||
sub dodir {
|
||||
my ($dir)=@_;
|
||||
|
||||
my %lcartists;
|
||||
my %lcalbums;
|
||||
|
||||
print "$dir\n";
|
||||
|
||||
# getdir() returns all entries in the given dir
|
||||
my @a = getdir($dir);
|
||||
|
||||
# extractmp3 filters out only the mp3 files from all given entries
|
||||
my @m = extractmp3($dir, @a);
|
||||
|
||||
my $f;
|
||||
|
||||
for $f (sort @m) {
|
||||
|
||||
my $id3 = singlefile("$dir/$f");
|
||||
|
||||
if (not defined $$id3{'ARTIST'} or $$id3{'ARTIST'} eq "") {
|
||||
$$id3{'ARTIST'} = "<Untagged>";
|
||||
}
|
||||
|
||||
# Only use one case-variation of each artist
|
||||
if (exists($lcartists{lc($$id3{'ARTIST'})})) {
|
||||
$$id3{'ARTIST'} = $lcartists{lc($$id3{'ARTIST'})};
|
||||
}
|
||||
else {
|
||||
$lcartists{lc($$id3{'ARTIST'})} = $$id3{'ARTIST'};
|
||||
}
|
||||
#printf "Artist: %s\n", $$id3{'ARTIST'};
|
||||
|
||||
if (not defined $$id3{'ALBUM'} or $$id3{'ALBUM'} eq "") {
|
||||
$$id3{'ALBUM'} = "<Untagged>";
|
||||
if ($dirisalbum) {
|
||||
$$id3{'ALBUM'} = $dir;
|
||||
}
|
||||
}
|
||||
|
||||
# Only use one case-variation of each album
|
||||
if (exists($lcalbums{lc($$id3{'ALBUM'})})) {
|
||||
$$id3{'ALBUM'} = $lcalbums{lc($$id3{'ALBUM'})};
|
||||
}
|
||||
else {
|
||||
$lcalbums{lc($$id3{'ALBUM'})} = $$id3{'ALBUM'};
|
||||
}
|
||||
#printf "Album: %s\n", $$id3{'ALBUM'};
|
||||
|
||||
if (not defined $$id3{'GENRE'} or $$id3{'GENRE'} eq "") {
|
||||
$$id3{'GENRE'} = "<Untagged>";
|
||||
}
|
||||
#printf "Genre: %s\n", $$id3{'GENRE'};
|
||||
|
||||
if (not defined $$id3{'TITLE'} or $$id3{'TITLE'} eq "") {
|
||||
# fall back on basename of the file if no title tag.
|
||||
($$id3{'TITLE'} = $f) =~ s/\.\w+$//;
|
||||
}
|
||||
#printf "Title: %s\n", $$id3{'TITLE'};
|
||||
|
||||
my $path = "$dir/$f";
|
||||
if ($strip ne "" and $path =~ /^$strip(.*)/) {
|
||||
$path = $1;
|
||||
}
|
||||
|
||||
if ($add ne "") {
|
||||
$path = $add . $path;
|
||||
}
|
||||
#printf "Path: %s\n", $path;
|
||||
|
||||
if (not defined $$id3{'COMPOSER'} or $$id3{'COMPOSER'} eq "") {
|
||||
$$id3{'COMPOSER'} = "<Untagged>";
|
||||
}
|
||||
#printf "Composer: %s\n", $$id3{'COMPOSER'};
|
||||
|
||||
if (not defined $$id3{'YEAR'} or $$id3{'YEAR'} eq "") {
|
||||
$$id3{'YEAR'} = "-1";
|
||||
}
|
||||
#printf "Year: %s\n", $$id3{'YEAR'};
|
||||
|
||||
if (not defined $$id3{'TRACKNUM'} or $$id3{'TRACKNUM'} eq "") {
|
||||
$$id3{'TRACKNUM'} = "-1";
|
||||
}
|
||||
#printf "Track num: %s\n", $$id3{'TRACKNUM'};
|
||||
|
||||
if (not defined $$id3{'BITRATE'} or $$id3{'BITRATE'} eq "") {
|
||||
$$id3{'BITRATE'} = "-1";
|
||||
}
|
||||
#printf "Bitrate: %s\n", $$id3{'BITRATE'};
|
||||
|
||||
if (not defined $$id3{'SECS'} or $$id3{'SECS'} eq "") {
|
||||
$$id3{'SECS'} = "-1";
|
||||
}
|
||||
#printf "Length: %s\n", $$id3{'SECS'};
|
||||
|
||||
$$id3{'PATH'} = $path;
|
||||
$entries{$path} = $id3;
|
||||
}
|
||||
|
||||
# extractdirs filters out only subdirectories from all given entries
|
||||
my @d = extractdirs($dir, @a);
|
||||
my $d;
|
||||
|
||||
for $d (sort @d) {
|
||||
$dir =~ s|/$||;
|
||||
dodir("$dir/$d");
|
||||
}
|
||||
}
|
||||
|
||||
use_mp3_utf8(1);
|
||||
dodir($dir);
|
||||
print "\n";
|
||||
|
||||
sub dumpshort {
|
||||
my ($num)=@_;
|
||||
|
||||
# print "int: $num\n";
|
||||
|
||||
if ($littleendian) {
|
||||
print DB pack "v", $num;
|
||||
}
|
||||
else {
|
||||
print DB pack "n", $num;
|
||||
}
|
||||
}
|
||||
|
||||
sub dumpint {
|
||||
my ($num)=@_;
|
||||
|
||||
# print "int: $num\n";
|
||||
|
||||
if ($littleendian) {
|
||||
print DB pack "V", $num;
|
||||
}
|
||||
else {
|
||||
print DB pack "N", $num;
|
||||
}
|
||||
}
|
||||
|
||||
sub dump_tag_string {
|
||||
my ($s, $index) = @_;
|
||||
|
||||
my $strlen = length($s)+1;
|
||||
my $padding = $strlen%4;
|
||||
if ($padding > 0) {
|
||||
$padding = 4 - $padding;
|
||||
$strlen += $padding;
|
||||
}
|
||||
|
||||
dumpshort($strlen);
|
||||
dumpshort($index);
|
||||
print DB $s."\0";
|
||||
|
||||
for (my $i = 0; $i < $padding; $i++) {
|
||||
print DB "X";
|
||||
}
|
||||
}
|
||||
|
||||
sub dump_tag_header {
|
||||
my ($entry_count) = @_;
|
||||
|
||||
my $size = tell(DB) - 12;
|
||||
seek(DB, 0, 0);
|
||||
|
||||
dumpint($dbver);
|
||||
dumpint($size);
|
||||
dumpint($entry_count);
|
||||
}
|
||||
|
||||
sub openfile {
|
||||
my ($f) = @_;
|
||||
open(DB, "> $f") || die "couldn't open $f";
|
||||
binmode(DB);
|
||||
}
|
||||
|
||||
sub create_tagcache_index_file {
|
||||
my ($index, $key, $unique) = @_;
|
||||
|
||||
my $num = 0;
|
||||
my $prev = "";
|
||||
my $offset = 12;
|
||||
|
||||
openfile $db ."_".$index.".tcd";
|
||||
dump_tag_header(0);
|
||||
|
||||
for(sort {uc($entries{$a}->{$key}) cmp uc($entries{$b}->{$key})} keys %entries) {
|
||||
if (!$unique || !($entries{$_}->{$key} eq $prev)) {
|
||||
my $index;
|
||||
|
||||
$num++;
|
||||
$prev = $entries{$_}->{$key};
|
||||
$offset = tell(DB);
|
||||
printf(" %s\n", $prev) if ($verbose);
|
||||
|
||||
if ($unique) {
|
||||
$index = 0xFFFF;
|
||||
}
|
||||
else {
|
||||
$index = $entries{$_}->{'INDEX'};
|
||||
}
|
||||
dump_tag_string($prev, $index);
|
||||
}
|
||||
$entries{$_}->{$key."_OFFSET"} = $offset;
|
||||
}
|
||||
|
||||
dump_tag_header($num);
|
||||
close(DB);
|
||||
}
|
||||
|
||||
if (!scalar keys %entries) {
|
||||
print "No songs found. Did you specify the right --path ?\n";
|
||||
print "Use the --help parameter to see all options.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my $i = 0;
|
||||
for (sort keys %entries) {
|
||||
$entries{$_}->{'INDEX'} = $i;
|
||||
$i++;
|
||||
}
|
||||
|
||||
if ($db) {
|
||||
# Artists
|
||||
create_tagcache_index_file(0, 'ARTIST', 1);
|
||||
# Albums
|
||||
create_tagcache_index_file(1, 'ALBUM', 1);
|
||||
# Genres
|
||||
create_tagcache_index_file(2, 'GENRE', 1);
|
||||
# Titles
|
||||
create_tagcache_index_file(3, 'TITLE', 0);
|
||||
# Filenames
|
||||
create_tagcache_index_file(4, 'PATH', 0);
|
||||
# Composers
|
||||
create_tagcache_index_file(5, 'COMPOSER', 1);
|
||||
|
||||
# Master index file
|
||||
openfile $db ."_idx.tcd";
|
||||
dump_tag_header(0);
|
||||
|
||||
for (sort keys %entries) {
|
||||
dumpint($entries{$_}->{'ARTIST_OFFSET'});
|
||||
dumpint($entries{$_}->{'ALBUM_OFFSET'});
|
||||
dumpint($entries{$_}->{'GENRE_OFFSET'});
|
||||
dumpint($entries{$_}->{'TITLE_OFFSET'});
|
||||
dumpint($entries{$_}->{'PATH_OFFSET'});
|
||||
dumpint($entries{$_}->{'COMPOSER_OFFSET'});
|
||||
dumpint($entries{$_}->{'YEAR'});
|
||||
dumpint($entries{$_}->{'TRACKNUM'});
|
||||
dumpint($entries{$_}->{'BITRATE'});
|
||||
dumpint($entries{$_}->{'SECS'});
|
||||
dumpint(0);
|
||||
}
|
||||
|
||||
dump_tag_header(scalar keys %entries);
|
||||
close(DB);
|
||||
}
|
||||
732
tools/vorbiscomm.pm
Normal file
732
tools/vorbiscomm.pm
Normal file
|
|
@ -0,0 +1,732 @@
|
|||
#############################################################################
|
||||
# This is
|
||||
# http://search.cpan.org/~amolloy/Ogg-Vorbis-Header-PurePerl-0.07/PurePerl.pm
|
||||
# written by Andrew Molloy
|
||||
# Code under GNU GENERAL PUBLIC LICENCE v2
|
||||
# $Id$
|
||||
#############################################################################
|
||||
|
||||
package vorbiscomm;
|
||||
|
||||
use 5.005;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Fcntl qw/SEEK_END/;
|
||||
|
||||
our $VERSION = '0.07';
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $file = shift;
|
||||
|
||||
return load($class, $file);
|
||||
}
|
||||
|
||||
sub load
|
||||
{
|
||||
my $class = shift;
|
||||
my $file = shift;
|
||||
my $from_new = shift;
|
||||
my %data;
|
||||
my $self;
|
||||
|
||||
# there must be a better way...
|
||||
if ($class eq 'vorbiscomm')
|
||||
{
|
||||
$self = bless \%data, $class;
|
||||
}
|
||||
else
|
||||
{
|
||||
$self = $class;
|
||||
}
|
||||
|
||||
if ($self->{'FILE_LOADED'})
|
||||
{
|
||||
return $self;
|
||||
}
|
||||
|
||||
$self->{'FILE_LOADED'} = 1;
|
||||
|
||||
# check that the file exists and is readable
|
||||
unless ( -e $file && -r _ )
|
||||
{
|
||||
warn "File does not exist or cannot be read.";
|
||||
# file does not exist, can't do anything
|
||||
return undef;
|
||||
}
|
||||
# open up the file
|
||||
open FILE, $file;
|
||||
# make sure dos-type systems can handle it...
|
||||
binmode FILE;
|
||||
|
||||
$data{'filename'} = $file;
|
||||
$data{'fileHandle'} = \*FILE;
|
||||
|
||||
if (_init(\%data)) {
|
||||
_loadInfo(\%data);
|
||||
_loadComments(\%data);
|
||||
_calculateTrackLength(\%data);
|
||||
}
|
||||
|
||||
close FILE;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub info
|
||||
{
|
||||
my $self = shift;
|
||||
my $key = shift;
|
||||
|
||||
# if the user did not supply a key, return the entire hash
|
||||
unless ($key)
|
||||
{
|
||||
return $self->{'INFO'};
|
||||
}
|
||||
|
||||
# otherwise, return the value for the given key
|
||||
return $self->{'INFO'}{lc $key};
|
||||
}
|
||||
|
||||
sub comment_tags
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
if ( $self && $self->{'COMMENT_KEYS'} ) {
|
||||
return @{$self->{'COMMENT_KEYS'}};
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub comment
|
||||
{
|
||||
my $self = shift;
|
||||
my $key = shift;
|
||||
|
||||
# if the user supplied key does not exist, return undef
|
||||
unless($self->{'COMMENTS'}{lc $key})
|
||||
{
|
||||
return undef;
|
||||
}
|
||||
|
||||
return @{$self->{'COMMENTS'}{lc $key}};
|
||||
}
|
||||
|
||||
sub add_comments
|
||||
{
|
||||
warn "Ogg::Vorbis::Header::PurePerl add_comments() unimplemented.";
|
||||
}
|
||||
|
||||
sub edit_comment
|
||||
{
|
||||
warn "Ogg::Vorbis::Header::PurePerl edit_comment() unimplemented.";
|
||||
}
|
||||
|
||||
sub delete_comment
|
||||
{
|
||||
warn "Ogg::Vorbis::Header::PurePerl delete_comment() unimplemented.";
|
||||
}
|
||||
|
||||
sub clear_comments
|
||||
{
|
||||
warn "Ogg::Vorbis::Header::PurePerl clear_comments() unimplemented.";
|
||||
}
|
||||
|
||||
sub path
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
return $self->{'fileName'};
|
||||
}
|
||||
|
||||
sub write_vorbis
|
||||
{
|
||||
warn "Ogg::Vorbis::Header::PurePerl write_vorbis unimplemented.";
|
||||
}
|
||||
|
||||
# "private" methods
|
||||
|
||||
sub _init
|
||||
{
|
||||
my $data = shift;
|
||||
my $fh = $data->{'fileHandle'};
|
||||
my $byteCount = 0;
|
||||
|
||||
# check the header to make sure this is actually an Ogg-Vorbis file
|
||||
$byteCount = _checkHeader($data);
|
||||
|
||||
unless($byteCount)
|
||||
{
|
||||
# if it's not, we can't do anything
|
||||
return undef;
|
||||
}
|
||||
|
||||
$data->{'startInfoHeader'} = $byteCount;
|
||||
return 1; # Success
|
||||
}
|
||||
|
||||
sub _checkHeader
|
||||
{
|
||||
my $data = shift;
|
||||
my $fh = $data->{'fileHandle'};
|
||||
my $buffer;
|
||||
my $pageSegCount;
|
||||
my $byteCount = 0; # stores how far into the file we've read,
|
||||
# so later reads into the file can skip right
|
||||
# past all of the header stuff
|
||||
|
||||
# check that the first four bytes are 'OggS'
|
||||
read($fh, $buffer, 4);
|
||||
if ($buffer ne 'OggS')
|
||||
{
|
||||
warn "This is not an Ogg bitstream (no OggS header).";
|
||||
return undef;
|
||||
}
|
||||
$byteCount += 4;
|
||||
|
||||
# check the stream structure version (1 byte, should be 0x00)
|
||||
read($fh, $buffer, 1);
|
||||
if (ord($buffer) != 0x00)
|
||||
{
|
||||
warn "This is not an Ogg bitstream (invalid structure version).";
|
||||
return undef;
|
||||
}
|
||||
$byteCount += 1;
|
||||
|
||||
# check the header type flag
|
||||
# This is a bitfield, so technically we should check all of the bits
|
||||
# that could potentially be set. However, the only value this should
|
||||
# possibly have at the beginning of a proper Ogg-Vorbis file is 0x02,
|
||||
# so we just check for that. If it's not that, we go on anyway, but
|
||||
# give a warning (this behavior may (should?) be modified in the future.
|
||||
read($fh, $buffer, 1);
|
||||
if (ord($buffer) != 0x02)
|
||||
{
|
||||
warn "Invalid header type flag (trying to go ahead anyway).";
|
||||
}
|
||||
$byteCount += 1;
|
||||
|
||||
# skip to the page_segments count
|
||||
read($fh, $buffer, 20);
|
||||
$byteCount += 20;
|
||||
# we do nothing with this data
|
||||
|
||||
# read the number of page segments
|
||||
read($fh, $buffer, 1);
|
||||
$pageSegCount = ord($buffer);
|
||||
$byteCount += 1;
|
||||
|
||||
# read $pageSegCount bytes, then throw 'em out
|
||||
read($fh, $buffer, $pageSegCount);
|
||||
$byteCount += $pageSegCount;
|
||||
|
||||
# check packet type. Should be 0x01 (for indentification header)
|
||||
read($fh, $buffer, 1);
|
||||
if (ord($buffer) != 0x01)
|
||||
{
|
||||
warn "Wrong vorbis header type, giving up.";
|
||||
return undef;
|
||||
}
|
||||
$byteCount += 1;
|
||||
|
||||
# check that the packet identifies itself as 'vorbis'
|
||||
read($fh, $buffer, 6);
|
||||
if ($buffer ne 'vorbis')
|
||||
{
|
||||
warn "This does not appear to be a vorbis stream, giving up.";
|
||||
return undef;
|
||||
}
|
||||
$byteCount += 6;
|
||||
|
||||
# at this point, we assume the bitstream is valid
|
||||
return $byteCount;
|
||||
}
|
||||
|
||||
sub _loadInfo
|
||||
{
|
||||
my $data = shift;
|
||||
my $start = $data->{'startInfoHeader'};
|
||||
my $fh = $data->{'fileHandle'};
|
||||
my $buffer;
|
||||
my $byteCount = $start;
|
||||
my %info;
|
||||
|
||||
seek $fh, $start, 0;
|
||||
|
||||
# read the vorbis version
|
||||
read($fh, $buffer, 4);
|
||||
$info{'version'} = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# read the number of audio channels
|
||||
read($fh, $buffer, 1);
|
||||
$info{'channels'} = ord($buffer);
|
||||
$byteCount += 1;
|
||||
|
||||
# read the sample rate
|
||||
read($fh, $buffer, 4);
|
||||
$info{'rate'} = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# read the bitrate maximum
|
||||
read($fh, $buffer, 4);
|
||||
$info{'bitrate_upper'} = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# read the bitrate nominal
|
||||
read($fh, $buffer, 4);
|
||||
$info{'bitrate_nominal'} = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# read the bitrate minimal
|
||||
read($fh, $buffer, 4);
|
||||
$info{'bitrate_lower'} = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# read the blocksize_0 and blocksize_1
|
||||
read($fh, $buffer, 1);
|
||||
# these are each 4 bit fields, whose actual value is 2 to the power
|
||||
# of the value of the field
|
||||
$info{'blocksize_0'} = 2 << ((ord($buffer) & 0xF0) >> 4);
|
||||
$info{'blocksize_1'} = 2 << (ord($buffer) & 0x0F);
|
||||
$byteCount += 1;
|
||||
|
||||
# read the framing_flag
|
||||
read($fh, $buffer, 1);
|
||||
$info{'framing_flag'} = ord($buffer);
|
||||
$byteCount += 1;
|
||||
|
||||
# bitrate_window is -1 in the current version of vorbisfile
|
||||
$info{'bitrate_window'} = -1;
|
||||
|
||||
$data->{'startCommentHeader'} = $byteCount;
|
||||
|
||||
$data->{'INFO'} = \%info;
|
||||
}
|
||||
|
||||
sub _loadComments
|
||||
{
|
||||
my $data = shift;
|
||||
my $fh = $data->{'fileHandle'};
|
||||
my $start = $data->{'startCommentHeader'};
|
||||
my $buffer;
|
||||
my $page_segments;
|
||||
my $vendor_length;
|
||||
my $user_comment_count;
|
||||
my $byteCount = $start;
|
||||
my %comments;
|
||||
|
||||
seek $fh, $start, 0;
|
||||
|
||||
# check that the first four bytes are 'OggS'
|
||||
read($fh, $buffer, 4);
|
||||
if ($buffer ne 'OggS')
|
||||
{
|
||||
warn "No comment header?";
|
||||
return undef;
|
||||
}
|
||||
$byteCount += 4;
|
||||
|
||||
# skip over next ten bytes
|
||||
read($fh, $buffer, 10);
|
||||
$byteCount += 10;
|
||||
|
||||
# read the stream serial number
|
||||
read($fh, $buffer, 4);
|
||||
push @{$data->{'commentSerialNumber'}}, _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# read the page sequence number (should be 0x01)
|
||||
read($fh, $buffer, 4);
|
||||
if (_decodeInt($buffer) != 0x01)
|
||||
{
|
||||
warn "Comment header page sequence number is not 0x01: " +
|
||||
_decodeInt($buffer);
|
||||
warn "Going to keep going anyway.";
|
||||
}
|
||||
$byteCount += 4;
|
||||
|
||||
# and ignore the page checksum for now
|
||||
read($fh, $buffer, 4);
|
||||
$byteCount += 4;
|
||||
|
||||
# get the number of entries in the segment_table...
|
||||
read($fh, $buffer, 1);
|
||||
$page_segments = _decodeInt($buffer);
|
||||
$byteCount += 1;
|
||||
# then skip on past it
|
||||
read($fh, $buffer, $page_segments);
|
||||
$byteCount += $page_segments;
|
||||
|
||||
# check the header type (should be 0x03)
|
||||
read($fh, $buffer, 1);
|
||||
if (ord($buffer) != 0x03)
|
||||
{
|
||||
warn "Wrong header type: " . ord($buffer);
|
||||
}
|
||||
$byteCount += 1;
|
||||
|
||||
# now we should see 'vorbis'
|
||||
read($fh, $buffer, 6);
|
||||
if ($buffer ne 'vorbis')
|
||||
{
|
||||
warn "Missing comment header. Should have found 'vorbis', found " .
|
||||
$buffer;
|
||||
}
|
||||
$byteCount += 6;
|
||||
|
||||
# get the vendor length
|
||||
read($fh, $buffer, 4);
|
||||
$vendor_length = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# read in the vendor
|
||||
read($fh, $buffer, $vendor_length);
|
||||
$comments{'vendor'} = $buffer;
|
||||
$byteCount += $vendor_length;
|
||||
|
||||
# read in the number of user comments
|
||||
read($fh, $buffer, 4);
|
||||
$user_comment_count = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
$data->{'COMMENT_KEYS'} = [];
|
||||
|
||||
# finally, read the comments
|
||||
for (my $i = 0; $i < $user_comment_count; $i++)
|
||||
{
|
||||
# first read the length
|
||||
read($fh, $buffer, 4);
|
||||
my $comment_length = _decodeInt($buffer);
|
||||
$byteCount += 4;
|
||||
|
||||
# then the comment itself
|
||||
read($fh, $buffer, $comment_length);
|
||||
$byteCount += $comment_length;
|
||||
|
||||
my ($key) = $buffer =~ /^([^=]+)/;
|
||||
my ($value) = $buffer =~ /=(.*)$/;
|
||||
|
||||
push @{$comments{lc $key}}, $value;
|
||||
push @{$data->{'COMMENT_KEYS'}}, lc $key;
|
||||
}
|
||||
|
||||
# read past the framing_bit
|
||||
read($fh, $buffer, 1);
|
||||
$byteCount += 1;
|
||||
|
||||
$data->{'INFO'}{'offset'} = $byteCount;
|
||||
|
||||
$data->{'COMMENTS'} = \%comments;
|
||||
|
||||
# Now find the offset of the first page
|
||||
# with audio data.
|
||||
while(_findPage($fh))
|
||||
{
|
||||
$byteCount = tell($fh) - 4;
|
||||
|
||||
# version flag
|
||||
read($fh, $buffer, 1);
|
||||
if (ord($buffer) != 0x00)
|
||||
{
|
||||
warn "Invalid stream structure version: " .
|
||||
sprintf("%x", ord($buffer));
|
||||
return;
|
||||
}
|
||||
|
||||
# header type flag
|
||||
read($fh, $buffer, 1);
|
||||
# Audio data starts as a fresh packet on a new page, so
|
||||
# if header_type is odd it's not a fresh packet
|
||||
next if ( ord($buffer) % 2 );
|
||||
|
||||
# skip past granule position, stream_serial_number,
|
||||
# page_sequence_number, and crc
|
||||
read($fh, $buffer, 20);
|
||||
|
||||
# page_segments
|
||||
read($fh, $buffer, 1);
|
||||
my $page_segments = ord($buffer);
|
||||
|
||||
# skip past the segment table
|
||||
read($fh, $buffer, $page_segments);
|
||||
|
||||
# read packet_type byte
|
||||
read($fh, $buffer, 1);
|
||||
|
||||
# Not an audio packet. All audio packet numbers are even
|
||||
next if ( ord($buffer) % 2 );
|
||||
|
||||
# Found the first audio packet
|
||||
last;
|
||||
}
|
||||
|
||||
$data->{'INFO'}{'audio_offset'} = $byteCount;
|
||||
}
|
||||
|
||||
sub _calculateTrackLength
|
||||
{
|
||||
my $data = shift;
|
||||
my $fh = $data->{'fileHandle'};
|
||||
my $buffer;
|
||||
my $pageSize;
|
||||
my $granule_position;
|
||||
|
||||
seek($fh,-8500,SEEK_END); # that magic number is from vorbisfile.c
|
||||
# in the constant CHUNKSIZE, which comes
|
||||
# with the comment /* a shade over 8k;
|
||||
# anyone using pages well over 8k gets
|
||||
# what they deserve */
|
||||
|
||||
# we just keep looking through the headers until we get to the last one
|
||||
# (there might be a couple of blocks here)
|
||||
while(_findPage($fh))
|
||||
{
|
||||
# stream structure version - must be 0x00
|
||||
read($fh, $buffer, 1);
|
||||
if (ord($buffer) != 0x00)
|
||||
{
|
||||
warn "Invalid stream structure version: " .
|
||||
sprintf("%x", ord($buffer));
|
||||
return;
|
||||
}
|
||||
|
||||
# header type flag
|
||||
read($fh, $buffer, 1);
|
||||
# we should check this, but for now we'll just ignore it
|
||||
|
||||
# absolute granule position - this is what we need!
|
||||
read($fh, $buffer, 8);
|
||||
$granule_position = _decodeInt($buffer);
|
||||
|
||||
# skip past stream_serial_number, page_sequence_number, and crc
|
||||
read($fh, $buffer, 12);
|
||||
|
||||
# page_segments
|
||||
read($fh, $buffer, 1);
|
||||
my $page_segments = ord($buffer);
|
||||
|
||||
# reset pageSize
|
||||
$pageSize = 0;
|
||||
|
||||
# calculate approx. page size
|
||||
for (my $i = 0; $i < $page_segments; $i++)
|
||||
{
|
||||
read($fh, $buffer, 1);
|
||||
$pageSize += ord($buffer);
|
||||
}
|
||||
|
||||
seek $fh, $pageSize, 1;
|
||||
}
|
||||
|
||||
$data->{'INFO'}{'length'} =
|
||||
int($granule_position / $data->{'INFO'}{'rate'});
|
||||
}
|
||||
|
||||
sub _findPage
|
||||
{
|
||||
# search forward in the file for the 'OggS' page header
|
||||
my $fh = shift;
|
||||
my $char;
|
||||
my $curStr = '';
|
||||
|
||||
while (read($fh, $char, 1))
|
||||
{
|
||||
$curStr = $char . $curStr;
|
||||
$curStr = substr($curStr, 0, 4);
|
||||
|
||||
# we are actually looking for the string 'SggO' because we
|
||||
# tack character on to our test string backwards, to make
|
||||
# trimming it to 4 characters easier.
|
||||
if ($curStr eq 'SggO')
|
||||
{
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub _decodeInt
|
||||
{
|
||||
my $bytes = shift;
|
||||
my $num = 0;
|
||||
my @byteList = split //, $bytes;
|
||||
my $numBytes = @byteList;
|
||||
my $mult = 1;
|
||||
|
||||
for (my $i = 0; $i < $numBytes; $i ++)
|
||||
{
|
||||
$num += ord($byteList[$i]) * $mult;
|
||||
$mult *= 256;
|
||||
}
|
||||
|
||||
return $num;
|
||||
}
|
||||
|
||||
sub _decodeInt5Bit
|
||||
{
|
||||
my $byte = ord(shift);
|
||||
|
||||
$byte = $byte & 0xF8; # clear out the bottm 3 bits
|
||||
$byte = $byte >> 3; # and shifted down to where it belongs
|
||||
|
||||
return $byte;
|
||||
}
|
||||
|
||||
sub _decodeInt4Bit
|
||||
{
|
||||
my $byte = ord(shift);
|
||||
|
||||
$byte = $byte & 0xFC; # clear out the bottm 4 bits
|
||||
$byte = $byte >> 4; # and shifted down to where it belongs
|
||||
|
||||
return $byte;
|
||||
}
|
||||
|
||||
sub _ilog
|
||||
{
|
||||
my $x = shift;
|
||||
my $ret = 0;
|
||||
|
||||
unless ($x > 0)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
while ($x > 0)
|
||||
{
|
||||
$ret++;
|
||||
$x = $x >> 1;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
1;
|
||||
__DATA__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Ogg::Vorbis::Header::PurePerl - An object-oriented interface to Ogg Vorbis
|
||||
information and comment fields, implemented entirely in Perl. Intended to be
|
||||
a drop in replacement for Ogg::Vobis::Header.
|
||||
|
||||
Unlike Ogg::Vorbis::Header, this module will go ahead and fill in all of the
|
||||
information fields as soon as you construct the object. In other words,
|
||||
the C<new> and C<load> constructors have identical behavior.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Ogg::Vorbis::Header::PurePerl;
|
||||
my $ogg = Ogg::Vorbis::Header::PurePerl->new("song.ogg");
|
||||
while (my ($k, $v) = each %{$ogg->info}) {
|
||||
print "$k: $v\n";
|
||||
}
|
||||
foreach my $com ($ogg->comment_tags) {
|
||||
print "$com: $_\n" foreach $ogg->comment($com);
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is intended to be a drop in replacement for Ogg::Vorbis::Header,
|
||||
implemented entirely in Perl. It provides an object-oriented interface to
|
||||
Ogg Vorbis information and comment fields. (NOTE: This module currently
|
||||
supports only read operations).
|
||||
|
||||
=head1 CONSTRUCTORS
|
||||
|
||||
=head2 C<new ($filename)>
|
||||
|
||||
Opens an Ogg Vorbis file, ensuring that it exists and is actually an
|
||||
Ogg Vorbis stream. This method does not actually read any of the
|
||||
information or comment fields, and closes the file immediately.
|
||||
|
||||
=head2 C<load ([$filename])>
|
||||
|
||||
Opens an Ogg Vorbis file, ensuring that it exists and is actually an
|
||||
Ogg Vorbis stream, then loads the information and comment fields. This
|
||||
method can also be used without a filename to load the information
|
||||
and fields of an already constructed instance.
|
||||
|
||||
=head1 INSTANCE METHODS
|
||||
|
||||
=head2 C<info ([$key])>
|
||||
|
||||
Returns a hashref containing information about the Ogg Vorbis file from
|
||||
the file's information header. Hash fields are: version, channels, rate,
|
||||
bitrate_upper, bitrate_nominal, bitrate_lower, bitrate_window, and length.
|
||||
The bitrate_window value is not currently used by the vorbis codec, and
|
||||
will always be -1.
|
||||
|
||||
The optional parameter, key, allows you to retrieve a single value from
|
||||
the object's hash. Returns C<undef> if the key is not found.
|
||||
|
||||
=head2 C<comment_tags ()>
|
||||
|
||||
Returns an array containing the key values for the comment fields.
|
||||
These values can then be passed to C<comment> to retrieve their values.
|
||||
|
||||
=head2 C<comment ($key)>
|
||||
|
||||
Returns an array of comment values associated with the given key.
|
||||
|
||||
=head2 C<add_comments ($key, $value, [$key, $value, ...])>
|
||||
|
||||
Unimplemented.
|
||||
|
||||
=head2 C<edit_comment ($key, $value, [$num])>
|
||||
|
||||
Unimplemented.
|
||||
|
||||
=head2 C<delete_comment ($key, [$num])>
|
||||
|
||||
Unimplemented.
|
||||
|
||||
=head2 C<clear_comments ([@keys])>
|
||||
|
||||
Unimplemented.
|
||||
|
||||
=head2 C<write_vorbis ()>
|
||||
|
||||
Unimplemented.
|
||||
|
||||
=head2 C<path ()>
|
||||
|
||||
Returns the path/filename of the file the object represents.
|
||||
|
||||
=head1 NOTE
|
||||
|
||||
This is ALPHA SOFTWARE. It may very well be very broken. Do not use it in
|
||||
a production environment. You have been warned.
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS
|
||||
|
||||
Dave Brown <cpan@dagbrown.com> made this module significantly faster
|
||||
at calculating the length of ogg files.
|
||||
|
||||
Robert Moser II <rlmoser@earthlink.net> fixed a problem with files that
|
||||
have no comments.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Andrew Molloy E<lt>amolloy@kaizolabs.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2003, Andrew Molloy. All Rights Reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU General Public License as published by the
|
||||
Free Software Foundation; either version 2 of the License, or (at
|
||||
your option) any later version. A copy of this license is included
|
||||
with this module (LICENSE.GPL).
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Ogg::Vorbis::Header>, L<Ogg::Vorbis::Decoder>
|
||||
|
||||
=cut
|
||||
Loading…
Reference in a new issue