Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
Greetings!

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 # # pmgoogle.pl # Generates compressed KMZ (Google Earth) files # with placemarks for Perlmonks monks # See: earth.google.com # # 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/monks.store'; my $kmlfile = '/home/mcdarren/temp.kml'; my $www_dir = '/home/mcdarren/var/www/googlemonks'; my $palette_url = 'http://mcdarren.perlmonk.org/googlemonks/img/monk-p +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="http://earth.google.com/kml/2.1"> <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 \\> http://www.perlmonks.org/?node_id=$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 = 'http://tinymicros.com/pm/monks.xml'; 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; }

Cheers,
Darren :)


In reply to Google Earth Monks - Part II (The Code) by McDarren

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    [ambrus]: Corion: well Prima::Object says something like that the cleanup method will send an onDestory message and that you can't get more messages after cleanup, or something.
    [Corion]: ambrus: Yeah - I don't think the deep source dive will be necessary if things are implemented as simple as they could be :)) And hopefully I won't need (more) timely object destruction. I can update the screen at 60Hz and hopefully even do HTTP ...
    [Corion]: ... transfers in the background. Now that I think about it, this maybe even means that I can run the OpenGL filters on Youtube input :)
    [ambrus]: Corion: I mentioned that the unix event loop of Prima always wakes up at least once every 0.2 seconds. Have you found out whether the win32 event loop of Prima does that too?
    [Corion]: ambrus: Hmm - I would assume that the onDestroy message is sent from the destructor and doesn't go through the messageloop, but maybe it is sent when a window gets destroyed but all components are still alive...
    [ambrus]: Corion: partly deep source dive, partly just conservative coding even if it adds an overhead.
    [Corion]: ambrus: Hmm - no, I haven't looked at wakeup intervals ... I wonder why it should want to wakeup periodically because it gets a lot of messages from the Windows message loop (on Windows obviously)
    [ambrus]: (Alternately a deep source dive and then rewrite that event loop to make it better, and then as a bonus you get an idle method.)
    [ambrus]: The 0.2 seconds wakeup is likely a workaround for some bug, but I can't guess what bug that is.
    [ambrus]: It's been there since Prima 1.00 iirc

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (7)
    As of 2016-12-09 10:29 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      On a regular basis, I'm most likely to spy upon:













      Results (150 votes). Check out past polls.