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
|
package Alien::Build::Plugin::Fetch::Corpus;
use strict;
use warnings;
use Alien::Build::Plugin;
use Carp ();
use Path::Tiny ();
sub _path { Path::Tiny::path(@_) }
has '+url' => sub {
Carp::croak "url is required";
};
has return_listing_as => 'list'; # or html or dir_listing
has return_file_as => 'content'; # or path
has regex => qr/\.tar\.gz$/;
sub init
{
my($self, $meta) = @_;
my $list = {
type => 'list',
protocol => 'https',
list => [
map {
my %h = (
filename => $_,
url => "https://test1.test/foo/bar/baz/$_",
);
\%h;
} ((map { $_->basename } grep { -f $_ } _path('corpus/dist')->children), map { sprintf "foo-0.%02d.tar.gz", $_ } 0..99),
],
};
$meta->prop->{start_url} = 'https://test1.test/foo/bar/baz/';
$meta->register_hook(
fetch => sub {
my(undef, $url) = @_;
$url ||= $self->url;
if($url =~ qr!^https://test1\.test/foo/bar/baz/?$!)
{
if($self->return_listing_as eq 'list')
{
return $list;
}
elsif($self->return_listing_as =~ /^(?:html|dir_listing)$/)
{
return {
type => $self->return_listing_as,
base => 'https://test1.test/foo/bar/baz/',
content => 'test content',
protocol => 'https',
};
}
else
{
die "todo: @{[ $self->return_listing_as ]}";
}
}
elsif($url =~ qr!^https://test1\.test/foo/bar/baz/(.*)$!)
{
my $path = _path "corpus/dist/$1";
if(-f $path)
{
my %hash = (
type => 'file',
filename => $path->basename,
);
if($self->return_file_as eq 'content')
{
$hash{content} = $path->slurp_raw;
}
elsif($self->return_file_as eq 'path')
{
$hash{path} = $path->stringify;
}
$hash{protocol} = 'https';
return \%hash;
}
else
{
die "bad file: @{[ $path->basename ]}";
}
}
else
{
die "bad url: $url";
}
},
);
$meta->register_hook(
decode => sub {
return $list;
}
);
$meta->register_hook(
prefer => sub {
my(undef, $res) = @_;
my @list = sort { $b->{filename} cmp $a->{filename} }
grep { $_->{filename} =~ $self->regex }
@{ $res->{list} };
return {
type => 'list',
list => \@list,
};
}
);
}
1;
|
