# $Id: Ogg.pm,v 1.6 2003/12/14 23:52:04 ianb Exp $
package MP3::Archive::Lint::Tools::Ogg;

use strict;
use warnings;

use vars qw(@ISA $VERSION);
@ISA = qw(MP3::Archive::Lint::Tool);
$VERSION = '0.01';

=head1 ogg - Tool to check .ogg files

Checks Ogg Vorbis files. Requires the program C<ogginfo>, available
from L<http:E<sol>E<sol>www.vorbis.comE<sol>download_unix.psp>

On debian systems, it can be installed by typing
C<apt-get install vorbis-tools> as root.

=head2 Tests

=over 4

=cut

sub new
{
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my $opts=shift;
	my $self=$class->SUPER::new($opts);;
	bless($self,$class);

	$self->{cmd}=$self->findprogram("ogginfo");
	unless (defined $self->{cmd})
	{
		$self->say("ogginfo not found,tests skipped");
		return $self;
	}

	if($self->config->quickscan)
	{
		$self->debug("quick mode enabled, tests skipped");
		return $self;
	}

	$self->settests("header","short","tags","tracknum","artist","album","track",
					"serial","bitrate","samplerate","channels","stream");

	return $self;
}


sub initscan
{
	my $self=shift;

	return 0 unless (defined($self->{tests}) && scalar(@{$self->{tests}}));
	return 0 unless($self->{filename}=~/\.ogg$/i);
	return 0 if (-z $self->{file});	
	return 0 if (-d $self->{file});	

	unless(open(I,"$self->{cmd} $self->{qfile} 2>/dev/null |"))
	{
		$self->say("cannot run ogginfo:$!");
		return;
	}

	@{$self->{ogginfo}}=<I>;
	chomp(@{$self->{ogginfo}});
	
	unless(close(I)) # ogginfo returned nonzero
	{
		# fake message from stream
		$self->say("stream:ogg corrupt");
	}
}

=item B<header>

Tests integrity of Ogg header.	

=cut

sub header
{
	my $self=shift;
	if(scalar(grep(/(?:header_integrity=fail|could not decode vorbis header|Vorbis stream \d+ does not have headers|Invalid header page)/i,@{$self->{ogginfo}})))
	{
		$self->say("integrity failure");
	}
}

=item B<short>

Tests if Ogg is truncated.

=cut

sub short
{
	my $self=shift;
	if(scalar(grep(/(?:stream_truncated=true|EOS not set)/i,@{$self->{ogginfo}})))
	{
		$self->say("ogg truncated");
	}
}

=item B<tags>

Tests for corrupt comment tags

=cut

sub tags
{
	my $self=shift;
	if(scalar(grep(/(?:Invalid comment fieldname|Illegal UTF-8 sequence)/i,@{$self->{ogginfo}})))
	{
		$self->say("corrupt comment tag");
	}
}

	
=item B<tracknum>

Tests if Ogg has a TRACKNUMBER comment, that it is a number, and
matches the filename. If the B<-n> option is given to mp3lint, this
test only checks that the tracknum is a valid number, not that it
matches the filename.

=cut

sub tracknum
{
	my $self=shift;

	return unless($self->isalbum());
	
	my $found=0;
	my $filenum;
	for my $line (@{$self->{ogginfo}})
	{
		if($line=~/^\s*TRACKNUMBER=(.*)/)
		{
			$found++;
			my $num=$1;
			if($num!~/^\d+$/)
			{
				$self->say("not a number");
			}
			elsif((!$self->config->skipnametests()) &&
				  ($filenum=$self->config->archive->tracknum($self->{pathfilename})))
			{
				if($num != $filenum)
				{
					$self->say("file/comment mismatch:$num");
				}
			}
		}
	}
	if(!$found)
	{
		$self->say("no TRACKNUMBER comment");
	}
}

=item B<artist>

Tests if Ogg has a ARTIST comment, and that it matches the filename.
The filename test is suppressed if the B<-n> option is given to
mp3lint.

=cut

sub artist
{
	my $self=shift;
	my $found=0;
	for my $line (@{$self->{ogginfo}})
	{
		if($line=~/^\s*ARTIST=(.*)/)
		{
			$found++;
			if(!$self->config->skipnametests())
			{
				my $artist=$1;
				my $fileartist;
				if($fileartist=$self->config->archive->artist($self->{pathfilename}))
				{
					if($artist ne $fileartist)
					{
						$self->say("file/comment mismatch:$artist");
					}
				}
			}
		}
	}
	if(!$found)
	{
		$self->say("no ARTIST comment");
	}
}

=item B<album>

Tests if Ogg has a ALBUM comment, and that it matches the filename.
The filename test is suppressed if the B<-n> option is given to
mp3lint.

=cut

sub album
{
	my $self=shift;

	return unless($self->isalbum());

	my $found=0;
	for my $line (@{$self->{ogginfo}})
	{
		if($line=~/^\s*ALBUM=(.*)/)
		{
			$found++;
			if(!$self->config->skipnametests())
			{
				my $album=$1;
				my $filealbum;
				if($filealbum=$self->config->archive->album($self->{pathfilename}))
				{
					if($album ne $filealbum)
					{
						$self->say("file/comment mismatch:$album");
					}
				}
			}
		}
	}
	if(!$found)
	{
		$self->say("no ALBUM comment");
	}
}

=item B<track>

Tests if Ogg has a TITLE comment (track name), and that it matches the
filename.  The filename test is suppressed if the B<-n> option is
given to mp3lint.

=cut

sub track
{
	my $self=shift;
	my $found=0;
	for my $line (@{$self->{ogginfo}})
	{
		if($line=~/^\s*TITLE=(.*)/)
		{
			$found++;
			if(!$self->config->skipnametests())
			{
				my $track=$1;
				my $filetrack;
				if($filetrack=$self->config->archive->track($self->{pathfilename}))
				{
					if($track ne $filetrack)
					{
						$self->say("file/comment mismatch:$track");
					}
				}
			}
		}
	}
	if(!$found)
	{
		$self->say("no TITLE comment");
	}
}

=item B<serial>

Tests if Ogg has multiple streams in it by the presence of multiple
serial numbers.

=cut

sub serial
{
	my $self=shift;

	my $count=scalar(grep(/^(?:\s*serial=|.*stream.*serial\:)/,@{$self->{ogginfo}}));
	if($count>1)
	{
		$self->say("multiple streams:$count");
	}
}

=item B<bitrate>

Tests Ogg nominal (requested) bitrate is at least $lint_minbitrate_ogg
kbps.

Variables:

=over 4

=item $lint_minbitrate_ogg

(number, default 100 kbps)

=back

=cut

sub bitrate
{
	my $self=shift;
	my $minbitrate=$self->config->get("lint_minbitrate_ogg");
	if($minbitrate<1000)
	{
		$minbitrate *= 1000;
	}
	for my $line (@{$self->{ogginfo}})
	{
		# go for nominal (intended) not average (actual)
		if($line=~/bitrate_nominal=(.*)/)
		{
			my $nominal=$1;
			if($nominal<$minbitrate)
			{
				$self->say(sprintf("%s%.2fkbps (min %.2fkbps)","low bitrate:",$nominal/1000,$minbitrate/1000));
			}
		}
		elsif($line=~/Nominal\s+bitrate:\s+([\d\.]+)/i)
		{
			my $nominal=$1;
			$nominal *= 1000; # convert to bps
			$nominal=sprintf("%.0f",$nominal);
			if($nominal<$minbitrate)
			{
				$self->say(sprintf("%s%.2fkbps (min %.2fkbps)","low bitrate:",$nominal/1000,$minbitrate/1000));
			}
		}
	}
}

=item B<channels>

Tests if Ogg is stereo.

=cut

sub channels
{
	my $self=shift;
	for my $line (@{$self->{ogginfo}})
	{
		if($line=~/channels(?:=|:)\s*(\d+)/i)
		{
			my $channels=$1;
			if($channels==1)
			{
				$self->say("mono");
			}
			elsif($channels!=2)
			{
				$self->say("not stereo:$channels channels");
			}
		}
	}
}


=item B<samplerate>

Tests Ogg samplerate is at least $lint_minsamplerate Hz.

Variables:

=over 4

=item $lint_minsamplerate

(number, default 44100 Hz)

=back

=cut

sub samplerate
{
	my $self=shift;
	my $minsamplerate=$self->config->get("lint_minsamplerate");
	for my $line (@{$self->{ogginfo}})
	{
		if($line=~/^\s*rate(?:=|:)\s*(\d+)/i)
		{
			if($1 < $minsamplerate)
			{
				$self->say("low samplerate:$1 (min $minsamplerate)");
			}
		}
	}
}


=item B<stream>

Tests integrity of Ogg stream[s] in file.

=cut

sub stream
{
	my $self=shift;
	for my $line (@{$self->{ogginfo}})
	{
		if($line=~/(?:stream_integrity=fail|Warning: granulepos|Hole in data|Illegally placed page|Warning: stream start flag|sequence number gap|Input probably not ogg)/i)
		{
			$self->say("integrity failure");
			last;
		}
	}
}

=back

=head2 Bugs

Does not yet handle flac files embedded in .ogg files.

=cut

#filename=Hydrate-Kenny_Beltrey.ogg
#
#serial=6109
#header_integrity=pass
#TITLE=Hydrate - Kenny Beltrey
#ARTIST=Kenny Beltrey
#ALBUM=Favorite Things
#DATE=2002
#COMMENT=http://www.kahvi.org
#TRACKNUMBER=2
#vendor=Xiph.Org libVorbis I 20020713
#version=0
#channels=2
#rate=44100
#bitrate_upper=0
#bitrate_nominal=128003
#bitrate_lower=0
#stream_integrity=pass
#bitrate_average=117573
#length=264.568163
#playtime=4:24
#stream_truncated=false
#
#total_length=264.568163
#total_playtime=4:24


1;