1# $Id: Tool.pm,v 1.13 2003/12/14 09:43:56 ianb Exp $
2package MP3::Archive::Lint::Tool;
3
4use strict;
5use warnings;
6use Cwd;
7
8require Exporter;
9use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK);
10@ISA = qw(Exporter);
11
12%EXPORT_TAGS = ( 'all' => [ qw(
13	tool2module module2tool findprogram
14) ] );
15
16@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
17
18$VERSION = '0.01';
19
20=head1 NAME
21
22MP3::Archive::Lint::Tool - Base class for mp3lint tools
23
24=head1 SYNOPSIS
25
26    $tool->say("message:optionaldetail");
27    $tool->settests("test1","test2","testn");
28    $config=$tool->config;
29    $archive=$tool->archive;
30    if($tool->isalbum) { ... }
31    if($tool->istrack) { ... }
32    if($tool->skipnametests) { ... }
33    if($tool->debug) { ... }
34    $modname=$tool->tool2module($toolname);
35    $toolname=MP3::Archive::Lint::Tool::module2tool($modname);
36    $progpath=$tool->findprogram("programname");
37
38
39=head1 DESCRIPTION
40
41MP3::Archive::Lint::Tool is a base class used by all the tools that
42live under C<MP3::Archive::Lint::Tools::>. It provides as much as
43possible of the common functionality needed by all tools.
44
45=head1 METHODS
46
47=cut
48
49=head2 new($conf)
50
51This should be called by the C<new> method in the subclass. It takes a
52reference to a MP3::Archive::Lint::Conf object.
53
54=cut
55
56sub new
57{
58	my $proto=shift;
59	my $class=ref($proto) || $proto;
60	my $self={};
61	bless($self,$class);
62	$self->{config}=shift;
63	my $pkg=(caller)[0];
64	$pkg=~s/.*:://;
65	$self->{name}=module2tool($pkg);
66	$self->{origfile}="";
67	$self->{wantfileerrors}=0; # hack for filesys
68#	$self->{currenttest}="new";
69	return $self;
70}
71
72=head2 config, archive
73
74These methods return references to the appropriate
75C<MP3::Archive::Lint::Conf> and C<MP3::Archive> objects respectively.
76
77=cut
78
79sub config         { return shift->{config};            }
80sub archive        { return shift->{config}->{archive}; }
81
82=head2 isalbum, istrack, skipnametests
83
84These methods all return the corresponding internal flags.
85
86=cut
87
88sub isalbum        { return shift->{isalbum};           }
89sub istrack        { return shift->{istrack};           }
90sub skipnametests  { return shift->{skipnametests};     }
91
92=head2 getfile
93
94This method returns a list containing the current (possibly renamed)
95$self->{file}, and the original, unrenamed filename
96($self->{origfile}).
97
98=cut
99
100sub getfile
101{
102	my $self=shift;
103	return(($self->{pathfilename},$self->{origfile}));
104}
105
106=head2 say($msg)
107
108Prints out a message, after checking it is not to be skipped.
109Prepends the name of the tool and the test, and appends the filename,
110all separated by colons (`B<:>').
111
112=cut
113
114sub say
115{
116	my $self=shift;
117	my $msg=shift;
118
119	my $name=(defined($self->{name}))?$self->{name}:"mp3lint";
120	my $test=(defined($self->{currenttest}))?$self->{currenttest}.":" : "";
121	my $file=(defined($self->{file}))?$self->{file}:"";
122	if(exists($self->{printfile}))
123	{
124		# special hack for Dir
125		$file=$self->{printfile};
126	}
127	my $str="$name:$test$msg:$file";
128	if((!$self->config->ignoreskip) && $self->config->skip->skip($str))
129	{
130#		print "SKIPPED:$str\n";
131	}
132	else
133	{
134		print "$str\n";
135	}
136}
137
138=head2 debug($msg)
139
140Prints out a debug message, if debug is enabled.  Prepends "debug",
141the tool and test name. Appends the filename. All fields are separated
142by colons (`B<:>').
143
144=cut
145
146sub debug
147{
148	my $self=shift;
149	my $msg=shift;
150
151	return unless ($self->config->debug);
152
153	my $name=(defined($self->{name})) ? $self->{name}.":" : "";
154	my $test=(defined($self->{currenttest})) ? $self->{currenttest}.":" : "";
155	my $file=(defined($self->{file})) ? ":".$self->{file} : "";
156
157	print "debug:$name$test$msg$file\n";
158}
159
160=head2 runtool($file)
161
162First it canonicalises the pathname of $file, quotes it ruthlessly,
163and initialises the C<isalbum>, C<istrack>, and C<skipnametests>
164variables appropriately to that pathname.
165
166Then, it calls C<initscan>, and if that succeeds, calls C<runtests>.
167
168=cut
169
170sub runtool
171{
172	my $self=shift;
173	$self->{file}=shift;
174	if((!(-r $self->{file})) && (!($self->{wantfileerrors})))
175	{
176		return;
177	}
178	$self->setfiledata($self->{file});
179	$self->{origfile}=$self->{pathfilename};
180	$self->debug("scanning");
181
182	if($self->initscan)
183	{
184		$self->runtests;
185	}
186}
187
188
189=head2 setfiledata($filename)
190
191[Re]initialises internal state if new filename (runtool())
192or file renamed (some fixes).
193
194=cut
195
196sub setfiledata
197{
198	my($self,$file)=@_;
199	$self->{file}=$file;
200
201	if($self->{file}=~/(.*\/)(.*)/)
202	{
203		$self->{path}=Cwd::abs_path($1);
204		$self->{filename}=$2;
205	}
206	else
207	{
208		$self->{path}=getcwd;
209		$self->{filename}=$self->{file};
210	}
211	$self->{pathfilename}=$self->{path}."/".$self->{filename};
212	$self->{qfile}=$self->{file};
213	#replace ' with '\''
214	$self->{qfile}=~s/\'/\'\\\'\'/g;
215	# enclose in quotes
216	$self->{qfile}=~s/^/\'/;
217	$self->{qfile}=~s/$/\'/;
218
219
220	if($self->config->skipnametests)
221	{
222		$self->{isalbum}=0;
223		$self->{istrack}=0;
224		$self->{skipnametests}=1;
225	}
226	else
227	{
228		my $defformat=$self->config->get("format_default");
229		if(($self->config->archive->isalbum($self->{pathfilename})) ||
230		   ($defformat eq "album"))
231		{
232			$self->{isalbum}=1;
233			$self->{istrack}=0;
234			$self->{skipnametests}=0;
235		}
236		elsif(($self->config->archive->istrack($self->{pathfilename})) ||
237			  ($defformat eq "track"))
238		{
239			$self->{isalbum}=0;
240			$self->{istrack}=1;
241			$self->{skipnametests}=0;
242		}
243		else
244		{
245			$self->{isalbum}=0;
246			$self->{istrack}=0;
247			$self->{skipnametests}=1;
248		}
249	}
250}
251
252=head2 renamefile($old,$new)
253
254Renames $old to $new, and updates internal state to match new name.
255
256=cut
257
258sub renamefile
259{
260	my($self,$new)=@_;
261	my $newpath=$new;
262	unless($newpath=~/\//)
263	{
264		$newpath=$self->{path}."/".$new;
265	}
266	if (-e $newpath)
267	{
268		$self->say("not renaming, new file exists:$new");
269		return;
270	}
271	$new=~s/.*\/(.*)/$1/;
272	if(rename($self->{pathfilename},$newpath))
273	{
274		my $old=$self->{filename};
275		$self->setfiledata($newpath);
276		$self->say("fixed:renamed from $old");
277	}
278	else
279	{
280		$self->say("cannot rename:$!");
281	}
282}
283
284=head2 initscan
285
286This is a stub function that just returns 1. It is here in case the
287tool does not need to implement an initscan method.
288
289=cut
290
291sub initscan
292{
293	return 1;
294}
295
296=head2 settests(@tests)
297
298Sets the list of tests (methods within the tool) to be called.
299
300=cut
301
302sub settests
303{
304	my ($self,@tests)=@_;
305	@{$self->{tests}}=@tests;
306}
307
308=head2 runtests
309
310Runs all the tests set by C<settests> in the current tool.
311
312=cut
313
314sub runtests
315{
316	my $self=shift;
317	if($#{$self->{tests}}<0)
318	{
319		$self->debug("no tests defined");
320	}
321	else
322	{
323		$self->{bail}=0;
324		for my $test (@{$self->{tests}})
325		{
326			$self->{currenttest}=$test;
327			$self->debug("scanning");
328			$self->$test();
329			if($self->{bail})
330			{
331				$self->debug("bailing out of tool");
332				last;
333			}
334		}
335		$self->{currenttest}=undef;
336	}
337}
338
339=head2 tool2module($tool)
340
341Converts a toolname (lowercase) to its perl module equivalent (first
342letter capitalised). Can be called as a static method.
343
344=cut
345
346sub tool2module
347{
348	my $tool=shift;
349	if(ref $tool) # method call, dont care about $self
350	{
351		$tool=shift;
352	}
353	return ucfirst(lc($tool));
354}
355
356=head2 module2tool($module)
357
358Converts a tool's perl module name (first letter capitalised) to its
359toolname (lowercase). Can be called as a static method.
360
361=cut
362
363sub module2tool
364{
365	my $mod=shift;
366	if(ref $mod) # method call, dont care about $self
367	{
368		$mod=shift;
369	}
370	$mod=~s/\.[Pp][Mm]$//;
371	return lc($mod);
372}
373
374=head2 findprogram($program)
375
376Attempts to find $program in the users $PATH. Returns either the full
377path to the program or undef if not found.
378
379=cut
380
381sub findprogram
382{
383	my $program=shift;
384	if(ref $program) # method call, dont care about $self
385	{
386		$program=shift;
387	}
388	unless(exists($ENV{PATH}))
389	{
390		$ENV{PATH}="/usr/local/bin:/usr/bin:/bin:/sbin";
391	}
392	my @path=split(/:/,$ENV{PATH});
393	foreach my $pathname (@path)
394	{
395		my $try=$pathname."/".$program;
396		if(-x $try)
397		{
398			return $try;
399		}
400	}
401	# not found
402	return undef;
403}
404
405=head1 BUGS
406
407None known. Please report any found to ianb@nessie.mcc.ac.uk
408
409=head1 SEE ALSO
410
411L<mp3lint(1)>, L<mp3lint-tools(3)>, L<mp3lintskip(1)>,
412L<mp3lintsum(1)>, L<mp3lintrc(5)>, L<MP3::Archive(3)>,
413L<mp3-archive-tools(1)>
414
415=head1 AUTHOR
416
417Ian Beckwith <ianb@nessie.mcc.ac.uk>
418
419=cut
420
4211;
422