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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
### the shell prints to STDOUT, so capture that here
### and we can check the output
### make sure we can find our conf.pl file
BEGIN {
use FindBin;
require "$FindBin::Bin/inc/conf.pl";
}
### this lets us capture output from the default shell
{ no warnings 'redefine';
my $out;
*CPANPLUS::Shell::Default::__print = sub {
my $self = shift;
$out .= "@_";
};
sub _out { $out }
sub _reset_out { $out = '' }
}
use strict;
use Test::More 'no_plan';
use CPANPLUS::Internals::Constants;
### in some subprocesses, the Term::ReadKey code will go
### balistic and die because it can't figure out terminal
### dimensions. If we add these env vars, it'll use them
### as a default and not die. Thanks to Slaven Rezic for
### reporting this.
local $ENV{'COLUMNS'} = 80 unless $ENV{'COLUMNS'};
local $ENV{'LINES'} = 40 unless $ENV{'LINES'};
my $Conf = gimme_conf();
my $Class = 'CPANPLUS::Shell';
my $Default = SHELL_DEFAULT;
my $TestMod = TEST_CONF_MODULE;
my $TestAuth= TEST_CONF_AUTHOR;
unless ( -t ) {
ok('We are not on a terminal');
exit 0;
}
### basic load tests
use_ok( $Class, 'Default' );
is( $Class->which, SHELL_DEFAULT,
"Default shell loaded" );
### create an object
my $Shell = $Class->new( $Conf );
ok( $Shell, " New object created" );
isa_ok( $Shell, $Default, " Object" );
### method tests
{
### uri to use for /cs tests
my $cs_path = File::Spec->rel2abs(
File::Spec->catfile(
$FindBin::Bin,
TEST_CONF_CPAN_DIR,
)
);
my $cs_uri = $Shell->backend->_host_to_uri(
scheme => 'file',
host => '',
path => $cs_path,
);
my $base = $Conf->get_conf('base');
### XXX have to keep the list ordered, as some methods only work as
### expected *after* others have run
my @map = (
'v' => qr/CPANPLUS/,
'! $self->__print($$)' => qr/$$/,
'?' => qr/\[General\]/,
'h' => qr/\[General\]/,
's' => qr/Unknown type/,
's conf' => qr/$Default/,
's program' => qr/sudo/,
's mirrors' => do { my $re = TEST_CONF_CPAN_DIR; qr/$re/ },
's selfupdate' => qr/selfupdate/,
'b' => qr/autobundle/,
"a $TestAuth" => qr/$TestAuth/,
"m $TestMod" => qr/$TestMod/,
"w" => qr/$TestMod/,
"r 1" => qr/README/,
"r $TestMod" => qr/README/,
"f $TestMod" => qr/$TestAuth/,
"d $TestMod" => qr/$TestMod/,
### XXX this one prints to stdout in a subprocess -- skipping this
### for now due to possible PERL_CORE issues
#"t $TestMod" => qr/$TestMod.*tested successfully/i,
"l $TestMod" => qr/$TestMod/,
'! die $$; p' => qr/$$/,
'/plugins' => qr/Available plugins:/i,
'/? ?' => qr/usage/i,
### custom source plugin tests
### lower case path matching, as on VMS we can't predict case
"/? cs" => qr|/cs|,
"/cs --add $cs_uri" => qr/Added remote source/,
"/cs --list" => do { my $re = quotemeta($cs_uri); qr/$re/i },
"/cs --contents $cs_uri" => qr/$TestAuth/i,
"/cs --update" => qr/Updated remote sources/,
"/cs --update $cs_uri" => qr/Updated remote sources/,
### --write leaves a file that we should clean up, so make
### sure it's in the path that we clean up already anyway
"/cs --write $base" => qr/Wrote remote source index/,
"/cs --remove $cs_uri" => qr/Removed remote source/,
);
my $meth = 'dispatch_on_input';
can_ok( $Shell, $meth );
while( my($input,$out_re) = splice(@map, 0, 2) ) {
### empty output cache
__PACKAGE__->_reset_out;
CPANPLUS::Error->flush;
ok( 1, "Testing '$input'" );
$Shell->$meth( input => $input );
my $out = __PACKAGE__->_out;
### XXX remove me
#diag( $out );
ok( $out, " Output received" );
like( $out, $out_re, " Output matches '$out_re'" );
}
}
__END__
#### test separately, they have side effects
'q' => qr/^$/, # no output!
's save boxed' => do { my $re = CONFIG_BOXED; qr/$re/ },
### this doens't write any output
'x --update_source' => qr/module tree/i,
s edit
s reconfigure
'c' => '_reports',
'i' => '_install',
'u' => '_uninstall',
'z' => '_shell',
### might not have any out of date modules...
'o' => '_uptodate',
|
