#!/usr/bin/perl
use warnings;
use strict;
use LWP::Simple;
use XML::Simple;
use Data::Dumper;
use Text::Table;
##### CONFIG
my @monks = qw{ }; #Add your monks here
##### END CONFIG
my $table = Text::Table->new("#Latitude", "Longitude", "Monk Name");
foreach my $monk (@monks) {
my $node_xml = get("http://www.perlmonks.org/index.pl?type=use
+r&displaytype=xml&node=".$monk);
unless($node_xml) {
warn "Failed to get contents of node $monk: $!\n";
next;
}
my $content = eval {XMLin($node_xml)};
if($@) {
warn "parsing ",$monk,"'s homenode failed: $@\n";
next;
}
my $monk_location = extract_location_tag($content->{data}{fiel
+d}{doctext}{content});
if($monk_location) {
my $long = sprintf("%02.2f", $monk_location->{"long"})
+;
my $lat = sprintf("%02.2f", $monk_location->{"lat"});
$table->load([$lat, $long, '"'.$monk.'"']);
} else {
warn "$monk has no location tag, or parsing failed\n";
}
}
print $table;
#Yuck. Here be beasties.
sub extract_location_tag {
my $input = shift;
my $results = {};
foreach my $line (split "\n", $input) { # Spli
+t HTML on newlines? Bad Idea.
next unless($line =~ /<!--/i);
next unless($line =~ /location\s*:/i);
$line =~ s/-->//g;
$results->{long} = $1 if($line =~ /longitude\s*=\s*([-
+0-9.]+)/i);
$results->{lat} = $1 if($line =~ /latitude\s*=\s*([-0
+-9.]+)/i);
}
return undef unless($results->{long} and $results->{lat});
$results->{long} = parse_location_coord($results->{long}, "lon
+g");
$results->{lat} = parse_location_coord($results->{lat}, "lat"
+);
return $results;
}
sub parse_location_coord {
my $coord = shift;
my $type = shift;
my ($deg, $min, $sec) = split '\.', $coord;
$deg ||= 0;
$min ||= 0;
$sec ||= 0;
if($type eq "long") {
$deg = ($deg >= -180 ? $deg : -180); #Long's
+ range is twice that
$deg = ($deg <= 180 ? $deg : 180);
} else {
$deg = ($deg >= -90 ? $deg : -90); # of la
+t.
$deg = ($deg <= 90 ? $deg : 90);
}
$min = ($min >= 0 ? $min : 0);
$sec = ($sec >= 0 ? $sec : 0);
$min = ($min <= 59 ? $min : 59);
$sec = ($sec <= 59 ? $sec : 59);
if($deg =~ /^\s*-/) { #If it starts with a '-', it
+'s /probably/ negative. Not nice.
$min = -$min;
$sec = -$sec;
}
#decimalize
return($deg + ($min/60) + ($sec/3600));
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|