File Coverage

blib/lib/App/Stow/Check.pm

Criterion	Covered	Total	%
statement	18	48	37.5
branch	0	10	0.0
condition	0	9	0.0
subroutine	6	9	66.6
pod	2	2	100.0
total	26	78	33.3

package App::Stow::Check;

use strict;
use warnings;

use Cwd qw(realpath);
use File::Spec::Functions qw(abs2rel splitdir);
use File::Which qw(which);
use Getopt::Std;

our $VERSION = 0.01;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Object.
	return $self;
}

# Run.
sub run {
	my $self = shift;

	# Process arguments.
	$self->{'_opts'} = {
		'h' => 0,
	};
	if (! getopts('h', $self->{'_opts'}) || $self->{'_opts'}->{'h'} || @ARGV < 1) {
		print STDERR "Usage: $0 [-h] [--version] command\n";
		print STDERR "\t-h\t\tHelp.\n";
		print STDERR "\t--version\tPrint version.\n";
		print STDERR "\tcommand\t\tCommand for which is stow dist looking.\n";
		return 1;
	}
	$self->{'_command'} = $ARGV[0];

	my ($exit_code, $message) = $self->_check;
	if ($exit_code == 0) {
		print $message."\n";
	} else {
		print STDERR $message."\n";
	}

	return $exit_code;
}

sub _check {
	my $self = shift;

	my $command = $self->{'_command'};

	my $command_path = which($command);
	if (! defined $command_path) {
		return (1, "Command '$command' not found.");
	}

	# XXX Need to be flexible.
	my $stow_dir = '/usr/local/stow';

	my $rel_path = abs2rel(realpath($command_path), $stow_dir);
	my @rel_path = splitdir($rel_path);
	if ($rel_path[0] eq '..') {
		return (1, "Command '$command' doesn't use stow.");
	}
	if ($rel_path[1] ne 'bin' && $rel_path[1] ne 'sbin') {
		return (1, "Command '$command' don't use 'bin/sbin' path.");
	}

	return (0, $rel_path[0]);
}

1;


__END__