#!/usr/local/bin/perl
# The kmlgen.pl script generates a kmldoit.kml file from the kmldoit.work file
use strict;
use warnings;
my $old_stdout = select(STDOUT);
$| = 1;
select($old_stdout);
my $old_stderr = select(STDERR);
$| = 1;
select($old_stderr);
my $arg="";
my $key="";
my $debug="";
my $modfile="modeldir/kmlmodel.kml";
my $workfile="kmldoit.work";
my $kmlfile="kmldoit.kml";
my $debugfile="kmlgen.debug";
my $br="<br/>";
my $line;
my $cntr;
my $entrycnt;
my $preffamin;
my $scolorin;
my $fnamein;
my $sample;
my $indkey;
my $type;
my $dat;
my $desctype;
my $descfname;
my $lat;
my $long;
my $place;
my $i;
my $j;
my $junk;
my $namfile;
my @lineargs;
my @lineflds1;
my @lineflds2;
my @placeargs;
my %rin;
my %famrin;
my %namrin;
my %indfamsnum;
my %indfamc;
my %indfams;
my %sexcolor;
my %fullnameplus;
my %preffamkey;
my $placenum;
my $pmkey;
my $pmname1;
my $pmnamesep;
my $pmname2;
my $pmcity;
my $pmcounty;
my $pmstate;
my $pmcountry;
my $pmdescline;
my %pmplace;
my %pmid;
my %pmname;
my %pmdesc;
my %pmlat;
my %pmlong;
my %pmnametyp;
my %pmdescnum;
my %pmpincol;
my %distcounts;
my %distcolors;
my $placestat;
my $placelcnt;
my @placeltab;
my $loopcntr;
my $loopmax=999999;
# The sequence of called subroutines is:
# Getopts
# Getdatafiles
# Printpage
# Printline
# PrintKML
Getopts();
if ($debug eq "") { $debug=" "; }
if ($debug ne " ") {
open (DOUT,">$debugfile") or die "Can't open $debugfile: $!";
}
Getdatafiles();
Printpage();
print "Done\n";
exit;
# <key> <numfams> <famcin> <fams> ...
sub Getdatafiles {
# <key> <preffamin> <scolorin> <fnamein>
$namfile="kmldir/namfile";
open (NAM,"<$namfile") or die "Can't open $namfile: $!";
Dprint("2","Reading $namfile ...\n");
$cntr=0;
while (<NAM>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("2","$cntr: $line\n");
$key="";
$preffamin="";
$scolorin="";
$fnamein="";
@lineargs = split(/\s/,$line,4);
if (defined $lineargs[0]) { $key=$lineargs[0]; }
if (defined $lineargs[1]) { $preffamin=$lineargs[1]; }
if (defined $lineargs[2]) { $scolorin=$lineargs[2]; }
if (defined $lineargs[3]) { $fnamein=$lineargs[3]; }
Dprint("2","key: $key\n");
Dprint("2","fnamein: $fnamein\n");
if ($key ne "") {
$namrin{$key}=$key;
$preffamkey{$key}=$preffamin;
$sexcolor{$key}=$scolorin;
$fullnameplus{$key}=$fnamein;
}
}
close NAM;
# <key> <place type> <lat> <long> #city,county,state,country
open (WORK,"<$workfile") or die "Can't open $workfile: $!";
Dprint("2","Reading $workfile ...\n");
$cntr=0;
$placenum=0;
while (<WORK>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
$placenum=$placenum+1;
Dprint("2","$cntr: $line\n");
$indkey="";
$type="";
$dat="";
$lat="";
$long="";
$place="";
($junk,$pmkey) = split(/#/,$line,2);
Dprint("p","pmkey=$pmkey\n");
@lineargs = split(/:/,$line,2);
@lineflds1 = split(/\s+/,$lineargs[0],3);
@lineflds2 = split(/\s+/,$lineargs[1],3);
if (defined $lineflds1[0]) { $indkey=$lineflds1[0]; }
if (defined $lineflds1[1]) { $type=$lineflds1[1]; }
if (defined $lineflds1[2]) { $dat=$lineflds1[2]; }
if (defined $lineflds2[0]) { $lat=$lineflds2[0]; }
if (defined $lineflds2[1]) { $long=$lineflds2[1]; }
if (defined $lineflds2[2]) { $place=$lineflds2[2]; }
if (!defined $pmplace{$pmkey}) {
# first time for pmkey
$pmname1="";
$pmnamesep="";
$pmname2="";
$pmcity="";
$pmcounty="";
$pmstate="";
$pmcountry="";
@placeargs = split(/,/,$pmkey,4);
if (defined $placeargs[0]) { $pmcity=$placeargs[0]; }
if (defined $placeargs[1]) { $pmcounty=$placeargs[1]; }
if (defined $placeargs[2]) { $pmstate=$placeargs[2]; }
if (defined $placeargs[3]) { $pmcountry=$placeargs[3]; }
if ($pmcity ne "") {
$pmname1=$pmcity;
$pmnametyp{$pmkey}="CITY";
if ($pmcounty ne "") {
$pmnamesep=",";
$pmname2=$pmcounty;
} elsif ($pmstate ne "") {
$pmnamesep=",";
$pmname2=$pmstate;
} elsif ($pmcountry ne "") {
$pmnamesep=",";
$pmname2=$pmcountry;
}
} elsif ($pmcounty ne "") {
$pmname1=$pmcounty;
$pmnametyp{$pmkey}="COUNTY";
if ($pmstate ne "") {
$pmnamesep=",";
$pmname2=$pmstate;
} elsif (($pmcountry ne "") && ($pmcountry ne "United States")) {
$pmnamesep=",";
$pmname2=$pmcountry;
}
} elsif ($pmstate ne "") {
$pmname1=$pmstate;
$pmnametyp{$pmkey}="STATE";
if (($pmcountry ne "") && ($pmcountry ne "United States")) {
$pmnamesep=",";
$pmname2=$pmcountry;
}
} elsif ($pmcountry ne "") {
$pmname1=$pmcountry;
$pmnametyp{$pmkey}="COUNTRY";
} else {
$pmname1="???";
$pmnametyp{$pmkey}="???";
}
Dprint("w","For line: $line\n");
Dprint("w","pmkey: $pmkey\n");
Dprint("w","lineargs[1]: $lineargs[1]\n");
Dprint("w","lat: $lat\n");
Dprint("w","long: $long\n");
Dprint("w","place: $place\n");
Dprint("w","pmkey: $pmkey\n");
$pmid{$pmkey}="myid$cntr";
$pmplace{$pmkey}=$pmkey;
$pmname{$pmkey}="$pmname1$pmnamesep$pmname2";
$pmdesc{$pmkey}="$pmkey$br$lat,$long$br";
$pmdescnum{$pmkey}=0;
$pmpincol{$pmkey}="DEFAULT";
}
if (defined $fullnameplus{$indkey}) {
$descfname=$fullnameplus{$indkey};
} else {
$descfname="Unknown";
}
if ($type eq "1BIRT") { $desctype="BIRTH";
} elsif ($type eq "2CHR") { $desctype="CHRISTENING";
} elsif ($type eq "6DEAT") { $desctype="DEATH";
} elsif ($type eq "7BURI") { $desctype="BURIED";
} elsif ($type eq "3EVEN") { $desctype="";
} elsif ($type eq "4MARR") { $desctype="MARRIAGE";
} elsif ($type eq "5MAEV") { $desctype="";
} else { $desctype="UNKNOWN";
}
$pmdescline="$indkey $desctype $dat $descfname$br";
$pmdesc{$pmkey}=$pmdesc{$pmkey} . $pmdescline;
$pmlat{$pmkey}=$lat;
$pmlong{$pmkey}=$long;
$pmdescnum{$pmkey}=$pmdescnum{$pmkey}+1;
Dprint("p","$pmdescnum{$pmkey} $pmnametyp{$pmkey} $pmname{$pmkey} $indkey $desctype\n");
}
close WORK;
}
sub Printpage {
open (KML,">$kmlfile") or die "Can't open $kmlfile: $!";
Dprint("G","Generating $kmlfile ...\n");
open(MOD,"<$modfile") or die "Can't open $modfile: $!";
Dprint("G","Reading $modfile ...\n");
$cntr=0;
$placestat=0;
$placelcnt=0;
while (<MOD>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("g","$cntr: $line\n");
if ($line =~ /^.+xXx/) {
Dprint("G","Got xXx at line $cntr: $line\n");
if ($line =~ /^.+xBEGINPLACEx/) {
$placestat=1;
} elsif ($line =~ /^.+xENDPLACEx/) {
$placestat=2;
Dprint("I","Place table has $placelcnt lines\n");
Dprint("I","There are $placenum places\n");
if ($placenum > 0) {
$entrycnt=0;
# Determine distribution of pin counts
foreach $i (keys %pmplace) {
$j=$pmdescnum{$i};
if (!defined $distcounts{$j}) {
$distcounts{$j}=1;
} else {
$distcounts{$j}=$distcounts{$j}+1;
}
}
# Print pin count distribution
foreach $j (keys %distcounts) {
Dprint("c","Pin count $j has $distcounts{$j} pins\n");
}
# Determine color of pin
foreach $i (keys %pmplace) {
if (($pmnametyp{$i} eq "STATE") || ($pmnametyp{$i} eq "COUNTRY")) {
$pmpincol{$i}="DEFAULT";
} elsif ($pmdescnum{$i} > 10) {
$pmpincol{$i}="RED";
} elsif ($pmdescnum{$i} > 5) {
$pmpincol{$i}="ORANGE";
} elsif ($pmdescnum{$i} > 3) {
$pmpincol{$i}="YELLOW";
} elsif ($pmdescnum{$i} > 1) {
$pmpincol{$i}="BLUE";
} else {
$pmpincol{$i}="GREEN";
}
}
# Determine distribution of pin colors
$distcolors{"DEFAULT"}=0;
$distcolors{"RED"}=0;
$distcolors{"ORANGE"}=0;
$distcolors{"YELLOW"}=0;
$distcolors{"BLUE"}=0;
$distcolors{"GREEN"}=0;
foreach $i (keys %pmplace) {
$j=$pmpincol{$i};
$distcolors{$j}=$distcolors{$j}+1;
}
# Print pin color distribution
foreach $j (keys %distcolors) {
print "Pin color $j has $distcolors{$j} pins\n";
}
foreach $i (keys %pmplace) {
$entrycnt=$entrycnt+1;
$j=0;
while ($j < $placelcnt) {
$j=$j+1;
$line=$placeltab[$j];
Dprint("I","Place model line: $line\n");
$line =~ s/xXxIDx/$pmid{$i}/;
$line =~ s/xXxNAMEx/$pmname{$i}/;
$line =~ s/xXxDESCx/$pmdesc{$i}$br/;
$line =~ s/xXxLATx/$pmlat{$i}/;
$line =~ s/xXxLONGx/$pmlong{$i}/;
$line =~ s/xXxPINCOLORx/$pmpincol{$i}/;
PrintKML("$line\n");
Dprint("I","Modified place table line: $line\n");
}
}
}
} elsif ($placestat == 1) {
# If in middle of place table create place table array
$placelcnt=$placelcnt+1;
$placeltab[$placelcnt]=$line;
} else {
# Modify line and then write it
$line =~ s/xXxSAMPLEx/$sample/;
PrintKML("$line\n");
Dprint("I","Modified model line: $line\n");
}
} else {
if (($placestat == 0) || ($placestat == 2)) {
# If not inside place table just write line
PrintKML("$line\n");
Dprint("I","Copy model line: $line\n");
} else {
# If in middle of place table create place table array
$placelcnt=$placelcnt+1;
$placeltab[$placelcnt]=$line;
}
}
}
close MOD;
close KML;
print "Output file $kmlfile has $entrycnt Placemark entries\n";
}
sub PrintKML {
my $kmldata=$_[0];
print KML "$kmldata";
}
sub Getopts {
if ($#ARGV >= 0) {
my $i=0;
while ($i <= $#ARGV) {
if ($ARGV[$i] eq "-help") {
Help();
++$i;
} elsif (($i+1) <= $#ARGV) {
if ($ARGV[$i] eq "-d") {
# enable debug mode
$debug = $ARGV[++$i];
++$i;
} else {
Usage();
}
} else {
$arg=$ARGV[$i];
print "Argument is: $arg\n";
++$i;
}
}
}
}
# Debug print
sub Dprint {
my $dlev=$_[0];
my $dline=$_[1];
# See if $dlev is any of the characters in $debug
if (($debug eq "all") || ($debug =~ m/$dlev/)) {
print "$dline";
print DOUT "$dline";
}
}
sub Usage {
die "Usage: $0 [-help] [-test] [-nogen] [-d <debuglevel>] <arg>\n";
}
sub Help {
print "Usage: $0 [-help] [-d <debuglevel>] <arg>\n";
print "-help = Display this help information\n";
print "-d <debuglevel> = Enable printout for various debug levels\n";
print "<arg> = input argument\n";
exit;
}