summarylogtreecommitdiffstats
path: root/generator.pl
blob: 6e7cfbbaf137fd92a0493a3b38c8fb8c8dfc7629 (plain)
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
#!/usr/bin/perl
use v5.10;
use strict;
use warnings;
use experimental 'smartmatch';
use Tie::File;
use Template;
use LWP::UserAgent;
use HTML::TreeBuilder;
use List::Util qw(maxstr);

use constant {
    ROOT => 'http://ftp.mozilla.org/pub/thunderbird/nightly/',
};

sub _find_max {
    my ($tree, $filter) = @_;

    my @values =  map { $_->as_text } $tree->find('a');
    @values    = grep { $_ ~~ $filter } @values if defined $filter;

    unless(@values) {
        say "No values can be extracted.";
        exit 1;
    }

    return maxstr @values;
}

sub _get_tree {
    my ($ua, $url) = @_;

    my $req = HTTP::Request->new(GET => $url);
    my $res = $ua->request($req);

    if ( $res->is_success ) {
        my $tree = HTML::TreeBuilder->new_from_content($res->content);
        return $tree;
    }
    else {
        say "Request $url is failed";
        exit 2;
    }
}

sub _get_part {
    my ($ua, $uri, $filter) = @_;

    return _find_max(_get_tree($ua, $uri), $filter);
}

sub _get_data {
    my ($ua, $lang) = @_;
    $lang //= 'en-US';
    my $uri = ROOT;
    my $is_num = qr/^\d+/;
    my $data = {};

    my $year = _get_part($ua,$uri, $is_num);
    $uri .= $year;
    $year =~ s:/::;
    $data->{year} = $year;

    my $month = _get_part($ua, $uri, $is_num);
    $uri .= $month;
    $month =~ s:/::;
    $data->{month} = $month;

    my $release = _get_part($ua, $uri, qr(aurora/$));
    $uri .= $release;
    $release =~ /^\d{4}-\d{2}-(?<day>\d+)-(?<hour>\d+)-(?<minute>\d+)-(?<second>\d+)/;
    $data = { %$data, %+ };

    my $package_i686 = _get_part($ua, $uri, qr($lang.linux-i686.tar.bz2$));
    my $package_i686_sums = _get_part($ua, $uri, qr($lang.linux-i686.checksums$));
    $data->{sha512sums_i686} = _get_hashsum($ua, $uri . $package_i686_sums, $package_i686);

    my $package_x86_64  = _get_part($ua, $uri, qr($lang.linux-x86_64.tar.bz2$));
    my $package_x86_64_sums = _get_part($ua, $uri, qr($lang.linux-x86_64.checksums$));
    $data->{sha512sums_x86_64} = _get_hashsum($ua, $uri . $package_x86_64_sums, $package_x86_64);

    $data->{version} = $1 if $package_x86_64 =~ /thunderbird-(\d+)/;

    return $data;
}

sub _get_hashsum {
    my ($ua, $uri, $file) = @_;

    my $req = HTTP::Request->new(GET => $uri);
    my $res = $ua->request($req);
    if ( $res->is_success ) {
        $res->content =~ /(?<sum>[0-9a-f]+) sha512 [\d]+ $file/m;
        return $+{sum};
    }
}

my $ua = LWP::UserAgent->new;
my $data = _get_data($ua);

my $t = Template->new(RELATIVE => 1);

say "Generate PKGBUILD for version $data->{version}...";
$t->process('PKGBUILD.template', $data, 'PKGBUILD') || die $t->error();