Main menu:

Site search

Categories

Tags

intern

Oracle und SQL

Perl

Geo::Heatmap for Google Maps

Yesterday I released a new Version of Geo::Heatmap (0.16) it should be available on the CPAN mirror of your choice
Please see my older post to the same aucasinosonline topic

Two major changes:

  • I got rid of Image::Magik (which ain’t fun to install) and replaced it with Imager which installs easily
  • The example provided now uses the Version 3 of the Google Maps API

The example (Geo::Heatmap Demonstration) still looks the same

Coding example

The “calling” HTML

  <head>
     <meta name="viewport" content="initial-scale=1.0, user-scalable=no" />
     <style type="text/css">
       html { height: 100% }
       body { height: 100%; margin: 0; padding: 0 }
       #map-canvas { height: 100% }
     </style>
     <script type="text/javascript"
       src="https://maps.googleapis.com/maps/api/js?key=&sensor=true">
     </script>
     <script type="text/javascript">
       var overlayMaps = [{
         getTileUrl: function(coord, zoom) {
           return "hm.fcgi?tile="+coord.x+"+"+coord.y+"+"+zoom;
         },

         tileSize: new google.maps.Size(256, 256),
         isPng: true,
         opacity: 0.4
       }];

       function initialize() {
         var mapOptions = {
           center: new google.maps.LatLng(48.2130, 16.375),
           zoom: 9
         };
         var map = new google.maps.Map(document.getElementById("map-canvas"),
             mapOptions);

       var overlayMap = new google.maps.ImageMapType(overlayMaps[0]);
       map.overlayMapTypes.setAt(0,overlayMap);

       }
       google.maps.event.addDomListener(window, 'load', initialize);

     </script>
   </head>
   <body>
     <div id="map-canvas"/>
  </body>

The (f)cgi script

#!/usr/bin/env perl

use strict;
use FCGI;
use DBI;
use CHI;
use FindBin qw/$Bin/;
use lib "$Bin/../lib";

use Geo::Heatmap;

my $cache = CHI->new( driver => 'File',
         root_dir => '/tmp/domainmap'
     );

our $dbh = DBI->connect("dbi:Pg:dbname=gisdb", 'gisdb', 'gisdb', {AutoCommit => 0});

my $request = FCGI::Request();

while ($request->Accept() >= 0) {
  my $env = $request->GetEnvironment();
  my $p = $env->{'QUERY_STRING'};

  my ($tile) = ($p =~ /tile=(.+)/);
  $tile =~ s/\+/ /g;

  # package needs a CHI Object for caching
  #               a Function Reference to get LatLOng within a Google Tile
  #               maximum number of points per zoom level

  my $ghm = Geo::Heatmap->new();
  $ghm->palette('palette.store');

  # in this case the zoom scale is static - basically it is the count of the tile with the most values 
  $ghm->zoom_scale( {
    1 => 298983,
    2 => 177127,
    3 => 104949,
    4 => 90185,
    5 => 70338,
    6 => 37742,
    7 => 28157,
    8 => 12541,
    9 => 3662,
    10 => 1275,
    11 => 417,
    12 => 130,
    13 => 41,
    14 => 18,
    15 => 10,
    16 => 6,
    17 => 2,
    18 => 0,
  } );

  $ghm->cache($cache);
  $ghm->return_points( \&get_points );
  my $image = $ghm->tile($tile);

  my $length = length($image);

  print "Content-type: image/png\n";
  print "Content-length: $length \n\n";
  binmode STDOUT;
  print $image;

}

sub get_points {
  my $r = shift;

  my $sth = $dbh->prepare( qq(select ST_AsEWKT(geom) from geodata
                         where geom &&
              ST_SetSRID(ST_MakeBox2D(ST_Point($r->{LATN}, $r->{LNGW}),
                                                       ST_Point($r->{LATS}, $r->{LNGE})
                        ),4326))
              );

  $sth->execute();

  my @p;
  while (my @r = $sth->fetchrow) {
    my ($x, $y) = ($r[0] =~/POINT\((.+?) (.+?)\)/);
    push (@p, [$x ,$y]);
  }
  $sth->finish;
  return \@p;
}

Write a comment