15_cpanplus-shell.t

source of perl for linux application,

### 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;

 
### 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 seperately, 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',