Geo-Location-TimeZone
view release on metacpan or search on metacpan
b/build-data.pl view on Meta::CPAN
#!/usr/bin/perl
$|=1;
use strict;
use Geo::ShapeFile;
use Math::Polygon;
use Data::Dumper;
use lib "../lib";
use lib "lib";
use Geo::Location::TimeZone;
# This is a hacky script to generate the data used by Geo::Location::TimeZone.
# It essentially uses brute force. It is run by the package maintainer, and
# not as part of unpacking the package.
# The steps taken are:
# 1) Read in list of centroid points and matching names.
# 2) read the ESRI Timezone boundary DB.
# 3) Iterate through above:
# 3a) Get the bounding box of the polygon.
# 3b) Work through each 15x15 box within the boundary, seeing if
# anything is within.
# 3b1) Check to see if any known centroids are within
# this 15x15 square.
# 3b2) else, check to see if the timezone matches the
# calculated zone. Skip if so (save memory)
# 3b3) If a name different to the calculated one is
# found, write out this polygon.
# 3b4) If multiple polygons are found, work out the one
# with the largest area and use that one as the
# default.
#
# Note: Everything found is kept in memory, so it can be output in one hit.
# Master data store.
my %data = ();
my $outdir = "../lib/Geo/Location/TimeZone/";
my $basezone = "Geo::Location::TimeZone";
my $geotzobj = $basezone->new();
my $totpack = 0;
my $totunpack = 0;
# Fun, ESRI did decimal hour offsets.
my %offcountries = ( "3.50" => "Asia/Tehran",
"4.50" => "Asia/Kabul",
"5.75" => "Asia/Katmandu",
"-3.50" => "Canada/Newfoundland",
"-9.50" => "Pacific/Marquesas",
"9.50" => "Australia/Darwin",
"6.50" => "Indian/Cocos",
"-8.50" => "Pacific/Marquesas",
"11.50" => "Pacific/Norfolk",
"10.50" => "Australia/Adelaide",
"12.75" => "Pacific/Chatham",
"5.50" => "Asia/Calcutta",
);
sub close15 {
my $arg = shift;
my $retval = int(( abs( $arg ) + 7.5 ) /15 );
if( $arg < 7.5 ){
$retval = 0 - $retval;
}
return( $retval );
}
b/build-data.pl view on Meta::CPAN
$keycount++;
}
}
}
}
}
closedir( INDIR );
}
# sleep 5;
# Finally, read in the shapefile data from ESRI.
my $shapeobjs = new Geo::ShapeFile( $shapefile );
for ( my $c = 1 ; $c <= $shapeobjs->shapes() ; $c++ ){
# for ( my $c = 1 ; $c <= 2 ; $c++ ){
my $lshape = $shapeobjs->get_shp_record( $c );
# Retrieve the textual records associated with this shape.
my %lsh_db = $shapeobjs->get_dbf_record( $c );
my $lzone = undef;
# Collect the initial zone.
if( defined( $lsh_db{"ZONE"} ) ){
if( $lsh_db{"ZONE"} =~ /^\s*(\-?\d+)(\.00)?\s*$/ ){
my $loff = $1;
$lzone = "Etc/GMT";
if( $loff > 0 ){
$lzone .= "+" . $loff;
}elsif( $loff < 0 ){
$lzone .= $loff;
}
}else{
# It is a zone with a fractional offset. Use the
# inbuilt list.
if( defined( $offcountries{$lsh_db{"ZONE"}} ) ){
$lzone = $offcountries{$lsh_db{"ZONE"}};
}else{
$lzone = "Unknown/" . $lsh_db{"ZONE"};
}
}
}else{
$lzone = "undefinedzone";
}
print STDERR "Shape number $c , zone is " . $lsh_db{"ZONE"} . " and $lzone X\n";
# If a zone hasn't been found, we might find it later via the centroid
# list. Lets start looping.
for ( my $s = 1 ; $s <= $lshape->num_parts ; $s++ ){
my @points = ();
# Store the points in a local array.
foreach my $point( $lshape->get_part( $s ) ){
push @points, [$point->X, $point->Y];
}
# Create the polygon.
my $poly = Math::Polygon->new( @points );
# What is the bounding box for this?
my ($xmin, $ymin, $xmax, $ymax) = $poly->bbox;
# Change those into 15 degree chunks.
$xmin = &close15( $xmin );
$ymin = &close15( $ymin );
$xmax = &close15( $xmax );
$ymax = &close15( $ymax );
my $oymin = $ymin;
# print STDERR "$lzone received $xmin $ymin $xmax $ymax\n";
# Start working through all of the possibilities.
while( $xmin <= $xmax ){
# Get the zone for this longitude.
my $szone = "Etc/GMT";
if( $xmin > 0 ){
$szone .= "+" . $xmin;
}elsif( $xmin < 0 ){
$szone .= $xmin;
}
# See whether we found a specific match.
my $forceuse = 0;
if( $lzone !~ /^Etc/ || $szone ne $lzone ){
$forceuse++;
}
$ymin = $oymin;
while( $ymin <= $ymax ){
# We skip this grid if there is already data
# from other sources.
if( defined( $data{"$xmin"}{"$ymin"}{"o"} ) ){
$ymin++;
next;
}
my $usezone = $lzone;
# print STDERR "$xmin/$xmax , $ymin/$ymax \n";
# Expand the xmin,ymin to a rectangle that
# we can use fillClip on.
my @bbox = &expandbox( $xmin, $ymin );
print STDERR "$lzone Grid $xmin:$ymin - Restricting to " . join( ",", @bbox ) . " \r";
my $newpoly = $poly->fillClip1( @bbox );
# Skip if nothing sensible was returned,
# meaning that there is nothing in this
# block.
if( ! defined( $newpoly ) ){
$ymin++;
next;
b/build-data.pl view on Meta::CPAN
# the polygon.
if( $szone ne $usezone || $forceuse ){
# Unfortunately, simplify occasionally
# has issues. At heart is that
# fillClip1 will sometimes produce a
# lot of points along a clipped line.
# Since we're clipping on only vertical
# and horizontal lines, we can simplify
# this ourselves, although it'll be
# slower.
# $newpoly = $newpoly->simplify( same => 0, slope => 0.001 );
my @masspoints = $newpoly->points();
my $diddel = 0;
for( my $curoff = 0; $curoff < ( scalar @masspoints ) - 3 ; $curoff++ ){
$curoff=0 if( $curoff < 0 );
# If either the X or Y coords of
# 3 points in succession are
# the same, then it is a line
# that we can simplify ourselve
my $trimX = 0;
my $trimY = 0;
my $candel = 0;
if( $masspoints[$curoff][0] == $masspoints[$curoff+1][0] && $masspoints[$curoff][0] == $masspoints[$curoff+2][0] ){
$trimX++;
}
if( $masspoints[$curoff][1] == $masspoints[$curoff+1][1] && $masspoints[$curoff][1] == $masspoints[$curoff+2][1] ){
$trimY++;
}
# Match the case of two
# identical points being
# present, but not part of a
# line series.
if( ! $trimX && ! $trimY ){
if( $masspoints[$curoff][0] == $masspoints[$curoff+1][0] && $masspoints[$curoff][1] == $masspoints[$curoff+1][1] ){
$candel++;
}
}else{
$candel++ if( $trimX );
$candel++ if( $trimY );
}
while( $candel > 0 ){
# print STDERR "Removing point: " . $masspoints[$curoff][0] . "," . $masspoints[$curoff][1] . " vs ". $masspoints[$curoff+1][0] . "," . $masspoints[$curoff+1][1] . "\n";
# delete( $masspoints[$curoff+1] );
splice( @masspoints, $curoff+1, 1 );
$candel--;
$diddel++;
}
if( $trimX || $trimY ){
$curoff--;
}
}
if( $diddel ){
print STDERR "Removed $diddel points leaving " . scalar @masspoints . " \n";
# Recreate the poly using the
# reduced set of points.
# print STDERR "Recreating the polygon: " . join( ",", @masspoints ) . " X\n";
$newpoly = Math::Polygon->new( @masspoints );
}
}
# Save this zone if something different
# is found, and the polygon has a bit of area.
my $tarea = 0;
if( $szone ne $usezone || $forceuse ){
$tarea = $newpoly->area();
if( $tarea > 0 ){
# Increment the count.
$keycount++;
$data{"$xmin"}{"$ymin"}{"$keycount"}{"a"} = $tarea;
}
}
if( $tarea != 0 ){
# print "\t\$data{\"$xmin\"}{\"$ymin\"}{\"$keycount\"}{\"z\"} = \"$usezone\";\n";
# print "\t\$data{\"$xmin\"}{\"$ymin\"}{\"$keycount\"}{\"p\"} = ( ";
# Save the area of the poly.
$data{"$xmin"}{"$ymin"}{"$keycount"}{"a"} = $newpoly->area();
if( scalar @centzones <= 1 ){
$data{"$xmin"}{"$ymin"}{"$keycount"}{"z"} = "$usezone";
if( $usezone =~ /^\s*$/ ){
print STDERR "Huh? No zone! ($xmin, $ymin, $keycount, ESRI $c, $s )\n";
}
}else{
print STDERR "Found centzones with " . scalar @centzones . " records\n";
for( my $centoff = 0; $centoff < scalar @centzones ; $centoff++ ){
$data{"$xmin"}{"$ymin"}{"$keycount"}{"z" . $centoff} = $centzones["$centoff"];
}
}
$data{"$xmin"}{"$ymin"}{"$keycount"}{"c"} = "ESRI";
# Reference for finding where the
# data came from.
$data{"$xmin"}{"$ymin"}{"$keycount"}{"s"} = "$c,$s";
my $teststr = $geotzobj->do_pack( poly => $newpoly );
# print STDERR "Got do_pack string of " . length( $teststr ) . "\n";
$totpack += length( $teststr );
foreach my $fpoint( $newpoly->points ){
# print ${$fpoint}[0] . "," . ${$fpoint}[1] . ",";
push @{$data{"$xmin"}{"$ymin"}{"$keycount"}{"p"}}, [${$fpoint}[0], ${$fpoint}[1]];
}
# print " );\n";
$recheck{"$xmin"}{"$ymin"}++;
}else{
# print STDERR "Skipping - $lzone, $szone\n";
}
# Finally increment.
$ymin++;
}
# Inc xmin
# print STDERR "inc xmin $xmin\n";
$xmin++;
}
}
}
b/build-data.pl view on Meta::CPAN
"8", "H",
"9", "I",
"10", "K",
"11", "L",
"12", "M",
"-1", "N",
"-2", "O",
"-3", "P",
"-4", "Q",
"-5", "R",
"-6", "S",
"-7", "T",
"-8", "U",
"-9", "V",
"-10", "W",
"-11", "X",
"-12", "Y",
);
# Run through the list of things checked, outputting all the data.
my $fc = 0;
my $ec = 0;
# print "\n# Output of all data at " . time . "\nmy \%data = {\n";
for ( my $xc = -12 ; $xc <= 12 ; $xc++ ){
my $doneX = 0;
for ( my $yc = -6 ; $yc <= 6 ; $yc++ ){
$ec++;
if( ! $doneX && defined( $zulus{"$xc"} ) ){
my $outfile = $outdir . "/" . $zulus{"$xc"} . ".pm";
if( open( OUTPUT, "> $outfile" ) ){
$doneX = 1;
print OUTPUT "######## GeoData for $basezone - Check main library for copyright.\n";
print OUTPUT "######## Roughly GMT $xc\n";
print OUTPUT "package " . $basezone . "::" . $zulus{"$xc"} . ";\n";
print OUTPUT "use Class::Singleton;\n";
print OUTPUT "use " . $basezone . ";\n";
print OUTPUT "\@ISA = qw(Class::Singleton Geo::Location::TimeZone);\n";
print OUTPUT "# Coordinates are X,Y, NOT lat,lon\n";
print OUTPUT "# Output of partial data at " . time . "\nmy \$data = {\n";
print OUTPUT "\t# Longitude " . ( ( $xc * 15 ) - 7.5 ) . " to " . ( ( $xc * 15 ) + 7.5 ) . "\n";
print OUTPUT "\t\"$xc\" => {\n";
}else{
print STDERR "Could not open file for $xc - $outfile \n";
}
}
if( ! defined( $recheck{"$xc"}{"$yc"} ) ){
print STDERR "$xc:$yc - Nothing\n";
if( $doneX ){
print OUTPUT "\t\t# Grid $xc:$yc ; No records found\n";
}
}elsif( $doneX ){
print OUTPUT "\t\t# Grid $xc:$yc ; " . $recheck{"$xc"}{"$yc"} . " records\n";
print OUTPUT "\t\t\"$yc\" => {\n";
my $maxarea = -1;
my $maxname = undef;
foreach my $rkey( sort keys %{$data{"$xc"}{"$yc"}} ){
next if( $rkey eq "o" );
if( ! defined( $data{"$xc"}{"$yc"}{"$rkey"}{"a"} ) ){
my $newpoly = Math::Polygon->new( @{$data{"$xc"}{"$yc"}{"$rkey"}{"p"}} );
$data{"$xc"}{"$yc"}{"$rkey"}{"a"} = $newpoly->area();
}
if( $data{"$xc"}{"$yc"}{"$rkey"}{"a"} > $maxarea || $maxarea == -1 ){
$maxarea = $data{"$xc"}{"$yc"}{"$rkey"}{"a"};
$maxname = $rkey;
}
}
# Decide what the default timezone is.
if( defined( $maxname ) ){
my @bbox = &expandbox( $xc, $yc );
my @points = ();
push @points, [$bbox[0],$bbox[1]];
push @points, [$bbox[2],$bbox[3]];
my $npoly = Math::Polygon->new( @points );
# If there is only one polygon, and the area
# is less than the bounding box, then we
# need to retain it in the output.
if( $maxarea < $npoly->area && $recheck{"$xc"}{"$yc"} > 1 ){
# Need to output the timezones found
# on the object that we're not putting
# in as def_zs.
foreach my $foundzs( keys %{$data{"$xc"}{"$yc"}{"$maxname"}} ){
next unless( $foundzs =~ /^z/ );
print OUTPUT "\t\t\t\"def_" . $foundzs . "\" => \"" . $data{"$xc"}{"$yc"}{"$maxname"}{"$foundzs"} . "\",\n";
$data{"$xc"}{"$yc"}{"$maxname"}{"isdef"} = 1;
}
}else{
# Huh. One polygon found, 80.8481929106774 , 0 X
print STDERR "Huh. One polygon found, $maxarea , " . $npoly->area . " from points " . join(',', @bbox ) . " X\n";
}
}
foreach my $rkey( sort keys %{$data{"$xc"}{"$yc"}} ){
next if( $rkey eq "o" );
next if( defined( $data{"$xc"}{"$yc"}{"$rkey"}{"isdef"} ) );
print OUTPUT "\t\t\t\"$rkey\" => {\n";
foreach my $foundzs( keys %{$data{"$xc"}{"$yc"}{"$rkey"}} ){
next unless( $foundzs =~ /^z/ );
print OUTPUT "\t\t\t\t\"" . $foundzs . "\" => \"" . $data{"$xc"}{"$yc"}{"$rkey"}{"$foundzs"} . "\",\n";
}
foreach my $maybe( "c", "s" ){
next unless( defined( $data{"$xc"}{"$yc"}{"$rkey"}{"$maybe"} ) );
print OUTPUT "\t\t\t\t\"$maybe\" => \"" . $data{"$xc"}{"$yc"}{"$rkey"}{"$maybe"} . "\",\n";
}
print OUTPUT "\t\t\t\t\"p\" => [";
foreach my $tpoint (@{$data{"$xc"}{"$yc"}{"$rkey"}{"p"}} ){
my $tmpstr = "[" . ${$tpoint}[0] . "," . ${$tpoint}[1] . "],";
print OUTPUT $tmpstr;
$totunpack += length( $tmpstr );
}
print OUTPUT "],\n";
print OUTPUT "\t\t\t},\n";
}
print OUTPUT "\t\t},\n";
$fc++;
}
}
if( $doneX ){
print OUTPUT "\t},\n";
print OUTPUT "};\n";
print OUTPUT "\n# Used by Class::Singleton\n";
print OUTPUT "sub _new_instance\n";
print OUTPUT "{\n";
print OUTPUT "\treturn shift->_init( \@_, data => \$data );\n";
print OUTPUT "}\n";
print OUTPUT "\n1;\n";
close( OUTPUT );
$doneX = 0;
( run in 0.314 second using v1.01-cache-2.11-cpan-eab888a1d7d )