Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options

Google Earth Monks - Part II (The Code)

by McDarren (Abbot)
on Jul 11, 2006 at 15:23 UTC ( #560490=CUFP: print w/replies, xml ) Need Help??


This is the "final" (..heh) version of the code that's used to generate the Google Earth KMZ files referred to in Google Earth Monks. It's presented here partly for posterity, and partly to elicit some feedback and (hopefully) some suggestions for improvement.

For some background, read the original thread, or visit the "googlemonks" homepage.

Note: I've posted the code here in CUFP (rather than in the original thread) after seeking advice in the CB.

Edit: s/illicit/elicit/ (thanks, GrandFather)

#!/usr/bin/perl -w # # # Generates compressed KMZ (Google Earth) files # with placemarks for Perlmonks monks # See: # # Darren - July 2006 use strict; use XML::Simple; use LWP::UserAgent; use Storable; use Time::HiRes qw( time ); my $start = time(); say("$0 started at ", scalar localtime($start)); # Where everything lives my $monkfile = '/home/mcdarren/scripts/'; my $kmlfile = '/home/mcdarren/temp.kml'; my $www_dir = '/home/mcdarren/var/www/googlemonks'; my $palette_url = ' +alette.png'; my $monks; # hashref $|++; # Uncomment this for testing # Avoids re-fetching the data #if (! -f $monkfile) { # Fetch and parse the XML from tinymicros $monks = get_monk_data(); store $monks, $monkfile; #} $monks = retrieve($monkfile) or die "Could not retrieve $monkfile:$!\n"; # A pretty lousy attempt at abstraction :/ my %types = ( by_level => { desc => 'By Level', outfile => 'perlmonks_by_level.kmz', }, by_name => { desc => 'By Monk', outfile => 'perlmonks_by_monk.kmz', } ); my @levels = qw( Initiate Novice Acolyte Sexton Beadle Scribe Monk Pilgrim Friar Hermit Chaplain Deacon Curate Priest Vicar Parson Prior Monsignor Abbot Canon Chancellor Bishop Archbishop Cardinal Sage Saint Apostle Pope ); # Create a reference to a LoL, # which represents xy offsets to each of the # icons on the palette image # The palette consists of 28 icons in a 7x4 grid my $xy_data = get_xy(); my @t = time(); print "Writing and compressing output files..."; for (keys %types) { open OUT, ">", $kmlfile or die "Could not open $kmlfile:$!\n"; my $kml = build_kml($monks, $_); print OUT $kml; close OUT; write_zip($kmlfile, "$www_dir/$types{$_}{outfile}"); } $t[1] = time(); say("done (", formatted_time_diff(@t), " secs)"); my $end = time(); say("Total run time ", formatted_time_diff($start, $end), " secs"); say("Total monks: ", scalar keys %{$monks->{monk}}); exit; #################################### # End of main - subs below #################################### sub say { # Perl Hacks #86 print @_, "\n"; } sub formatted_time_diff { return sprintf("%.2f", $_[1]-$_[0]) } sub by_level { return $monks->{monk}{$b}{level} <=> $monks->{monk}{$a}{level} || lc($a) cmp lc($b); } sub by_name { return lc($a) cmp lc($b); } sub write_zip { my ($infile, $outfile) = @_; use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); my $zip = Archive::Zip->new(); my $member = $zip->addFile($infile); return undef unless $zip->writeToFileNamed($outfile) == AZ_OK; } sub build_kml { # This whole subroutine is pretty fugly # I really wanted to do it without an if/elsif, # but I couldn't figure out how my $ref = shift; my $type = shift; my $kml = qq(<?xml version="1.0" encoding="UTF-8"?> <kml xmlns=""> <Folder> <name>Perl Monks - $types{$type}{desc}</name> <open>1</open>); if ($type eq 'by_level') { my $level = 28; $kml .= qq(<Folder><name>Level $level - Pope</name><open>0</op +en>\n); for my $id (sort by_level keys %{$ref->{monk}}) { my $mlevel = $ref->{monk}{$id}{level}; if ($mlevel < $level) { $level = $mlevel; my $level_name = $levels[$level-1]; $kml .= qq(</Folder><Folder><name>Level $level - $leve +l_name</name><open>0</open>\n); } $kml .= mk_placemark($id,$mlevel); } $kml .= q(</Folder>); } elsif ($type eq 'by_name') { my @monks = sort by_name keys %{$ref->{monk}}; my $nummonks = scalar @monks; my $mpf = 39; # monks-per-folder my $start = 0; while ($start < $nummonks) { my $first = lc(substr($monks[$start],0,2)); my $last = defined $monks[$start+$mpf] ? lc(substr($monks[$start+$mpf],0,2)) : lc(substr($monks[-1],0,2)); $kml .= qq(<Folder><name>Monks $first-$last</name><open>0< +/open>\n); MONK: for my $cnt ($start .. $start+$mpf) { last MONK if !$monks[$cnt]; my $monk = $monks[$cnt]; my $mlevel = $ref->{monk}{$monk}{level}; $kml .= mk_placemark($monk,$mlevel); } $start += ($mpf + 1); $kml .= q(</Folder>); } } $kml .= q(</Folder></kml>); return $kml; } sub mk_placemark { my $id = shift; my $mlevel = shift; my $p; $p = qq( <Placemark> <description> <![CDATA[ Level: $mlevel<br \\> Experience: $monks->{monk}{$id}{xp}<br \\> Writeups: $monks->{monk}{$id}{writeups}<br \\> User Since: $monks->{monk}{$id}{since}<br \\>$monks->{monk}{$id}{id} ]]> </description> <Snippet></Snippet> <name>$id</name> <LookAt> <longitude>$monks->{monk}{$id}{location}{longitude}</longi +tude> <latitude>$monks->{monk}{$id}{location}{latitude}</latitud +e> <altitude>0</altitude> <range>10000</range> <tilt>0</tilt> <heading>0</heading> </LookAt> <Style> <IconStyle> <Icon> <href>$palette_url</href> <x>$xy_data->[$mlevel-1][0]</x> <y>$xy_data->[$mlevel-1][1]</y> <w>32</w> <h>32</h> </Icon> </IconStyle> </Style> <Point> <coordinates>$monks->{monk}{$id}{location}{longitude},$mon +ks->{monk}{$id}{location}{latitude},0</coordinates> </Point> </Placemark> ); return $p; } sub get_xy { # This returns an AoA, which represents xy-offsets # to each of the monk level icons on the image palette my @xy; for my $y (qw(96 64 32 0)) { for my $x (qw(0 32 64 96 128 160 192)) { push @xy, [ $x, $y ]; } } return \@xy; } sub get_monk_data { my $monk_url = ''; my @t = time(); print "Fetching data...."; my $ua = LWP::UserAgent->new(); my $req = HTTP::Request->new(GET=>"$monk_url"); my $result = $ua->request($req); return 0 if !$result->is_success; my $content = $result->content; $t[1] = time(); say("done (", formatted_time_diff(@t), " secs)"); print "Parsing XML...."; my $monks = XMLin($content, Cache => 'storable'); $t[2] = time(); say("done (", formatted_time_diff(@t[1,2]), " secs)"); return $monks; }

Darren :)

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://560490]
Approved by Paladin
Front-paged by GrandFather
[karlgoethebier]: marioroy ;Men need a challenge
Lady_Aleena remembers winning dodgeball and wonders why parents who played it will not let their kids play it.
[marioroy]: Disciplus My wife and I went on vacation. At work, I was stuck polling SNMP from 20 million devices. It would hang at 80,000. On the mist boat, hear a voice to enable grace in the design that 10x and more performance awaits.
[Lady_Aleena]: Women need challenges too karlgoethebier. 8)
[marioroy]: s/hear/heard/
[karlgoethebier]: Discipulus: No. See https://en. wiki/Tribe_( Native_American)
[karlgoethebier]: They took Unix from some aliens
[marioroy]: Perl is so powerful that it can poll 40 metrics from 20 million devices in 40 minutes using 4 nodes only.
[karlgoethebier]: http://www. aliens.htm
[Lady_Aleena]: marioroy, I can't decide whether or not to move my RolePlaying:: Random:: modules to just Random::. I'm not as sophisticated as most here.

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (12)
As of 2017-05-29 08:51 GMT
Find Nodes?
    Voting Booth?