lib/CPANPLUS/t/15_CPANPLUS-Shell.t

   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
   4 BEGIN {
   5     use FindBin;
   6     require "$FindBin::Bin/inc/conf.pl";
   7 }
   8
   9 ### this lets us capture output from the default shell
  10 {   no warnings 'redefine';
  11
  12     my $out;
  13     *CPANPLUS::Shell::Default::__print = sub {
  14         my $self = shift;
  15         $out .= "@_";
  16     };
  17
  18     sub _out        { $out }
  19     sub _reset_out  { $out = '' }
  20 }
  21
  22 use strict;
  23 use Test::More      'no_plan';
  24 use CPANPLUS::Internals::Constants;
  25
  26 my $Conf    = gimme_conf();
  27 my $Class   = 'CPANPLUS::Shell';
  28 my $Default = SHELL_DEFAULT;
  29 my $TestMod = TEST_CONF_MODULE;
  30 my $TestAuth= TEST_CONF_AUTHOR;
  31
  32
  33 ### basic load tests
  34 use_ok( $Class, 'Default' );
  35 is( $Class->which,  SHELL_DEFAULT,
  36                                 "Default shell loaded" );
  37
  38 ### create an object
  39 my $Shell = $Class->new( $Conf );
  40 ok( $Shell,                     "   New object created" );
  41 isa_ok( $Shell, $Default,       "   Object" );
  42
  43 ### method tests
  44 {
  45     ### uri to use for /cs tests
  46     my $cs_path = File::Spec->rel2abs(
  47                         File::Spec->catfile(
  48                             $FindBin::Bin,
  49                             TEST_CONF_CPAN_DIR,
  50                         )
  51                     );
  52     my $cs_uri = $Shell->backend->_host_to_uri(
  53                         scheme  => 'file',
  54                         host    => '',
  55                         path    => $cs_path,
  56                     );
  57
  58
  59     ### XXX have to keep the list ordered, as some methods only work as
  60     ### expected *after* others have run
  61     my @map = (
  62         'v'                     => qr/CPANPLUS/,
  63         '! $self->__print($$)'  => qr/$$/,
  64         '?'                     => qr/\[General\]/,
  65         'h'                     => qr/\[General\]/,
  66         's'                     => qr/Unknown type/,
  67         's conf'                => qr/$Default/,
  68         's program'             => qr/sudo/,
  69         's mirrors'             => do { my $re = TEST_CONF_CPAN_DIR; qr/$re/ },
  70         's selfupdate'          => qr/selfupdate/,
  71         'b'                     => qr/autobundle/,
  72         "a $TestAuth"           => qr/$TestAuth/,
  73         "m $TestMod"            => qr/$TestMod/,
  74         "w"                     => qr/$TestMod/,
  75         "r 1"                   => qr/README/,
  76         "r $TestMod"            => qr/README/,
  77         "f $TestMod"            => qr/$TestAuth/,
  78         "d $TestMod"            => qr/$TestMod/,
  79         ### XXX this one prints to stdout in a subprocess -- skipping this
  80         ### for now due to possible PERL_CORE issues
  81         #"t $TestMod"            => qr/$TestMod.*tested successfully/i,
  82         "l $TestMod"            => qr/$TestMod/,
  83         '! die $$; p'           => qr/$$/,
  84         '/plugins'              => qr/Available plugins:/i,
  85         '/? ?'                  => qr/usage/i,
  86
  87         ### custom source plugin tests
  88         "/? cs"                  => qr|/cs|,
  89         "/cs --add $cs_uri"      => qr/Added remote source/,
  90         "/cs --list"             => do { my $re = quotemeta($cs_uri); qr/$re/ },
  91         "/cs --contents $cs_uri" => qr/$TestAuth/,
  92         "/cs --update"           => qr/Updated remote sources/,
  93         "/cs --update $cs_uri"   => qr/Updated remote sources/,
  94         "/cs --write $cs_path"   => qr/Wrote remote source index/,
  95         "/cs --remove $cs_uri"   => qr/Removed remote source/,
  96     );
  97
  98     my $meth = 'dispatch_on_input';
  99     can_ok( $Shell, $meth );
 100
 101     while( my($input,$out_re) = splice(@map, 0, 2) ) {
 102
 103         ### empty output cache
 104         __PACKAGE__->_reset_out;
 105         CPANPLUS::Error->flush;
 106
 107         ok( 1,                  "Testing '$input'" );
 108         $Shell->$meth( input => $input );
 109
 110         my $out = __PACKAGE__->_out;
 111
 112         ### XXX remove me
 113         #diag( $out );
 114
 115         ok( $out,               "   Output received" );
 116         like( $out, $out_re,    "   Output matches '$out_re'" );
 117     }
 118 }
 119
 120 __END__
 121
 122 #### test seperately, they have side effects
 123 'q'                     => qr/^$/,          # no output!
 124 's save boxed'          => do { my $re = CONFIG_BOXED;       qr/$re/ },
 125 ### this doens't write any output
 126 'x --update_source'     => qr/module tree/i,
 127 s edit
 128 s reconfigure
 129 'c'     => '_reports',
 130 'i'     => '_install',
 131 'u'     => '_uninstall',
 132 'z'     => '_shell',
 133 ### might not have any out of date modules...
 134 'o'     => '_uptodate',
 135
 136