Re: make http://www.debian.org/CD/http-ftp/ more compact
On Mon, 22 Apr 2013 17:43:28 +0900
victory wrote:
> 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
previous patch prints both ftp and http link even if it's blank
and does not create tags correctly when the country has only 1 mirror
--
victory
no need to CC me :-)
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 22 Apr 2013 17:32:01 -0000
@@ -14,10 +14,11 @@
index.$(LANGUAGE).html: index.wml $(TEMPLDIR)/cdimage.wml \
$(ENGLISHDIR)/CD/http-ftp/cdimage_mirrors.list \
+ $(ENGLISHDIR)/CD/http-ftp/list.defs \
$(TEMPLDIR)/release_info.wml $(TEMPLDIR)/release_images.wml
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,228 @@
+<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(my $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 ($fc, $lc, $fh, $lh);
+ $fc=1 if($l<1); $lc=1 if($l==$#ll);
+ $fh=1 if($i<2); $lh=1 if($i==$#site);
+
+ if($+{ftp} && $+{http}){
+ if($fc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=first>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=first>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=first>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=first>| if(!$lh && !$fh);
+ }
+ if($lc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=last>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=last>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=last>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 ftp=$+{ftp} http=$+{http} cpos=last>| if(!$lh && !$fh);
+ }
+ if(!$fc && !$lc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http}>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http}>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 ftp=$+{ftp} http=$+{http}>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 ftp=$+{ftp} http=$+{http}>| if(!$lh && !$fh);
+ }
+ } # endif($+{ftp} && $+{http})
+ if($+{ftp} && !$+{http}){
+ if($fc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 ftp=$+{ftp} cpos=first>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 ftp=$+{ftp} cpos=first>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 ftp=$+{ftp} cpos=first>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 ftp=$+{ftp} cpos=first>| if(!$lh && !$fh);
+ }
+ if($lc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 ftp=$+{ftp} cpos=last>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 ftp=$+{ftp} cpos=last>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 ftp=$+{ftp} cpos=last>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 ftp=$+{ftp} cpos=last>| if(!$lh && !$fh);
+ }
+ if(!$fc && !$lc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 ftp=$+{ftp}>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 ftp=$+{ftp}>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 ftp=$+{ftp}>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 ftp=$+{ftp}>| if(!$lh && !$fh);
+ }
+ } # endif($+{ftp} && !$+{http})
+ if(!$+{ftp} && $+{http}){
+ if($fc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 http=$+{http} cpos=first>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 http=$+{http} cpos=first>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 http=$+{http} cpos=first>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 http=$+{http} cpos=first>| if(!$lh && !$fh);
+ }
+ if($lc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 http=$+{http} cpos=last>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 http=$+{http} cpos=last>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 http=$+{http} cpos=last>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 http=$+{http} cpos=last>| if(!$lh && !$fh);
+ }
+ if(!$fc && !$lc){
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1
+ v6=$a1 http=$+{http}>| if($fh && !$lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] fh=1 lh=1
+ v6=$a1 http=$+{http}>| if($fh && $lh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l] lh=1
+ v6=$a1 http=$+{http}>| if($lh && !$fh);
+ print qq|<host host=$+{name} cn=$countries{$ll[$l]} cc=$ll[$l]
+ v6=$a1 http=$+{http}>| if(!$lh && !$fh);
+ }
+ } # endif(!$+{ftp} && $+{http})
+ } # end foreach my $i(1..$#site)
+ } # end foreach my $l(0..$#ll)
+ } # end if (keys %sites)
+:>
+<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 cpos fh lh />
+<set-var %attributes />
+<when <get-var fh />>
+ <ifeq "<get-var cpos />" "first" "
+<hr />
+<ul class="cdi">
+ ">
+ <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>]
+<when <get-var lh />>
+ </p>
+ </div></li>
+<ifeq "<get-var cpos />" "last" "</ul>">
+</when>
+<restore host ftp http v6 cc cn cpos fh lh />
+</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: