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

use strict;
use warnings;

use MP3::Archive::Lint::Tool;

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

=head1 filename - Tool to check filenames

Tests various (often pedantic) features of the filename. All tests
performed by this tool are disabled if the B<-n> option is given to
mp3lint.

Tests that test/fix directories are very cautious about whether to
treat that directory as part of the music metadata. They err on the
side of caution, and only check the directories if they match up with
music files inside them.

This can cause directories to be unexpectedly skipped, if the
filenames it finds within them are not valid. It also means you may
need to run mp3lint more than once with the B<-f> (fix) option, first
to fix files, then to fix directories.

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

	# This should take care of the throbbing gristle box set
	# anything bigger than 24 discs?
	my @numbers=qw(zero one two three four five six seven eight nine ten 
				   eleven twelve thirteen fourteen fifteen sixteen seventeen
				   eighteen nineteen twenty twentyone twentytwo 
				   twentythree twentyfour);

	my $count=0;
	%{$self->{numbers}}=( map { $_ => $count++ } @numbers );

	$self->{useautoformat}=0;
	if(eval("require Text::Autoformat;"))
	{
		import Text::Autoformat;
		$self->{useautoformat}=1;
	}

	$self->settests("format","disc","ext","space","the","caps","paren");

	return $self;
}

sub initscan
{
	my $self=shift;

	if($self->{filename}=~/\.m3u$/i)
	{
		$self->settests("format");
		return 1;
	}
	if (-d $self->{file})
	{
	 	$self->settests("disc","space","caps","the","paren");
	}
	else
	{
		$self->settests("format","disc","ext","space","the","caps","paren");
	}
	return 1;
}

=item B<format>

Checks to see the filename is in a valid format. See L<mp3lintrc(5)>
for details of how to specify filename formats. Only works on
filenames.

=cut	

sub format
{
	my $self=shift;
	return if($self->config->skipnametests);
	return if(-d $self->{file});

	my $format=$self->config->archive->getfileformat($self->{pathfilename});
	unless($self->config->archive->validate($self->{pathfilename}))
	{
		$self->say("filename in wrong format");
		return;
	}

	# if directory, skip remaining test
	return if(-d ($self->{file}));
	
	my $delim;
	if($self->isalbum())
	{
		$delim=$self->config->get("format_delimiter_album");
	}
	elsif($self->istrack())
	{
		$delim=$self->config->get("format_delimiter_track");
	}
	if(defined $delim)
	{
		my $matched=0;
		my $format=$self->config->archive->getfileformat($self->{pathfilename});
		return unless(defined $format); 

		my @right=map { my @c=split(/$delim/,$_); $#c;} @{$format};
		my @actual=split(/$delim/,$self->{filename});
		foreach my $cnt (@right)
		{
			if($cnt == $#actual)
			{
				$matched=1;
			}
		}
		unless($matched)
		{
			$self->say("wrong number of fields");
		}
	}
}

=item B<disc>

If the filename or directory name contains something resembling
I<(Disc 1)>, checks the spelling of "Disc", and that it is followed by
a space then a number.

Possibly the most pedantic and debatable test, hence it is in the
default list of tests to skip (B<$lint_skip>)

If B<-f> (fix) is enabled, it attempts to correct the problem.

=cut

sub disc
{
	my $self=shift;
	return if($self->config->skipnametests());
	my $new=$self->{filename};
	my $fix=$self->config->fix;
	# regexps here utterly break emacs formatting
	while($self->{filename}=~/([({<\[]\s*(dis[kc])(\s*)([^)>\]}]+)[)}>\]])/ig)
	{
		my ($all,$disc,$space,$num)=($1,$2,$3,$4);
		if($disc ne "Disc")
		{
			$self->say("\"Disc\" misspelt:\"$disc\"") unless $fix;
			$disc="Disc";
		}
		if((!defined($num)) || ($num!~/^\d+$/))
		{
			if(defined($num))
			{
				$self->say("non-numeric disc number:$num") unless $fix;
				$num=lc($num);
				if(exists($self->{numbers}->{$num}))
				{
					$num=$self->{numbers}->{$num};
				}
			}
			else
			{
				$self->say("no disc number");
			}
		}
		if(!defined($space) || ($space eq ""))
		{
			$self->say("No space between Disc and number") unless $fix;
			$space=" ";
		}
		if($fix && defined($num))
		{
			my $right="(Disc $num)";
			if($right ne $all)
			{
				$new=~s/\Q$all/$right/;
			}
		}
	}
	if($fix && ($new ne $self->{filename}))
	{
		$new=$self->{path}."/".$new;
		$self->renamefile($new);
	}
}

=item B<ext>

Checks the extension of the file. Complains if it is uppercase or .mp2

.mp2 files are often .mp3 files mislabelled, plus MPEG Layer 2
files are generally playable by most mp3 (Layer 3) players,
so the utility of a .mp2 extension is dubious.

If B<-f> (fix) is enabled, renames the file to correct the problem.

=cut	

sub ext
{
	my $self=shift;

	return unless -f $self->{file};
	return if($self->config->skipnametests());

	my ($base,$ext);
	if($self->{filename}=~/(.*)\.(.*)/)
	{
		$base=$1;
		$ext=$2;
	}
	else
	{
		return;
	}

	if($ext ne lc($ext))
	{
		if($self->config->fix)
		{
			my $new="$base." . lc($ext);
			$self->renamefile($new);
		}
		else
		{
			$self->say("uppercase extension");
		}
	}

	if($ext=~/mp2/i)
	{
		if($self->config->fix)
		{
			$ext=~s/mp2/mp3/;
			my $new="$base.$ext";
			$self->renamefile($new);
		}
		else
		{
			$self->say("mp2 file");
		}
	}
}

=item B<space>

Checks if the filename (minus the extension) or directory name ends in
a space, eg C<"Fade Into .mp3">. This is often a sign that the
filename has been truncated, preserving the extension.

=cut

sub space
{
	my $self=shift;
	return if($self->config->skipnametests());
	if($self->{filename}=~/(.*\s+)(\.[^\.]+)?$/)
	{
		$self->say("name ends in space - truncated?");
	}
}

=item B<the>

Complains if the artist name begins with B<The>.

This is another debatable test, so it is in the default list
of messages to skip (B<$lint_skip>)	

It is arguably a good idea to remove "The" from the start of artist
names, as it is often debatable whether or not they should have one,
and it leads to extra confusion trying to find songs.

An exception is made for B<The The>, for obvious reasons.

If B<-f> (fix> is enabled, the file or directory is renamed
to remove the leading I<"The ">.

=cut

sub the
{
	my $self=shift;
	return if($self->config->skipnametests());

	my ($artist,$offset);
	if(-d $self->{file})
	{
		($artist,$offset,undef,undef)=$self->getdirinfo();
		return unless(defined($artist));
		$offset=0 unless(defined($offset));
	}
	else
	{
		($artist,$offset)=$self->config->archive->artist($self->{pathfilename});
	}

	if(defined($artist) && ($artist=~/^(The )/i) && ($artist!~/^The The$/i))
	{
		# fix and rename if necessary
		if($self->config->fix)
		{
			my $newfile=$self->{pathfilename};
			if($offset < length($newfile))
			{
				substr($newfile,$offset,4,"");
			}
			if($newfile ne $self->{pathfilename})
			{
				$self->renamefile($newfile);
			}
		}
		else
		{
			$self->say("artist name begins with:$1");
		}
	}
}

=item B<caps>

Does a check of the filename or directory name capitalisation.

As it is quite picky, it is in the default list (C<$lint_skip>)
of messages to skip.

If installed, it uses Text::Autoformat to work out the correct format,
otherwise it falls back on a crude internal method.

If B<-f> (fix) is enabled (and Text::Autoformat is installed), it
renames the file or directory to correct the capitalisation.

Variables:

=over 4

=item $lint_case

(string, default "highlight")

Capitalisation style to use. Available values:

=over 4

=item highlight

Capitalises everything except "unimportant" words. This is the
default.

=item title

Capitalises every word.

=item sentence

Capitalises the first word.

=item upper

Uppercases everything.

=item lower

Lowercases everything.

=back

=back

=cut

sub caps
{
	my $self=shift;
	return if($self->config->skipnametests());
	my $musicfile=undef;
	my $new={};
	
	if(-d $self->{file})
	{
		my($artist,$artoffset,$album,$alboffset)=$self->getdirinfo();
		if(defined($artist) && defined($artoffset))
		{
			$self->capscheck($artist,"artist",$new,$artoffset);
		}
		if(defined($album) && defined($alboffset))
		{
			$self->capscheck($album,"album",$new,$alboffset);
		}
	}
	else
	{
		foreach my $test (qw(artist album track))
		{
			my ($val,$offset)=$self->config->archive->$test($self->{pathfilename});
			if(defined($val))
			{
				$self->capscheck($val,$test,$new,$offset);
			}
		}
	}

	# fix and rename if necessary
	if($self->config->fix && scalar(keys(%$new)))
	{
		my $newfile=$self->{pathfilename};
		for my $offset (sort {$b <=> $a} keys(%$new))
		{
			if($offset <= length($newfile))
			{
				substr($newfile,$offset,length($new->{$offset}{from}),$new->{$offset}{to});
			}
		}
		if($newfile ne $self->{pathfilename})
		{
			$self->renamefile($newfile);
		}
	}
}

# helper method used by caps
# checks the capitalisation of a section of text,
# maybe writing fixed version to %$new, keyed by offset
sub capscheck
{
	my($self,$val,$name,$new,$offset)=@_;
	if($self->{useautoformat})
	{
		my $case=$self->config->get("lint_case");
		my $newtext=autoformat($val,{case=>lc($case)});
		# remove whitespace and newlines
		chomp($newtext);
		$newtext=~s/\n/ /g;
		$newtext=~s/^\s+//;
		$newtext=~s/\s+$//;
		if($newtext ne $val)
		{
			if($self->config->fix)
			{
				$new->{$offset}{from}=$val;
				$new->{$offset}{to}=$newtext;
			}
			else
			{
				$self->say("bad $name capitalisation:$val");
			}
		}
	}
	else
	{
		if(grep(/^[a-z]/,split(/\s+/,$val)))
		{
			$self->say("bad $name capitalisation");
		}
	}
}

# attempts to extract/validate directory metadata
# by finding a music file in that dir and using that.
sub getdirinfo
{
	my $self=shift;
	my ($retartist,$retartistoffset)=(undef,undef);
	my ($retalbum,$retalbumoffset)=(undef,undef);
	my($musicfile,$depth)=(undef,0);

	# directory should be checked if it is part of the artist
	# or album spec for a track.

	# this should never fail (unless weird perms?)
	if(opendir(DIR,$self->{pathfilename}))
	{
		my $match=$self->{filename};
		while(my $ent=readdir(DIR))
		{
			next if($ent=~/^\.\.?/);
			my $path="$self->{pathfilename}/$ent";
			if(-f $path)
			{
				# files directly in us
				if($self->matchmusicfile($path))
				{
					$musicfile=$path;
					$depth=1;
					last;
				}
			}
			elsif(-d $path)
			{
				if(opendir(SUBDIR,$path))
				{
					while(my $subent=readdir(SUBDIR))
					{
						next if($subent=~/^\.\.?/);
						my $thisent="$path/$subent";
						# files in direct subdirs of us.
						if((-f $thisent) && ($self->matchmusicfile($thisent)))
						{
							$depth=2 unless($depth==1);
							$musicfile=$thisent;
							# last inner, not outer
							# we don't want to break out of outer
							# because depth==1 takes priority
							# and there may be more matches
							last;
						}
					}
					closedir(SUBDIR);
				}
			}
		}
		closedir(DIR);
	}

	unless(defined($musicfile))
	{
		return((undef,undef,undef,undef));
	}

	my $musicpath=$musicfile;
	$musicpath=~s/(.*)\/.*/$1/;
	my ($album,$albumoffset)=(undef,undef);
	my $isalbum=$self->config->archive->isalbum($musicfile);

	# get musicfile's version of artist/album
	my ($artist,$artistoffset)=$self->config->archive->dirartist($musicpath);
	if($isalbum)
	{
		($album,$albumoffset)=$self->config->archive->diralbum($musicpath);
	}

	if((!defined($artist)) || ($isalbum && (!defined($album))))
	{
		# should never happen
		return((undef,undef,undef,undef));
	}

	# if something resembling the artist is in our filename
	if($self->fuzzycmp($self->{filename},$artist))	
	{
		$retartist=$artist;
		$retartistoffset=$artistoffset;
	}
	
	# if something resembling the album is in our filename
	if($isalbum && $self->fuzzycmp($self->{filename},$album))
	{
		$retalbum=$album;
		$retalbumoffset=$albumoffset;
	}
	
	return(($retartist,$retartistoffset,$retalbum,$retalbumoffset));
}

# returns 1 if $file is a music file and
# everything matches up with us being part of its metadata
sub matchmusicfile
{
	my($self,$file)=@_;
	my $path=$file;
	$path=~s/(.*)\/.*/$1/;
	if($self->ismusicfile($file))
	{
		# first check tracks idea of diralbum/dirartist matches us
		my ($dirartist,$dirartoffset)=$self->config->archive->dirartist($path);
		my ($diralbum,$diralboffset) =$self->config->archive->diralbum ($path);
		my $isalbum=$self->config->archive->isalbum($file);
		return(0) unless(((defined($dirartist)) && (defined($dirartoffset)) &&
						  ($self->{filename} =~ /\Q$dirartist/)) ||
						 (($isalbum) &&
						  (defined($diralbum)) && (defined($diralboffset)) &&
						  ($self->{filename} =~ /\Q$diralbum/))); 

		# check tracks idea of artist/album offset is inside us.
		my $start=length($self->{pathfilename}) - length($self->{filename}) - 1;
		my $end=length($self->{pathfilename}) - 1 ;
		my $artistin=(($dirartoffset >= $start) && ($dirartoffset <= $end));
		my $albumin=0;
		if($isalbum)
		{
			$albumin=(($diralboffset >= $start) && ($diralboffset <= $end));
		}

		unless($artistin || $albumin) 
		{
			return 0;
		}

		# then check tracks idea of artist/album roughly matches us
		my $fartist=$self->config->archive->artist($file);
		my $falbum=$self->config->archive->album($file);

		return(0) unless(((defined($fartist)) &&
						  ($self->fuzzycmp($self->{filename},$fartist))) ||
						 ((defined($falbum))  &&
						  ($self->fuzzycmp($self->{filename},$falbum))));
		return 1;
	}
	return 0;
}

# does a fuzzy comparison
# returns 1 if a munged version of $two
# is a substring of $one
sub fuzzycmp
{
	my($self,$one,$two)=@_;
	$one=$self->munge($one);
	$two=$self->munge($two);
	return($one=~/\Q$two/);
}

# mangle an item of data to help
# two similar ones match
# (squashing whitespace, removing "^The ", lowercasing, etc)
sub munge
{
	my ($self,$it)=@_;
	$_=lc($it);
	s/^the\s+//;
	s/^\s+//;
	s/\s+$//;
	s/\s+/ /g;
	s/[\[\{\<]/\(/g;
	s/[\]\>\}]/\)/g; 
	return($_);
}

# return 1 if file extension matches one of the music extensions we
# are looking for and the filename is parsable
sub ismusicfile
{
	my($self,$file)=@_;
	my $exts=$self->config->get("lint_extensions");

	my $ext=($file=~/.*\.([^\.]+)$/)[0];
	if((defined($ext)) && (@$exts) &&
	   (scalar(grep(/\Q$ext/i,@$exts))) &&
	   ($self->config->archive->validate($file)))
	{
		return 1;
	}
	return 0;
}

=item B<paren>

Checks that brackets in the filename or directory name
balance. Arguably pedantic, but it is useful for catching truncated
filenames, eg C<"Foo (remixed by Fatb.mp3">

If B<-f> (fix> is enabled, it renames the file/directory to correct
mismatched parentheses, but leaves unclosed parentheses alone
as probably a symptom of a deeper problem (truncated filenames).

=cut

sub paren
{
	my $self=shift;
	return if($self->config->skipnametests());

	my %map=("[" => "]", "(" => ")", "{" => "}", "<" => ">");
	
    # maintains a stack of opening parentheses
    # a closing paren must match last opening paren
	# and there must not be unmatched ones left
	my @st=();
	my $offset=-1;
	my $new=$self->{filename};
	foreach my $c (split(//,$self->{filename}))
	{
		++$offset;
		if($c=~/[\[({<]/)
		{
        	push(@st,$c);
		}
		elsif($c=~/[\]>)}]/) 
		{ 
			my $last=(scalar(@st)!=0) ? $st[$#st] : "";
			pop(@st);
			unless($map{$last} eq $c)
			{
				if(exists($map{$last}))
				{
					if($self->config->fix)
					{
						pop(@st);
						substr($new,$offset,length($map{$last}),$map{$last});
						# allow for longer braces (why not?)
						if(length($map{$last}))
						{
							$offset += (length($map{$last})-1);
						}
					}
					else
					{
						$self->say("mismatched parenthesis:"."got '$c', expected '$map{$last}'");
					}
				}
				else
				{
					$self->say("mismatched parenthesis");
				}
			}
		}
	}
	if($self->config->fix && ($new ne $self->{filename}))
	{
		$self->renamefile($self->{path} ."/". $new);
	}
	
	if(scalar(@st)) # unmatched parens left
	{
		$self->say("mismatched parenthesis - truncated?");
	}
}

=back

=cut

1;
