# $Id: Flac.pm,v 1.5 2003/12/14 09:43:56 ianb Exp $
package MP3::Archive::Lint::Tools::Flac;

use strict;
use warnings;

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

=head1 flac - Tool to check .flac files

Checks .flac files using B<flac> and B<metaflac> from the flac
distribution at L<http:E<sol>E<sol>flac.sourceforge.netE<sol>download.html>

It also uses L<md5sum(1)>, see L<mp3lint(1)> for more details on
needed software.

=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->{metaflac}=$self->findprogram("metaflac");
	$self->{flac}=$self->findprogram("flac");
	$self->{md5sum}=$self->findprogram("md5sum");
	unless (defined $self->{metaflac})
	{
		$self->debug("metaflac not found,tests skipped");
		return $self;
	}
	my @tests=("tracknum","artist","album","track","samplerate","samplesize","channels");
	if($self->config->quickscan)
	{
		$self->debug("quick mode enabled, skipping md5sum");
	}
	else
	{
		if(defined($self->{flac}))
		{
			if(defined($self->{md5sum}))
			{
				push(@tests,"md5sum");
			}
			else
			{
				$self->debug("md5sum not found, md5sum test skipped");
			}
		}
		else
		{
			$self->debug("flac not found, md5sum test skipped");
		}
	}

	$self->settests(@tests);

	return $self;
}


sub initscan
{
	my $self=shift;

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

	my $opts='--show-md5sum --show-sample-rate --show-bps --show-channels --export-vc-to=-';
	unless(open(I,"$self->{metaflac} $opts $self->{qfile} 2>/dev/null |"))
	{
		$self->say("cannot fork:$!");
		return 0;
	}

	my @output=<I>;
	unless(close(I)) # metaflac returned nonzero
	{
		$self->say("corrupt:flac corrupt");
		return 0;
	}

	chomp(@output);
	my $max=$#output;
	if($max < 3)
	{
		$self->say("corrupt:flac corrupt");
		return 0;
	}
	my $offset=0;
	%{$self->{flacinfo}}=();
	
	$self->{flacinfo}{md5sum}=$output[$offset++];
	$self->{flacinfo}{samplerate}=$output[$offset++];
	$self->{flacinfo}{bitsize}=$output[$offset++];
	$self->{flacinfo}{channels}=$output[$offset++];
	while($offset<=$max)
	{
		my($key,$val)=split(/=/,$output[$offset++]);
		$self->{flacinfo}{$key}=$val;
	}
		
	return 1;
}

=item B<tracknum>

Tests for presence of a vorbis TRACKNUMBER comment, and compares it to
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;
	if((exists($self->{flacinfo}{TRACKNUMBER})) &&
	   (defined($self->{flacinfo}{TRACKNUMBER})))
	{
		$found++;
		my $num=$self->{flacinfo}{TRACKNUMBER};
		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 for presence of a vorbis ARTIST comment, and compares it to 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;
	if((exists($self->{flacinfo}{ARTIST})) &&
	   (defined($self->{flacinfo}{ARTIST})))
	{
		$found++;
		if(!$self->config->skipnametests())
		{
			my $artist=$self->{flacinfo}{ARTIST};
			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 for presence of a vorbis ALBUM comment, and compares it to 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;
	if((exists($self->{flacinfo}{ALBUM})) &&
	   (defined($self->{flacinfo}{ALBUM})))
	{
		$found++;
		if(!$self->config->skipnametests())
		{
			my $album=$self->{flacinfo}{ALBUM};
			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 for presence of a vorbis TITLE comment (track name), and
compares it to 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;
	if((exists($self->{flacinfo}{TITLE})) &&
	   (defined($self->{flacinfo}{TITLE})))
	{
		$found++;
		if(!$self->config->skipnametests())
		{
			my $track=$self->{flacinfo}{TITLE};
			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<channels>

Tests if flac is stereo

=cut

sub channels
{
	my $self=shift;
	if((exists($self->{flacinfo}{channels})) &&
	   (defined($self->{flacinfo}{channels})))
	{
		my $channels=$self->{flacinfo}{channels};
		if($channels==1)
		{
			$self->say("mono");
		}
		elsif($channels!=2)
		{
			$self->say("not stereo:$channels channels");
		}
	}
}

=item B<samplerate>

Tests 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");
	if((exists($self->{flacinfo}{samplerate})) &&
	   (defined($self->{flacinfo}{samplerate})))
	{
		my $rate=$self->{flacinfo}{samplerate};
		if($rate < $minsamplerate)
		{
			$self->say("low samplerate:$rate (min $minsamplerate)");
		}
	}
}

=item B<samplesize>

Tests sample bitsize is at least $lint_minbitsize bits.

Variables:

=over 4

=item $lint_minbitsize

(number, default 16 bits)

=back

=cut

sub samplesize
{
	my $self=shift;
	my $min=$self->config->get("lint_minbitsize");
	my $actual=$self->{flacinfo}{bitsize};
	if($actual < $min)
	{
		$self->say("low bitsize:$actual (should be $min)");
	}
}

=item B<md5sum>

Decompresses and checksums audio using md5sum, and compares it to the
md5 checksum for the original data, stored in the STREAMINFO metadata block.

Assumes the original uncompressed audio was signed and little-endian.

=cut

sub md5sum
{
	my $self=shift;
	# Portability? works on i386 with data from sox on i386
	my $cmd=($self->{flac}.
			 " -d -c --force-raw-format --endian=little --sign=signed ".
			 $self->{qfile}.
			 " 2>/dev/null |".
			 $self->{md5sum}.
			 "|");

	unless(open(P,$cmd))
	{
		$self->say("cannot fork:$!");
		return;
	}
	my $line=<P>;
	if((!close(P)) ||(!defined($line)))
	{
		$self->say("problem running flac/md5sum:$!");
		return;
	}
	my $sum;
	if($line=~/^(\S+)/)
	{
		$sum=$1;
	}
	else
	{
		$self->say("error parsing md5sum output:$line");
	}

	if($sum ne $self->{flacinfo}{md5sum})
	{
		$self->say("checksum error - flac corrupt");
	}
}

=back

=head2 Bugs

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

Does not yet parse id3 tags. Although the reference implementation
only supports them to the extent of noticing and skipping them, some
players use them.

=cut

1;
