1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
|
use 5.008004;
use lib 't/lib';
use MyTest::FauxFetchCommand;
use MyTest::CaptureNote;
use MyTest::HTTP;
use Test2::V0 -no_srand => 1;
use Test::Alien::Build;
use Alien::Build::Plugin::Fetch::Wget;
use Path::Tiny qw( path );
use Alien::Build::Util qw( _dump );
use JSON::PP qw( decode_json );
skip_all "No wget or not real wget" unless Alien::Build::Plugin::Fetch::Wget->_wget;
$Alien::Build::Plugin::Fetch::Wget::VERSION = '1.19';
subtest 'fetch from http' => sub {
my $config = test_config 'httpd';
skip_all 'Test requires httpd config' unless $config;
my $base = $config->{url};
my($proto) = $base =~ /^([a-z]+):/;
like $proto, qr/^https?$/, "protocol is either http or https (url = $base)";
# This test runs against a real http or ftp server, usually only in CI
# the server is running on localhost
local $ENV{ALIEN_DOWNLOAD_RULE} = $ENV{ALIEN_DOWNLOAD_RULE};
$ENV{ALIEN_DOWNLOAD_RULE} = 'warn' if $proto ne 'https';
my $build = alienfile_ok qq{
use alienfile;
meta->prop->{start_url} = '$base/html_test.html';
probe sub { 'share' };
share {
plugin 'Fetch::Wget';
};
};
alien_install_type_is 'share';
subtest 'html' => sub {
my $list = capture_note { $build->fetch };
is(
$list,
hash {
field type => 'html';
field base => "$base/html_test.html";
field content => "<html><head><title>Hello World</title></head><body><p>Hello World</p></body></html>\n";
field protocol => $proto;
end;
},
'list'
);
};
subtest 'file' => sub {
my $file = capture_note { $build->fetch("$base/foo-1.01.tar") };
is(
$file,
hash {
field type => 'file';
field filename => 'foo-1.01.tar';
field path => T();
field protocol => $proto;
end;
},
'file meta',
);
is(
scalar path($file->{path})->slurp,
"content:foo-1.01\n",
'file content',
);
};
subtest '404' => sub {
my($file, $error) = capture_note {
my $file = eval {
$build->fetch("$base/bogus.html");
};
($file, $@);
};
isnt $error, '', 'throws error';
note "error is: $error";
};
};
subtest 'headers' => sub {
my $url = http_url;
skip_all http_error unless $url;
require URI;
my $furl = URI->new_abs("test1/foo.txt", $url);
note "url = $furl";
# This test runs against a real http or ftp server, usually only in CI
# the server is running on localhost
local $ENV{ALIEN_DOWNLOAD_RULE} = $ENV{ALIEN_DOWNLOAD_RULE};
$ENV{ALIEN_DOWNLOAD_RULE} = 'warn' if $url ne 'https';
my $build = do {
my $plugin = Alien::Build::Plugin::Fetch::Wget->new;
my $build = alienfile filename => 'corpus/blank/alienfile';
my $meta = $build->meta;
$plugin->init($meta);
$build;
};
my $res = capture_note { $build->fetch("$furl", http_headers => [ Foo => 'Bar1', Foo => 'Bar2', Baz => 1 ]) };
note _dump($res);
my $content;
is
$content = decode_json(path($res->{path})->slurp_raw),
hash {
field headers => hash {
field Foo => 'Bar1, Bar2';
field Baz => 1;
etc;
};
etc;
},
;
note _dump($content);
};
done_testing;
|