File Coverage

blib/lib/XAS/Lib/Spawn.pm
Criterion Covered Total %
statement 11 38 28.9
branch 1 20 5.0
condition n/a
subroutine 4 6 66.6
pod 1 1 100.0
total 17 65 26.1


line stmt bran cond sub pod time code
1             package XAS::Lib::Spawn;
2              
3             our $VERSION = '0.01';
4              
5             my $mixin;
6              
7             BEGIN {
8 1     1   706 $mixin = 'XAS::Lib::Spawn::Unix';
9 1 50       24 $mixin = 'XAS::Lib::Spawn::Win32' if ($^O eq 'MSWin32');
10             }
11              
12 1     1   5 use Hash::Merge;
  1         1  
  1         30  
13 1     1   4 use Badger::Filesystem 'Cwd File';
  1         1  
  1         6  
14              
15             use XAS::Class
16 1         9 debug => 0,
17             version => $VERSION,
18             base => 'XAS::Base',
19             mixin => "XAS::Lib::Mixins::Process $mixin",
20             utils => 'dotid trim',
21             accessors => 'merger',
22             vars => {
23             PARAMS => {
24             -command => 1,
25             -priority => { optional => 1, default => 0 },
26             -environment => { optional => 1, default => {} },
27             -umask => { optional => 1, default => '0022' },
28             -group => { optional => 1, default => 'nobody' },
29             -user => { optional => 1, default => 'nobody' },
30             -directory => { optional => 1, default => Cwd, isa => 'Badger::Filesystem::Directory' },
31             }
32             }
33 1     1   155 ;
  1         1  
34              
35             #use Data::Dumper;
36              
37             # ----------------------------------------------------------------------
38             # Public Methods
39             # ----------------------------------------------------------------------
40              
41             # ----------------------------------------------------------------------
42             # Private Methods
43             # ----------------------------------------------------------------------
44              
45             sub init {
46 0     0 1   my $class = shift;
47              
48 0           my $self = $class->SUPER::init(@_);
49              
50 0           $self->{'merger'} = Hash::Merge->new('RIGHT_PRECEDENT');
51              
52 0           return $self;
53              
54             }
55              
56             sub _resolve_path {
57 0     0     my $self = shift;
58 0           my $command = shift;
59 0           my $extensions = shift;
60 0           my $xpaths = shift;
61              
62             # Make the path to the progam absolute if it isn't already. If the
63             # path is not absolute and if the path contains a directory element
64             # separator, then only prepend the current working to it. If the
65             # path is not absolute, then look through the PATH environment to
66             # find the executable.
67              
68 0           my $path = File($command);
69              
70 0 0         if ($path->is_absolute) {
    0          
71              
72 0 0         if ($path->exists) {
73              
74 0           return $path->absolute;
75              
76             }
77              
78             } elsif ($path->is_relative) {
79              
80 0 0         if ($path->name eq $path) {
81              
82 0           foreach my $xpath (@$xpaths) {
83              
84 0 0         next if ($xpath eq '');
85              
86 0 0         if ($path->extension) {
87              
88 0           my $p = File($xpath, $path->name);
89              
90 0 0         if ($p->exists) {
91              
92 0           return $p->absolute;
93              
94             }
95              
96             } else {
97              
98 0           foreach my $ext (@$extensions) {
99              
100 0           my $p = File($xpath, $path->basename . $ext);
101              
102 0 0         if ($p->exists) {
103              
104 0           return $p->absolute;
105              
106             }
107              
108             }
109              
110             }
111              
112             }
113              
114             } else {
115              
116 0           my $p = File($path->absoulte);
117              
118 0 0         if ($p->exists) {
119              
120 0           return $p->absolute;
121              
122             }
123              
124             }
125              
126             }
127              
128             $self->throw_msg(
129 0           dotid($self->class) . '.resolve_path.path',
130             'process_location',
131             $command
132             );
133              
134             }
135              
136             1;
137              
138             __END__