Bug#706325: make http://www.debian.org/CD/http-ftp/ more compact
Package: www.debian.org
Severity: minor
Tags: patch
set Severity: minor as the wiki page says "this is not a wish list!"
http://wiki.debian.org/Teams/Webmaster/TODO#line-38:
make http://www.debian.org/CD/http-ftp/ more compact (like CD/vendors,
need mirror_list.pl tweak, and sorting the user country first)
this patch does list users' preferred country first, then list other
countries, both of country list and mirrors list
NOTE that which web pages users see can be classfied by *language*, not by country
the patch w/ css below will look like:
list
country1(number of sites in the country) country2() ...
country1: [site1: ftp http] [site2: ftp http] ...
country2: [site1: ftp http] [site2: ftp http] ...
another patch creates <host> tags
css fragments need to be added somewhere, something like this:
/* for cdimage mirrror list */
ul.cdi li {
margin-top: -2.7em;
padding: 0;
line-height: 1.3em;
}
ul.cdi li:first-child {
margin-top: 0em;
}
ul.cdi div {
position: relative;
height: 70%;
}
ul.cdi h4 {
height: 0em;
font-style: normal;
}
ul.cdi h4:after {
content: ":";
}
ul.cdi p {
position: relative;
left: 8.5em;
top: -1.5em;
}
--
victory
http://userscripts.org/scripts/show/102724 0.0.1.4
http://userscripts.org/scripts/show/163846 0.0.1
http://userscripts.org/scripts/show/163848 0.0.1
Index: Makefile
===================================================================
RCS file: /cvs/webwml/webwml/english/CD/http-ftp/Makefile,v
retrieving revision 1.13
diff -u -r1.13 Makefile
--- Makefile 17 Aug 2008 12:46:47 -0000 1.13
+++ Makefile 19 Apr 2013 11:34:45 -0000
@@ -14,10 +14,11 @@
index.$(LANGUAGE).html: index.wml $(TEMPLDIR)/cdimage.wml \
$(ENGLISHDIR)/CD/http-ftp/cdimage_mirrors.list \
- $(TEMPLDIR)/release_info.wml $(TEMPLDIR)/release_images.wml
+ $(TEMPLDIR)/release_info.wml $(TEMPLDIR)/release_images.wml \
+ $(ENGLISHDIR)/CD/http-ftp/list.defs
ifeq "$(LANGUAGE)" "en"
$(ENGLISHDIR)/CD/http-ftp/cdimage_mirrors.list: \
- $(ENGLISHDIR)/mirror/mirror_list.pl $(ENGLISHDIR)/mirror/Mirrors.masterlist
- $< -m $(word 2,$^) -t cdimages-httpftp > $@
+ $(ENGLISHDIR)/CD/http-ftp/cd-mirror_list.pl $(ENGLISHDIR)/mirror/Mirrors.masterlist
+ $<
endif
Index: index.wml
===================================================================
RCS file: /cvs/webwml/webwml/english/CD/http-ftp/index.wml,v
retrieving revision 1.52
diff -u -r1.52 index.wml
--- index.wml 8 Apr 2011 20:55:19 -0000 1.52
+++ index.wml 22 Apr 2013 08:25:58 -0000
@@ -120,9 +120,11 @@
mirror? If yes, see the <a href="../mirroring/">instructions on
how to set up a CD image mirror</a>.</p>
-#use wml::debian::countries
-#include "$(ENGLISHDIR)/CD/http-ftp/cdimage_mirrors.list"
-
+<h3>list</h3>
+#include "$(ENGLISHDIR)/CD/http-ftp/list.defs"
+# translators: put preferred countries as country code in your language as preferred= values
+# eg: <cdmirrors preferred="jp de fr">
+<cdmirrors>
<comment>
<h2><a name="unofficial">Unofficial CD/DVD images of the <q>testing</q> and
--- cd-mirror_list.pl
+++ cd-mirror_list.pl
@@ -0,0 +1,125 @@
+#!/usr/bin/perl -w
+#
+# based on mirror_list.pl -- generate cdimage Debian mirror lists
+# authors for original mirror_list.pl:
+# Copyright (C) 1998 James Treacy
+# Copyright (C) 2000-2002, 2007-2008 Josip Rodin
+# Copyright (C) 2005 Joey Hess
+
+use strict;
+ use Time::HiRes;
+ my $st=Time::HiRes::time;
+
+my $m_src = '../../mirror/Mirrors.masterlist';
+my (%countries, %cc, %cn, %p);
+my $count = 0;
+my (@mirror, $crl);
+
+open (SRC, "<", "$m_src") or die "Error: problem opening mirror source file, $m_src\n";
+
+foreach (<SRC>) {
+ chomp;
+ next if (/^$/ && !$crl);
+ # keep the previous lines and add this line if this line is a subsequence
+ # process previous line if this line is blank or a new attribute
+ # flush the previous lines and take this line if this is a new attribute
+ if (/^$/) { process_line($crl); $crl = ''; next;}
+ if (/^\s+(.*)$/) { $crl .= "\n$1"; next;}
+ if (/^[\w-]+:\s/) { process_line($crl); $crl = $_; next;}
+ die "Error: unknown format on line $.:\n$_\n";
+}
+# process the last site if exists
+process_line($crl) if($crl);
+&process_host if($p{'cdi'});
+
+# count the number of mirrors
+$count = @mirror;
+
+# Create arrays of countries, with their mirrors.
+foreach my $id (0..$#mirror) {
+ push @{ $countries{ $mirror[$id]{country} } }, $id if (exists $mirror[$id]{country});
+}
+
+&cdimage_mirrors;
+ print (Time::HiRes::time - $st);
+
+# only needed lines are passed
+sub process_line {
+ $_ && /^(Site|IPv6|Country|CDImage-(f|ht)tp)/ ? process_line_($_) : return
+}
+
+# this routine deal with a global hash %p
+# using hash enables to flush the values by one instruction
+# gloal value is needed as each line has only one attribute
+sub process_line_ {
+ my ($line) = @_;
+ my $field = '';
+ if ($line =~ /^Country:\s*(.+)\s*$/is) { $p{'country'} = $1; }
+ elsif ($line =~ /^IPv6:\s*yes\s*$/is) { $p{'ipv6'} = 1; }
+ elsif ($line =~ /^Site:\s*(.+)\s*$/i) {
+ &process_host if ($p{'cdi'});
+ %p = ();
+ $p{'site'} = $1;
+ }
+ elsif ($line =~ /^(CDimage)-(?<met>ftp|http):\s*(?<dir>.*)\s*$/i) {
+ foreach my $m('ftp','http'){ $p{$m} = $+{dir} if (lc $+{met} eq $m)}
+ $p{'cdi'} = 1;
+ }
+ elsif ($line !~ /^([\w-]+):\s*(.+)\s*$/s) {
+ warn "Error: incorrect line format\n\"$line\"\n";
+ }
+}
+
+# process site's informations when all the entries for the site are stored
+sub process_host {
+ $mirror[$count]{site} = $p{'site'} if $p{'site'};
+ $mirror[$count]{'ipv6'} = 1 if $p{'ipv6'};
+ foreach my $m('ftp','http'){ $mirror[$count]{"cdimage-$m"} = $p{$m} if $p{$m}}
+ if ($p{'country'}){
+ if ($p{'country'} =~ /^(?<cc>(?<ccode>\w\w)\s+(?<cname>.+))\s*$/is) {
+ $mirror[$count]{'country'} = $+{cc};
+ $cc{$p{'country'}} = $+{ccode};
+ $cn{$p{'country'}} = $+{cname};
+ }else{
+ warn "strangely formatted Country line: $p{'country'}";
+ }
+ }else{
+ warn "found a mirror without a country, wtf? (site: $mirror[$count]{site})";
+ }
+ %p = (); $count++;
+}
+
+# create a list data and its country list, then processed by WML
+sub cdimage_mirrors {
+ # country list, previous country's name, previous country's host count
+ my ($cs, $prevc, $prev);
+ open ML, ">", "./cdimage_mirrors.list" || die("cannot open mirror list file");
+ foreach my $country (sort keys %countries) {
+ my $cnum = 0; # current country's host count
+ foreach my $id (sort {$mirror[$a]{site} # sort the country's mirror
+ cmp $mirror[$b]{site}} @{ $countries{$country} }) {
+ my $ftploc = $mirror[$id]{'cdimage-ftp'};
+ my $httploc = $mirror[$id]{'cdimage-http'};
+ if ($ftploc || $httploc) {
+ # country's host num = 0 means the 1st host in this country
+ if (! $cnum){
+ # cs: [country code(2bytes)] [how many host in the country] [country's name]
+ $cs .= join(' ',substr($prevc,0,2), $prev, substr($prevc,3,)) . "\n" if ($prev);
+ print ML "\n" . substr($country,0,2) . "\x00";
+ $prevc = $country;
+ }
+ $cnum++; $prev = $cnum; my $host = $mirror[$id]{site};
+ $host = "[site]<name>$host</name>";
+ $ftploc = $ftploc ? "<ftp>$ftploc</ftp>" : "";
+ $httploc = $httploc ? "<http>$httploc</http>" : "";
+ my $v6 = $mirror[$id]{'ipv6'} ? "<v6>1</v6>" : "";
+ print ML "$host$ftploc$httploc$v6";
+ }
+ }
+ }
+ close ML;
+ $cs .= join(' ',substr($prevc,0,2), $prev, substr($prevc,3,)) . "\n" if ($prev);
+ open CL, ">", "./cdimage_countries.list" || die("cannot open country list file");
+ print CL $cs;
+ close CL;
+}
--- list.defs
+++ list.defs
@@ -0,0 +1,150 @@
+<define-tag cdmirrors>
+<preserve preferred />
+<set-var %attributes />
+<:
+ use encoding "utf8";
+ # create/update a country list cache file
+ # using cache file is about 25x faster than doing isoquery
+ my $isoq = "countries.list";
+ # this sub does isoquery and save to a file
+ sub clist_cache{
+ # update once per a month.
+ return if(stat($isoq) && (stat($isoq))[10] && (time - (stat($isoq))[10] < 2600000));
+ my $arg = "-l $CUR_ISO_LANG";
+ $arg = "" if($arg eq '-l en');
+ system "isoquery -c $arg > $isoq" || die "isoquery failed.\n";
+ }
+ my (%count, %countrylist, %countries);
+ &clist_cache;
+ open (my $iq, "<", $isoq) || die "Unable to read $isoq";;
+ foreach (<$iq>) {
+ chomp;
+ my $code = substr($_,0,2);
+ s/.*\t//; # [alpha-2-code]\t[alpha-3-code]\t[numerical-code]\t[name]->[name]
+ s/(,|Federation).*//i; # after ',' 'Federation' seems not needed
+ s/(\s*\(|��).*//; # in Japanese, parenthesis says the same thing twice, �� is not needed
+ s/\s+/ /g; # don't divide country name
+ $countrylist{$code} = $_;
+ }
+ close($iq);
+
+ my $listfile = "$(ENGLISHDIR)/CD/http-ftp/cdimage_countries.list";
+ open (my $cs, "<", $listfile) || die "Unable to read $listfile";
+ while (<$cs>) {
+ # [country code(2bytes)] [how many host in the country] [country's name]
+ if (/^\s*(\w+)\s+(\d+)\s+(\w[^,\n]+)\n/) {
+ $count{$1} = $2;
+ # use isoquery's output and fallback if failed
+ $countries{$1} = $countrylist{$1} || $3;
+ }
+ }
+ close($cs);
+
+ # preferred list, remain list, the language's list
+ my (@pl,@rl,%ll,@ll);
+ @ll = ("<get-var preferred />") &&
+ split(/[\s,\/_\:;\+\-\.&'"]+/, "<get-var preferred />");
+ # add to @pl if the ll exists in %countries
+ # this eliminates countries that don't have any mirror hosts, in the language's list
+ if(@ll && length(@ll)){
+ foreach (@ll){ $_=uc; $ll{$_}=1; push(@pl,$_) if($countries{$_});}
+ # add to @rl if %countries not exists in @pl
+ foreach (keys %countries){ push (@rl,$_) unless($ll{$_});}
+ # if preferred list exists, sort only "remain list"
+ @rl = sort { Unicode::Normalize::NFKD($countries{$a})
+ cmp Unicode::Normalize::NFKD($countries{$b}) } @rl if(@rl && length(@rl));
+ @ll = (@pl, @rl); # then add "remain list" after "preferred list"
+ }else{ # sort country list otherwise
+ @ll = sort { Unicode::Normalize::NFKD($countries{$a})
+ cmp Unicode::Normalize::NFKD($countries{$b}) } keys %countries;
+ }
+ # writes country list
+ if (keys %countries){
+ foreach my $i(0..$#ll){
+ print qq|<clist id=$ll[$i] country=$countries{$ll[$i]} count=$count{$ll[$i]} pos=first>| if($i<1);
+ print qq|<clist id=$ll[$i] country=$countries{$ll[$i]} count=$count{$ll[$i]} pos=last>| if($i==$#ll);
+ print qq|<clist id=$ll[$i] country=$countries{$ll[$i]} count=$count{$ll[$i]}>| if($i && $i < $#ll);
+ }
+ }
+ $listfile = "$(ENGLISHDIR)/CD/http-ftp/cdimage_mirrors.list";
+ my %sites;
+ open($ms, "<", $listfile) || die "Unable to read $listfile";
+ while (<$ms>) {
+ # [country code(2bytes)]\x00
+ if (/^(\w+)\x00/){ $sites{$1} = substr($_,3,);}
+ }
+ close($ms);
+
+ # writes mirror list
+ if (keys %sites){
+ foreach my $l(0..$#ll){
+ # [site]<name>name</name><ftp>ftp</ftp><http>http</http><v6>v6</v6>[site]...
+ my @site = split(/\[site\]/,$sites{$ll[$l]});
+ foreach my $i(1..$#site){
+ my $re = '<name>(?<name>[\.\w\-]+)</name>(<ftp>(?<ftp>[\.\w\-/]+)';
+ $re.= '</ftp>)?(<http>(?<http>[\.\w\-/]+)</http>)?(<v6>(?<v6>1)</v6>)?';
+ $site[$i] =~ m|$re|;
+ next unless($+{name});
+ my $a1 = ($+{v6}) ? "6enabled" : "v4only";
+ my $f1 = ($+{ftp}) || "";
+ my $h1 = ($+{http}) || "";
+
+ # for the first hosts of the first country
+ print qq|<host host=$+{name} v6=$a1 ftp=$f1 http=$h1 cc=$ll[$l]
+ cn=$countries{$ll[$l]} pos=first>| if($i < 2 && $l < 1);
+ # for the first hosts of the [2 .. n]th countries
+ print qq|<host host=$+{name} v6=$a1 ftp=$f1 http=$h1 cc=$ll[$l]
+ cn=$countries{$ll[$l]}>| if($i < 2 && $l > 0);
+ # for the last hosts of the [1 .. n-1] country
+ print qq|<host host=$+{name} v6=$a1 ftp=$f1 http=$h1 pos=c-last>|
+ if($i==$#site && $l < $#ll);
+ # for the last hosts of the last country
+ print qq|<host host=$+{name} v6=$a1 ftp=$f1 http=$h1 pos=last>|
+ if($i==$#site && $l == $#ll);
+ # for all other hosts
+ print qq|<host host=$+{name} v6=$a1 ftp=$f1 http=$h1>|
+ if($i > 1 && $i < $#site);
+ }
+ }
+ }
+:>
+<restore preferred />
+</define-tag>
+
+<define-tag clist>
+<preserve id country count pos />
+<set-var %attributes />
+<ifeq "<get-var pos />" "first" "<p>">
+ <a href="#<get-var id />"><get-var country /> (<get-var count />)</a>
+<ifeq "<get-var pos />" "last" "</p>">
+<restore id country count pos />
+</define-tag>
+
+<define-tag host>
+<preserve host ftp http v6 cc cn pos />
+<set-var %attributes />
+<ifeq "<get-var pos />" "first" "
+<hr />
+<ul class="cdi">
+">
+<when <get-var cn />>
+ <li><div>
+ <h4 id="<get-var cc />" name="<get-var cc />"><get-var cn /></h4>
+ <p>
+</when>
+ [ <get-var host />: <when <get-var ftp
+ />><a rel="nofollow" class="ip<get-var v6 />" href="ftp://<get-var
+ host /><get-var ftp />">FTP</a> </when><when <get-var http
+ />><a rel="nofollow" class="ip<get-var v6 />" href="http://<get-var
+ host /><get-var http />">HTTP</a> </when>]
+<ifeq "<get-var pos />" "c-last" "
+ </p>
+ </div></li>
+">
+<ifeq "<get-var pos />" "last" "
+ </p>
+ </div></li>
+</ul>
+">
+<restore host ftp http v6 cc cn pos />
+</define-tag>
sub create_host_tag{
my @m1 = ('$+{ftp} && $+{http}','$+{ftp} && !$+{http}','!$+{ftp} && $+{http}');
my @m2 = ('ftp=$+{ftp} http=$+{http}','ftp=$+{ftp}','http=$+{http}');
my @c1 = ('$fc','$lc','!$fc && !$lc');
my @c2 = (' cpos=first',' cpos=last','');
my @h1 = ('fh=1','fh=1 lh=1','lh=1','');
my @h2 = ('$fh && !$lh','$fh && $lh','$lh && !$fh','!$lh && !$fh');
my $co = '|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] ';
my $co2= 'v6=$a1 ';
foreach my $m(0..$#m1){
print "\tif($m1[$m]){\n";
foreach my $c(0..$#c1){
print "\t if($c1[$c]){\n";
foreach my $h(0..$#h1){
print "\t print qq$co$h1[$h]\n\t\t$co2$m2[$m]$c2[$c]>| if($h2[$h]);\n";
}
print "\t }\n";
}
print "\t}\t#if($m1[$m])\n";
}
}
&create_host_tag;
Reply to: