# $Id: Skip.pm,v 1.7 2003/10/30 04:10:48 ianb Exp $
package MP3::Archive::Lint::Skip;

use strict;
use warnings;

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

=head1 NAME

MP3::Archive::Lint::Skip - Manage skip lists for mp3lint

=head1 SYNOPSIS

	use MP3::Archive::Lint::Skip;
	my $skip=MP3::Archive::Lint::Skip->new($opts);
	if($skip->skip($msg)) { ... }
	$skip->addlocal($msg);
	$skip->addglobal($msg);
	$skip->save;

=head1 DESCRIPTION

MP3::Archive::Lint::Skip handles maintenance of global and
per-directory lists of messages for mp3lint to skip.

=head1 PUBLIC METHODS

=cut

=head2 new([$opts])

Creates an instance of MP3::Archive::Lint::Skip

Takes an optional hashref of options:

=over 4	

=item skip

initial list of messages to skip (from .mp3lintrc)

=item overwrite

Boolean. Whether to overwrite (1) or merge(0) skip files (global and
local).

=back

=cut

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

	$self->{globalskipfile}=$ENV{HOME}."/.mp3lintskip-global";
	$self->{localskipfile}=".mp3lintskip";

	$self->{overwrite}=0;

	$self->{lastdir}="";
	@{$self->{globalskip}}=();
	@{$self->{newglobalskip}}=();
	@{$self->{rcglobalskip}}=();
	@{$self->{localskip}}=();
	@{$self->{newlocalskip}}=();

	my $hashref;
	if($hashref=shift)
	{
		if(exists($hashref->{skip}))
		{
			$self->{rcglobalskip}=$hashref->{skip};
		}
		if(exists($hashref->{overwrite}))
		{
			$self->{overwrite}=$hashref->{overwrite};
		}
	}

	if(open(GLOBAL,$self->{globalskipfile}))
	{
		while(<GLOBAL>)
		{
			chomp;
			next if /^$/;
			next if /^\s*#/;
			push(@{$self->{globalskip}},$_);
		}
		close(GLOBAL);
	}
	return $self;
}

=head2 skip($msg)

Decides which messages to skip printing by consulting skip files and
the current configuration. Returns 1 if the message should be skipped,
0 if it should be printed.

=cut	

sub skip
{
	my($self,$msg)=@_;
	return 0 if($msg=~/^mp3lint:/);
	return 0 if($msg=~/^debug:/);
	# malformed line, print anyway
	return 0 if(scalar(grep {$_ eq ":" } split(//,$msg)) < 3);

	my ($start,undef,$file)=$self->parsemsg($msg);
	return 0 unless defined($start); # couldnt parse
	
	# Do substr regexp matches on rcglobalskip as user defined
	for my $skip (@{$self->{rcglobalskip}})
	{
		if($start =~/$skip/)
		{
			return 1;
		}
	}
	
	for my $skip (@{$self->{globalskip}},@{$self->{newglobalskip}})
	{
		if($skip eq $start)
		{
			return 1;
		}
	}

	$self->newmsg($msg);
	
	my $match=$start.$file;
#	print $match."\n";
	for my $skip (@{$self->{localskip}}, @{$self->{newlocalskip}})
	{
#		print "Skip: \n${skip}\n${match}\n";
		if($skip eq $match)
		{
			return 1;
		}
	}

	return 0;
}

=head2 save

Saves all skip files by calling C<$self-E<gt>writeglobal> and
C<$self-E<gt>writelocal>.

=cut	

sub save
{
	my $self=shift;
	$self->writeglobal;
	$self->writelocal;
}

=head2 addglobal($msg)

Adds a skip message to the global list.

=cut

sub addglobal
{
	my($self,$msg)=@_;
	my $add;
	if($add=($self->parsemsg($msg))[0])
	{
		push(@{$self->{newglobalskip}},$add);
	}
}

=head2 addlocal($msg)

Adds a skip message to the local (per directory) list.

=cut

sub addlocal
{
	my($self,$msg)=@_;
	$self->newmsg($msg);
	my ($start,$file);
	($start,undef,$file)=$self->parsemsg($msg);
	if(defined($start))
	{
		push(@{$self->{newlocalskip}}, $start.$file );
	}
}

=head1 INTERNAL METHODS

=head2 DESTROY

Destructor. Ensures skip files are saved on exit. Calls
C<$self-E<gt>save>.

=cut	

sub DESTROY
{
	my $self=shift;
	$self->save;
}

=head2 newmsg($msg)

Called for each message. If the file referred to is in a different
directory to the last one, it saves the last .mp3lintskip file, and
preloads the new skip list with the contents of the latest directory's
.mp3lintskip, if it exists.

=cut

sub newmsg
{
	my($self,$msg)=@_;
	my $dir=($self->parsemsg($msg))[1];
	if(defined($dir) && ($dir ne $self->{lastdir}))
	{
		$self->writelocal;

		@{$self->{localskip}}=();
		@{$self->{newlocalskip}}=();
		$self->{lastdir}=$dir;
		
		if(open(LOCAL,$dir.$self->{localskipfile}))
		{
			while(<LOCAL>)
			{
				chomp;
				push(@{$self->{localskip}},$_);
			}
			close(LOCAL);
		}
	}
}

=head2 parsemsg($msg)

Parses a message and returns the constant initial portion and the
filename.

=cut

sub parsemsg
{
	my($self,$msg)=@_;
	if($msg=~/(^[^:]+:[^:]+:[^:]+:)(?:.*:)?([^:]+)$/)
	{
		my($start,$filepath)=($1,$2);
		if(!-e $filepath)
		{
#			print "FILEPATH $filepath not found\n";
		}
		else
		{
			if(-d $filepath)
			{
				$filepath=$filepath."/.";
			}
		}
		if($filepath!~/\//) # just filename
		{
			$filepath="./$filepath";
		}
		my ($dir,$file)=($filepath=~/(.*\/)(.*)/);
		return($start,$dir,$file);
	}
	return(());
}

=head2 writelocal

Writes the current local skip list to the per-directory .mp3lintskip
file.

=cut

sub writelocal
{
	my $self=shift;
	# anything to write?
	return unless(@{$self->{newlocalskip}});

	my @local=@{$self->{newlocalskip}};
	unless($self->{overwrite})
	{
		push(@local,@{$self->{localskip}});
	}
	
	my $filename=$self->{lastdir}.$self->{localskipfile};
	$self->writefile($filename,\@local);

	push(@{$self->{localskip}},@{$self->{newlocalskip}});
	@{$self->{newlocalskip}}=();
}

=head2 writeglobal

Writes the global ~/.mp3lintskip-global file.

=cut

sub writeglobal
{
	my $self=shift;

	# anything to write?
	return unless(@{$self->{newglobalskip}});
	
	my @global=@{$self->{newglobalskip}};
	unless($self->{overwrite})
	{
		push(@global,@{$self->{globalskip}});
	}

	$self->writefile($self->{globalskipfile},\@global);
	push(@{$self->{globalskip}},@{$self->{newglobalskip}});
	@{$self->{newglobalskip}}=();
}

=head2 writefile($file,$lines)

Removes duplicates from $lines, sorts the remaining lines, then writes
them to $file. This is a helper method used by C<writelocal> and
C<writeglobal>.

=cut

sub writefile
{
	my($self,$file,$lines)=@_;
	
	@$lines=sort($self->uniq(@$lines)) ;

	if(open(W,">$file"))
	{
		foreach my $line (@$lines)
		{
			print W "$line\n";
		}
		close(W);
	}
	else
	{
		warn("$0: cannot write $file:$!\n");
	}
}

=head2 uniq(@list)

Returns @list with duplicates removed. Order is not preserved.

uniq can be called as a static method

=cut

sub uniq
{
	if(ref($_[0]))
	{
		shift; # method call
	}
	my %items=map { $_ => 1 } @_;
	return(keys %items);
}

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