File: alien_build_plugin_fetch_wget.t

package info (click to toggle)
libalien-build-perl 2.84-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,116 kB
  • sloc: perl: 10,350; ansic: 134; sh: 66; makefile: 2
file content (146 lines) | stat: -rw-r--r-- 3,258 bytes parent folder | download
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;