# $Id: Filesys.pm,v 1.4 2003/10/26 03:31:13 ianb Exp $
package MP3::Archive::Lint::Tools::Filesys;

use strict;
use warnings;

use MP3::Archive::Lint::Tool;
use File::stat ();

use vars qw(@ISA $VERSION);
@ISA = qw(MP3::Archive::Lint::Tool);
$VERSION = '0.01';

=head1 filesys - Tool for misc filesys tests

Various checks that don't belong anywhere else and are related to the file system.

=head2 Tests

=over 4

=cut

sub new
{
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my $opts=shift;
	my $self=$class->SUPER::new($opts);
	bless($self,$class);

	$self->{perms_file}=$self->config->get("lint_perms_file");
	$self->{perms_dir}=$self->config->get("lint_perms_dir");

	$self->settests("empty","perms");
	$self->{wantfileerrors}=1;

	return $self;
}

sub initscan
{
	my $self=shift;
	$self->settests("access");
	if(-e $self->{file})
	{
		my $stat=File::stat::stat($self->{file});
		if($stat)
		{
			$self->settests("access","empty","perms");
			$self->{mode}=$stat->mode & 07777;
		}
	}
	return 1;
}


=item B<empty>

Checks for zero-length files.

=cut

sub empty
{
	my $self=shift;
	if(-z $self->{file})
	{
		$self->say("file is empty");
	}
}

=item B<access>

Checks for non-existant or unreadable files and broken symbolic links.

=cut	

sub access
{
	my $self=shift;
	if(!-e $self->{file})
	{
		if(-l $self->{file})
		{
			my $link=readlink($self->{file});
			if(!defined($link))
			{
				$link="";
			}
			else
			{
				$link=":$link";
			}
			$self->say("broken link$link");
		}
		else
		{
			$self->say("file not found");
		}
	}
	elsif(!-r $self->{file})
	{
		$self->say("file unreadable");
	}
}

=item B<perms>

Checks permissions. If -F (fix) is specified, attempts
to fix incorrect permissions. 

Variables:

=over 4

=item $perms_file

(octal number, default 0644 (rw-r--r--))

=item $perms_dir

(octal number, default 0755 (rwxr-xr-x))

=back

For details on the encoding of permissions, see L<chmod(1)>,
but briefly, the value consists of a leading 0, then 3 digits,
one each for the user, group, and everyone else. Each digit is
the sum of the values I<4> for write, I<2> for read, and I<1>
for execute.

For instance, if you wanted full access for yourself, read and execute
for your group, and no access for anyone else, you would use (r+w+x =
4+2+1 =) 7 for user, (r+x = 4+1=) 5 for group and 0 for world
(everyone else). Putting this together, we get B<0750>

Example values:

	0700 = rwx------
	0751 = rwxr-x--x
	0604 = rw-----w-
	0124 = --x-w-r--

If you want to let other users on your machine read your files, use
I<0644> (rw-r--r--) for C<$perms_file> and I<0755> (rw-r--r--) for
C<$perms_dir>. If you want to keep your files private, use I<0600>
(rw-------) for C<$perms_file> and I<0700> (rwx------) for
C<$perms_dir>

Directories need to have their "x" flag set if you want people to be
able to change into them.

It is essential that C<$perms_dir> and C<$perms_file> start with a 0,
eg I<0755> not I<755>, for them to correctly be interpreted as
octal values.

=cut

sub perms
{
	my $self=shift;
	my $wantperms;
	
	if(-d $self->{file})
	{
		$wantperms=$self->{perms_dir};
	}
	else
	{
		$wantperms=$self->{perms_file};
	}
	
	if($self->{mode} != $wantperms)
	{
		if($self->config->fix)
		{
			if(chmod($wantperms,$self->{file}))
			{
				$self->say("fixed:permissions set to ".sprintf("%04o",$wantperms));
			}
			else
			{
				$self->say("error - could not fix permissions:$!");
			}
		}
		else
		{
			$self->say(sprintf("wrong permissions:%04o (should be %04o)",$self->{mode},$wantperms));
		}
		return 0;
	}
}

=back

=cut

1;