1*256a93a4Safresh1use strict; 2*256a93a4Safresh1use warnings; 3*256a93a4Safresh1use Test::More; 4*256a93a4Safresh1 5*256a93a4Safresh1unless ($ENV{AUTHOR_TEST}) { 6*256a93a4Safresh1 my $msg = 'running MinimumVersion test only run when AUTHOR_TEST set'; 7*256a93a4Safresh1 plan( skip_all => $msg ); 8*256a93a4Safresh1} 9*256a93a4Safresh1 10*256a93a4Safresh1unshift @INC, './lib', './t'; 11*256a93a4Safresh1require local_utils; 12*256a93a4Safresh1local_utils::cleanup_dot_cpan(); 13*256a93a4Safresh1local_utils::prepare_dot_cpan(); 14*256a93a4Safresh1local_utils::read_myconfig(); 15*256a93a4Safresh1require CPAN::MyConfig; 16*256a93a4Safresh1require CPAN; 17*256a93a4Safresh1CPAN::HandleConfig->load; 18*256a93a4Safresh1 19*256a93a4Safresh1for (qw(HTTP::Tiny Net::SSLeay IO::Socket::SSL)) { 20*256a93a4Safresh1 my $has_it = eval "require $_; 1"; 21*256a93a4Safresh1 ok $has_it, "found $_" or plan( skip_all => "$_ not available" ); 22*256a93a4Safresh1} 23*256a93a4Safresh1 24*256a93a4Safresh1{ 25*256a93a4Safresh1 package CPAN::Shell::tacet; 26*256a93a4Safresh1 my $output; 27*256a93a4Safresh1 sub init { 28*256a93a4Safresh1 $output = ""; 29*256a93a4Safresh1 } 30*256a93a4Safresh1 sub myprint { 31*256a93a4Safresh1 shift; 32*256a93a4Safresh1 $output .= shift; 33*256a93a4Safresh1 } 34*256a93a4Safresh1 sub mydie { 35*256a93a4Safresh1 shift; 36*256a93a4Safresh1 die shift; 37*256a93a4Safresh1 } 38*256a93a4Safresh1 *mywarn = *mywarn = \&myprint; 39*256a93a4Safresh1 sub output { 40*256a93a4Safresh1 $output; 41*256a93a4Safresh1 } 42*256a93a4Safresh1} 43*256a93a4Safresh1 44*256a93a4Safresh1sub collect_output { 45*256a93a4Safresh1 CPAN::Shell::tacet->init(); 46*256a93a4Safresh1 my $command = shift @_; 47*256a93a4Safresh1 CPAN::Shell->$command(@_); 48*256a93a4Safresh1 return CPAN::Shell::tacet->output(); 49*256a93a4Safresh1} 50*256a93a4Safresh1 51*256a93a4Safresh1$CPAN::Frontend = $CPAN::Frontend = "CPAN::Shell::tacet"; 52*256a93a4Safresh1 53*256a93a4Safresh1require File::Which; 54*256a93a4Safresh1my %HAVE; 55*256a93a4Safresh1for (qw(curl wget)) { 56*256a93a4Safresh1 if (my $which = File::Which::which($_)) { 57*256a93a4Safresh1 pass $which; 58*256a93a4Safresh1 my $o = collect_output ( o => conf => $_ => $which ); 59*256a93a4Safresh1 like $o, qr(Please use), "'Please use' on $_" or diag ">>>>$o<<<<"; 60*256a93a4Safresh1 $HAVE{$_} = $which; 61*256a93a4Safresh1 } else { 62*256a93a4Safresh1 plan( skip_all => "$_ not found" ); 63*256a93a4Safresh1 } 64*256a93a4Safresh1} 65*256a93a4Safresh1 66*256a93a4Safresh1like collect_output ( o => conf => pushy_https => 1 ), qr(Please use), "'Please use' on pushy_https"; 67*256a93a4Safresh1like collect_output ( o => conf => tar_verbosity => "none" ), qr(Please use), "'Please use' on tar_verbosity"; 68*256a93a4Safresh1 69*256a93a4Safresh1# | HTTP::Tiny | Net::SSLeay+IO::Socket::SSL | curl | wget | proto | 70*256a93a4Safresh1# |------------+-----------------------------+------+------+-------| 71*256a93a4Safresh1# | 1 | 1 | 1 | 1 | https | (1) 72*256a93a4Safresh1# | 1 | 1 | 0 | 0 | https | (2) 73*256a93a4Safresh1# | 1 | 0 | 0 | 0 | http | (3) 74*256a93a4Safresh1# | 0 | 0 | 0 | 0 | - | (4) 75*256a93a4Safresh1# | 0 | 0 | 1 | 0 | https | (5) 76*256a93a4Safresh1# | 0 | 0 | 0 | 1 | https | (6) 77*256a93a4Safresh1 78*256a93a4Safresh1my $getmodule = "CPAN::Test::Dummy::Perl5::Make"; 79*256a93a4Safresh1my $getdistro_qr = qr(CPAN-Test-Dummy-Perl5-Make); 80*256a93a4Safresh1 81*256a93a4Safresh1# 1 82*256a93a4Safresh1like collect_output ( force => get => $getmodule ), 83*256a93a4Safresh1 qr((?s)Fetching with HTTP::Tiny.*https://.+/$getdistro_qr), "saw (1) https with all parties ON"; 84*256a93a4Safresh1ok unlink(CPAN::Shell->expand("Module", $getmodule)->distribution->{localfile}), "unlink tarball"; 85*256a93a4Safresh1 86*256a93a4Safresh1# 2 87*256a93a4Safresh1like collect_output ( o => conf => curl => "" ), qr(Please use), "'Please use' on curl OFF"; 88*256a93a4Safresh1like collect_output ( o => conf => wget => "" ), qr(Please use), "'Please use' on wget OFF"; 89*256a93a4Safresh1like collect_output ( force => get => $getmodule ), 90*256a93a4Safresh1 qr((?s)Fetching with HTTP::Tiny.*https://.+/$getdistro_qr), "saw (2) https with HTTP::Tiny+SSL ON"; 91*256a93a4Safresh1ok unlink(CPAN::Shell->expand("Module", $getmodule)->distribution->{localfile}), "unlink tarball"; 92*256a93a4Safresh1 93*256a93a4Safresh1# 3 94*256a93a4Safresh1ok delete $CPAN::HAS_USABLE->{"Net::SSLeay"}, "delete Net::SSLeay from %HAS_USABLE"; 95*256a93a4Safresh1ok delete $INC{"Net/SSLeay.pm"}, "delete Net::SSLeay from %INC"; 96*256a93a4Safresh1like collect_output ( o => conf => dontload_list => "Net::SSLeay" ), 97*256a93a4Safresh1 qr(Please use), "'Please use' on Net::SSLeay OFF"; 98*256a93a4Safresh1like collect_output ( force => get => $getmodule ), 99*256a93a4Safresh1 qr((?si)fall back to http.*fetching with HTTP::Tiny.*http://.+/$getdistro_qr), 100*256a93a4Safresh1 "saw (3) http:// with HTTP::Tiny without SSL"; 101*256a93a4Safresh1ok unlink(CPAN::Shell->expand("Module", $getmodule)->distribution->{localfile}), "unlink tarball"; 102*256a93a4Safresh1 103*256a93a4Safresh1# 4 104*256a93a4Safresh1ok delete $CPAN::HAS_USABLE->{"HTTP::Tiny"}, "delete HTTP::Tiny from %HAS_USABLE"; 105*256a93a4Safresh1ok delete $INC{"HTTP/Tiny.pm"}, "delete HTTP::Tiny from %INC"; 106*256a93a4Safresh1like collect_output ( o => conf => dontload_list => push => "HTTP::Tiny" ), 107*256a93a4Safresh1 qr(Please use), "'Please use' on HTTP::Tiny OFF"; 108*256a93a4Safresh1eval { collect_output ( force => get => $getmodule ) }; 109*256a93a4Safresh1my $output = CPAN::Shell::tacet->output; 110*256a93a4Safresh1like $@, qr(Giving up), "saw error 'Giving up'"; 111*256a93a4Safresh1like $output, qr(Missing or unusable module), "saw (4) 'unusable module'"; 112*256a93a4Safresh1 113*256a93a4Safresh1# 5 114*256a93a4Safresh1like collect_output ( o => conf => curl => $HAVE{curl} ), qr(Please use), "'Please use' on curl ON"; 115*256a93a4Safresh1ok $CPAN::Config->{curl}, "set curl to $CPAN::Config->{curl}"; 116*256a93a4Safresh1like collect_output ( force => get => $getmodule ), 117*256a93a4Safresh1 qr((?s)Trying with.*curl.*to get.*https://.+/$getdistro_qr), "saw (5) https with curl ON"; 118*256a93a4Safresh1ok unlink(CPAN::Shell->expand("Module", $getmodule)->distribution->{localfile}), "unlink tarball"; 119*256a93a4Safresh1 120*256a93a4Safresh1# 6 121*256a93a4Safresh1like collect_output ( o => conf => curl => "" ), qr(Please use), "'Please use' on curl OFF"; 122*256a93a4Safresh1ok !$CPAN::Config->{curl}, "set curl to '$CPAN::Config->{curl}'"; 123*256a93a4Safresh1like collect_output ( o => conf => wget => $HAVE{wget} ), qr(Please use), "'Please use' on wget ON"; 124*256a93a4Safresh1ok $CPAN::Config->{wget}, "set wget to $CPAN::Config->{wget}"; 125*256a93a4Safresh1like collect_output ( force => get => $getmodule ), 126*256a93a4Safresh1 qr((?s)Trying with.*wget.*to get.*https://.+/$getdistro_qr), "saw (6) https with wget ON"; 127*256a93a4Safresh1ok unlink(CPAN::Shell->expand("Module", $getmodule)->distribution->{localfile}), "unlink tarball"; 128*256a93a4Safresh1 129*256a93a4Safresh1done_testing; 130