1 | #! /usr/bin/perl -w
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 | use utf8;
|
---|
5 | use open qw/:std :encoding(utf8)/;
|
---|
6 | use Net::HTTPS;
|
---|
7 |
|
---|
8 | use XML::LibXML;
|
---|
9 |
|
---|
10 | my $dom = XML::LibXML->load_xml(location => "imagery_josm.imagery.xml");
|
---|
11 | my $xpc = XML::LibXML::XPathContext->new($dom);
|
---|
12 | $xpc->registerNs('j', 'http://josm.openstreetmap.de/maps-1.0');
|
---|
13 | my %urls;
|
---|
14 |
|
---|
15 | foreach my $entry ($xpc->findnodes("//j:entry"))
|
---|
16 | {
|
---|
17 | my $name = $xpc->findvalue("./j:name", $entry);
|
---|
18 | for my $e ($xpc->findnodes(".//j:*", $entry))
|
---|
19 | {
|
---|
20 | if($e->textContent =~ /^http:\/\/(.*?)[\/]/)
|
---|
21 | {
|
---|
22 | my $u = $1;
|
---|
23 | if($u =~ /^(.*)\{switch:(.*)\}(.*)$/)
|
---|
24 | {
|
---|
25 | my ($f,$switch,$e) = ($1, $2, $3);
|
---|
26 | for my $s (split(",", $switch))
|
---|
27 | {
|
---|
28 | $urls{"$f$s$e"}{$name}++;
|
---|
29 | }
|
---|
30 | }
|
---|
31 | else
|
---|
32 | {
|
---|
33 | $urls{$u}{$name}++;
|
---|
34 | }
|
---|
35 | }
|
---|
36 | }
|
---|
37 | }
|
---|
38 |
|
---|
39 | for my $url (sort keys %urls)
|
---|
40 | {
|
---|
41 | my $i = join(" # ", sort keys %{$urls{$url}});
|
---|
42 | eval
|
---|
43 | {
|
---|
44 | local $SIG{ALRM} = sub {die "--Alarm--"};
|
---|
45 |
|
---|
46 | alarm(5);
|
---|
47 | my $s = Net::HTTPS->new(Host => $url) || die $@;
|
---|
48 | $s->write_request(GET => "/", 'User-Agent' => "TestHTTPS/1.0");
|
---|
49 | my($code, $mess, %h) = $s->read_response_headers;
|
---|
50 | alarm(0);
|
---|
51 | print "* $url [$code $mess]: $i\n";
|
---|
52 | };
|
---|
53 | if($@ && $@ !~ "(--Alarm--|Connection refused)")
|
---|
54 | {
|
---|
55 | my $e = $@;
|
---|
56 | $e =~ s/[\r\n]//g;
|
---|
57 | $e =~ s/ at scripts\/TestHTTPS.pl .*//;
|
---|
58 | print "* $url [Error $e] :$i\n";
|
---|
59 | }
|
---|
60 | }
|
---|