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

use strict;
use warnings;

use File::Find;
use Cwd;
use MP3::Archive;
use MP3::Archive::Lint::Tool ':all';

use vars qw($VERSION);
$VERSION = '0.01';

=head1 NAME

MP3::Archive::Lint - Main driver for mp3lint

=head1 SYNOPSIS

	use MP3::Archive::Lint;
	my $lint=MP3::Archive::Lint->new($config,$archive,$files);
	$lint->lint;

=head1 DESCRIPTION

MP3::Archive::Lint is the main driver class for mp3lint.

=head1 PUBLIC METHODS

=cut

=head2 new

Creates an instance of MP3::Archive::Lint

Takes 3 arguments: a reference to a MP3::Archive::Lint::Conf object, a
reference to a MP3::Archive object, and a reference to an array of
filenames/dirs/links to check.

=cut

sub new
{
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my $self={};
	bless($self,$class);

	$self->{config}=shift;
	$self->{config}->{archive}=shift;
	my $argv=shift;

	$self->{me}=($0=~/(?:.*\/)?(.*)/)[0];

	$self->{extensions}=$self->{config}->get("lint_extensions");
	$self->gettools;
	$self->makefilelist(@$argv);

	return($self);
}

=head2 lint

Runs each tool on each file. If the tool renames a file or directory,
updates the filelist to match.

=cut

sub lint
{
	my $self=shift;
	use Data::Dumper;
	my $count="0000";
	foreach my $file (@{$self->{files}})
	{
		$count++;
#		if(open(DBG,">mp3lint.debug.$count"))
#		{
#			print DBG Dumper($self);
#			close DBG;
#		}
		foreach my $tool (@{$self->{tools}})
		{
			$tool->runtool($file);
			# in case tool has renamed file
			my ($newfile,$ofile)=$tool->getfile();
			if($newfile ne $ofile)
			{
				$file=$newfile;
				my ($dfrom,$dto)=$self->diff($ofile,$file);
				for my $fixfile (@{$self->{files}})
				{
					if(substr($fixfile,0,1) ne "/")
					{
						$fixfile=getcwd() . "/" . $fixfile;
					}
					my $ofix=$fixfile;
					$fixfile=~s,/\Q$dfrom/,/$dto/,g;
				}
			}
		}
	}
}


=head1 INTERNAL METHODS


=head2 diff($from,$to)

Passed two pathnames, it removes leading and trailing path components
that match, leaving only the difference. It returns a list
c<($from,$to)> of trimmed strings.

Can be called as a static method.
	
=cut

sub diff
{
	my @args=@_;
	if((defined($args[0])) && (ref($args[0])))
	{
		# method call, ditch self
		shift(@args);
	}
	my @from=split(/\//,$args[0]);
	my @to  =split(/\//,$args[1]);
	# trim front
	trim(\@from,\@to);
	@from=reverse @from;
	@to=reverse @to;
	# trim rear
	trim(\@from,\@to);
	# get back to right order
	@from=reverse @from;
	@to=reverse @to;
	my $from=join("/",@from);
	my $to=join("/",@to);
	return($from,$to);
}

=head2 trim(\@from,\@$to)

Takes two array references, and trims matching leading components from
the two arrays. Used by C<diff()>.

Can be called as a static method.

=cut

sub trim
{
	my @args=@_;
	if((defined($args[0])) && (ref($args[0]) ne "ARRAY"))
	{
		# method call, ditch self
		shift(@args);
	}
	my($from,$to)=@args;
	for(my $i=0; $i<$#{@$from};$i++)
	{
		if($from->[$i] eq $to->[$i])
		{
			shift(@$from);
			shift(@$to);
		}
		else { last; }
	}
}
			
=head2 makefilelist

Builds the list of files to check, using L<File::Find>.  Exits if no
files found. See also C<wanted>, which is used as a callback by
File::Find.

=cut

sub makefilelist
{
	my $self=shift;
	$self->{files}=();
	my $wanted_closure = sub {
		$self->wanted(shift);
	};
	print "debug:building file list\n" if $self->{config}->debug;
	foreach my $f (@_)
	{
		if(-d $f)
		{
			# can't call wanted_closure for dirs
			&File::Find::find( {wanted => $wanted_closure }, $f);
		}
		else
		{
			$File::Find::name=$f;
			$_=$f;
			&$wanted_closure($f);
		}
	}

	unless(defined($self->{files}))
	{
		print "debug:no files found:exiting\n" if $self->{config}->debug;
		exit;
	}
	@{$self->{files}}=sort @{$self->{files}};
}

=head2 wanted

Used as a callback to File::Find.
Recursively calls File::Find again to handle symlinks.
Adds filenames to @{$self->{files}}	

=cut

sub wanted
{
	my $self=shift;
	my $wanted_closure = sub {
		$self->wanted(shift);
	};

	my $f=$_;
	my $ext=$f;
	$ext=~s/.*\.(.*)/$1/;
	$ext=lc($ext);

	my $link;
	if(-l $f)
	{
		$link=readlink($f);
		# relative link;
		if($link!~/^\//)
		{
			# link to something in same dir
			if($link!~/\//)
			{
				my $new=$File::Find::name;
				$new=~s/^(.*\/).*/$1$link/;
				$link=$new;
			}
			else
			{
				# last resort - make it relative to cwd
				$link=getcwd."/".$link;
			}
		}
	}
		
	if((-l $f) && (-e $link))
	{
		&File::Find::find( {wanted => $wanted_closure }, $link);
	}
	else
	{
		if((-d $f) || (-l $f) || grep({$ext =~/$_/i;} @{$self->{extensions}}))
		{
			push(@{$self->{files}},$File::Find::name);
		}
	}
}

=head2 gettools

Gets the list of tools to run, as modified by command line arguments.
Sets @{$self->{tools}} to an array of tool objects.

=cut

sub gettools
{
	my $self=shift;
	$self->{tools}=();
	$self->{toolnames}=();
	my $toolspath="/MP3/Archive/Lint/Tools/";
	my %tools=();

	my %skiptools=();
	my $skiptools=$self->{config}->get("skiptools");

	if(defined($skiptools))
	{
		# parse -x option
		$skiptools=~s/\s+//g; # ditch whitespace
		my @skiptools=split(/,/,$skiptools);
		if($#skiptools>-1)
		{
			@skiptools=map { tool2module($_) } @skiptools;
			%skiptools=map { $_=>1 } @skiptools;
		}
	}
		
  	my $usertools=$self->{config}->get("tools");
	my %usertools=();
	if(defined($usertools))
	{
		# parse -t option
		$usertools=~s/\s+//g; # ditch whitespace
		my @usertools=split(/,/,$usertools);
		if($#usertools>-1)
		{
			@usertools=map { tool2module($_) } @usertools;
			%usertools=map { $_ => 0 } @usertools;
		}
		else
		{
			die("$self->{me}:bad toolnames:$usertools\n");
		}
	}

	# look in each perl lib directory for tools
	foreach my $prefix (@INC)
	{
		my $toolsdir=$prefix.$toolspath;
		if( (-d $toolsdir) && (opendir(D,$toolsdir)))
		{
			while($_=readdir(D))
			{
				if(/^([A-Z].*)\.pm$/)
				{
					my $mod=$1;
					if(exists($skiptools{$mod}))
					{
						print "debug:skipping tool ",module2tool($mod),"\n" if $self->{config}->debug;
						next;
					}
					$tools{$mod}++;
					
					if(exists($usertools{$mod}))
					{
						$usertools{$mod}++;
					}
				}
			}
			closedir(D);
		}
	}


	# search for -t tools that haven't been found
	if(defined $usertools)
	{
		my $bad=0;
		my @badtools;
		foreach (keys(%usertools))
		{
			if($usertools{$_} == 0)
			{
				$bad++;
				push(@badtools,module2tool($_));
			}
		}
		
		if($bad || !keys(%usertools))
		{
			die("$self->{me}:bad tool spec. could not find: ", join(", ",@badtools),"\n");
		}
	}
	
	unless(keys(%tools) > 0)
	{
		die("$self->{me}:no tools found, aborting\n");
	}

	if(defined($usertools))
	{
		foreach my $i (keys %usertools)
		{
			if($usertools{$i})
			{
				push(@{$self->{toolnames}},$i);
			}
		}
	}
	else
	{
		push(@{$self->{toolnames}},keys(%tools));
	}

	@{$self->{toolnames}}=sort @{$self->{toolnames}};

	# make $self->{tools} an array of tool objects
	for my $thistool (@{$self->{toolnames}})
	{
		my $newtool;
		my $newcmd="\$newtool=MP3::Archive::Lint::Tools::$thistool->new(\$self->{config})";
		print("debug:loading tool ",
			  &MP3::Archive::Lint::Tool::module2tool($thistool),
			  "\n") if $self->{config}->debug;

		eval "require MP3::Archive::Lint::Tools::$thistool" or die ("$self->{me}:cannot load $thistool:$@\n");
		eval "$newcmd" or die("$self->{me}:cannot init $thistool:$@\n");

		push (@{$self->{tools}}, $newtool);
	}
}

=head1 BUGS

None known. Please report any found to ianb@nessie.mcc.ac.uk	

=head1 SEE ALSO    

L<mp3lint(1)>, L<mp3lint-tools(3)>, L<mp3lintskip(1)>, L<mp3lintsum(1)>,
L<mp3lintrc(5)>, L<MP3::Archive(3)>, L<mp3-archive-tools(1)>

=head1 AUTHOR

Ian Beckwith <ianb@nessie.mcc.ac.uk>

=cut

1;
