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

use strict;
use warnings;

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

=head1 id3 - Tool to check id3 tags

Checks ID3 tags in mp3 files using the MP3::Tag module

If your machine is set up correctly, the module can be installed by
typing (as root):

	# perl -MCPAN -e shell
	cpan> install MP3::Tag
	cpan> quit

If you have problems with the CPAN client, download MP3::Tag from
L<http:E<sol>E<sol>www.cpan.orgE<sol>modulesE<sol>by-moduleE<sol>MP3E<sol>tagged-0.40.tar.gz>
(or any later version).

This follows the standard perl installation procedure as used by
mp3lint, ie unpack,  C<perl Makefile.PL>, C<make>, C<make install>. You will
need to be root for C<make install>.

The I<tagged> package has a web page at L<http:E<sol>E<sol>tagged.sourceforge.netE<sol>>

=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);

	unless(eval("require MP3::Tag;"))
	{
	    # avoiding colons in error messages
		$self->debug("MP3/Tag.pm not found, skipping tests");
		$self->settests();
	}
	else
	{
		$SIG{__WARN__}=\&warnsig;
		$self->settests("warnings","tag","tracknum","artist","album","track","compare");
	}
	return $self;
}

use vars qw(@warningmsgs);

sub warnsig
{
	my @newmsgs=@_;
	chomp(@newmsgs);
	push(@warningmsgs,@newmsgs);
}

sub initscan
{
	my $self=shift;

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

	$self->{dontread}=0;

	@warningmsgs=();

	if(exists($self->{mp3}) && defined($self->{mp3}))
	{
		$self->{mp3}->close();
	}
	
	$self->{mp3}=MP3::Tag->new($self->{file});
	unless (defined $self->{mp3})
	{
		$self->say("cannot scan:$!");
		return 0;
	}

	$self->{mp3}->get_tags;

	return 1;
}


=item B<tag>

Checks for the existence of an id3 tag.

=cut

sub tag
{
	my $self=shift;
	return if($self->{dontread});
	unless((exists($self->{mp3}->{ID3v1})) ||
		   (exists($self->{mp3}->{ID3v2})))
	{
		$self->say("no tag");
	}
}


=item B<tracknum>

Tests for a tracknumber tag (id3 v1.1 and v2.0+ only).  Checks it is
numeric and matches the filename. If the B<-n> option is given to
mp3lint, the filename test is skipped.

=cut

sub tracknum
{
	my $self=shift;
	return if($self->{dontread});
	my $mp3=$self->{mp3};
	my $found=0;
	my $tracknum;

	return unless($self->isalbum());
	
	unless((exists($mp3->{ID3v1})) ||
		   (exists($mp3->{ID3v2})))
	{
		return;
	}
	
	if(exists($mp3->{ID3v1}))
	{
		$tracknum=$mp3->{ID3v1}->track;
		if($tracknum > 0)
		{
			$found++;
		}
	}
	if(exists($mp3->{ID3v2}))
	{
		my $v2tracknum=$mp3->{ID3v2}->track;
		if(defined($v2tracknum))
		{
			if($v2tracknum=~/\s*(\d+)\s*\/\s*\d+\s*/)
			{
				$v2tracknum=$1;
			}
			if($v2tracknum=~/^\s*(\d+)\s*$/)
			{
				$tracknum=$1;
				if($tracknum != 0)
				{
					$found++;
				}
			}
			else
			{
				$self->say("ID3v2 tracknum not a number:$v2tracknum");
				return;
			}
		}
	}

	unless($found)
	{
		$self->say("no tracknumber tag");
		return;
	}
	if(!$self->config->skipnametests)
	{
		my $filetracknum;
		if($filetracknum=$self->config->archive->tracknum($self->{pathfilename}))
		{
			if(($filetracknum=~/^\d+$/) && ($tracknum != $filetracknum))
			{
				$self->say("id3/filename mismatch:$tracknum");
			}
		}
	}
}

=item B<artist>

Tests for an artist tag and compares it to the filename. This test is
suppressed if the B<-n> option is given to mp3lint.

=cut

sub artist
{
	my $self=shift;
	return if($self->{dontread});
	$self->id3item("artist");
}

=item B<album>

Tests for an album tag and compares it to the filename. This test is
suppressed if the B<-n> option is given to mp3lint.

=cut

sub album
{
	my $self=shift;
	return if($self->{dontread});
	return unless($self->isalbum());
	$self->id3item("album");
}

=item B<track>

Tests for a song tag (track name) and compares it to the
filename. This test is suppressed if the B<-n> option is given to
mp3lint.

=cut

sub track
{
	my $self=shift;
	return if($self->{dontread});
	$self->id3item("song","track");
}

sub id3item
{
	my $self=shift;
	my $item=shift;
	my $itemstr=$item;
	if($#_ == 0)
	{
		$itemstr=shift;
	}
	
	my $mp3=$self->{mp3};
	my $found=0;
	my $data;
	
	unless((exists($mp3->{ID3v1})) ||
		   (exists($mp3->{ID3v2})))
	{
		return;
	}

	if(exists($mp3->{ID3v1}))
	{
		$data=$mp3->{ID3v1}->$item;
		if(defined($data) && ($data ne ""))
		{
			$found++;
		}
	}
	if(exists($mp3->{ID3v2}))
	{
		my $v2data=$mp3->{ID3v2}->$item;
		if(defined($v2data) && ($v2data ne ""))
		{
			$data=$v2data;
			$found++;
		}
	}

	unless($found)
	{
		$self->say("no $itemstr tag");
		return;
	}

	if(!$self->config->skipnametests())
	{
		my $fnitem;
		
		if($fnitem=$self->config->archive->$itemstr($self->{pathfilename}))
		{
			unless($self->fuzzymatch($data,$fnitem))
			{
				$self->say("id3/filename mismatch:$data");
			}
		}
	}
}

=item B<compare>

If a file has both id3v1 and id3v2 tags, tests they are the same.

=cut

sub compare
{
	my $self=shift;
	return if($self->{dontread});
	my $mp3=$self->{mp3};
	return unless((exists($mp3->{ID3v1})) && (exists($mp3->{ID3v2})));
	foreach my $tag (qw(track artist album song))
	{
		my $msgtag=$tag;
		my $v1=$mp3->{ID3v1}->$tag();
		my $v2=$mp3->{ID3v2}->$tag();
		if($tag eq "track")
		{
			$msgtag="tracknum";
			next unless((defined($v1)) && (defined($v2)) && ($v1 != 0));

			if($v2=~/\s*(\d+)\s*\/\s*\d+\s*/)
			{
				$v2=$1;
			}
			if($v2=~/^\s*(\d+)\s*$/)
			{
				$v2=$1;
			}
			else
			{
				next; # not a number, warned elsewhere
			}
			
			unless($v1 == $v2)
			{
				$self->say("$msgtag id3 v1/v2 mismatch:v1 \"$v1\" v2 \"$v2\"");
			}
		}
		else
		{
			if($tag eq "song")
			{
				$msgtag="track";
			}
			next unless((defined($v1)) && (defined($v2)) && ($v1 ne ""));
			unless($self->fuzzymatch($v1,$v2))
			{
				$self->say("$msgtag id3 v1/v2 mismatch:v1 \"$v1\" v2 \"$v2\"");
			}
		}
	}
}


sub fuzzymatch
{
	my ($self,$id3,$fn)=@_;

	if($fn eq $id3) 
	{
		return 1;
	}
	else
	{
		# maybe id3v1 truncation to 30
		# MP3::Tag truncates trailing whitespace so we dont know the
		# what length means it was truncated
		my $id3length=length($id3); 
		if(!$id3length)
		{
			# has to be *some* text
			return 0;
		}
		$fn=substr($fn,0,$id3length);
		if($fn eq $id3)
		{
			return 1;
		}
	}
	return 0;
}

=item B<warnings>

Shows warnings generated by the MP3::Tag module, generally
about unsupported id3 tag versions/features.	

=cut

sub warnings
{
	my $self=shift;
	my $flag=0;
	foreach my $msg (@warningmsgs)
	{
		if($msg=~/failed: Permission denied/)
		{
			# don't warn, filesys:perms will mention permissions,
			# just skip the rest of the tests
			$self->{dontread}=1;
		}
		elsif($msg=~/^Unknown ID3v2-Tag version:\s*(.*)/)
		{
			$self->say("unsupported ID3v2 version:$1");
			$self->{dontread}=1;
		}
		elsif(($msg=~/Flag: Experimental not supported/ ) ||
			  ($msg=~/But trying to read the tag/ ) ||
			  ($msg=~/Unsupported flag/ ))
		{
			$flag++;
		}
		else
		{
			$self->say("unhandled ID3 warning:$msg");
		}
	}
	if($flag)
	{
		$self->say("unsupported ID3v2 features, trying to read anyway");
	}
	@warningmsgs=();
}

=back

=head2 Caveats

The id3v1 tag format has very short fixed length fields. This often
means that data is unavoidably truncated. 

All tests that compare id3v1 data allow for this by only comparing up
to the length of the id3v1 data. This currently affects the tests
B<compare>, B<artist>, B<album>, and B<track>.

ID3v2.4 is not yet supported.

=cut	

1;

