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