[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 |
|
---|
| 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 | }
|
---|