diff options
| -rw-r--r-- | perl-install/install/share/list.xml | 5 | ||||
| -rw-r--r-- | perl-install/mirror.pm | 67 |
2 files changed, 62 insertions, 10 deletions
diff --git a/perl-install/install/share/list.xml b/perl-install/install/share/list.xml index fcab1be9b..e8b6273ce 100644 --- a/perl-install/install/share/list.xml +++ b/perl-install/install/share/list.xml @@ -236,6 +236,10 @@ iso8859-1 </from> +<from dir="/usr/share/zoneinfo"> + zone.tab +</from> + <filter command="strip"> <from dir="/LIB"> libnss_files.so.2 @@ -623,6 +627,7 @@ MDV/Snapshot/Restore.pm Parse/EDID.pm String/ShellQuote.pm + Time/ZoneInfo.pm XML/SAX/Exception.pm urpm.pm urpm/args.pm diff --git a/perl-install/mirror.pm b/perl-install/mirror.pm index 654bdb2e9..33dbe1c9c 100644 --- a/perl-install/mirror.pm +++ b/perl-install/mirror.pm @@ -158,20 +158,67 @@ 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 (@country, @zone); - foreach my $mirror (@$mirrors) { - my @tzs = @{$land2tzs{$mirror->{country}} || []}; - eval { push @{$country[find_index { $_ eq $timezone } @tzs]}, $mirror }; - eval { push @{$zone[find_index { ((split '/')[0] eq (split '/', $timezone)[0]) } @tzs]}, $mirror }; + 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 @l = @country ? @country : @zone; - shift @l while !$l[0] && @l; - - my @possible = @l ? ((@{$l[0]}) x 2, @{$l[1] || []}) : @$mirrors; - $possible[rand @possible]; + 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 |