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 |
|
---|
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
|
---|
25 | www.muenchen.de
|
---|
26 | www.osm-tools.org
|
---|
27 | www.webatlasde.de
|
---|
28 | zibi.openstreetmap.org.pl
|
---|
29 | );
|
---|
30 |
|
---|
31 | sub getmaps
|
---|
32 | {
|
---|
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"))
|
---|
37 | {
|
---|
38 | my $name = $xpc->findvalue("./j:name", $entry);
|
---|
39 | for my $e ($xpc->findnodes(".//j:*", $entry))
|
---|
40 | {
|
---|
41 | if($e->textContent =~ /^http:\/\/(.*?)[\/]/)
|
---|
42 | {
|
---|
43 | my $u = $1;
|
---|
44 | if($u =~ /^(.*)\{switch:(.*)\}(.*)$/)
|
---|
45 | {
|
---|
46 | my ($f,$switch,$e) = ($1, $2, $3);
|
---|
47 | for my $s (split(",", $switch))
|
---|
48 | {
|
---|
49 | $urls{"$f$s$e"}{"MAP:$name"}++;
|
---|
50 | }
|
---|
51 | }
|
---|
52 | else
|
---|
53 | {
|
---|
54 | $urls{$u}{"MAP:$name"}++;
|
---|
55 | }
|
---|
56 | }
|
---|
57 | }
|
---|
58 | }
|
---|
59 | }
|
---|
60 |
|
---|
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 |
|
---|
79 | print "Options: PLUGIN STYLE RULE PRESET MAP GETPLUGIN GETSTYLE GETRULE GETPRESET GETMAP LOCAL\n" if !@ARGV;
|
---|
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 |
|
---|
97 | for my $url (sort keys %urls)
|
---|
98 | {
|
---|
99 | my $i = join(" # ", sort keys %{$urls{$url}});
|
---|
100 | if($local) # skip test
|
---|
101 | {
|
---|
102 | print "* ".($known{$url} ? "~~" : "")."$url:$i\n";
|
---|
103 | next;
|
---|
104 | }
|
---|
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);
|
---|
114 | print "* ".($known{$url} ? "~~" : "")."$url [$code $mess]: $i\n";
|
---|
115 | };
|
---|
116 | if($@ && $@ !~ "(--Alarm--|Connection refused)")
|
---|
117 | {
|
---|
118 | my $e = $@;
|
---|
119 | $e =~ s/[\r\n]//g;
|
---|
120 | $e =~ s/ at scripts\/TestHTTPS.pl .*//;
|
---|
121 | print "* ".($known{$url} ? "~~" : "")."$url [Error $e] :$i\n";
|
---|
122 | }
|
---|
123 | }
|
---|