#!/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; }