[13555] | 1 | #! /usr/bin/perl -w
|
---|
| 2 |
|
---|
| 3 | use strict;
|
---|
| 4 | use utf8;
|
---|
| 5 | use open qw/:std :encoding(utf8)/;
|
---|
| 6 | use Net::HTTPS;
|
---|
| 7 | use XML::LibXML;
|
---|
| 8 |
|
---|
| 9 | my %urls;
|
---|
| 10 |
|
---|
[13585] | 11 | my %known = map {$_ => 1} qw(
|
---|
| 12 | a.tile.osm-tools.org
|
---|
| 13 | b.tile.osm-tools.org
|
---|
| 14 | c.tile.osm-tools.org
|
---|
| 15 | d.tile.osm-tools.org
|
---|
| 16 | e-mapa.net
|
---|
| 17 | ge.ch
|
---|
| 18 | gis.mapa.lodz.pl
|
---|
| 19 | osmdata.asitvd.ch
|
---|
| 20 | siglon.londrina.pr.gov.br
|
---|
| 21 | tiles.itoworld.com
|
---|
| 22 | tms.cadastre.openstreetmap.fr
|
---|
| 23 | wms.openstreetmap.de
|
---|
| 24 | www.jgoodies.com
|
---|
[13592] | 25 | www.muenchen.de
|
---|
[13585] | 26 | www.osm-tools.org
|
---|
| 27 | www.webatlasde.de
|
---|
| 28 | zibi.openstreetmap.org.pl
|
---|
| 29 | );
|
---|
| 30 |
|
---|
[13556] | 31 | sub getmaps
|
---|
[13555] | 32 | {
|
---|
[13556] | 33 | my $dom = XML::LibXML->load_xml(location => "imagery_josm.imagery.xml");
|
---|
| 34 | my $xpc = XML::LibXML::XPathContext->new($dom);
|
---|
| 35 | $xpc->registerNs('j', 'http://josm.openstreetmap.de/maps-1.0');
|
---|
| 36 | foreach my $entry ($xpc->findnodes("//j:entry"))
|
---|
[13555] | 37 | {
|
---|
[13556] | 38 | my $name = $xpc->findvalue("./j:name", $entry);
|
---|
| 39 | for my $e ($xpc->findnodes(".//j:*", $entry))
|
---|
[13555] | 40 | {
|
---|
[13556] | 41 | if($e->textContent =~ /^http:\/\/(.*?)[\/]/)
|
---|
[13555] | 42 | {
|
---|
[13556] | 43 | my $u = $1;
|
---|
| 44 | if($u =~ /^(.*)\{switch:(.*)\}(.*)$/)
|
---|
[13555] | 45 | {
|
---|
[13556] | 46 | my ($f,$switch,$e) = ($1, $2, $3);
|
---|
| 47 | for my $s (split(",", $switch))
|
---|
| 48 | {
|
---|
| 49 | $urls{"$f$s$e"}{"MAP:$name"}++;
|
---|
| 50 | }
|
---|
[13555] | 51 | }
|
---|
[13556] | 52 | else
|
---|
| 53 | {
|
---|
| 54 | $urls{$u}{"MAP:$name"}++;
|
---|
| 55 | }
|
---|
[13555] | 56 | }
|
---|
| 57 | }
|
---|
| 58 | }
|
---|
| 59 | }
|
---|
| 60 |
|
---|
[13556] | 61 | sub getfile($$)
|
---|
| 62 | {
|
---|
| 63 | my ($type, $file) = @_;
|
---|
| 64 | open FILE,"<:encoding(utf-8)",$file or die;
|
---|
| 65 | my $name;
|
---|
| 66 | for my $line (<FILE>)
|
---|
| 67 | {
|
---|
| 68 | if($line =~ /^([^ \t].*);/)
|
---|
| 69 | {
|
---|
| 70 | $name = $1;
|
---|
| 71 | }
|
---|
| 72 | if($line =~ /http:\/\/(.*?)[\/]/)
|
---|
| 73 | {
|
---|
| 74 | $urls{$1}{"$type:$name"}++;
|
---|
| 75 | }
|
---|
| 76 | }
|
---|
| 77 | }
|
---|
| 78 |
|
---|
[13585] | 79 | print "Options: PLUGIN STYLE RULE PRESET MAP GETPLUGIN GETSTYLE GETRULE GETPRESET GETMAP LOCAL\n" if !@ARGV;
|
---|
[13556] | 80 |
|
---|
| 81 | my $local = 0;
|
---|
| 82 | for my $ARG (@ARGV)
|
---|
| 83 | {
|
---|
| 84 | if($ARG eq "LOCAL") {$local = 1; }
|
---|
| 85 | if($ARG eq "GETMAP") { system "curl https://josm.openstreetmap.de/maps -o imagery_josm.imagery.xml"; getmaps();}
|
---|
| 86 | if($ARG eq "MAP") { getmaps(); }
|
---|
| 87 | for my $x ("PLUGIN", "STYLE", "RULE", "PRESET")
|
---|
| 88 | {
|
---|
| 89 | my $t = lc($x);
|
---|
| 90 | my $url = $x eq "PLUGIN" ? $t : "${t}s";
|
---|
| 91 | my $file = "josm_$t.xml";
|
---|
| 92 | if($ARG eq "GET$x") { system "curl https://josm.openstreetmap.de/$url -o $file"; getfile($x, $file);}
|
---|
| 93 | if($ARG eq $x) { getfile($x, $file); }
|
---|
| 94 | }
|
---|
| 95 | }
|
---|
| 96 |
|
---|
[13555] | 97 | for my $url (sort keys %urls)
|
---|
| 98 | {
|
---|
| 99 | my $i = join(" # ", sort keys %{$urls{$url}});
|
---|
[13556] | 100 | if($local) # skip test
|
---|
| 101 | {
|
---|
[13585] | 102 | print "* ".($known{$url} ? "~~" : "")."$url:$i\n";
|
---|
[13556] | 103 | next;
|
---|
| 104 | }
|
---|
[13555] | 105 | eval
|
---|
| 106 | {
|
---|
| 107 | local $SIG{ALRM} = sub {die "--Alarm--"};
|
---|
| 108 |
|
---|
| 109 | alarm(5);
|
---|
| 110 | my $s = Net::HTTPS->new(Host => $url) || die $@;
|
---|
| 111 | $s->write_request(GET => "/", 'User-Agent' => "TestHTTPS/1.0");
|
---|
| 112 | my($code, $mess, %h) = $s->read_response_headers;
|
---|
| 113 | alarm(0);
|
---|
[13585] | 114 | print "* ".($known{$url} ? "~~" : "")."$url [$code $mess]: $i\n";
|
---|
[13555] | 115 | };
|
---|
| 116 | if($@ && $@ !~ "(--Alarm--|Connection refused)")
|
---|
| 117 | {
|
---|
| 118 | my $e = $@;
|
---|
| 119 | $e =~ s/[\r\n]//g;
|
---|
| 120 | $e =~ s/ at scripts\/TestHTTPS.pl .*//;
|
---|
[13585] | 121 | print "* ".($known{$url} ? "~~" : "")."$url [Error $e] :$i\n";
|
---|
[13555] | 122 | }
|
---|
| 123 | }
|
---|