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

use strict;
use warnings;
use Cwd;

require Exporter;
use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK);
@ISA = qw(Exporter);

%EXPORT_TAGS = ( 'all' => [ qw(
	tool2module module2tool findprogram
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

$VERSION = '0.01';

=head1 NAME

MP3::Archive::Lint::Tool - Base class for mp3lint tools

=head1 SYNOPSIS

    $tool->say("message:optionaldetail");
    $tool->settests("test1","test2","testn");
    $config=$tool->config;
    $archive=$tool->archive;
    if($tool->isalbum) { ... }
    if($tool->istrack) { ... }
    if($tool->skipnametests) { ... }
    if($tool->debug) { ... }
    $modname=$tool->tool2module($toolname);
    $toolname=MP3::Archive::Lint::Tool::module2tool($modname);
    $progpath=$tool->findprogram("programname");


=head1 DESCRIPTION

MP3::Archive::Lint::Tool is a base class used by all the tools that
live under C<MP3::Archive::Lint::Tools::>. It provides as much as
possible of the common functionality needed by all tools.

=head1 METHODS

=cut

=head2 new($conf)

This should be called by the C<new> method in the subclass. It takes a
reference to a MP3::Archive::Lint::Conf object.

=cut

sub new
{
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my $self={};
	bless($self,$class);
	$self->{config}=shift;
	my $pkg=(caller)[0];
	$pkg=~s/.*:://;
	$self->{name}=module2tool($pkg);
	$self->{origfile}="";
	$self->{wantfileerrors}=0; # hack for filesys
#	$self->{currenttest}="new";
	return $self;
}

=head2 config, archive

These methods return references to the appropriate
C<MP3::Archive::Lint::Conf> and C<MP3::Archive> objects respectively.

=cut

sub config         { return shift->{config};            }
sub archive        { return shift->{config}->{archive}; }

=head2 isalbum, istrack, skipnametests

These methods all return the corresponding internal flags.

=cut

sub isalbum        { return shift->{isalbum};           }
sub istrack        { return shift->{istrack};           }
sub skipnametests  { return shift->{skipnametests};     }

=head2 getfile

This method returns a list containing the current (possibly renamed)
$self->{file}, and the original, unrenamed filename
($self->{origfile}).

=cut

sub getfile
{
	my $self=shift;
	return(($self->{pathfilename},$self->{origfile}));
}

=head2 say($msg)

Prints out a message, after checking it is not to be skipped.
Prepends the name of the tool and the test, and appends the filename,
all separated by colons (`B<:>').

=cut

sub say
{
	my $self=shift;
	my $msg=shift;

	my $name=(defined($self->{name}))?$self->{name}:"mp3lint";
	my $test=(defined($self->{currenttest}))?$self->{currenttest}.":" : "";
	my $file=(defined($self->{file}))?$self->{file}:"";
	if(exists($self->{printfile}))
	{
		# special hack for Dir
		$file=$self->{printfile};
	}
	my $str="$name:$test$msg:$file";
	if((!$self->config->ignoreskip) && $self->config->skip->skip($str))
	{
#		print "SKIPPED:$str\n";
	}
	else
	{
		print "$str\n";
	}
}

=head2 debug($msg)

Prints out a debug message, if debug is enabled.  Prepends "debug",
the tool and test name. Appends the filename. All fields are separated
by colons (`B<:>').

=cut

sub debug
{
	my $self=shift;
	my $msg=shift;

	return unless ($self->config->debug);

	my $name=(defined($self->{name})) ? $self->{name}.":" : "";
	my $test=(defined($self->{currenttest})) ? $self->{currenttest}.":" : "";
	my $file=(defined($self->{file})) ? ":".$self->{file} : "";

	print "debug:$name$test$msg$file\n";
}

=head2 runtool($file)

First it canonicalises the pathname of $file, quotes it ruthlessly,
and initialises the C<isalbum>, C<istrack>, and C<skipnametests>
variables appropriately to that pathname.

Then, it calls C<initscan>, and if that succeeds, calls C<runtests>.

=cut

sub runtool
{
	my $self=shift;
	$self->{file}=shift;
	if((!(-r $self->{file})) && (!($self->{wantfileerrors})))
	{
		return;
	}
	$self->setfiledata($self->{file});
	$self->{origfile}=$self->{pathfilename};
	$self->debug("scanning");
		
	if($self->initscan)
	{
		$self->runtests;
	}
}


=head2 setfiledata($filename)

[Re]initialises internal state if new filename (runtool())
or file renamed (some fixes).

=cut

sub setfiledata
{
	my($self,$file)=@_;
	$self->{file}=$file;
	
	if($self->{file}=~/(.*\/)(.*)/)
	{
		$self->{path}=Cwd::abs_path($1);
		$self->{filename}=$2;
	}
	else
	{
		$self->{path}=getcwd;
		$self->{filename}=$self->{file};
	}
	$self->{pathfilename}=$self->{path}."/".$self->{filename};
	$self->{qfile}=$self->{file};
	#replace ' with '\''
	$self->{qfile}=~s/\'/\'\\\'\'/g;
	# enclose in quotes
	$self->{qfile}=~s/^/\'/;
	$self->{qfile}=~s/$/\'/;


	if($self->config->skipnametests)
	{
		$self->{isalbum}=0;
		$self->{istrack}=0;
		$self->{skipnametests}=1;
	}
	else
	{
		my $defformat=$self->config->get("format_default");
		if(($self->config->archive->isalbum($self->{pathfilename})) ||
		   ($defformat eq "album"))
		{
			$self->{isalbum}=1;
			$self->{istrack}=0;
			$self->{skipnametests}=0;
		}
		elsif(($self->config->archive->istrack($self->{pathfilename})) ||
			  ($defformat eq "track"))
		{
			$self->{isalbum}=0;
			$self->{istrack}=1;
			$self->{skipnametests}=0;
		}
		else
		{
			$self->{isalbum}=0;
			$self->{istrack}=0;
			$self->{skipnametests}=1;
		}
	}
}	

=head2 renamefile($old,$new)

Renames $old to $new, and updates internal state to match new name.

=cut

sub renamefile
{
	my($self,$new)=@_;
	my $newpath=$new;
	unless($newpath=~/\//)
	{
		$newpath=$self->{path}."/".$new;
	}
	if (-e $newpath)
	{
		$self->say("not renaming, new file exists:$new");
		return;
	}
	$new=~s/.*\/(.*)/$1/;
	if(rename($self->{pathfilename},$newpath))
	{
		my $old=$self->{filename};
		$self->setfiledata($newpath);
		$self->say("fixed:renamed from $old");
	}
	else
	{
		$self->say("cannot rename:$!");
	}
}

=head2 initscan

This is a stub function that just returns 1. It is here in case the
tool does not need to implement an initscan method.

=cut

sub initscan
{
	return 1;
}

=head2 settests(@tests)

Sets the list of tests (methods within the tool) to be called.

=cut

sub settests
{
	my ($self,@tests)=@_;
	@{$self->{tests}}=@tests;
}
	
=head2 runtests

Runs all the tests set by C<settests> in the current tool.

=cut

sub runtests
{
	my $self=shift;
	if($#{$self->{tests}}<0)
	{
		$self->debug("no tests defined");
	}
	else
	{
		$self->{bail}=0;
		for my $test (@{$self->{tests}})
		{
			$self->{currenttest}=$test;
			$self->debug("scanning");
			$self->$test();
			if($self->{bail})
			{
				$self->debug("bailing out of tool");
				last;
			}
		}
		$self->{currenttest}=undef;
	}
}

=head2 tool2module($tool)

Converts a toolname (lowercase) to its perl module equivalent (first
letter capitalised). Can be called as a static method.

=cut

sub tool2module
{
	my $tool=shift;
	if(ref $tool) # method call, dont care about $self
	{
		$tool=shift;
	}
	return ucfirst(lc($tool));
}

=head2 module2tool($module)

Converts a tool's perl module name (first letter capitalised) to its
toolname (lowercase). Can be called as a static method.

=cut

sub module2tool
{
	my $mod=shift;
	if(ref $mod) # method call, dont care about $self
	{
		$mod=shift;
	}
	$mod=~s/\.[Pp][Mm]$//;
	return lc($mod);		
}

=head2 findprogram($program)

Attempts to find $program in the users $PATH. Returns either the full
path to the program or undef if not found.

=cut

sub findprogram
{
	my $program=shift;
	if(ref $program) # method call, dont care about $self
	{
		$program=shift;
	}
	unless(exists($ENV{PATH}))
	{
		$ENV{PATH}="/usr/local/bin:/usr/bin:/bin:/sbin";
	}
	my @path=split(/:/,$ENV{PATH});
	foreach my $pathname (@path)
	{
		my $try=$pathname."/".$program;
		if(-x $try)
		{
			return $try;
		}
	}
	# not found
	return undef;
}

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