File Coverage

blib/lib/App/Stow/Check.pm
Criterion Covered Total %
statement 21 54 38.8
branch 0 12 0.0
condition 0 9 0.0
subroutine 7 10 70.0
pod 2 2 100.0
total 30 87 34.4


line stmt bran cond sub pod time code
1             package App::Stow::Check;
2              
3 2     2   78933 use strict;
  2         12  
  2         61  
4 2     2   10 use warnings;
  2         4  
  2         56  
5              
6 2     2   35 use Cwd qw(realpath);
  2         5  
  2         166  
7 2     2   1141 use File::Spec::Functions qw(abs2rel splitdir);
  2         2033  
  2         139  
8 2     2   1098 use File::Which qw(which);
  2         2253  
  2         109  
9 2     2   4421 use Getopt::Std;
  2         125  
  2         148  
10 2     2   1202 use Readonly;
  2         8382  
  2         1046  
11              
12             Readonly::Scalar our $DEFAULT_STOW_DIR => '/usr/local/stow';
13              
14             our $VERSION = 0.02;
15              
16             # Constructor.
17             sub new {
18 0     0 1   my ($class, @params) = @_;
19              
20             # Create object.
21 0           my $self = bless {}, $class;
22              
23             # Object.
24 0           return $self;
25             }
26              
27             # Run.
28             sub run {
29 0     0 1   my $self = shift;
30              
31             # Process arguments.
32 0           $self->{'_opts'} = {
33             'd' => $DEFAULT_STOW_DIR,
34             'h' => 0,
35             };
36 0 0 0       if (! getopts('d:h', $self->{'_opts'}) || $self->{'_opts'}->{'h'} || @ARGV < 1) {
      0        
37 0           print STDERR "Usage: $0 [-d stow_dir] [-h] [--version] command\n";
38 0           print STDERR "\t-d stow_dir\tStow directory (default value is '$DEFAULT_STOW_DIR').\n";
39 0           print STDERR "\t-h\t\tHelp.\n";
40 0           print STDERR "\t--version\tPrint version.\n";
41 0           print STDERR "\tcommand\t\tCommand for which is stow dist looking.\n";
42 0           return 1;
43             }
44 0           $self->{'_command'} = $ARGV[0];
45              
46 0           my ($exit_code, $message) = $self->_check;
47 0 0         if ($exit_code == 0) {
48 0           print $message."\n";
49             } else {
50 0           print STDERR $message."\n";
51             }
52              
53 0           return $exit_code;
54             }
55              
56             sub _check {
57 0     0     my $self = shift;
58              
59 0           my $command = $self->{'_command'};
60              
61 0           my $command_path = which($command);
62 0 0         if (! defined $command_path) {
63 0           return (1, "Command '$command' not found.");
64             }
65              
66 0           my $stow_dir = $self->{'_opts'}->{'d'};
67 0 0         if (! -d $stow_dir) {
68 0           return (1, "Stow directory '$stow_dir' doesn't exist.");
69             }
70 0           my $rel_path = abs2rel(realpath($command_path), $stow_dir);
71 0           my @rel_path = splitdir($rel_path);
72 0 0         if ($rel_path[0] eq '..') {
73 0           return (1, "Command '$command' doesn't use stow.");
74             }
75 0 0 0       if ($rel_path[1] ne 'bin' && $rel_path[1] ne 'sbin') {
76 0           return (1, "Command '$command' don't use 'bin/sbin' path.");
77             }
78              
79 0           return (0, $rel_path[0]);
80             }
81              
82             1;
83              
84              
85             __END__