package mirror;

use diagnostics;
use strict;
use feature 'state';

use common;
use log;

=head1 SYNOPSYS

B<mirror> enables to manage Mageia distribution mirrors

=head1 Functions

=over

=cut

=item mirror2text($mirror)

Returns a displayable string from a mirror struct

=cut

sub mirror2text {
    my ($mirror) = @_;
    translate($mirror->{country})  . '|' . $mirror->{host} . ($mirror->{method} ? " ($mirror->{method})" : '');
}

=item register_downloader($func)

Sets a downloader program

=cut

my $downloader;
sub register_downloader {
    my ($func) = @_;
    $downloader = $func;
}

sub _mirrors_raw_install {
    my ($list) = @_;
    require install::http;
    my $f = install::http::getFile($list, "strict-certificate-check" => 1) or die "mirror list not found";
    local $SIG{ALRM} = sub { die "timeout" };
    alarm 60;
    log::l("using mirror list $list");
    my @lines;
    push @lines, $_ while <$f>;
    alarm 0;
    @lines;
}

sub _mirrors_raw_standalone {
    my ($list) = @_;
    my @lines;
    if (ref($downloader)) {
        @lines = $downloader->($list);
        @lines or die "mirror list not found";
    } else {
        die "Missing download callback";
    }
    @lines;
}

=item mirrors_raw($product_id)

Returns a list of mirrors hash refs from http://mirrors.mageia.org

Note that in standalone mode, one has to actually use register_downloader()
first in order to provide a downloader callback.

=cut

sub mirrors_raw {
    my ($product_id) = @_;

    #- contact the following URL to retrieve the list of mirrors.
    #- http://wiki.mageia.org/en/Product_id
    my $type = lc($product_id->{type}); $type =~ s/\s//g;
    my $list = "https://mirrors.mageia.org/api/$type.$product_id->{version}.$product_id->{arch}.list?product=$product_id->{product}";
    log::explanations("trying mirror list from $list");
    my @lines = $::isInstall ? _mirrors_raw_install($list) : _mirrors_raw_standalone($list);
    map { common::parse_LDAP_namespace_structure(chomp_($_)) } @lines;
}

=item list($product_id, $type)


Returns a list of mirrors hash refs as returned by mirrors_raw() but filters it.

One can select the type of mirrors ('distrib', 'updates', ...) or 'all'

=cut

sub list {
    my ($product_id, $type) = @_;

    our @mirrors_raw;
    if (!@mirrors_raw) {
        @mirrors_raw = eval { mirrors_raw($product_id) };
        if (my $err = $@) {
            log::explanations("failed to download mirror list");
            die $err;
        }
        @mirrors_raw or log::explanations("empty mirror list"), return;
    }

	my @mirrors = grep {
	    ($_->{method}, $_->{host}, $_->{dir}) = $_->{url} =~ m!^(ftp|https?)://(.*?)(/.*)!;
	    $_->{method} && (member($type, 'all', $_->{type}));
	} @mirrors_raw or log::explanations("no mirrors of type $type"), return;

    @mirrors && \@mirrors;
}

=item nearest($timezone, $mirrors)

Randomly returns one of the nearest mirror

=cut

#- TODO: The following code was forked from urpm::mirrors. Consider refactoring.

sub nearest {
    my ($timezone, $mirrors) = @_;

    my ($latitude, $longitude, $country_code);

    require Time::ZoneInfo;
    if (my $zones = Time::ZoneInfo->new) {
        if (($latitude, $longitude) = $zones->latitude_longitude_decimal($timezone)) {
            $country_code = $zones->country($timezone);
        }
    }
    defined $latitude && defined $longitude or return;

    foreach (@$mirrors) {
        $_->{latitude} || $_->{longitude} or next;
        my $PI = 3.14159265358979;
        my $x = $latitude - $_->{latitude};
        my $y = ($longitude - $_->{longitude}) * cos($_->{latitude} / 180 * $PI);
        $_->{proximity} = sqrt($x * $x + $y * $y);
    }
    my ($best) = sort { $a->{proximity} <=> $b->{proximity} } @$mirrors;

    foreach (@$mirrors) {
        $_->{proximity_corrected} = $_->{proximity} * _random_correction();
        $_->{proximity_corrected} *= _between_country_correction($country_code, $_->{country}) if $best;
        $_->{proximity_corrected} *= _between_continent_correction($best->{continent}, $_->{continent}) if $best;
        $_->{proximity_corrected} *= _protocol_correction($_->{url});
    }
    ($best) = sort { $a->{proximity_corrected} <=> $b->{proximity_corrected} } @$mirrors;
    $best;
}

# add +/- 5% random
sub _random_correction() {
    my $correction = 0.05;
    1 + (rand() - 0.5) * $correction * 2;
}

sub _between_country_correction {
    my ($here, $mirror) = @_;
    $here && $mirror or return 1;
    $here eq $mirror ? 0.5 : 1;
}

sub _between_continent_correction {
    my ($here, $mirror) = @_;
    $here && $mirror or return 1;
    $here eq $mirror ? 0.5 : # favor same continent
      $here eq 'SA' && $mirror eq 'NA' ? 0.9 : # favor going "South America" -> "North America"
	1;
}

sub _protocol_correction {
    my ($url) = @_;
    # favor encrypted protocols, then http
    ( $url =~ m!https://! ) and return 0.7;
    ( $url =~ m!ftps://! ) and return 0.8;
    ( $url =~ m!http://! ) and return 0.9;
    1;
}

=back

=cut

1;