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