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