#!/usr/bin/perl
# gentree.pl - Generate family tree HTML files
# gentree.pl [-help] [-test] [-nogen] [-d <debuglevel>] [-ged <gedfile>] [-mod <modeldir>] [-html <htmldir>] [-del <surname>]
use strict;
use warnings;
my $old_stdout = select(STDOUT);
$| = 1;
select($old_stdout);
my $old_stderr = select(STDERR);
$| = 1;
select($old_stderr);
my $debug="";
my $test=0;
my $nogen=0;
my $gedfile="gedfile.ged";
my $htmldir="htmldir";
my $modeldir="modeldir";
my $delname="";
my $debugfile="gentree.debug";
my $placfile="gentree.places";
my $searchfs="href=\"https://www.familysearch.org/search/tree/results?count=100&q.anyDate.from=xDTx&q.anyPlace=xPLx&q.givenName=xGNx&q.surname=xSNx\"";
my $searchfg="href=\"https://www.findagrave.com/memorial/search?firstname=xFNx&lastname=xLNx&birthyear=xBYx&deathyear=xDYx\"";
my $valDT;
my $valPL;
my $valGN;
my $valSN;
my $valFN;
my $valLN;
my $valBY;
my $valDY;
my $val1;
my $val2;
my $val3;
my $val4;
my $valrest;
my $atagdata="?";
my $indfile;
my $famfile;
my $namfile;
my $modfile;
my $htmlfile;
my $line;
my $eline;
my $cntr;
my $lev;
my $typ;
my $val;
my $i;
my $j;
my $x;
my $work;
my $newtablecolumn;
my $nochildren;
my $key="";
my $hkey="";
my $hpkey="";
my $hfkey="";
my $hmkey="";
my $wkey="";
my $wpkey="";
my $wfkey="";
my $wmkey="";
my $numerickey;
my $savekey;
my $lev0typ="";
my $lev1typ="";
my $lev2typ="";
my $lev3typ="";
my $lev4typ="";
my $ignore=0;
my $numnames=0;
my $lev0notenum=0;
my $numevents=0;
my $numfams=0;
my $numfamc=0;
my $numchild=0;
my $gseqno=0;
my $lev1evtyp;
my %rin;
my %numericrin;
my %fullname;
my %fullnameplus;
my %altnum;
my %altnames;
my %altdata;
my %altcolor;
my %givenname;
my %surname;
my %cemeteryname;
my %cemeterynote;
my %givennamezzz;
my %surnamezzz;
my %birthdatezzz;
my %birthplacezzz;
my %cemeterynamezzz;
my %nameprefix;
my %namesuffix;
my %ixsurname;
my %ixgiven;
my %chgdate;
my %chgtime;
my %sex;
my %sexcolor;
my %uid;
my %birthdate;
my %birthage;
my %birthplace;
my %birthaddr;
my %birthaddrnote;
my %birthnote;
my %birthdata;
my %birthcolor;
my %chrdate;
my %chrage;
my %chrplace;
my %chraddr;
my %chraddrnote;
my %chrnote;
my %chrdata;
my %chrcolor;
my %dead;
my %deathdate;
my %deathage;
my %deathplace;
my %deathaddr;
my %deathaddrnote;
my %deathnote;
my %deathdata;
my %deathcolor;
my %deathcause;
my %burdate;
my %burplace;
my %buraddr;
my %buraddrnote;
my %burnote;
my %burcrem;
my %burlati;
my %burlong;
my %burdata;
my %burcolor;
my %lev0note;
my %lev0notekey;
my %lev1note;
my %notedata;
my %notecolor;
my %eventnum;
my %eventage;
my %eventtype;
my %eventdesc;
my %eventdate;
my %eventplace;
my %eventnote;
my %eventdescplacenote;
my %fsftid;
my %fslink;
my %fgrave;
my %fglink;
my %indfamc;
my %indfamcnum;
my %preffamkey;
my %famlink;
my %indfams;
my %indfamsnum;
my %indstat;
my %rinorder;
my %surnameorder;
my %givenorder;
my %husbkey;
my %wifekey;
my %husbpref;
my %wifepref;
my %husbtitl;
my %wifetitl;
my %mardate;
my %marplace;
my %mardateplace;
my %mardateinplace;
my %marstat;
my %marwin;
my %statdate;
my %childpref;
my %childkeynum;
my %allchildkeynum;
my %childkey;
my $eventstat;
my $eventlcnt;
my @eventltab;
my $childstat;
my $childlcnt;
my @childltab;
my %childfamkey;
my %childfullname;
my %childsexcolor;
my %childdata;
my %famrin;
my %husbfathhref;
my %husbfather;
my %husbmothhref;
my %husbmother;
my %wifefathhref;
my %wifefather;
my %wifemothhref;
my %wifemother;
my %husbhref;
my %husbfullname;
my %husbbirthdateplace;
my %husbchrdateplace;
my %husbdeathdateplace;
my %husbburdateplace;
my %husbdeathcause;
my %husbnumspouses;
my %husbspouselink;
my %husbspousename;
my %husbfglink;
my %husbfgid;
my %wifehref;
my %wifefullname;
my %wifebirthdateplace;
my %wifechrdateplace;
my %wifedeathdateplace;
my %wifeburdateplace;
my %wifedeathcause;
my %wifenumspouses;
my %wifespouselink;
my %wifespousename;
my %wifefglink;
my %wifefgid;
my $ixtype;
my $ixcolor;
my $ixname;
my $ixsex;
my $ixfglink;
my $ixfgrave;
my $ixfslink;
my $ixfsftid;
my $bdateseq;
my $cemprefix;
my $cemloc;
my $cemloc1;
my $cemloc2;
my $cemloc3;
my $cemloc4;
my $bplaceloc;
my $bplaceloc1;
my $bplaceloc2;
my $bplaceloc3;
my $bplaceloc4;
my $cplaceloc1;
my $cplaceloc2;
my $cplaceloc3;
my $cplaceloc4;
my $dplaceloc1;
my $dplaceloc2;
my $dplaceloc3;
my $dplaceloc4;
my $numixlines;
my $xlinestat;
my $xlinelcnt;
my @xlineltab;
my @keysbyrin;
my @keysbysurname;
my @keysbygivenname;
my @keysbybirthdate;
my @keysbybirthplace;
my @keysbycemeteryname;
my %indrec;
my %famrec;
my %namrec;
Getopts();
if ($debug eq "") { $debug=" "; }
if ($debug ne " ") {
open (DOUT,">$debugfile") or die "Can't open $debugfile: $!";
}
open (GED,"<$gedfile") or die "Can't open $gedfile: $!";
if ($nogen == 0) {
opendir (*HTMLDIR,"$htmldir") or die "Can't find directory $htmldir: $!";
closedir (*HTMLDIR);
} else {
print "Nogen is on, HTML files will not be written\n";
}
opendir (*MODDIR,"$modeldir") or die "Can't find directory $modeldir: $!";
closedir (*MODDIR);
open (PLAC,">$placfile") or die "Can't open $placfile: $!";
print "Reading $gedfile ...\n";
$cntr=0;
while (<GED>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("a","$cntr: $line\n");
($lev,$typ,$val) = split(/\s/,$line,3);
if (!defined $lev) { $lev=""; }
if (!defined $typ) { $typ=""; }
if (!defined $val) { $val=""; }
Dprint("a","lev: $lev\n");
Dprint("a","typ: $typ\n");
Dprint("a","val: $val\n");
# Level 0 processing
if ($lev eq "0") {
if ($val eq "NOTE") {
# level 0 NOTE processing
$lev0notenum=$lev0notenum+1;
$lev0notekey{$key,$lev0notenum}=$typ;
$lev0note{$key,$lev0notenum}="";
} else {
Processlev0();
$lev0typ="$val";
$lev0notenum=0;
$numevents=0;
$ignore=0;
$numnames=0;
$numfams=0;
$numfamc=0;
$numchild=0;
Dprint(0,"Level 0: $typ $val\n");
if ($val eq "INDI") {
$key=$typ;
Initind();
$rin{$key}=$key;
$numerickey=$key;
$numerickey=~s/[^\d.]//g; # digits only
$numericrin{$key}=$numerickey;
$eventnum{$key}=0;
} elsif ($val eq "FAM") {
$key=$typ;
Initfam();
$famrin{$key}=$key;
$numerickey=$key;
$numerickey=~s/[^[A-Z,0-9]//g; # digits and capital letters only
$numericrin{$key}=$numerickey;
$eventnum{$key}=0;
} elsif ($val eq "_STORY") {
$lev0typ="";
$ignore=1;
} elsif ($val eq "SOUR") {
$lev0typ="";
$ignore=1;
} elsif ($val eq "REPO") {
$lev0typ="";
$ignore=1;
} elsif ($typ eq "_TODO") {
$lev0typ="";
$ignore=1;
} elsif ($typ eq "_PLAC_DEFN") {
$lev0typ="";
$ignore=1;
} elsif ($typ eq "_EVENT_DEFN") {
$lev0typ="";
$ignore=1;
} elsif ($typ eq "_HASHTAG_DEFN") {
$lev0typ="";
$ignore=1;
} elsif ($val eq "SUBM") {
$lev0typ="";
$ignore=1;
} elsif ($typ eq "HEAD") {
$lev0typ="";
$ignore=1;
} elsif ($typ eq "TRLR") {
$lev0typ="";
$ignore=1;
} elsif ($typ eq "SOUR") {
$lev0typ="";
$ignore=1;
} else {
print "Unhandled level 0 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
}
} elsif ($ignore == 1) {
} elsif ($lev0typ eq "INDI") {
# INDI Level 1 processing
if ($lev eq "1") {
$lev1typ=$typ;
Dprint(1,"Level 1: $typ $val\n");
if (($typ eq "CONC") || ($typ eq "CONT")) {
Dprint("c","Found in level 1: NOTE $typ\n");
} elsif ($typ eq "NOTE") {
Dprint("n","Found in level 1: $lev0typ $typ\n");
}
if ($lev0notenum > 0) {
if ($typ eq "CONC") {
$lev0note{$key,$lev0notenum}=$lev0note{$key,$lev0notenum} . $val;
} elsif ($typ eq "CONT") {
$lev0note{$key,$lev0notenum}=$lev0note{$key,$lev0notenum} . "\n" . $val;
} else {
print "Unhandled level 1 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($typ eq "SEX") {
if ($val eq "M") {
$sex{$key}="Male";
$sexcolor{$key}="blue";
} elsif ($val eq "F") {
$sex{$key}="Female";
$sexcolor{$key}="red";
} else {
$sex{$key}="Unknown";
$sexcolor{$key}="black";
}
} elsif ($typ eq "NAME") {
$numnames=$numnames+1;
$givenname{$key,$numnames}="";
$surname{$key,$numnames}="";
$nameprefix{$key,$numnames}="";
$namesuffix{$key,$numnames}="";
} elsif ($typ eq "BIRT") {
} elsif ($typ eq "CHR") {
} elsif ($typ eq "DEAT") {
$dead{$key}="y";
if ($val eq "Y") {
$deathdate{$key}="Yes";
}
} elsif ($typ eq "BURI") {
} elsif ($typ eq "RESN") {
} elsif ($typ eq "_PPEXCLUDE") {
} elsif ($typ eq "OCCU") { # Occupation
$lev1evtyp="Occupation";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "EDUC") { # Education
$lev1evtyp="Education";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "GRAD") { # Education
$lev1evtyp="Graduation";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "NATU") { # Naturalized
$lev1evtyp="Naturalized";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "IMMI") { # Immigrated
$lev1evtyp="Immigrated";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "DIV") { # Divorced
$lev1evtyp="Divorced";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "CENS") { # Census
$lev1evtyp="Census";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "RESI") { # Residence
$lev1evtyp="Residence";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "ORDN") { # Ordination
$lev1evtyp="Ordination";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "EVEN") {
$lev1evtyp="Unknown";
} elsif ($typ eq "_FSFTID") {
$fsftid{$key}=$val;
} elsif ($typ eq "_FSLINK") {
if ($val ne "") {
$fslink{$key}="href=\"$val\"";
}
} elsif ($typ eq "_FGRAVE") {
$fgrave{$key}=$val;
} elsif ($typ eq "_FGLINK") {
if ($val ne "") {
$fglink{$key}="href=\"$val\"";
}
} elsif ($typ eq "_STAT") {
$indstat{$key}=$val;
} elsif ($typ eq "CHAN") {
} elsif ($typ eq "FAMS") {
$numfams=$numfams+1;
$indfams{$key,$numfams}=$val;
} elsif ($typ eq "FAMC") {
$numfamc=$numfamc+1;
$indfamc{$key,$numfamc}=$val;
} elsif ($typ eq "_UID") {
$uid{key}=$val;
} elsif ($typ eq "NOTE") {
# level 1 NOTE processing, there is only one of these per lev 0
$lev1note{$key}=$val;
} elsif ($typ eq "AFN") {
Dprint("s","Ignoring in level 1: $lev0typ $typ\n");
} elsif ($typ eq "OBJE") {
Dprint("s","Ignoring in level 1: $lev0typ $typ\n");
} elsif ($typ eq "_TODO") {
Dprint("s","Ignoring in level 1: $lev0typ $typ\n");
} elsif ($typ eq "_STORY") {
Dprint("s","Ignoring in level 1: $lev0typ $typ\n");
} elsif ($typ eq "_HASHTAG") {
Dprint("s","Ignoring in level 1: $lev0typ $typ\n");
} else {
print "Unhandled level 1 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
if ($typ eq "EVEN") {
# level 1 EVEN processing
$numevents=$numevents+1;
$eventnum{$key}=$numevents;
$eventtype{$key,$numevents}=$lev1evtyp;
$eventdesc{$key,$numevents}=$val;
$eventdate{$key,$numevents}="";
$eventage{$key,$numevents}="";
$eventplace{$key,$numevents}="";
$eventnote{$key,$numevents}="";
$eventdescplacenote{$key,$numevents}="";
}
} elsif ($lev eq "2") {
# INDI Level 2 processing
$lev2typ=$typ;
Dprint(2,"Level 2: $typ $val\n");
if (($typ eq "CONC") || ($typ eq "CONT")) {
Dprint("c","Found in level 2: $lev0typ $lev1typ $typ\n");
} elsif ($typ eq "NOTE") {
Dprint("n","Found in level 2: $lev0typ $lev1typ $typ\n");
}
if ($typ eq "SOUR") {
Dprint("s","Found in level 2: $lev0typ $lev1typ $typ\n");
} elsif ($typ eq "_SHAR") {
Dprint("s","Ignoring in level 2: $lev0typ $lev1typ $typ\n");
} elsif (($lev1typ eq "OBJE") || ($lev2typ eq "OBJE")) {
Dprint("s","Ignoring in level 2: $lev0typ $lev1typ $typ\n");
} elsif ($lev1typ eq "_TODO") {
Dprint("s","Ignoring in level 2: $lev0typ $lev1typ $typ\n");
} elsif ($lev1typ eq "NAME") {
if ($typ eq "GIVN") {
$givenname{$key,$numnames}=$val;
} elsif ($typ eq "SURN") {
#
# Special delete for specific surname
#
if ($delname ne "") {
if (($val eq $delname) && ($numnames == 1)) {
$givenname{$key,$numnames}="";
$val="Deleted";
$ignore=1;
}
}
$surname{$key,$numnames}=$val;
} elsif ($typ eq "NPFX") {
$nameprefix{$key,$numnames}=$val;
} elsif ($typ eq "NSFX") {
$namesuffix{$key,$numnames}=$val;
}
} elsif ($lev1typ eq "BIRT") {
if ($typ eq "DATE") {
$birthdate{$key}=$val;
} elsif ($typ eq "PLAC") {
$birthplace{$key}=$val;
Doplac($key,"1BIRT",$val);
} elsif ($typ eq "ADDR") {
$birthaddr{$key}=$val;
} elsif ($typ eq "NOTE") {
$birthnote{$key}=$val;
}
} elsif ($lev1typ eq "CHR") {
if ($typ eq "DATE") {
$chrdate{$key}=$val;
} elsif ($typ eq "PLAC") {
$chrplace{$key}=$val;
Doplac($key,"2CHR",$val);
} elsif ($typ eq "ADDR") {
$chraddr{$key}=$val;
} elsif ($typ eq "NOTE") {
$chrnote{$key}=$val;
}
} elsif ($lev1typ eq "DEAT") {
if ($typ eq "DATE") {
$deathdate{$key}=$val;
} elsif ($typ eq "PLAC") {
$deathplace{$key}=$val;
Doplac($key,"6DEAT",$val);
} elsif ($typ eq "ADDR") {
$deathaddr{$key}=$val;
} elsif ($typ eq "NOTE") {
$deathnote{$key}=$val;
} elsif ($typ eq "CAUS") {
$deathcause{$key}=$val;
}
} elsif ($lev1typ eq "BURI") {
if ($typ eq "DATE") {
$burdate{$key}=$val;
$dead{$key}="y";
} elsif ($typ eq "PLAC") {
$burplace{$key}=$val;
Doplac($key,"7BURI",$val);
} elsif ($typ eq "ADDR") {
$buraddr{$key}=$val;
} elsif ($typ eq "NOTE") {
$burnote{$key}=$val;
} elsif ($typ eq "CREM") {
$burcrem{$key}="Cremated";
}
} elsif ($lev1typ eq "EVEN") {
if ($typ eq "TYPE") {
Dprint("e","Event type $val set for $key event number $numevents\n");
$eventtype{$key,$numevents}=$val;
} elsif ($typ eq "NOTE") {
$eventnote{$key,$numevents}=$val;
} elsif ($typ eq "ADDR") {
Dprint("e","Event addr $val ignored for $key event number $numevents\n");
} elsif ($typ eq "PLAC") {
$eventplace{$key,$numevents}=$val;
Doplac($key,"3EVEN",$val);
} elsif ($typ eq "DATE") {
$eventdate{$key,$numevents}=$val;
} else {
print "Unhandled level 2 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($lev1typ eq "CHAN") {
if ($typ eq "DATE") {
$chgdate{$key}=$val;
}
}
# INDI Level 3 processing
} elsif ($lev eq "3") {
$lev3typ=$typ;
Dprint(3,"Level 3: $typ $val\n");
if (($typ eq "CONC") || ($typ eq "CONT")) {
Dprint("c","Found in level 3: $lev0typ $lev1typ $lev2typ $typ\n");
} elsif ($typ eq "NOTE") {
Dprint("n","Found in level 3: $lev0typ $lev1typ $lev2typ $typ\n");
}
if ($lev2typ eq "SOUR") {
Dprint("s","Ignoring level 3 because level 2 type is SOUR\n");
} elsif ($lev1typ eq "_TODO") {
Dprint("s","Ignoring in level 3: $lev0typ $lev1typ $lev2typ $typ\n");
} elsif ($typ eq "ROLE") {
Dprint("s","Ignoring in level 3: $lev0typ $lev1typ $lev2typ $typ\n");
} elsif ($typ eq "CONC") {
# so far CONC and CONT in level 3 are all for event type notes
if ($lev1typ eq "EVEN") {
if ($lev2typ eq "NOTE") {
$eventnote{$key,$numevents}=$eventnote{$key,$numevents} . $val;
}
} elsif ($lev1typ eq "BIRT") {
$birthnote{$key}=$birthnote{$key} . $val;
} elsif ($lev1typ eq "CHR") {
$chrnote{$key}=$chrnote{$key} . $val;
} elsif ($lev1typ eq "DEAT") {
$deathnote{$key}=$deathnote{$key} . $val;
} elsif ($lev1typ eq "BURI") {
$burnote{$key}=$burnote{$key} . $val;
} else {
print "Unhandled level 3 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($typ eq "CONT") {
if ($lev1typ eq "EVEN") {
if ($lev2typ eq "NOTE") {
$eventnote{$key,$numevents}=$eventnote{$key,$numevents} . "\n" . $val;
}
} elsif ($lev1typ eq "BIRT") {
$birthnote{$key}=$birthnote{$key} . "\n" . $val;
} elsif ($lev1typ eq "CHR") {
$chrnote{$key}=$chrnote{$key} . "\n" . $val;
} elsif ($lev1typ eq "DEAT") {
$deathnote{$key}=$deathnote{$key} . "\n" . $val;
} elsif ($lev1typ eq "BURI") {
$burnote{$key}=$burnote{$key} . "\n" . $val;
} else {
print "Unhandled level 4 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($lev1typ eq "CHAN") {
if ($typ eq "TIME") {
$chgtime{$key}=$val;
}
} elsif ($lev1typ eq "BIRT") {
if ($lev2typ eq "ADDR") {
if ($typ eq "NOTE") {
$birthaddrnote{$key}=$val;
}
}
} elsif ($lev1typ eq "CHR") {
if ($lev2typ eq "ADDR") {
if ($typ eq "NOTE") {
$chraddrnote{$key}=$val;
}
}
} elsif ($lev1typ eq "DEAT") {
if ($lev2typ eq "ADDR") {
if ($typ eq "NOTE") {
$deathaddrnote{$key}=$val;
}
}
} elsif ($lev1typ eq "BURI") {
if ($lev2typ eq "ADDR") {
if ($typ eq "NOTE") {
$buraddrnote{$key}=$val;
}
}
}
# INDI Level 4 processing
} elsif ($lev eq "4") {
$lev4typ=$typ;
Dprint(4,"Level 4: $typ $val\n");
if (($typ eq "CONC") || ($typ eq "CONT")) {
Dprint("c","Found in level 4: $lev0typ $lev1typ $lev2typ $lev3typ $typ\n");
} elsif ($typ eq "NOTE") {
Dprint("n","Found in level 4: $lev0typ $lev1typ $lev2typ $lev3typ $typ\n");
}
if ($lev2typ eq "SOUR") {
Dprint("s","Ignoring level 4 because level 2 type is SOUR\n");
} elsif (($typ eq "CONC") && ($lev2typ eq "ADDR")) {
# currently handle CONC and CONT in level 4 only for addr notes
if ($lev1typ eq "BIRT") {
$birthaddrnote{$key}=$birthaddrnote{$key} . $val;
} elsif ($lev1typ eq "CHR") {
$chraddrnote{$key}=$chraddrnote{$key} . $val;
} elsif ($lev1typ eq "DEAT") {
$deathaddrnote{$key}=$deathaddrnote{$key} . $val;
} elsif ($lev1typ eq "BURI") {
$buraddrnote{$key}=$buraddrnote{$key} . $val;
} else {
print "Unhandled level 4 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif (($typ eq "CONT") && ($lev2typ eq "ADDR")) {
if ($lev1typ eq "BIRT") {
$birthaddrnote{$key}=$birthaddrnote{$key} . "\n" . $val;
} elsif ($lev1typ eq "CHR") {
$chraddrnote{$key}=$chraddrnote{$key} . "\n" . $val;
} elsif ($lev1typ eq "DEAT") {
$deathaddrnote{$key}=$deathaddrnote{$key} . "\n" . $val;
} elsif ($lev1typ eq "BURI") {
$buraddrnote{$key}=$buraddrnote{$key} . "\n" . $val;
} else {
print "Unhandled level 4 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif (($lev1typ eq "BURI") && ($lev2typ eq "ADDR")) {
if ($typ eq "LATI") {
$burlati{$key}=$val;
} elsif ($typ eq "LONG") {
$burlong{$key}=$val;
}
} else {
print "Unhandled level 4 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} else {
if ($lev2typ eq "SOUR") {
Dprint("s","Ignoring level $lev because level 2 type is SOUR\n");
} else {
print "Unhandled level $lev entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
}
} elsif ($lev0typ eq "FAM") {
# FAM Level 1 processing
if ($lev eq "1") {
$lev1typ=$typ;
Dprint(1,"Level 1: $typ $val\n");
if ($lev0notenum > 0) {
if ($typ eq "CONC") {
$lev0note{$key,$lev0notenum}=$lev0note{$key,$lev0notenum} . $val;
} elsif ($typ eq "CONT") {
$lev0note{$key,$lev0notenum}=$lev0note{$key,$lev0notenum} . "\n" . $val;
} else {
print "Unhandled level 1 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($typ eq "HUSB") {
$husbkey{$key}=$val;
} elsif ($typ eq "WIFE") {
$wifekey{$key}=$val;
} elsif ($typ eq "_STAT") {
$marstat{$key}=$val;
} elsif ($typ eq "MARR") {
} elsif ($typ eq "_MARRIED") {
} elsif ($typ eq "CHIL") {
$numchild=$numchild+1;
$childkey{$key,$numchild}=$val;
} elsif ($typ eq "_NONE") { # No children
if ($numchild > 0) {
print "Number of children for family $key is $numchild\n";
die "Invalid level 1 entry at line $cntr: $typ $val, aborting\n";
}
} elsif ($typ eq "MARL") { # Marriage License
$lev1evtyp="Marriage License";
$lev1typ="EVEN";
$typ="EVEN";
} elsif ($typ eq "EVEN") {
$lev1evtyp="Unknown";
} elsif ($typ eq "CHAN") {
} else {
print "Unhandled level 1 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandeled entry in $gedfile file\n"; }
}
if ($typ eq "EVEN") {
# level 1 EVEN processing
$numevents=$numevents+1;
$eventnum{$key}=$numevents;
$eventtype{$key,$numevents}=$lev1evtyp;
$eventdesc{$key,$numevents}=$val;
$eventdate{$key,$numevents}="";
$eventage{$key,$numevents}="";
$eventplace{$key,$numevents}="";
$eventnote{$key,$numevents}="";
$eventdescplacenote{$key,$numevents}="";
}
} elsif ($lev eq "2") {
# FAM Level 2 processing
$lev2typ=$typ;
Dprint(2,"Level 2: $typ $val\n");
if (($typ eq "CONC") || ($typ eq "CONT")) {
Dprint("c","Found in level 2: $lev0typ $lev1typ $typ\n");
} elsif ($typ eq "NOTE") {
Dprint("n","Found in level 2: $lev0typ $lev1typ $typ\n");
}
if ($typ eq "SOUR") {
Dprint("s","Found in level 2: $lev0typ $lev1typ $typ\n");
} elsif ($typ eq "CONC") {
if ($lev1typ eq "EVEN") {
if ($lev2typ eq "NOTE") {
$eventnote{$key,$numevents}=$eventnote{$key,$numevents} . $val;
}
} else {
print "Unhandled level 3 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($typ eq "CONT") {
if ($lev1typ eq "EVEN") {
if ($lev2typ eq "NOTE") {
$eventnote{$key,$numevents}=$eventnote{$key,$numevents} . "\n" . $val;
}
} else {
print "Unhandled level 2 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($lev1typ eq "HUSB") {
if ($typ eq "_PREF") {
$husbpref{$key}=$val;
}
} elsif ($lev1typ eq "WIFE") {
if ($typ eq "_PREF") {
$wifepref{$key}=$val;
}
} elsif ($lev1typ eq "CHIL") {
if ($typ eq "_PREF") {
# Assume only one child in a family is preferred
if ($childpref{$key} ne "") {
print "Family $key has preferred child $childpref{$key}\n";
print "Invalid level 2 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to invalid entry in $gedfile file\n"; }
} else {
$childpref{$key}=$childkey{$key,$numchild};
}
}
} elsif ($lev1typ eq "MARR") {
if ($typ eq "DATE") {
$mardate{$key}=$val;
} elsif ($typ eq "PLAC") {
$marplace{$key}=$val;
Doplac($husbkey{$key},"4MARR",$val);
Doplac($wifekey{$key},"4MARR",$val);
} elsif ($typ eq "ADDR") {
$buraddr{$key}=$val;
}
} elsif ($lev1typ eq "_STAT") {
if ($typ eq "DATE") {
$statdate{$key}=$val;
}
} elsif ($lev1typ eq "EVEN") {
if ($typ eq "TYPE") {
Dprint("e","Event type $val set for $key event number $numevents\n");
$eventtype{$key,$numevents}=$val;
} elsif ($typ eq "NOTE") {
$eventnote{$key,$numevents}=$val;
} elsif ($typ eq "PLAC") {
$eventplace{$key,$numevents}=$val;
Doplac($husbkey{$key},"5MAEV",$val);
Doplac($wifekey{$key},"5MAEV",$val);
} elsif ($typ eq "DATE") {
$eventdate{$key,$numevents}=$val;
} else {
print "Unhandled level 2 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandeled entry in $gedfile file\n"; }
}
} elsif ($lev1typ eq "CHAN") {
if ($typ eq "DATE") {
$chgdate{$key}=$val;
}
}
} elsif ($lev eq "3") {
# FAM Level 3 processing
$lev3typ=$typ;
Dprint(3,"Level 3: $typ $val\n");
if ($lev2typ eq "SOUR") {
Dprint("s","Ignoring level 3 because level 2 type is SOUR\n");
} elsif ($typ eq "SOUR") {
Dprint("s","Found in level 3: $lev0typ $lev1typ $lev2typ $typ\n");
} elsif ($typ eq "CONC") {
# so far CONC and CONT in level 3 are all for event type notes
if ($lev1typ eq "EVEN") {
if ($lev2typ eq "NOTE") {
$eventnote{$key,$numevents}=$eventnote{$key,$numevents} . $val;
}
} else {
print "Unhandled level 3 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($typ eq "CONT") {
if ($lev1typ eq "EVEN") {
if ($lev2typ eq "NOTE") {
$eventnote{$key,$numevents}=$eventnote{$key,$numevents} . "\n" . $val;
}
} else {
print "Unhandled level 4 entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
} elsif ($lev1typ eq "CHAN") {
if ($typ eq "TIME") {
$chgtime{$key}=$val;
}
} elsif ($lev1typ eq "MARR") {
if ($typ eq "_HTITL") {
$husbtitl{$key}=$val;
} elsif ($typ eq "_WTITL") {
$wifetitl{$key}=$val;
}
}
} else {
if (($lev2typ eq "SOUR") || ($lev3typ eq "SOUR")) {
Dprint("s","Ignoring level $lev because level 2 type is SOUR\n");
} else {
print "Unhandled level $lev entry at line $cntr: $typ $val\n";
if ($test == 0) { die "Aborting due to unhandled entry in $gedfile file\n"; }
}
}
}
}
close GED;
close PLAC;
Processlev0();
Checkinds();
Processfams();
Genhtmlfiles();
Genkeydatafiles();
print "Done\n";
if ($debug ne " ") {
close DOUT;
}
exit;
sub Doplac {
my $plackey=$_[0];
my $plactyp=$_[1];
my $placdata=$_[2];
my $placdate="";
my $placevtyp="";
if ($plactyp eq "1BIRT") {
if (exists $birthdate{$key}) {
$placdate=$birthdate{$key};
}
} elsif ($plactyp eq "2CHR") {
if (exists $chrdate{$key}) {
$placdate=$chrdate{$key};
}
} elsif ($plactyp eq "6DEAT") {
if (exists $deathdate{$key}) {
$placdate=$deathdate{$key};
}
} elsif ($plactyp eq "7BURI") {
if (exists $burdate{$key}) {
$placdate=$burdate{$key};
}
} elsif ($plactyp eq "3EVEN") {
if (exists $eventdate{$key,$numevents}) {
$placdate=$eventdate{$key,$numevents};
}
if (exists $eventtype{$key,$numevents}) {
$placevtyp=$eventtype{$key,$numevents};
}
} elsif ($plactyp eq "4MARR") {
if (exists $mardate{$key}) {
$placdate=$mardate{$key};
}
} elsif ($plactyp eq "5MAEV") {
if (exists $eventdate{$key,$numevents}) {
$placdate=$eventdate{$key,$numevents};
}
if (exists $eventtype{$key,$numevents}) {
$placevtyp=$eventtype{$key,$numevents};
}
}
$placevtyp=uc($placevtyp);
$placdata=~s/, /,/g; # remove space after commas
PrintPLAC("$plackey $plactyp $placevtyp $placdate :#$placdata\n");
}
sub PrintPLAC {
my $poutdata=$_[0];
print PLAC "$poutdata";
}
sub Initind {
$altcolor{$key}="blue";
$birthcolor{$key}="blue";
$chrcolor{$key}="blue";
$deathcolor{$key}="blue";
$burcolor{$key}="blue";
$notecolor{$key}="blue";
$sex{$key}="";
$sexcolor{$key}="";
$uid{$key}="";
$ixgiven{$key}="";
$ixsurname{$key}="";
$birthdate{$key}="";
$birthage{$key}="";
$birthplace{$key}="";
$birthaddr{$key}="";
$birthaddrnote{$key}="";
$birthnote{$key}="";
$chrdate{$key}="";
$chrage{$key}="";
$chrplace{$key}="";
$chraddr{$key}="";
$chraddrnote{$key}="";
$chrnote{$key}="";
$dead{$key}="";
$deathdate{$key}="";
$deathage{$key}="";
$deathplace{$key}="";
$deathaddr{$key}="";
$deathaddrnote{$key}="";
$deathnote{$key}="";
$deathcause{$key}="";
$burdate{$key}="";
$burplace{$key}="";
$buraddr{$key}="";
$buraddrnote{$key}="";
$burnote{$key}="";
$burcrem{$key}="";
$burlati{$key}="";
$burlong{$key}="";
$cemeteryname{$key}="";
$cemeterynote{$key}="";
$lev1note{$key}="";
$indstat{$key}="";
$indfamc{$key,1}="";
$preffamkey{$key}="";
$famlink{$key}="";
$fsftid{$key}="";
$fslink{$key}="";
$fgrave{$key}="";
$fglink{$key}="";
$chgdate{$key}="";
$chgtime{$key}="";
$rinorder{$key}=0;
$surnameorder{$key}=0;
$givenorder{$key}=0;
}
sub Initfam {
$chgdate{$key}="";
$chgtime{$key}="";
$husbkey{$key}="";
$wifekey{$key}="";
$husbpref{$key}="";
$wifepref{$key}="";
$husbtitl{$key}="Husband";
$wifetitl{$key}="Wife";
$mardate{$key}="";
$marplace{$key}="";
$marstat{$key}="";
$statdate{$key}="";
$childpref{$key}="";
$husbfathhref{$key}="";
$husbfather{$key}=" ";
$husbmothhref{$key}="";
$husbmother{$key}=" ";
$wifefathhref{$key}="";
$wifefather{$key}=" ";
$wifemothhref{$key}="";
$wifemother{$key}=" ";
$husbhref{$key}="";
$husbfullname{$key}=" ";
$husbbirthdateplace{$key}="";
$husbchrdateplace{$key}="";
$husbdeathdateplace{$key}="";
$husbburdateplace{$key}="";
$husbdeathcause{$key}="";
$husbnumspouses{$key}="";
$husbspouselink{$key}="";
$husbspousename{$key}="";
$husbfglink{$key}="";
$husbfgid{$key}="";
$wifehref{$key}="";
$wifefullname{$key}=" ";
$wifebirthdateplace{$key}="";
$wifechrdateplace{$key}="";
$wifedeathdateplace{$key}="";
$wifeburdateplace{$key}="";
$wifedeathcause{$key}="";
$wifenumspouses{$key}="";
$wifespouselink{$key}="";
$wifespousename{$key}="";
$wifefglink{$key}="";
$wifefgid{$key}="";
$mardateinplace{$key}="";
$marwin{$key}="";
$mardateplace{$key}="";
}
sub Processlev0 {
if ($lev0typ eq "INDI") {
Dprint("i","\nProcessing INDI\n");
Dprint("i","For RIN: $rin{$key}\n");
Dprint("i","Sex: $sex{$key}\n");
Dprint("i","Sex color: $sexcolor{$key}\n");
Dprint("i","Number of names: $numnames\n");
$altnum{$key}=$numnames;
$altnames{$key}="";
$i=1;
while ($i <= $numnames) {
Dprint("i","Name prefix: $nameprefix{$key,$i}\n");
Dprint("i","Given name: $givenname{$key,$i}\n");
Dprint("i","Surname: $surname{$key,$i}\n");
Dprint("i","Name suffix: $namesuffix{$key,$i}\n");
# Compose fullname
if (($surname{$key,$i} eq "") && ($givenname{$key,$i} eq "")) {
$fullname{$key,$i}="Unknown";
} elsif ($surname{$key,$i} eq "") {
$fullname{$key,$i}=$givenname{$key,$i};
} elsif ($givenname{$key,$i} eq "") {
$fullname{$key,$i}=$surname{$key,$i};
} else {
$fullname{$key,$i}=$givenname{$key,$i} . " " . $surname{$key,$i};
}
if ($nameprefix{$key,$i} ne "") {
$fullname{$key,$i}=$nameprefix{$key,$i} . " " . $fullname{$key,$i};
}
if ($namesuffix{$key,$i} ne "") {
$fullname{$key,$i}=$fullname{$key,$i} . " " . $namesuffix{$key,$i};
}
if ($i == 2) {
$altnames{$key}=$fullname{$key,$i};
} elsif ($i > 2) {
$altnames{$key}=$altnames{$key} . "\n" . $fullname{$key,$i};
}
$i=$i+1;
}
# Compose index given name
if (($surname{$key,1} eq "") && ($givenname{$key,1} eq "")) {
$ixgiven{$key}="UNKNOWN";
} elsif ($surname{$key,1} eq "") {
$ixgiven{$key}=$givenname{$key,1};
} elsif ($givenname{$key,1} eq "") {
$ixgiven{$key}=$surname{$key,1};
} else {
$ixgiven{$key}=$givenname{$key,1} . ", " . $surname{$key,1};
}
if ($nameprefix{$key,1} ne "") {
$ixgiven{$key}=$ixgiven{$key} . " " . $nameprefix{$key,1};
}
if ($namesuffix{$key,1} ne "") {
$ixgiven{$key}=$ixgiven{$key} . " " . $namesuffix{$key,1};
}
# Compose index surname
if (($surname{$key,1} eq "") && ($givenname{$key,1} eq "")) {
$ixsurname{$key}="UNKNOWN";
} elsif ($surname{$key,1} eq "") {
$ixsurname{$key}=$givenname{$key,1};
} elsif ($givenname{$key,1} eq "") {
$ixsurname{$key}=$surname{$key,1};
} else {
$ixsurname{$key}=$surname{$key,1} . ", " . $givenname{$key,1};
}
if ($nameprefix{$key,1} ne "") {
$ixsurname{$key}=$ixsurname{$key} . " " . $nameprefix{$key,1};
}
if ($namesuffix{$key,1} ne "") {
$ixsurname{$key}=$ixsurname{$key} . " " . $namesuffix{$key,1};
}
# Calculate year date range to add to fullname
$i=Calcyear($birthdate{$key});
$j=Calcyear($deathdate{$key});
if (($i eq "") && ($j eq "")) {
$work="";
} else {
$work=" ($i-$j)";
}
$fullnameplus{$key}=$fullname{$key,1} . $work;
if ($deathcause{$key} ne "") { Dprint(9,"Death cause: $deathcause{$key}\n"); }
# Resolve any notes that are keys
if ($birthnote{$key} =~ /^@\w@$/) {
$birthnote{$key}=Fixnote("birthnote",$birthnote{$key});
}
if ($chrnote{$key} =~ /^@\w@$/) {
$chrnote{$key}=Fixnote("chrnote",$chrnote{$key});
}
if ($deathnote{$key} =~ /^@\w@$/) {
$deathnote{$key}=Fixnote("deathnote",$deathnote{$key});
}
if ($burnote{$key} =~ /^@\w@$/) {
$burnote{$key}=Fixnote("burnote",$burnote{$key});
}
if ($lev1note{$key} =~ /^@\w@$/) {
$lev1note{$key}=Fixnote("lev1note",$lev1note{$key});
}
if ($birthaddrnote{$key} =~ /^@\w@$/) {
$birthaddrnote{$key}=Fixnote("birthaddrnote",$birthaddrnote{$key});
}
if ($chraddrnote{$key} =~ /^@\w@$/) {
$chraddrnote{$key}=Fixnote("chraddrnote",$chraddrnote{$key});
}
if ($deathaddrnote{$key} =~ /^@\w@$/) {
$deathaddrnote{$key}=Fixnote("deathaddrnote",$deathaddrnote{$key});
}
if ($buraddrnote{$key} =~ /^@\w@$/) {
$buraddrnote{$key}=Fixnote("buraddrnote",$buraddrnote{$key});
}
# Fix up burial notes to include cremated, longitude and latitude
if ($burcrem{$key} ne "") {
$burnote{$key}=$burnote{$key} . "\n" . $burcrem{$key};
}
if ($burlati{$key} ne "") {
$buraddrnote{$key}=$buraddrnote{$key} . "\nLatitude: " . $burlati{$key};
}
if ($burlong{$key} ne "") {
$buraddrnote{$key}=$buraddrnote{$key} . "\nLongitude: " . $burlong{$key};
}
if ($altnames{$key} eq "") {
$work="(none)";
} else {
$work=$altnames{$key};
$altcolor{$key}="red";
}
$altdata{$key}=Genalert("Alternate Names",$work);
if (($birthaddr{$key} eq "") && ($birthaddrnote{$key} eq "") && ($birthnote{$key} eq "")) {
$work="(none)";
} else {
$work="";
$birthcolor{$key}="red";
}
if ($birthaddr{$key} ne "") {
$work="Address:\n$birthaddr{$key}\n\n";
}
if ($birthaddrnote{$key} ne "") {
$work=$work . "$birthaddrnote{$key}\n\n";
}
if ($birthnote{$key} ne "") {
$work=$work . "Note:\n$birthnote{$key}\n\n";
}
$birthdata{$key}=Genalert("Birth Data",$work);
if (($chraddr{$key} eq "") && ($chraddrnote{$key} eq "") && ($chrnote{$key} eq "")) {
$work="(none)";
} else {
$work="";
$chrcolor{$key}="red";
}
if ($chraddr{$key} ne "") {
$work="Address:\n$chraddr{$key}\n\n";
}
if ($chraddrnote{$key} ne "") {
$work=$work . "$chraddrnote{$key}\n\n";
}
if ($chrnote{$key} ne "") {
$work=$work . "Note:\n$chrnote{$key}\n\n";
}
$chrdata{$key}=Genalert("Christening Data",$work);
if (($deathaddr{$key} eq "") && ($deathaddrnote{$key} eq "") && ($deathnote{$key} eq "")) {
$work="(none)";
} else {
$work="";
$deathcolor{$key}="red";
}
if ($deathaddr{$key} ne "") {
$work="Address:\n$deathaddr{$key}\n\n";
}
if ($deathaddrnote{$key} ne "") {
$work=$work . "$deathaddrnote{$key}\n\n";
}
if ($deathnote{$key} ne "") {
$work=$work . "Note:\n$deathnote{$key}\n\n";
}
$deathdata{$key}=Genalert("Death Data",$work);
if (($buraddr{$key} eq "") && ($buraddrnote{$key} eq "") && ($burnote{$key} eq "")) {
$work="(none)";
} else {
$work="";
$burcolor{$key}="red";
}
if ($buraddr{$key} ne "") {
$work="Address:\n$buraddr{$key}\n\n";
}
if ($buraddrnote{$key} ne "") {
$work=$work . "$buraddrnote{$key}\n\n";
}
if ($burnote{$key} ne "") {
$work=$work . "Note:\n$burnote{$key}\n\n";
}
$burdata{$key}=Genalert("Burial Data",$work);
if ($lev1note{$key} eq "") {
$work="(none)";
} else {
$work=$lev1note{$key};
$notecolor{$key}="red";
}
$notedata{$key}=Genalert("Notes",$work);
$birthage{$key}=Calcage($birthdate{$key});
$chrage{$key}=Calcage($chrdate{$key});
$deathage{$key}=Calcage($deathdate{$key});
Dprint("i","Number of events: $numevents\n");
if ($numevents > 0) {
$i=1;
while ($i <= $numevents) {
$eventage{$key,$i}=Calcage($eventdate{$key,$i});
if ($eventnote{$key,$i} =~ /^@\w@$/) {
$eventnote{$key,$i}=Fixnote("eventnote",$eventnote{$key,$i});
}
if (($eventplace{$key,$i} ne "") && ($eventnote{$key,$i} ne "")) {
$eventdescplacenote{$key,$i}=$eventplace{$key,$i} . "/" . $eventnote{$key,$i};
} else {
$eventdescplacenote{$key,$i}=$eventplace{$key,$i} . $eventnote{$key,$i};
}
if (($eventdesc{$key,$i} ne "") && ($eventdescplacenote{$key,$i} ne "")) {
$eventdescplacenote{$key,$i}=$eventdesc{$key,$i} . "/" . $eventdescplacenote{$key,$i};
} else {
$eventdescplacenote{$key,$i}=$eventdesc{$key,$i} . $eventdescplacenote{$key,$i};
}
Dprint("9","eventdescplacenote{$key,$i}=$eventdescplacenote{$key,$i}\n");
$i=$i+1;
}
}
$indfamcnum{$key}=$numfamc;
Dprint("i","Number of child families for individual $key is $numfamc\n");
if ($numfamc > 0) {
$i=0;
while ($i < $numfamc) {
$i=$i+1;
Dprint("i","Child family: $indfamc{$key,$i}\n");
}
} else {
Dprint("i","No Child family for individual $key\n");
}
$indfamsnum{$key}=$numfams;
Dprint("i","Number of families: $numfams\n");
if ($numfams > 0) {
$i=0;
while ($i < $numfams) {
$i=$i+1;
Dprint("i","Family: $indfams{$key,$i}\n");
}
}
if ($chgdate{$key} ne "") { Dprint(9,"Change date: $chgdate{$key}\n"); }
if ($chgtime{$key} ne "") { Dprint(9,"Change time: $chgtime{$key}\n"); }
} elsif ($lev0typ eq "FAM") {
Dprint("f","\nProcessing FAM\n");
Dprint("f","For family RIN: $famrin{$key}\n");
Dprint("f","Husband RIN: $husbkey{$key}\n");
Dprint("f","Wife: RIN: $wifekey{$key}\n");
if ($numevents > 0) {
$i=0;
while ($i < $numevents) {
$i=$i+1;
if ($eventnote{$key,$i} =~ /^@\w@$/) {
$eventnote{$key,$i}=Fixnote("eventnote",$eventnote{$key,$i});
}
if (($eventplace{$key,$i} ne "") && ($eventnote{$key,$i} ne "")) {
$eventdescplacenote{$key,$i}=$eventplace{$key,$i} . "/" . $eventnote{$key,$i};
} else {
$eventdescplacenote{$key,$i}=$eventplace{$key,$i} . $eventnote{$key,$i};
}
if (($eventdesc{$key,$i} ne "") && ($eventdescplacenote{$key,$i} ne "")) {
$eventdescplacenote{$key,$i}=$eventdesc{$key,$i} . "/" . $eventdescplacenote{$key,$i};
} else {
$eventdescplacenote{$key,$i}=$eventdesc{$key,$i} . $eventdescplacenote{$key,$i};
}
Dprint("f","eventdescplacenote{$key,$i}=$eventdescplacenote{$key,$i}\n");
}
}
# Process children in the current family now
$childkeynum{$key}=$numchild;
Dprint("f","Number of children: $numchild\n");
if ($numchild > 0) {
$i=0;
while ($i < $numchild) {
$i=$i+1;
Dprint("f","Child RIN: $childkey{$key,$i}\n");
$j=$childkey{$key,$i};
if (exists($rin{$j})) {
$childfullname{$key,$i}=$fullnameplus{$j};
$childsexcolor{$key,$i}=$sexcolor{$j};
if ($indfamsnum{$j} == 0) {
$indfams{$j,1}=Genfam($j);
# Since this is the only family for this individual it is preferred
$preffamkey{$j}=$indfams{$j,1};
$indfamsnum{$j}=1;
}
# Cannot use preferred family for this person because it is not found yet
$childfamkey{$key,$i}=$indfams{$j,1};
} else {
print "Unable to access Individual child record: $j\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
$childsexcolor{$key,$i}="";
$childfamkey{$key,$i}="";
$childfullname{$key,$i}="";
}
$childdata{$key,$i}=$childfullname{$key,$i};
}
}
$allchildkeynum{$key}=$numchild; # temporarary does not include half-siblings
if ($chgdate{$key} ne "") { Dprint("f","Change date: $chgdate{$key}\n"); }
if ($chgtime{$key} ne "") { Dprint("f","Change time: $chgtime{$key}\n"); }
}
}
sub Genfam {
my $gindkey=$_[0];
Dprint("G","Generating family record for $gindkey $fullname{$gindkey,1}\n");
$gseqno=$gindkey;
$gseqno=~s/[^\d.]//g; # digits only
my $newkey="\@G" . $gseqno . "\@";
if (exists($famrin{$newkey})) {
print "Unable to generate family record $newkey because it already exists\n";
die "Aborting due to inconsistent $gedfile file\n";
}
$savekey=$key;
$key=$newkey;
Initfam();
$famrin{$key}=$key;
$numerickey=$key;
$numerickey=~s/[^[A-Z,0-9]//g;
$numericrin{$key}=$numerickey;
$eventnum{$key}=0;
$childkeynum{$key}=0;
$allchildkeynum{$key}=0;
if ($sex{$gindkey} eq "Female") {
# put on right/wifes side
$wifekey{$key}=$gindkey;
} else {
# put on left/husbands side
$husbkey{$key}=$gindkey;
}
$key=$savekey;
return $newkey;
}
sub Checkinds {
Dprint("C","\nChecking INDIs FAMs\n");
foreach $key (keys %rin) {
if ($altnum{$key} == 0) {
print "Individual $key has no NAME record\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
if ($indfamc{$key,1} eq "") {
Dprint("C","Individual $key has no FAMC record\n");
}
if ($indfamsnum{$key} == 0) {
Dprint("C","Individual $key has no FAMS record\n");
} else {
# Find preferred family for this individual
if ($indfamsnum{$key} > 0) {
$i=0;
while ($i < $indfamsnum{$key}) {
$i=$i+1;
$work=$indfams{$key,$i}; # Key of a individuals family file
if (exists($famrin{$work})) {
if ($sex{$key} eq "Male") {
if ($wifepref{$work} eq "Y") {
Dprint("C","Setting preferred family to $work for husband $key\n");
$preffamkey{$key}=$work;
}
} elsif ($sex{$key} eq "Female") {
if ($husbpref{$work} eq "Y") {
Dprint("C","Setting preferred family to $work for wife $key\n");
$preffamkey{$key}=$work;
}
}
} else {
print "In individual $key, unable to access Family record: $work\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
if ($preffamkey{$key} eq "") {
Dprint("C","Did not find preferred family for individual $key\n");
$preffamkey{$key}=$indfams{$key,1};
}
$famlink{$key}="href=\"FAM$preffamkey{$key}.html\"";
} else {
# If no families for individual just leave preffamkey and famlink empty
}
}
}
}
sub Processfams {
Dprint("f","\nProcessing FAMs\n");
# Need to fill in fullnames for husband and wife first
foreach $key (keys %famrin) {
Dprint("f","For family RIN: $famrin{$key}\n");
Dprint("f","Husband RIN: $husbkey{$key}\n");
$hkey=$husbkey{$key};
if ($hkey ne "") {
if (exists($rin{$hkey})) {
$husbfullname{$key}=$fullname{$hkey,1};
} else {
print "In family $key, unable to access Individual record for husband: $hkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
Dprint("f","Wife: RIN: $wifekey{$key}\n");
$wkey=$wifekey{$key};
if ($wkey ne "") {
if (exists($rin{$wkey})) {
$wifefullname{$key}=$fullname{$wkey,1};
} else {
print "In family $key, unable to access Individual record for wife: $wkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
}
# Now work on the rest of the family data
foreach $key (keys %famrin) {
Dprint("f","For family RIN: $famrin{$key}\n");
Dprint("f","Husband RIN: $husbkey{$key}\n");
$hkey=$husbkey{$key};
if ($hkey ne "") {
if (exists($rin{$hkey})) {
$husbhref{$key}="href=\"IND$hkey.html\"";
$husbfgid{$key}=$fgrave{$hkey};
$husbfglink{$key}=$fglink{$hkey};
$husbbirthdateplace{$key}=Getdateplace($birthdate{$hkey},$birthplace{$hkey},", ");
$husbchrdateplace{$key}=Getdateplace($chrdate{$hkey},$chrplace{$hkey},", ");
$husbdeathdateplace{$key}=Getdateplace($deathdate{$hkey},$deathplace{$hkey},", ");
$husbburdateplace{$key}=Getdateplace($burdate{$hkey},$burplace{$hkey},", ");
$husbdeathcause{$key}=$deathcause{$hkey};
# Build table for spouse dropdown menu
if ($indfamsnum{$hkey} > 0) {
$husbnumspouses{$key}=$indfamsnum{$hkey};
$i=0;
while ($i < $husbnumspouses{$key}) {
$i=$i+1;
$work=$indfams{$hkey,$i}; # Key of a husbands family file
if (exists($famrin{$work})) {
$husbspouselink{$key,$i}="href=\"FAM$work.html\"";
$husbspousename{$key,$i}=$wifefullname{$work};
if ($wifepref{$work} eq "Y") {
$preffamkey{$hkey}=$work;
}
Addstepchildren($key,$work,$wifekey{$work});
} else {
print "In family $key, unable to access husbands Family record: $work\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
$husbspouselink{$key,$i}="";
$husbspousename{$key,$i}="NOT FOUND";
}
}
}
$hpkey=$indfamc{$hkey,1};
if ($hpkey ne "") {
if (exists($famrin{$hpkey})) {
$hfkey=$husbkey{$hpkey};
if ($hfkey ne "") {
if (exists($rin{$hfkey})) {
$husbfathhref{$key}="href=\"FAM$hpkey.html\"";
$husbfather{$key}=$fullnameplus{$hfkey};
} else {
print "In family $key, unable to access Individual record for husbands father: $hfkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
$hmkey=$wifekey{$hpkey};
if ($hmkey ne "") {
if (exists($rin{$hmkey})) {
$husbmothhref{$key}="href=\"FAM$hpkey.html\"";
$husbmother{$key}=$fullnameplus{$hmkey};
} else {
print "In family $key, unable to access Individual record for husbands mother: $hmkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
} else {
print "In family $key, unable to access Family record for husbands parents: $hpkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
} else {
print "In family $key, unable to access Individual record for husband: $hkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
Dprint("f","Wife: RIN: $wifekey{$key}\n");
$wkey=$wifekey{$key};
if ($wkey ne "") {
if (exists($rin{$wkey})) {
$wifehref{$key}="href=\"IND$wkey.html\"";
$wifefgid{$key}=$fgrave{$wkey};
$wifefglink{$key}=$fglink{$wkey};
$wifebirthdateplace{$key}=Getdateplace($birthdate{$wkey},$birthplace{$wkey},", ");
$wifechrdateplace{$key}=Getdateplace($chrdate{$wkey},$chrplace{$wkey},", ");
$wifedeathdateplace{$key}=Getdateplace($deathdate{$wkey},$deathplace{$wkey},", ");
$wifeburdateplace{$key}=Getdateplace($burdate{$wkey},$burplace{$wkey},", ");
$wifedeathcause{$key}=$deathcause{$wkey};
# Build table for spouse dropdown menu
if ($indfamsnum{$wkey} > 0) {
$wifenumspouses{$key}=$indfamsnum{$wkey};
$i=0;
while ($i < $wifenumspouses{$key}) {
$i=$i+1;
$work=$indfams{$wkey,$i}; # Key of a wifes family file
if (exists($famrin{$work})) {
$wifespouselink{$key,$i}="href=\"FAM$work.html\"";
$wifespousename{$key,$i}=$husbfullname{$work};
if ($husbpref{$work} eq "Y") {
$preffamkey{$wkey}=$work;
}
Addstepchildren($key,$work,$husbkey{$work});
} else {
print "In family $key, unable to access wifes Family record: $work\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
$wifespouselink{$key,$i}="";
$wifespousename{$key,$i}="NOT FOUND";
}
}
}
$wpkey=$indfamc{$wkey,1};
if ($wpkey ne "") {
if (exists($famrin{$wpkey})) {
$wfkey=$husbkey{$wpkey};
if ($wfkey ne "") {
if (exists($rin{$wfkey})) {
$wifefathhref{$key}="href=\"FAM$wpkey.html\"";
$wifefather{$key}=$fullnameplus{$wfkey};
} else {
print "In family $key, unable to access Individual record for wifes father: $wfkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
$wmkey=$wifekey{$wpkey};
if ($wmkey ne "") {
if (exists($rin{$wmkey})) {
$wifemothhref{$key}="href=\"FAM$wpkey.html\"";
$wifemother{$key}=$fullnameplus{$wmkey};
} else {
print "In family $key, unable to access Individual record for wifes mother: $wmkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
} else {
print "In family $key, unable to access Family record for wifes parents: $wpkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
} else {
print "In family $key, unable to access Individual record for wife: $wkey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
# Process marriage info
$mardateplace{$key}=Getdateplace($mardate{$key},$marplace{$key}," - ");
$mardateinplace{$key}=Getdateplace($mardate{$key},$marplace{$key}," in ");
# Update the family for the children with the preferred family
$numchild=$childkeynum{$key};
Dprint("P","Number of children: $numchild\n");
if ($numchild > 0) {
$i=0;
while ($i < $numchild) {
$i=$i+1;
Dprint("P","Child RIN: $childkey{$key,$i}\n");
$j=$childkey{$key,$i};
if (exists($rin{$j})) {
Dprint("P","Preferred family for individual $j is $preffamkey{$j}\n");
Dprint("P","First family for individual $j is $indfams{$j,1}\n");
$childfamkey{$key,$i}=$preffamkey{$j};
# $childfamkey{$key,$i}=$indfams{$j,1};
} else {
print "Unable to access Individual child record: $j\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
}
}
}
sub Addstepchildren() {
my $scfam1=$_[0];
my $scfam2=$_[1];
my $scind2=$_[2];
my $scspouse;
# Add the step-children to this family
Dprint("k","Add step children from individual $scind2 in family $scfam2 to family $scfam1\n");
my $scnum1=$childkeynum{$scfam1};
my $scnum2=$childkeynum{$scfam2};
# Get the given name of the spouse
if (exists($rin{$scind2})) {
$scspouse=" (" . $givenname{$scind2,1} . ")";
} else {
Dprint("k","Unable to access Individual spouse record $scind2 for family $scfam2\n");
# if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
$scspouse="";
}
if ($scfam1 ne $scfam2) {
# Add the step children from this family
if ($scnum2 > 0) {
my $sckey;
my $sci=0;
my $scj=$allchildkeynum{$scfam1};
while ($sci < $scnum2) {
$sci=$sci+1;
$sckey=$childkey{$scfam2,$sci};
if (exists($rin{$sckey})) {
Dprint("k","Adding step-child $sckey from family $scfam2 to family $scfam1\n");
$scj=$scj+1;
$childdata{$scfam1,$scj}="½" . $fullnameplus{$sckey} . $scspouse;
# character code for 1/2 is ½
$childsexcolor{$scfam1,$scj}=$sexcolor{$sckey};
# Use preferred family for this person
$childfamkey{$scfam1,$scj}=$preffamkey{$sckey};
} else {
print "Unable to access Individual child record: $sckey\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
}
$allchildkeynum{$scfam1}=$scj; # Now includes the children and step-children
Dprint("k","Now there are $scj children in family $scfam1\n");
} else {
Dprint("k","No children in family $scfam2\n");
}
}
}
sub Genhtmlfiles {
if ($nogen == 0) {
print "Generating IND HTML files ...\n";
} else {
print "Working on IND HTML files ...\n";
}
foreach $key (keys %rin) {
$htmlfile="$htmldir/IND$key\.html";
if ($nogen == 0) {
open (HTML,">$htmlfile") or die "Can't open $htmlfile: $!";
Dprint("I","Generating $htmlfile ...\n");
} else {
Dprint("I","Working on $htmlfile data ...\n");
}
$modfile="$modeldir/indmodel.html";
open(MOD,"<$modfile") or die "Can't open $modfile: $!";
Dprint("I","Reading $./modfile ...\n");
$cntr=0;
$eventstat=0;
$eventlcnt=0;
while (<MOD>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("i","$cntr: $line\n");
if (($line =~ /^.+xXx/) || ($eventstat == 1)) {
Dprint("I","Got xXx at line $cntr: $line\n");
if ($line =~ /^.+xBEGINEVENTx/) {
$eventstat=1;
} elsif ($line =~ /^.+xENDEVENTx/) {
$eventstat=2;
Dprint("I","Event table has $eventlcnt lines\n");
Dprint("I","Individual $key has $eventnum{$key} events\n");
if ($eventnum{$key} > 0) {
$i=0;
while ($i < $eventnum{$key}) {
$i=$i+1;
$j=0;
while ($j < $eventlcnt) {
$j=$j+1;
$line=$eventltab[$j];
Dprint("I","Event model line: $line\n");
$line =~ s/xXxEVENTAGEx/$eventage{$key,$i}/;
$line =~ s/xXxEVENTTYPEx/$eventtype{$key,$i}/;
$line =~ s/xXxEVENTDATEx/$eventdate{$key,$i}/;
$line =~ s/xXxEVENTDESCPLACENOTEx/$eventdescplacenote{$key,$i}/;
PrintHTML("$line\n");
Dprint("I","Modified event table line: $line\n");
}
}
}
} elsif ($eventstat == 1) {
# If in middle of event table create event table array
$eventlcnt=$eventlcnt+1;
$eventltab[$eventlcnt]=$line;
} else {
# Modify line and then write it
$line =~ s/xXxRINx/$rin{$key}/;
$line =~ s/xXxFAMLINKx/$famlink{$key}/;
$line =~ s/xXxINDEXLINKx/href=\"IDXSurname.html\"/;
$line =~ s/xXxIDESCLINKx/href=\"cgi-bin\/gendesc.cgi?ind=$key\"/;
$line =~ s/xXxIANCLINKx/href=\"cgi-bin\/genanc.cgi?ind=$key\"/;
$line =~ s/xXxIRELLINKx/href=\"cgi-bin\/genrel.cgi?ind=$key&sby=r\"/;
$line =~ s/xXxFULLNAMEx/$fullname{$key,1}/;
$line =~ s/xXxNUMERICRINx/$numericrin{$key}/;
$line =~ s/xXxSURNAMEx/$surname{$key,1}/;
$line =~ s/xXxGIVENNAMEx/$givenname{$key,1}/;
$line =~ s/xXxNAMEPREFIXx/$nameprefix{$key,1}/;
$line =~ s/xXxNAMESUFFIXx/$namesuffix{$key,1}/;
$line =~ s/xXxALTCOLORx/$altcolor{$key}/;
$line =~ s/xXxALTDATAx/$altdata{$key}/;
$line =~ s/xXxSEXCOLORx/$sexcolor{$key}/;
$line =~ s/xXxSEXx/$sex{$key}/;
$line =~ s/xXxBIRTHDATEx/$birthdate{$key}/;
$line =~ s/xXxBIRTHPLACEx/$birthplace{$key}/;
$line =~ s/xXxBIRTHCOLORx/$birthcolor{$key}/;
$line =~ s/xXxBIRTHDATAx/$birthdata{$key}/;
$line =~ s/xXxBIRTHAGEx/$birthage{$key}/;
$line =~ s/xXxCHRDATEx/$chrdate{$key}/;
$line =~ s/xXxCHRPLACEx/$chrplace{$key}/;
$line =~ s/xXxCHRCOLORx/$chrcolor{$key}/;
$line =~ s/xXxCHRDATAx/$chrdata{$key}/;
$line =~ s/xXxCHRAGEx/$chrage{$key}/;
$line =~ s/xXxDEATHDATEx/$deathdate{$key}/;
$line =~ s/xXxDEATHPLACEx/$deathplace{$key}/;
$line =~ s/xXxDEATHCOLORx/$deathcolor{$key}/;
$line =~ s/xXxDEATHDATAx/$deathdata{$key}/;
$line =~ s/xXxDEATHAGEx/$deathage{$key}/;
$line =~ s/xXxBURDATEx/$burdate{$key}/;
$line =~ s/xXxBURPLACEx/$burplace{$key}/;
$line =~ s/xXxBURCOLORx/$burcolor{$key}/;
$line =~ s/xXxBURDATAx/$burdata{$key}/;
$line =~ s/xXxDEATHCAUSEx/$deathcause{$key}/;
$line =~ s/xXxNOTECOLORx/$notecolor{$key}/;
$line =~ s/xXxNOTEDATAx/$notedata{$key}/;
$line =~ s/xXxFSLINKx/$fslink{$key}/;
$line =~ s/xXxFSFTIDx/$fsftid{$key}/;
$line =~ s/xXxFGLINKx/$fglink{$key}/;
$line =~ s/xXxFGRAVEx/$fgrave{$key}/;
PrintHTML("$line\n");
Dprint("I","Modified model line: $line\n");
}
} else {
if (($eventstat == 0) || ($eventstat == 2)) {
# If not inside event table just write line
PrintHTML("$line\n");
Dprint("I","Copy model line: $line\n");
} else {
# If in middle of event table create event table array
$eventlcnt=$eventlcnt+1;
$eventltab[$eventlcnt]=$line;
}
}
}
close MOD;
if ($nogen == 0) {
close HTML;
}
}
if ($nogen == 0) {
print "Generating FAM HTML files ...\n";
} else {
print "Working on FAM HTML files ...\n";
}
foreach $key (keys %famrin) {
$htmlfile="$htmldir/FAM$key\.html";
if ($nogen == 0) {
open (HTML,">$htmlfile") or die "Can't open $htmlfile: $!";
}
Dprint("F","######################################################## $key\n");
if ($nogen == 0) {
Dprint("F","Generating $htmlfile ...\n");
} else {
Dprint("F","Working on $htmlfile ...\n");
}
$modfile="$modeldir/fammodel.html";
open(MOD,"<$modfile") or die "Can't open $modfile: $!";
Dprint("F","Reading $modfile ...\n");
$cntr=0;
$eventstat=0;
$eventlcnt=0;
$childstat=0;
$childlcnt=0;
while (<MOD>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("F","$cntr: $line\n");
if (($line =~ /^.+xXx/) || ($eventstat == 1) || ($childstat == 1)) {
Dprint("F","Got xXx at line $cntr: $line\n");
if ($line =~ /^.+xBEGINMARWINx/) {
$eventstat=1;
} elsif ($line =~ /^.+xENDMARWINx/) {
$eventstat=2;
Dprint("F","Marriage window table has $eventlcnt lines\n");
Dprint("F","Family $key has $eventnum{$key} events\n");
$work="";
$j=0;
while ($j < $eventlcnt) {
$j=$j+1;
$eline=$eventltab[$j];
Dprint("F","Looking at marriage table line $j: $eline\n");
if ($eline =~ /^.+xEVENTTABx/) {
$eline =~ s/<!--xXxEVENTLINEx-->//;
if ($eventnum{$key} > 0) {
Dprint("F","Modified marriage event table: $eline\n");
$eline =~ s/\n//g; # Dont want any newlines
$work=$work . $eline;
}
} elsif ($eline =~ /^.+xEVENTLINEx/) {
if ($eventnum{$key} > 0) {
$i=0;
while ($i < $eventnum{$key}) {
$i=$i+1;
Dprint("F","eventdescplacenote{$key,$i}=$eventdescplacenote{$key,$i}\n");
$eline=$eventltab[$j]; # need to get it again
$eline =~ s/<!--xXxEVENTLINEx-->//;
Dprint("F","Marriage event model line: $eline\n");
$eline =~ s/xXxEVENTTYPEx/$eventtype{$key,$i}/;
$eline =~ s/xXxEVENTDATEx/$eventdate{$key,$i}/;
$eline =~ s/xXxEVENTDESCPLACENOTEx/$eventdescplacenote{$key,$i}/;
Dprint("F","Modified marriage event table line: $eline\n");
$eline =~ s/\n//g; # Dont want any newlines
$work=$work . $eline;
}
}
} else {
$eline =~ s/xXxMARDATEINPLACEx/$mardateinplace{$key}/;
if ($eline =~ /^.+xMARSTATx/) {
if ($marstat{$key} eq "") {
$eline=""; # Skip status line if empty
} else {
$eline =~ s/xXxMARSTATx/$marstat{$key}/;
}
}
if ($eline =~ /^.+xSTATDATEx/) {
if ($statdate{$key} eq "") {
$eline=""; # Skip status line if empty
} else {
$eline =~ s/xXxSTATDATEx/$statdate{$key}/;
}
}
Dprint("F","Modified marriage table line: $eline\n");
$eline =~ s/\n//g; # Dont want any newlines
$work=$work . $eline;
}
}
$marwin{$key}=Genwindow("Marriage Information",$work);
} elsif ($eventstat == 1) {
# If in middle of event table create event table array
$eventlcnt=$eventlcnt+1;
$eventltab[$eventlcnt]=$line;
} elsif ($line =~ /^.+xBEGINCHILDx/) {
$childstat=1;
} elsif ($line =~ /^.+xENDCHILDx/) {
$childstat=2;
Dprint("F","Child table has $childlcnt lines\n");
Dprint("F","Family $key has $allchildkeynum{$key} children\n");
if ($allchildkeynum{$key} > 0) {
$i=0;
while ($i < $allchildkeynum{$key}) {
$i=$i+1;
if (($i == 5) || ($i == 9)) {
# Start a new column
Dprint("F","Start new child column\n");
PrintHTML("$newtablecolumn\n");
}
$j=0;
while ($j < $childlcnt) {
$j=$j+1;
$line=$childltab[$j];
Dprint("F","Child $i Event model line $j: $line\n");
$line =~ s/xXxCHILDSEQNOx/$i/;
$line =~ s/xXxCHILDCOLORx/$childsexcolor{$key,$i}/;
$line =~ s/xXxCHILDFAMKEYx/$childfamkey{$key,$i}/;
$line =~ s/xXxCHILDDATAx/$childdata{$key,$i}/;
PrintHTML("$line\n");
Dprint("F","Modified event table line: $line\n");
}
}
} else {
Dprint("F","Indicate no children\n");
PrintHTML("$nochildren\n");
}
} elsif ($childstat == 1) {
$work=$line;
if ($work =~ /^xXxNEWTABLECOLUMNx/) {
$work =~ s/xXxNEWTABLECOLUMNx //;
$newtablecolumn=$work;
} elsif ($work =~ /^xXxNOCHILDRENx/) {
$work =~ s/xXxNOCHILDRENx //;
$nochildren=$work;
} else {
# If in middle of child table create child table array
$childlcnt=$childlcnt+1;
$childltab[$childlcnt]=$line;
}
} elsif ($line =~ /^.+xHUSBSPOUSELINKx/) {
if ($husbnumspouses{$key} ne "") {
# Build dropdown menu for spouses
if ($husbnumspouses{$key} > 0) {
$i=0;
while ($i < $husbnumspouses{$key}) {
$i=$i+1;
$work=$line;
$work =~ s/xXxHUSBSPOUSELINKx/$husbspouselink{$key,$i}/;
$work =~ s/xXxHUSBSPOUSENAMEx/$husbspousename{$key,$i}/;
PrintHTML("$work\n");
Dprint("F","Modified dropdown model line: $work\n");
}
}
}
} elsif ($line =~ /^.+xWIFESPOUSELINKx/) {
if ($wifenumspouses{$key} ne "") {
# Build dropdown menu for spouses
if ($wifenumspouses{$key} > 0) {
$i=0;
while ($i < $wifenumspouses{$key}) {
$i=$i+1;
$work=$line;
$work =~ s/xXxWIFESPOUSELINKx/$wifespouselink{$key,$i}/;
$work =~ s/xXxWIFESPOUSENAMEx/$wifespousename{$key,$i}/;
PrintHTML("$work\n");
Dprint("F","Modified dropdown model line: $work\n");
}
}
}
} else {
# Modify line and then write it
$line =~ s/xXxNUMERICRINx/$numericrin{$key}/;
$line =~ s/xXxINDEXLINKx/href=\"IDXSurname.html\"/;
$line =~ s/xXxHDESCLINKx/href=\"cgi-bin\/gendesc.cgi?ind=$husbkey{$key}\"/;
$line =~ s/xXxHANCLINKx/href=\"cgi-bin\/genanc.cgi?ind=$husbkey{$key}\"/;
$line =~ s/xXxWDESCLINKx/href=\"cgi-bin\/gendesc.cgi?ind=$wifekey{$key}\"/;
$line =~ s/xXxWANCLINKx/href=\"cgi-bin\/genanc.cgi?ind=$wifekey{$key}\"/;
$line =~ s/xXxHUSBFATHHREFx/$husbfathhref{$key}/;
$line =~ s/xXxHUSBFATHERx/$husbfather{$key}/;
$line =~ s/xXxHUSBMOTHHREFx/$husbmothhref{$key}/;
$line =~ s/xXxHUSBMOTHERx/$husbmother{$key}/;
$line =~ s/xXxWIFEFATHHREFx/$wifefathhref{$key}/;
$line =~ s/xXxWIFEFATHERx/$wifefather{$key}/;
$line =~ s/xXxWIFEMOTHHREFx/$wifemothhref{$key}/;
$line =~ s/xXxWIFEMOTHERx/$wifemother{$key}/;
$line =~ s/xXxHUSBTITLx/$husbtitl{$key}/;
$line =~ s/xXxHUSBHREFx/$husbhref{$key}/;
$line =~ s/xXxHUSBFULLNAMEx/$husbfullname{$key}/;
$line =~ s/xXxHUSBBIRTHDATEPLACEx/$husbbirthdateplace{$key}/;
$line =~ s/xXxHUSBCHRDATEPLACEx/$husbchrdateplace{$key}/;
$line =~ s/xXxHUSBDEATHDATEPLACEx/$husbdeathdateplace{$key}/;
$line =~ s/xXxHUSBBURDATEPLACEx/$husbburdateplace{$key}/;
$line =~ s/xXxHUSBDEATHCAUSEx/$husbdeathcause{$key}/;
$line =~ s/xXxHUSBNUMSPOUSESx/$husbnumspouses{$key}/;
$line =~ s/xXxHUSBSPOUSENAMEx/$husbspousename{$key}/;
$line =~ s/xXxHUSBFGLINKx/$husbfglink{$key}/;
$line =~ s/xXxHUSBFGIDx/$husbfgid{$key}/;
$line =~ s/xXxWIFETITLx/$wifetitl{$key}/;
$line =~ s/xXxWIFEHREFx/$wifehref{$key}/;
$line =~ s/xXxWIFEFULLNAMEx/$wifefullname{$key}/;
$line =~ s/xXxWIFEBIRTHDATEPLACEx/$wifebirthdateplace{$key}/;
$line =~ s/xXxWIFECHRDATEPLACEx/$wifechrdateplace{$key}/;
$line =~ s/xXxWIFEDEATHDATEPLACEx/$wifedeathdateplace{$key}/;
$line =~ s/xXxWIFEBURDATEPLACEx/$wifeburdateplace{$key}/;
$line =~ s/xXxWIFEDEATHCAUSEx/$wifedeathcause{$key}/;
$line =~ s/xXxWIFENUMSPOUSESx/$wifenumspouses{$key}/;
$line =~ s/xXxWIFEFGLINKx/$wifefglink{$key}/;
$line =~ s/xXxWIFEFGIDx/$wifefgid{$key}/;
$line =~ s/xXxMARDATEINPLACEx/$mardateinplace{$key}/;
$line =~ s/xXxMARSTATx/$marstat{$key}/;
$line =~ s/xXxMARWINx/$marwin{$key}/;
$line =~ s/xXxMARDATEPLACEx/$mardateplace{$key}/;
PrintHTML("$line\n");
Dprint("F","Modified model line: $line\n");
}
} else {
# Handle model lines that do not have xXx
if (($eventstat != 1) && ($childstat != 1)) {
# If not inside event or child table just write line
PrintHTML("$line\n");
Dprint("F","Copy model line: $line\n");
} elsif ($eventstat == 1) {
# If in middle of event table create event table array
$eventlcnt=$eventlcnt+1;
$eventltab[$eventlcnt]=$line;
} elsif ($childstat == 1) {
# If in middle of child table create child table array
$eventlcnt=$eventlcnt+1;
$eventltab[$eventlcnt]=$line;
}
}
}
close MOD;
if ($nogen == 0) {
close HTML;
}
}
if ($nogen == 0) {
print "Generating Index HTML files ...\n";
} else {
print "Working on Index HTML files ...\n";
}
# Set up the final keys used for the sort
# Put "junk" names at the end of the file using zzz
foreach $key (keys %rin) {
$surnamezzz{$key}=$surname{$key,1};
if ($surnamezzz{$key} eq "") {
$surnamezzz{$key}="zzz";
}
$givennamezzz{$key}=$givenname{$key,1};
if ($givennamezzz{$key} eq "") {
$givennamezzz{$key}="zzz";
} elsif ($givennamezzz{$key} =~ /^\d.*/) {
$givennamezzz{$key}="zzz" . $givennamezzz{$key};
}
# The birthdate key is composed of a year . month. day
$bdateseq=Getsortdate($birthdate{$key});
$birthdatezzz{$key}=$bdateseq;
Dprint("z","Birthdate sort key for $key: $birthdatezzz{$key}\n");
# The birthplace key is composed of a country . state . county. city. surname
if ($birthplace{$key} ne "") {
$bplaceloc1="";
$bplaceloc2="";
$bplaceloc3="";
$bplaceloc4="";
($bplaceloc1,$bplaceloc2,$bplaceloc3,$bplaceloc4) = split(/,/,$birthplace{$key},4);
if (!defined $bplaceloc1) { $bplaceloc1=""; }
if (!defined $bplaceloc2) { $bplaceloc2=""; }
if (!defined $bplaceloc3) { $bplaceloc3=""; }
if (!defined $bplaceloc4) {
$bplaceloc4="";
if ($bplaceloc1 ne "Unknown") {
print "Invalid birth place for $key $ixsurname{$key}: $birthplace{$key}\n";
}
}
$bplaceloc= $bplaceloc4 . "," . $bplaceloc3 . "," . $bplaceloc2 . "," . $bplaceloc1;
} else {
$bplaceloc="zzz";
}
$birthplacezzz{$key}=$bplaceloc;
Dprint("z","Birthplace sort key for $key: $birthplacezzz{$key}\n");
# Validate the Christening places, not used for index files
if ($chrplace{$key} ne "") {
$cplaceloc1="";
$cplaceloc2="";
$cplaceloc3="";
$cplaceloc4="";
($cplaceloc1,$cplaceloc2,$cplaceloc3,$cplaceloc4) = split(/,/,$chrplace{$key},4);
if (!defined $cplaceloc1) { $cplaceloc1=""; }
if (!defined $cplaceloc2) { $cplaceloc2=""; }
if (!defined $cplaceloc3) { $cplaceloc3=""; }
if (!defined $cplaceloc4) {
$cplaceloc4="";
if ($cplaceloc1 ne "Unknown") {
print "Invalid Christening place for $key $ixsurname{$key}: $chrplace{$key}\n";
}
}
}
# Validate the Death places, not used for index files
if ($deathplace{$key} ne "") {
$dplaceloc1="";
$dplaceloc2="";
$dplaceloc3="";
$dplaceloc4="";
($dplaceloc1,$dplaceloc2,$dplaceloc3,$dplaceloc4) = split(/,/,$deathplace{$key},4);
if (!defined $dplaceloc1) { $dplaceloc1=""; }
if (!defined $dplaceloc2) { $dplaceloc2=""; }
if (!defined $dplaceloc3) { $dplaceloc3=""; }
if (!defined $dplaceloc4) {
$dplaceloc4="";
if ($dplaceloc1 ne "Unknown") {
print "Invalid death place for $key $ixsurname{$key}: $deathplace{$key}\n";
}
}
}
# The cemetery key is composed of a prefix . country . state . county. city. cemetery . surname
# The prefix separates buried, cremations, unknown
# If person is cremated "Cremated" string is in burnote and location of ashes may be in buraddr
if ($burnote{$key} =~ /Cremated/) {
$cemprefix="C";
$cemeteryname{$key}="Cremated";
$cemeterynote{$key}=$buraddr{$key};
} elsif (($burplace{$key} eq "") && ($buraddr{$key} eq "") && ($buraddrnote{$key} eq "") && ($burnote{$key} eq "")) {
$cemprefix="U";
} else {
$cemprefix="B";
if ($buraddr{$key} ne "") {
$cemeteryname{$key}=$buraddr{$key};
if (($buraddrnote{$key} ne "") && ($burnote{$key} ne "")) {
$cemeterynote{$key}=$buraddrnote{$key} . " " . $burnote{$key} ;
} elsif ($buraddrnote{$key} ne "") {
$cemeterynote{$key}=$buraddrnote{$key};
} elsif ($burnote{$key} ne "") {
$cemeterynote{$key}=$burnote{$key};
}
$cemprefix= $cemprefix . "K";
} elsif ($buraddrnote{$key} ne "") {
$cemeteryname{$key}=$buraddrnote{$key};
$cemprefix= $cemprefix . "K";
} else {
$cemeteryname{$key}="Unknown";
$cemprefix= $cemprefix . "U";
}
}
if ($burplace{$key} ne "") {
$cemloc1="";
$cemloc2="";
$cemloc3="";
$cemloc4="";
($cemloc1,$cemloc2,$cemloc3,$cemloc4) = split(/,/,$burplace{$key},4);
if (!defined $cemloc1) { $cemloc1=""; }
if (!defined $cemloc2) { $cemloc2=""; }
if (!defined $cemloc3) { $cemloc3=""; }
if (!defined $cemloc4) {
$cemloc4="";
if ($cemloc1 ne "Unknown") {
print "Invalid burial place for $key $ixsurname{$key}: $burplace{$key}\n";
}
}
$cemloc= $cemloc4 . "," . $cemloc3 . "," . $cemloc2 . "," . $cemloc1;
} else {
$cemloc="";
}
$cemeterynamezzz{$key}=$cemprefix . $cemloc . $cemeteryname{$key};
Dprint("z","Cemetery sort key for $key: $cemeterynamezzz{$key}\n");
}
@keysbyrin=sort(Sortbyrin keys(%rin));
@keysbysurname=sort(Sortbysurname keys(%rin));
@keysbygivenname=sort(Sortbygivenname keys(%rin));
@keysbybirthdate=sort(Sortbybirthdate keys(%rin));
@keysbybirthplace=sort(Sortbybirthplace keys(%rin));
@keysbycemeteryname=sort(Sortbycemeteryname keys(%rin));
Dprint("s","\nbyrin\n");
foreach $x (@keysbyrin) {
Dprint("s","$x $numericrin{$x} $givenname{$x,1} $surname{$x,1}\n");
}
Dprint("s","\nbysurname\n");
foreach $x (@keysbysurname) {
Dprint("s","$x $surname{$x,1} $givenname{$x,1}\n");
}
Dprint("s","\nbygivenname\n");
foreach $x (@keysbygivenname) {
Dprint("s","$x $givenname{$x,1} $surname{$x,1}\n");
}
Dprint("s","\nbybirthdate\n");
foreach $x (@keysbybirthdate) {
Dprint("s","$x $birthdate{$x} $surname{$x,1}\n");
}
Dprint("s","\nbybirthplace\n");
foreach $x (@keysbybirthplace) {
Dprint("s","$x $birthplace{$x} $surname{$x,1}\n");
}
Dprint("s","\nbycemeteryname\n");
foreach $x (@keysbycemeteryname) {
Dprint("s","$x $cemeteryname{$x} $surname{$x,1}\n");
}
Dprint("s","\n");
foreach $ixtype ("RIN","Surname","Given","Bdate","Bplace","Cemetery","IDs") {
$htmlfile="$htmldir/IDX$ixtype\.html";
if ($nogen == 0) {
open (HTML,">$htmlfile") or die "Can't open $htmlfile: $!";
}
Dprint("X","######################################################## $ixtype\n");
if ($nogen == 0) {
Dprint("X","Generating $htmlfile ...\n");
} else {
Dprint("X"."Working on $htmlfile ...\n");
}
if ($ixtype eq "Cemetery") {
$modfile="$modeldir/idxcemmodel.html";
} elsif ($ixtype eq "IDs") {
$modfile="$modeldir/idxidsmodel.html";
} else {
$modfile="$modeldir/idxmodel.html";
}
open(MOD,"<$modfile") or die "Can't open $modfile: $!";
Dprint("X","Reading $modfile ...\n");
$cntr=0;
$xlinestat=0;
$xlinelcnt=0;
while (<MOD>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("X","$cntr: $line\n");
if (($line =~ /^.+xXx/) || ($xlinestat == 1)) {
Dprint("X","Got xXx at line $cntr: $line\n");
if ($line =~ /^.+xBEGININDEXLINEx/) {
$xlinestat=1;
} elsif ($line =~ /^.+xENDINDEXLINEx/) {
$xlinestat=2;
Dprint("X","Index line table has $xlinelcnt lines\n");
if ($ixtype eq "RIN") {
$numixlines=@keysbyrin;
} elsif ($ixtype eq "Surname") {
$numixlines=@keysbysurname;
} elsif ($ixtype eq "Given") {
$numixlines=@keysbygivenname;
} elsif ($ixtype eq "Bdate") {
$numixlines=@keysbybirthdate;
} elsif ($ixtype eq "Bplace") {
$numixlines=@keysbybirthplace;
} elsif ($ixtype eq "Cemetery") {
$numixlines=@keysbycemeteryname;
} elsif ($ixtype eq "IDs") {
$numixlines=@keysbysurname;
}
Dprint("X","$ixtype index has $numixlines lines\n");
if ($numixlines > 0) {
# Note that this array starts with index 0
$i=0;
while ($i < $numixlines) {
if ($ixtype eq "RIN") {
$key=$keysbyrin[$i];
$rinorder{$key}=$i;
} elsif ($ixtype eq "Surname") {
$key=$keysbysurname[$i];
$surnameorder{$key}=$i;
} elsif ($ixtype eq "Given") {
$key=$keysbygivenname[$i];
$givenorder{$key}=$i;
} elsif ($ixtype eq "Bdate") {
$key=$keysbybirthdate[$i];
$surnameorder{$key}=$i;
} elsif ($ixtype eq "Bplace") {
$key=$keysbybirthplace[$i];
$surnameorder{$key}=$i;
} elsif ($ixtype eq "Cemetery") {
$key=$keysbycemeteryname[$i];
$surnameorder{$key}=$i;
} elsif ($ixtype eq "IDs") {
$key=$keysbysurname[$i];
$surnameorder{$key}=$i;
}
Dprint("X","Sorted $ixtype key $i is $key\n");
$j=0;
while ($j < $xlinelcnt) {
$j=$j+1;
$line=$xlineltab[$j];
Dprint("X","Index line $i index table model line $j: $line\n");
if ($ixtype eq "Given") {
$ixname=$ixgiven{$key};
} else {
$ixname=$ixsurname{$key};
}
if ($sex{$key} eq "Male") {
$ixsex="M";
$ixcolor="blue";
} elsif ($sex{$key} eq "Female") {
$ixsex="F";
$ixcolor="red";
} else {
$ixsex="U";
$ixcolor="black";
}
# Set up Ids index to search for FSIDs and FGIDs not yet filled in
$ixfglink=$fglink{$key};
$ixfgrave=$fgrave{$key};
$ixfslink=$fslink{$key};
$ixfsftid=$fsftid{$key};
if ($ixtype eq "IDs") {
if (($givenname{$key,1} ne "") && ($surname{$key,1} ne "") && ($dead{$key} ne "") && ($ixsex ne "U")) {
if ($ixfglink eq "") {
($valFN,$valrest)=split(/\s/,$givenname{$key,1},2);
if (!defined $valFN) { $valFN=""; }
$valLN=$surname{$key,1};
$valBY=(split(/\s/,$birthdate{$key}))[-1];
if (!defined $valBY) { $valBY=""; }
$valDY=(split(/\s/,$deathdate{$key}))[-1];
if (!defined $valDY) { $valDY=""; }
if ($valDY eq "Yes") { $valDY=""; }
$ixfglink=$searchfg;
$ixfglink =~ s/xFNx/$valFN/;
$ixfglink =~ s/xLNx/$valLN/;
$ixfglink =~ s/xBYx/$valBY/;
$ixfglink =~ s/xDYx/$valDY/;
$ixfgrave=$atagdata;
}
if ($ixfslink eq "") {
($valGN,$valrest) = split(/\s/,$givenname{$key,1},2);
if (!defined $valGN) { $valGN=""; }
$valSN=$surname{$key,1};
$valDT=(split(/\s/,$birthdate{$key}))[-1];
if (!defined $valDT) { $valDT=""; }
($val1,$val2,$valPL,$val4)=split(/\,/,$birthplace{$key},4);
if (!defined $valPL) { $valPL=""; }
if ($valPL eq "") {
($val1,$val2,$valPL,$val4)=split(/\,/,$deathplace{$key},4);
if (!defined $valPL) { $valPL=""; }
}
$ixfslink=$searchfs;
$ixfslink =~ s/xGNx/$valGN/;
$ixfslink =~ s/xSNx/$valSN/;
$ixfslink =~ s/xDTx/$valDT/;
$ixfslink =~ s/xPLx/$valPL/;
$ixfsftid=$atagdata;
}
}
}
$line =~ s/xXxNUMERICRINx/$numericrin{$key}/;
$line =~ s/xXxFAMLINKx/$famlink{$key}/;
$line =~ s/xXxINDEXNAMEx/$ixname/;
$line =~ s/xXxSEXx/$ixsex/;
$line =~ s/xXxCOLORx/$ixcolor/g;
$line =~ s/xXxBIRTHDATEx/$birthdate{$key}/;
$line =~ s/xXxBIRTHPLACEx/$birthplace{$key}/;
$line =~ s/xXxDEATHDATEx/$deathdate{$key}/;
$line =~ s/xXxBURPLACEx/$burplace{$key}/;
$line =~ s/xXxCEMNAMEx/$cemeteryname{$key}/;
$line =~ s/xXxCEMNOTEx/$cemeterynote{$key}/;
$line =~ s/xXxFGLINKx/$ixfglink/;
$line =~ s/xXxFGRAVEx/$ixfgrave/;
$line =~ s/xXxFSLINKx/$ixfslink/;
$line =~ s/xXxFSFTIDx/$ixfsftid/;
PrintHTML("$line\n");
Dprint("X","Modified event table line: $line\n");
}
$i=$i+1;
}
}
} elsif ($xlinestat == 1) {
# If in middle of index line table create index line table array
$xlinelcnt=$xlinelcnt+1;
$xlineltab[$xlinelcnt]=$line;
} else {
# Modify line and then write it
$line =~ s/xXxINDEXTYPEx/$ixtype/;
$line =~ s/xXxRININDEXx/href=\"IDXRIN.html\"/;
$line =~ s/xXxSURNAMEx/href=\"IDXSurname.html\"/;
$line =~ s/xXxGIVENNAMEx/href=\"IDXGiven.html\"/;
$line =~ s/xXxBDATEORDERx/href=\"IDXBdate.html\"/;
$line =~ s/xXxBPLACEORDERx/href=\"IDXBplace.html\"/;
$line =~ s/xXxCEMETERYx/href=\"IDXCemetery.html\"/;
$line =~ s/xXxIDSx/href=\"IDXIDs.html\"/;
PrintHTML("$line\n");
Dprint("X","Modified model line: $line\n");
}
} else {
# Handle model lines that do not have xXx
if ($xlinestat == 1) {
# If in middle of index line table create index line table array
$xlinelcnt=$xlinelcnt+1;
$xlineltab[$xlinelcnt]=$line;
} else {
# If not inside index line table just write line
PrintHTML("$line\n");
Dprint("X","Copy model line: $line\n");
}
}
}
close MOD;
if ($nogen == 0) {
close HTML;
}
}
}
sub Genkeydatafiles {
if ($nogen == 0) {
print "Generating key data files ...\n";
} else {
print "Working on key data files ...\n";
}
$indfile="$htmldir/indfile";
if ($nogen == 0) {
open (IND,">$indfile") or die "Can't open $indfile: $!";
Dprint("D","Generating $indfile ...\n");
} else {
Dprint("D","Working on $indfile ...\n");
}
foreach $key (keys %rin) {
$line=$key . " " . $indfamsnum{$key};
$i=$indfamc{$key,1}; # Only use first FAMC record
if ($i eq "") { $i="@@"; }
$line=$line . " " . $i;
if ($indfamsnum{$key} > 0) {
$i=0;
while ($i < $indfamsnum{$key}) {
$i=$i+1;
$line=$line . " " . $indfams{$key,$i};
}
}
if ($nogen == 0) { print IND "$line\n"; }
}
if ($nogen == 0) {
close IND;
}
$namfile="$htmldir/namfile";
if ($nogen == 0) {
open (NAM,">$namfile") or die "Can't open $namfile: $!";
Dprint("D","Generating $namfile ...\n");
} else {
Dprint("D","Working on $namfile ...\n");
}
# namfile is in surname order
$numixlines=@keysbysurname;
$i=scalar(keys(%rin));
if ($numixlines != $i) {
print "$namfile should have $i entries but keysbysurname only has $numixlines entries\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
if ($numixlines > 0) {
# Note that this array starts with index 0
$i=0;
while ($i < $numixlines) {
$key=$keysbysurname[$i];
if ($preffamkey{$key} eq "") {
$j="@@";
} else {
$j=$preffamkey{$key};
}
$line=$key . " " . $j . " " . $sexcolor{$key} . " " . $fullnameplus{$key};
if ($nogen == 0) { print NAM "$line\n"; }
$i=$i+1;
}
}
if ($nogen == 0) {
close NAM;
}
$famfile="$htmldir/famfile";
if ($nogen == 0) {
open (FAM,">$famfile") or die "Can't open $famfile: $!";
Dprint("D","Generating $famfile ...\n");
} else {
Dprint("D","Working on $famfile ...\n");
}
foreach $key (keys %famrin) {
$line=$key . " " . $childkeynum{$key};
$i=$husbkey{$key};
if ($i eq "") { $i="@@"; }
$line=$line . " " . $i;
$i=$wifekey{$key};
if ($i eq "") { $i="@@"; }
$line=$line . " " . $i;
if ($childkeynum{$key} > 0) {
$i=0;
while ($i < $childkeynum{$key}) {
$i=$i+1;
$line=$line . " " . $childkey{$key,$i};
}
}
if ($nogen == 0) { print FAM "$line\n"; }
}
if ($nogen == 0) {
close FAM;
}
}
sub Sortbyrin {
$numericrin{$a} <=> $numericrin{$b}
or
$a cmp $b;
}
sub Sortbysurname {
$surnamezzz{$a} cmp $surnamezzz{$b}
or
$givenname{$a,1} cmp $givenname{$b,1}
or
$a cmp $b;
}
sub Sortbygivenname {
$givennamezzz{$a} cmp $givennamezzz{$b}
or
$surname{$a,1} cmp $surname{$b,1}
or
$a cmp $b;
}
sub Sortbybirthdate {
$birthdatezzz{$a} cmp $birthdatezzz{$b}
or
$surnamezzz{$a} cmp $surnamezzz{$b}
or
$givenname{$a,1} cmp $givenname{$b,1}
or
$a cmp $b;
}
sub Sortbybirthplace {
$birthplacezzz{$a} cmp $birthplacezzz{$b}
or
$surnamezzz{$a} cmp $surnamezzz{$b}
or
$givenname{$a,1} cmp $givenname{$b,1}
or
$a cmp $b;
}
sub Sortbycemeteryname {
$cemeterynamezzz{$a} cmp $cemeterynamezzz{$b}
or
$surnamezzz{$a} cmp $surnamezzz{$b}
or
$givenname{$a,1} cmp $givenname{$b,1}
or
$a cmp $b;
}
sub Getdateplace {
my $gdate=$_[0];
my $gplace=$_[1];
my $sep=$_[2];
my $gdateplace="";
# combine date and place with separator
if (($gdate eq "") && ($gplace eq "")) {
# no date or place
} elsif ($gdate eq "") {
$gdateplace=$gplace;
} elsif ($gplace eq "") {
$gdateplace=$gdate;
} else {
$gdateplace=$gdate . $sep . $gplace;
}
return $gdateplace;
}
sub Fixnote {
my $fnotetyp=$_[0];
my $fnotekey=$_[1];
# Look up notes that are reference by index number
my $j;
my $retval="@@";
if ($lev0notenum > 0) {
$j=0;
while ($j < $lev0notenum) {
$j=$j+1;
if ($fnotekey eq $lev0notekey{$key,$j}) {
$retval=$lev0note{$key,$j};
Dprint("n","Replacing note $fnotetyp $fnotekey with $retval at line $cntr\n");
}
}
}
if ($retval eq "@@") {
print "Unable to decode note $fnotetyp $fnotekey at line $cntr\n";
if ($test == 0) { die "Aborting due to inconsistent $gedfile file\n"; }
}
return $retval;
}
sub Genalert {
my $ahead=$_[0];
my $awork=$_[1];
my $adata;
$awork =~ s/[\"\']/+/g; # get rid of single,double quotes
$awork =~ s/\n/<br>/g; # convert linefeeds to <br>
$adata="<h2>$ahead</h2><p>$awork</p>";
return $adata;
}
sub Genwindow {
my $ahead=$_[0];
my $awork=$_[1];
my $adata;
$awork =~ s/[\"\']/+/g; # get rid of single,double quotes
$adata="<h2>$ahead</h2><p>$awork</p>";
return $adata;
}
sub Getsortdate {
my $date=$_[0];
my $month;
my $year;
my $day;
my $sd;
my $da;
my $mo;
my $yr;
($da,$mo,$yr) = split(/\s/,$date,3);
if (!defined $da) { $da=""; }
if (!defined $mo) { $mo=""; }
if (!defined $yr) { $yr=""; }
Dprint("d","da: $da\n");
Dprint("d","mo: $mo\n");
Dprint("d","yr: $yr\n");
$month=1;
$day="99";
if (($da =~ /^\d+$/) && ($mo =~ /^[A-Z][a-z][a-z]$/) && ($yr =~ /^\d+$/)) {
# 99 Xxx 9999
if ($da < 9) {
$day="0".$da;
} else {
$day=$da;
}
$year=$yr;
} elsif (($da =~ /^[A-Z][a-z][a-z]$/) && ($mo =~ /^\d+$/) && ($yr eq "")) {
# Xxx 9999
$day="00";
$year=$mo;
$mo=$da;
} elsif (($da =~ /^\d+$/) && ($mo eq "") && ($yr eq "")) {
# 9999
$day="00";
$year=$da;
$mo="00";
} else {
# Invalid date
$year="9999";
$mo=99;
}
if ($mo eq "00") {$mo=0;}
elsif ($mo eq "Abt") {$mo=0;}
elsif ($mo eq "Jan") {$mo=1;}
elsif ($mo eq "Feb") {$mo=2;}
elsif ($mo eq "Mar") {$mo=3;}
elsif ($mo eq "Apr") {$mo=4;}
elsif ($mo eq "May") {$mo=5;}
elsif ($mo eq "Jun") {$mo=6;}
elsif ($mo eq "Jul") {$mo=7;}
elsif ($mo eq "Aug") {$mo=8;}
elsif ($mo eq "Sep") {$mo=9;}
elsif ($mo eq "Oct") {$mo=10;}
elsif ($mo eq "Nov") {$mo=11;}
elsif ($mo eq "Dec") {$mo=12;}
else {
# Invalid date
$mo=99;
}
if ($mo < 10) {
$month="0".$mo;
} else {
$month=$mo;
}
if (($year < 1000) || ($year > 3000)) {
# Invalid year
$year="9999";
}
Dprint("d","year: $year\n");
Dprint("d","month: $month\n");
Dprint("d","day: $day\n");
$sd = $year . $month . $day;
Dprint("d","sortdate=$sd\n");
return $sd;
}
sub Calcage {
my $curdate=$_[0];
my $bdate=$birthdate{$key};
my $cur;
my $bda;
my $age=-1;
my $fage;
Dprint("a","curdate=$curdate\n");
Dprint("a","bdate=$bdate\n");
$cur=Calcmonth($curdate);
if ($cur >= 0) {
$bda=Calcmonth($bdate);
if ($bda >= 0) {
$fage=($cur-$bda)/12;
$age=int($fage);
Dprint("a","age: $age=int($fage)\n");
}
}
if ($age < 0 ) { $age=""; }
return $age;
}
sub Calcmonth {
my $date=$_[0];
my $month;
my $da;
my $mo;
my $yr;
($da,$mo,$yr) = split(/\s/,$date,3);
if (!defined $da) { $da=""; }
if (!defined $mo) { $mo=""; }
if (!defined $yr) { $yr=""; }
Dprint("a","da: $da\n");
Dprint("a","mo: $mo\n");
Dprint("a","yr: $yr\n");
$month=1;
if (($da =~ /^\d+$/) && ($mo =~ /^[A-Z][a-z][a-z]$/) && ($yr =~ /^\d+$/)) {
# 99 Xxx 9999
} elsif (($da =~ /^[A-Z][a-z][a-z]$/) && ($mo =~ /^\d+$/) && ($yr eq "")) {
# Xxx 9999
$yr=$mo;
$mo=$da;
} elsif (($da =~ /^\d+$/) && ($mo eq "") && ($yr eq "")) {
# 9999
$yr=$da;
$mo="0";
} else {
# Invalid date
$month=-1;
}
if ($mo eq "0") { $mo=0;}
elsif ($mo eq "Abt") {$mo=0;}
elsif ($mo eq "Jan") {$mo=1;}
elsif ($mo eq "Feb") {$mo=2;}
elsif ($mo eq "Mar") {$mo=3;}
elsif ($mo eq "Apr") {$mo=4;}
elsif ($mo eq "May") {$mo=5;}
elsif ($mo eq "Jun") {$mo=6;}
elsif ($mo eq "Jul") {$mo=7;}
elsif ($mo eq "Aug") {$mo=8;}
elsif ($mo eq "Sep") {$mo=9;}
elsif ($mo eq "Oct") {$mo=10;}
elsif ($mo eq "Nov") {$mo=11;}
elsif ($mo eq "Dec") {$mo=12;}
else {
# Invalid date
$month=-1;
}
if ($month > 0) {
$month=($yr*12)+$mo;
Dprint("a","$month=($yr * 12)+$mo\n");
}
return $month;
}
sub Calcyear {
my $date=$_[0];
my $year;
my $da;
my $mo;
my $yr;
($da,$mo,$yr) = split(/\s/,$date,3);
if (!defined $da) { $da=""; }
if (!defined $mo) { $mo=""; }
if (!defined $yr) { $yr=""; }
Dprint("y","da: $da\n");
Dprint("y","mo: $mo\n");
Dprint("y","yr: $yr\n");
if (($da =~ /^\d+$/) && ($mo =~ /^[A-Z][a-z][a-z]$/) && ($yr =~ /^\d+$/)) {
# 99 Xxx 9999
$year=$yr;
} elsif (($da =~ /^[A-Z][a-z][a-z]$/) && ($mo =~ /^\d+$/) && ($yr eq "")) {
# Xxx 9999
$year=$mo;
} elsif (($da =~ /^\d+$/) && ($mo eq "") && ($yr eq "")) {
# 9999
$year=$da;
} else {
$year=0;
}
if (($year < 1000) || ($year > 3000)) {
# Invalid year
$year="";
}
Dprint("y","year: $year\n");
return $year;
}
sub PrintHTML {
my $htmldata=$_[0];
if ($nogen == 0) {
print HTML "$htmldata";
}
}
sub Getopts {
if ($#ARGV >= 0) {
my $i=0;
while ($i <= $#ARGV) {
if ($ARGV[$i] eq "-help") {
Help();
++$i;
} elsif ($ARGV[$i] eq "-nogen") {
$nogen=1;
++$i;
} elsif ($ARGV[$i] eq "-test") {
$test=1;
++$i;
} elsif (($i+1) <= $#ARGV) {
if ($ARGV[$i] eq "-d") {
# enable debug mode
$debug = $ARGV[++$i];
++$i;
} elsif ($ARGV[$i] eq "-ged") {
$gedfile = $ARGV[++$i];
++$i;
} elsif ($ARGV[$i] eq "-mod") {
$modeldir = $ARGV[++$i];
++$i;
} elsif ($ARGV[$i] eq "-html") {
$htmldir = $ARGV[++$i];
++$i;
} elsif ($ARGV[$i] eq "-del") {
$delname = $ARGV[++$i];
++$i;
} else {
Usage();
}
} else {
Usage();
}
}
}
print "gedfile: $gedfile\n";
print "modeldir: $modeldir\n";
print "htmldir: $htmldir\n";
if ($delname ne "") {
print "delname: $delname\n";
}
}
# 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>] [-ged <gedfile>] [-mod <modeldir>] [-html <htmldir>] [-del <surname>]\n";
}
sub Help {
print "Usage: $0 [-help] [-test] [-nogen] [-d <debuglevel>] [-ged <gedfile>] [-mod <modeldir>] [-html <htmldir>] [-del <surname>]\n";
print "-help = Display this help information\n";
print "-test = Ignore incomplete or inconsistent or unhandled GED file errors\n";
print "-nogen = Suppress creating output files in the HTML directory\n";
print "-d <debuglevel> = Enable printout for various debug levels\n";
print "-ged <gedfile> = Use <gedfile> as the input GED file (default: gedfile.ged)\n";
print "-mod <modeldir> = Use <modeldir> as the directory where to find the input model files (default: modeldir)\n";
print "-html <htmldir> = Write the HTML output files into the <htmldir> directory (default: htmldir)\n";
print "-del <surname> = Delete any individuals with <surname> from the output files\n";
exit;
}