1 ### the shell prints to STDOUT, so capture that here
2 ### and we can check the output
3 ### make sure we can find our conf.pl file
6 require "$FindBin::Bin/inc/conf.pl";
9 ### this lets us capture output from the default shell
10 { no warnings 'redefine';
13 *CPANPLUS::Shell::Default::__print = sub {
19 sub _reset_out { $out = '' }
23 use Test::More 'no_plan';
24 use CPANPLUS::Internals::Constants;
26 ### in some subprocesses, the Term::ReadKey code will go
27 ### balistic and die because it can't figure out terminal
28 ### dimensions. If we add these env vars, it'll use them
29 ### as a default and not die. Thanks to Slaven Rezic for
31 local $ENV{'COLUMNS'} = 80 unless $ENV{'COLUMNS'};
32 local $ENV{'LINES'} = 40 unless $ENV{'LINES'};
34 my $Conf = gimme_conf();
35 my $Class = 'CPANPLUS::Shell';
36 my $Default = SHELL_DEFAULT;
37 my $TestMod = TEST_CONF_MODULE;
38 my $TestAuth= TEST_CONF_AUTHOR;
42 use_ok( $Class, 'Default' );
43 is( $Class->which, SHELL_DEFAULT,
44 "Default shell loaded" );
47 my $Shell = $Class->new( $Conf );
48 ok( $Shell, " New object created" );
49 isa_ok( $Shell, $Default, " Object" );
53 ### uri to use for /cs tests
54 my $cs_path = File::Spec->rel2abs(
60 my $cs_uri = $Shell->backend->_host_to_uri(
66 my $base = $Conf->get_conf('base');
68 ### XXX have to keep the list ordered, as some methods only work as
69 ### expected *after* others have run
72 '! $self->__print($$)' => qr/$$/,
73 '?' => qr/\[General\]/,
74 'h' => qr/\[General\]/,
75 's' => qr/Unknown type/,
76 's conf' => qr/$Default/,
77 's program' => qr/sudo/,
78 's mirrors' => do { my $re = TEST_CONF_CPAN_DIR; qr/$re/ },
79 's selfupdate' => qr/selfupdate/,
80 'b' => qr/autobundle/,
81 "a $TestAuth" => qr/$TestAuth/,
82 "m $TestMod" => qr/$TestMod/,
85 "r $TestMod" => qr/README/,
86 "f $TestMod" => qr/$TestAuth/,
87 "d $TestMod" => qr/$TestMod/,
88 ### XXX this one prints to stdout in a subprocess -- skipping this
89 ### for now due to possible PERL_CORE issues
90 #"t $TestMod" => qr/$TestMod.*tested successfully/i,
91 "l $TestMod" => qr/$TestMod/,
92 '! die $$; p' => qr/$$/,
93 '/plugins' => qr/Available plugins:/i,
96 ### custom source plugin tests
97 ### lower case path matching, as on VMS we can't predict case
99 "/cs --add $cs_uri" => qr/Added remote source/,
100 "/cs --list" => do { my $re = quotemeta($cs_uri); qr/$re/i },
101 "/cs --contents $cs_uri" => qr/$TestAuth/i,
102 "/cs --update" => qr/Updated remote sources/,
103 "/cs --update $cs_uri" => qr/Updated remote sources/,
105 ### --write leaves a file that we should clean up, so make
106 ### sure it's in the path that we clean up already anyway
107 "/cs --write $base" => qr/Wrote remote source index/,
108 "/cs --remove $cs_uri" => qr/Removed remote source/,
111 my $meth = 'dispatch_on_input';
112 can_ok( $Shell, $meth );
114 while( my($input,$out_re) = splice(@map, 0, 2) ) {
116 ### empty output cache
117 __PACKAGE__->_reset_out;
118 CPANPLUS::Error->flush;
120 ok( 1, "Testing '$input'" );
121 $Shell->$meth( input => $input );
123 my $out = __PACKAGE__->_out;
128 ok( $out, " Output received" );
129 like( $out, $out_re, " Output matches '$out_re'" );
135 #### test seperately, they have side effects
136 'q' => qr/^$/, # no output!
137 's save boxed' => do { my $re = CONFIG_BOXED; qr/$re/ },
138 ### this doens't write any output
139 'x --update_source' => qr/module tree/i,
146 ### might not have any out of date modules...