Following up on the basics from
The Center of PerlMonk Mass, I've gotten a
cron script that runs every 10 minutes that grabs the XML from the PM Statistics page, and another from the PM Other Users nodelet; combines that info, and generates a map
of the current PM users on the globe; this time, I've also
included the day/night map as well as a current (+/- 3hrs) cloud map for the earth. Now you can tell at a glance who is waaaay up past their bedtime... ;-)
You can view the maps here.
Update: I should have posted the code as well; it's not too hard to extrapolate from the previous one, but...
#!/usr/bin/perl -w
use strict;
use LWP::Simple;
use XML::Simple;
#Changed to protect the innocent...
my $site = "/some/location/on/my/server";
my $monk_loc_xml = "http://www.tinymicros.com/pm/monks.xml";
my $monk_present_xml = "http://perlmonks.org/index.pl?node=other+users
++xml+ticker";
my $clouds = "http://www.ssec.wisc.edu/data/comp/latest_moll.gif";
my $cloud_file = "$site/clouds.gif";
my @colors = qw( white yellow cyan lightgrey orange );
my $cloud_data = get( $clouds ) or die "Can't get clouds";
open FILE, ">$cloud_file" or die $!;
binmode FILE;
print FILE $cloud_data;
close FILE;
my $locs_data = get( $monk_loc_xml ) or die "Can't get monks loc";
my $locs = XMLin( $locs_data );
my $present_data = get( $monk_present_xml ) or die "Can't get monks pr
+esent";
my $present = XMLin( $present_data );
my $radius = 3986.34375; #Miles
my $coordfile = "$site/monkpresent.coord";
open FILE, ">$coordfile" or die $!;
my ( $total, $avg_x, $avg_y, $avg_z ) = ( 0,0,0,0 );
foreach my $monk ( @{ $present->{ user } } ) {
my $name = $monk->{ username };
if ( exists ( $locs->{ monk }->{ $name } ) ) {
my $lat = $locs->{ monk }->{ $name }->{ location }->{ latitude };
my $long = $locs->{ monk }->{ $name }->{ location }->{ longitude }
+;
my $color = pop @colors;
print FILE
"$lat $long \"$name\" font=Trebuchet_MS_Bold.ttf color=$color\n"
+;
unshift @colors, $color;
$lat *= 3.14159/180;
$long *= 3.14159/180;
$total++;
$avg_x += cos( $lat ) * sin( $long );
$avg_y += -cos( $lat ) * cos( $long );
$avg_z += sin( $lat );
}
}
close FILE;
$avg_x = $avg_x/$total;
$avg_y = $avg_y/$total;
$avg_z = $avg_z/$total;
my $lat_av = atan2( $avg_z, sqrt( $avg_x*$avg_x + $avg_y*$avg_y ) );
my $long_av = atan2( $avg_x, -$avg_y );
my $dep_av = $radius *
(1 - sqrt( $avg_x*$avg_x + $avg_y*$avg_y + $avg_z*$avg_z ) );
$lat_av *= 180/3.14159;
$long_av *= 180/3.14159;
my $caption = "Copyright Michael K. Neylon -- Generated on " . localti
+me(time);
my $average = sprintf "Average: Lat: %+3.2f Long: %+3.2f Depth: %3.2
+f mi",
$lat_av, $long_av, $dep_av;
my $capfile = "$site/monkpresent.cap";
open FILE, ">$capfile" or die $!;
print FILE
"15 15 \"$caption\" image=none position=pixel color=white fontsize=1
+8\n";
print FILE
"570 15 \"$average\" image=none position=pixel color=white fontsize=
+18\n";
close FILE;
my $globe_map = "$site/side1.tmp.png";
my $globe2_map = "$site/side2.tmp.png";
my $globe_mapf = "$site/side1.png";
my $globe2_mapf = "$site/side2.png";
my $olat = -$lat_av;
my $olong = $long_av + 180;
$olong -= 360 if $olong > 180;
my $globe_command =
qq( xplanet -markerfile $coordfile -output $globe_map -geometry 600x
+600
-starfreq 0 -grid -proj orthogonal -shade 30 -grid1 6 -grid2 5
-lat $lat_av -long $long_av -markerfile $capfile
-cloud_ssec $cloud_file );
my $globe2_command =
qq( xplanet -markerfile $coordfile -output $globe2_map -geometry 600
+x600
-starfreq 0 -grid -proj orthogonal -shade 30 -grid1 6 -grid2 5
-lat $olat -long $olong -markerfile $capfile
-cloud_ssec $cloud_file );
$globe_command =~ s/\n/ /g;
$globe2_command =~ s/\n/ /g;
system $globe_command;
system $globe2_command;
if ( -e "$globe_map" ) { rename "$globe_map", $globe_mapf; }
if ( -e "$globe2_map" ) { rename "$globe2_map", $globe2_mapf; }
chmod 0644, $globe_mapf, $globe2_mapf;
1;
Dr. Michael K. Neylon - mneylon-pm@masemware.com
||
"You've left the lens cap of your mind on again, Pinky" - The Brain
-
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.