1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
package MyTest::System;
use strict;
use warnings;
use Exporter qw( import );
use Scalar::Util qw( refaddr );
use Text::ParseWords qw( shellwords );
use Scalar::Util qw( weaken );
use File::Which ();
our @EXPORT = qw( system_fake system_add );
sub system_fake
{
__PACKAGE__->new(@_);
}
my @stack;
*CORE::GLOBAL::system = sub {
my $system = $stack[-1];
if($system)
{
$system->call(@_);
}
else
{
return CORE::system(@_);
}
};
{
my $old = \&File::Which::which;
no warnings 'redefine';
*File::Which::which = sub
{
my $system = $stack[-1];
if($system)
{
$system->can_run(@_);
}
else
{
return $old->(@_);
}
};
}
sub new
{
my($class, %cmds) = @_;
my $self = bless { %cmds }, $class;
push @stack, $self;
weaken $stack[-1];
$self;
}
sub add
{
my($self, $command, $code) = @_;
$self->{$command} = $code;
}
sub call
{
my($self, $command, @args) = @_;
if(@args == 0)
{
if($^O eq 'MSWin32' && $command =~ /^"(.*)"$/)
{ $command = $1 }
($command, @args) = shellwords $command;
}
if($self->{$command})
{
my $exit = $self->{$command}->(@args);
return $? = ($exit << 8);
}
else
{
$! = 'No such file or directory';
return $? = -1;
}
}
sub can_run
{
my($self, $command) = @_;
# we only really use can_run to figure out if
# we CAN run an executable, but make up some
# path just for pretends.
$self->{$command}
? "/bin/$command"
: undef;
}
sub DESTROY
{
my($self) = @_;
@stack = grep { refaddr($_) ne refaddr($self) } @stack;
}
1;
|
