http://qs321.pair.com?node_id=244058
Category: PerlMonks Related Scripts
Author/Contact Info /msg davis
Description:

Note: This is fairly similar in idea to OeufMayo's drawmap.pl, but it's a different approach. I don't think that it suffers from the "negative zero" bug that jcwren's code did (and perhaps still does)

I'm sat in an office with no external windows and spookily flat lighting. I decided to run xearth to give me some idea of the sun's position. Like a good geek, I put my location into the xearth markerfile, and carried on with my day.

A little while later, remembering the location tags that monks can put on their homenodes (documented here ), I thought it might be interesting to put some other monks on the map. Besides, it seemed like a good opportunity to use LWP::Simple and XML::Simple.

Caveats: The code's a dirty hack:

  • This code doesn't use HTML parsing modules to extract the HTML comment containing the location information. It splits based on newlines, and then uses a few regexen to extract the information. This is one of many Wrong Ways to do it, but I'm not really trying to parse, just extract one bit of info.
  • It uses Text::Table to output the text in a pretty-printed text table. You could change easily if you don't have this module.

Usage: Put your desired monks in the @monks array, then run the code. You probably want to append the output to your xearth markerfile. Note that this should also work for xplanet, the much prettier xearth alternative.

Fixed broken '/strong' tag - dvergin 2003-03-18

#!/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));
}