#!/usr/bin/perl

#
# This is a derivative of a script by mcr@sandelman.ca.
#  http://www.sandelman.ottawa.on.ca/SSW/ietf/geo-pi/
# The old script is gen-geo-pi-v1.pl.
#
# The primary modification was to adjust for the change
# to sections and origin. This version also adds an
# option for decimal degree input format.
#
# alh-ietf@tndh.net  2002/12/31
#

print "Please select format  1) dd.mm.ss  or  2) dd.ddddd: ";
chop($fmt=<STDIN>);

print "Use minus (-) for south or west values. \n";
print "Please enter your lattitude: ";
chop($lat=<STDIN>);

print "Please enter your longitude: ";
chop($long=<STDIN>);

if($fmt == 1) {
  ($longdeg, $longmin, $longsec) = split(/ /, $long);
  ($latdeg, $latmin, $latsec) = split(/ /, $lat);
  
  if($longdeg < 0) {
    $longdeg = 360 + $longdeg;
  }
  if($latdeg < 0) {
    $latdeg = -$latdeg;
    $south = 1;
  }
  $wgs84long = $longdeg + ($longmin / 60) + ($longsec / 360);
  $wgs84lat  = $latdeg +  ($latmin / 60)  + ($latsec / 360);

  if ($south == 1) {
    $wgs84lat = -$wgs84lat;
  }
} else {
  if ($long < 0) {
    $wgs84long = 360 + $long;
  } else {
    $wgs84long = $long;
  }
}

Hain                      Expires April 2010                        13 

  An IPv6 Provider-Independent Global      October 2009
  Unicast Address Format

  $wgs84lat = 90 + $lat;

# Origin is now south pole @ 0 degrees

if ($wgs84lat >= 30) {
  if ($wgs84lat < 150) {
    $seclat = $wgs84lat - 30;
    if ($wgs84long >= 90) {
      if ($wgs84long < 210) {
        $section = 0;
        $seclong = $wgs84long - 90;
      } elsif ($wgs84long < 330) {
        $section = 1;
        $seclong = $wgs84long - 210;
      } else {
        $section = 2;
        $seclong = $wgs84long - 330;
      }
    } else {
      $section = 2;
      $seclong = $wgs84long + 30;
    }
  } else {
    $section = 7;
    $seclat = $wgs84lat - 150;
    $seclong = $wgs84long - 90;
  }
} else {
  $section = 6;
  $seclat = $wgs84lat;
  $seclong = $wgs84long - 90;
}
if ($seclong < 0) {
  $seclong = 360 + $seclong;
}

# Origin is now normalized to section
print ("Sec Lat: $seclat \n");
print ("Sec Long: $seclong \n");

if ($section < 3) {
  $seclong = int($seclong / 0.000057220458984375);
  $seclat  = int($seclat  / 0.000057220458984375);
} else {
  $seclong = int($seclong / 0.00017166137695312500);
  $seclat  = int($seclat  / 0.00017166137695312500);
}

# convert to binary
@lat  = &convert_to_binary($seclat);
@long = &convert_to_binary($seclong);
@secbin = &convert_to_binary($section);

Hain                      Expires April 2010                        14 

  An IPv6 Provider-Independent Global      October 2009
  Unicast Address Format


  print "Raw sec:",join('', @secbin),"\n";
print "Raw lat: ",join('', @lat),"\n";
print "Raw long:",join('', @long),"\n";

# clean off excess leading 0's
foreach $i (1..11) {
  shift(@lat);
  shift(@long);
}
foreach $i (1..29) {
  shift(@secbin);
}

# interleave bits
@geopi=();
if ($section > 3) {
  foreach $i (1..3) {
    $secid = shift(@secbin);
    push(@geopi, $secid);
  }
} else {
  shift(@secbin);
  foreach $i (1..2) {
    $secid = shift(@secbin);
    push(@geopi, $secid);
  }
}
my($o,$a);
foreach $i (1..21) {
  $o = shift(@long);
  $a = shift(@lat);
  if ($section > 3 && $i == 1) {
    #  skip this bit in polar sections
  } else {
    push(@geopi, $a);
  }
  push(@geopi, $o);
}

print "Digits ",join('', @geopi),"\n";
print "Lat: $lat Long: $long  -> x";

foreach $i (0..10) {
  @nibble = @geopi[($i*4)..($i*4+3)];
  $nibble = $nibble[0]*8 + $nibble[1]*4 + $nibble[2]*2 + $nibble[3];
  print sprintf("%x", $nibble);
  if ($i==2 || $i==6) {
    print ":";
  }
}
print "\n";

Hain                      Expires April 2010                        15 

  An IPv6 Provider-Independent Global      October 2009
  Unicast Address Format


  exit;

sub convert_to_binary {
  local($num)=@_;
  local($i, @digits);

  @digits=();
  foreach $i (1..32) {
    if ($num & 1) {
      unshift(@digits, 1);
    } else {
      unshift(@digits, 0);
    }
    $num = $num >> 1;
  }
  return @digits;
}
