#!/usr/local/bin/perl
# The genrel.cgi script is used to display the relatives data for an individual
use strict;
use warnings;
#Useful for testing: Perl error messages, plus your die statements, will get
#sent to the browser. Otherwise you will just see "Internal Server Error".
use CGI::Carp qw/fatalsToBrowser/;
use CGI qw(param);
my $old_stdout = select(STDOUT);
$| = 1;
select($old_stdout);
my $old_stderr = select(STDERR);
$| = 1;
select($old_stderr);
my $arg="";
my $sby="r";
my $key="";
my $iscgi=0;
my $check=0;
my $nogen=0;
my $debug="";
my $modfile="relmodel.html";
my $htmlfile="genrel.html";
my $debugfile="genrel.debug";
my $htmlhead="<!DOCTYPE html>";
my $cgihead="Content-type: text\/html";
my $line;
my $cntr;
my $numfams;
my $famcin;
my $fnamein;
my $preffamin;
my $scolorin;
my $hkeyin;
my $wkeyin;
my $numchildkey;
my $i;
my $j;
my $x;
my $pfamlink="";
my $hindname="";
my $indfile;
my $famfile;
my $namfile;
my @lineargs;
my %rin;
my %famrin;
my %namrin;
# For each individual:
my %indfamsnum; # Number of families
my %indfamc; # Key of family of parents (@Innn,1) only one set of parents
my %indfams; # Key of Families for each spouse (@Innn,1...)
my %sexcolor; # Sex color: red, blue, black
my %fullnameplus; # Full name
my %preffamkey; # Preferred family key
# for each family:
my %childkeynum; # Number of children in family
my %husbkey; # Key of husband
my %wifekey; # Key of wife
my %childkey; # Keys of children (@Innn@,1...)
# For each individual:
my %relation;
my %relationall;
my %isdirectind; # 0 or 1
my %indalev; # alev for this individual
# Output of Checkcommon
my $indcom; # number of common individuals
my %alevcomind; # alev for common individual (1...
my %dlevcomind; # dlev for common individual (1...
# for each family:
my %isdirectfam; # 0 or 1
my %famalev; # alev for this family
# Output of Checkcommon
my $famcom; # number of common families
my %alevcomfam; # alev for common family (1...
my %dlevcomfam; # dlev for common family (1...
my $numrelines;
my @keysbyrel;
my $rellsave;
# For each individual:
my %sorttyp;
my %sortseq;
my %sortalev;
my %sortdlev;
my $loopcntrf;
my $loopcntra;
my $loopcntrc;
my $loopcntrd;
my $loopcntri;
my $loopmax;
my $numind;
my $numrin;
my $numkeysbyrel;
# The sequence of called subroutines is:
# Getopts
# Getdatafiles
# Checkdata
# Printpage
# Getrelatives
# Flagafamily *
# Getafamily *
# Dooneancestor
# Getdfamily *
# Doonedescendant
# Determinerelation
# Checkcommon
# Checkafamily *
# Parentsofinlaw
# Getinlaws
# Doinlawspouse *
# Dooneinlaw
# Determinlawrelation
# Sortbyrel
# Printrelline
# PrintHTML
# PrintHTML
# * = subroutine called recursively
if (exists($ARGV[0])) {
Getopts();
if ($debug eq "") { $debug=" "; }
if ($debug ne " ") {
open (DOUT,">$debugfile") or die "Can't open $debugfile: $!";
}
} else {
$iscgi=1;
$arg=param("ind");
$arg=~s/[^a-zA-Z0-9@]//g;
$sby=param("sby");
$sby=~s/[^a-z]//g;
}
Getdatafiles();
if ($check == 1) { Checkdata(); }
if (exists($rin{$arg})) {
$pfamlink="href=\"..\/FAM$preffamkey{$arg}.html\"";
$hindname=$fullnameplus{$arg};
} else {
# arg is missing
$arg="@@";
}
Printpage();
exit;
# <key> <numfams> <famcin> <fams> ...
sub Getdatafiles {
$indfile="../indfile";
open (IND,"<$indfile") or die "Can't open $indfile: $!";
Dprint("1","Reading $indfile ...\n");
$cntr=0;
while (<IND>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("1","$cntr: $line\n");
$key="";
$numfams=0;
$famcin="";
@lineargs = split(/\s/,$line);
if (defined $lineargs[0]) { $key=$lineargs[0]; }
if (defined $lineargs[1]) { $numfams=$lineargs[1]; }
if (defined $lineargs[2]) { $famcin=$lineargs[2]; }
Dprint("1","key: $key\n");
Dprint("1","numfams: $numfams\n");
Dprint("1","famcin: $famcin\n");
if ($key ne "") {
$rin{$key}=$key;
$relation{$key}="";
$relationall{$key}="";
$isdirectind{$key}=0;
$sorttyp{$key}=0;
$sortseq{$key}=0;
$sortalev{$key}=0;
$sortdlev{$key}=0;
$indfamsnum{$key}=$numfams;
$indfamc{$key,1}=$famcin; # Only use first FAMC record
if ($numfams > 0) {
$i=0;
while ($i < $numfams) {
$i=$i+1;
$indfams{$key,$i}="";
if (defined $lineargs[$i+2]) { $indfams{$key,$i}=$lineargs[$i+2]; }
}
}
}
}
$numind=$cntr;
close IND;
$loopmax=$cntr * 2;
# <key> <preffamin> <scolorin> <fnamein>
$namfile="../namfile";
open (NAM,"<$namfile") or die "Can't open $namfile: $!";
Dprint("2","Reading $namfile ...\n");
$cntr=0;
$numrelines=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 "") {
# namfile is currently in Surname alphabetical order
$keysbyrel[$numrelines]=$key;
$numrelines=$numrelines+1;
$namrin{$key}=$key;
$preffamkey{$key}=$preffamin;
$sexcolor{$key}=$scolorin;
$fullnameplus{$key}=$fnamein;
}
}
close NAM;
# <key> <numchildkey> <hkeyin> <wkeyin> <childkey> ...
$famfile="../famfile";
open (FAM,"<$famfile") or die "Can't open $famfile: $!";
Dprint("3","Reading $famfile ...\n");
$cntr=0;
while (<FAM>) {
s/\r[\n]*/\n/gm; # get rid of carriage returns, we only want line feeds
chomp;
$line=$_;
$cntr=$cntr+1;
Dprint("3","$cntr: $line\n");
$key="";
$numchildkey=0;
$hkeyin="";
$wkeyin="";
@lineargs = split(/\s/,$line);
if (defined $lineargs[0]) { $key=$lineargs[0]; }
if (defined $lineargs[1]) { $numchildkey=$lineargs[1]; }
if (defined $lineargs[2]) { $hkeyin=$lineargs[2]; }
if (defined $lineargs[3]) { $wkeyin=$lineargs[3]; }
Dprint("3","key: $key\n");
Dprint("3","numchildkey: $numchildkey\n");
if ($key ne "") {
$famrin{$key}=$key;
$isdirectfam{$key}=0;
$childkeynum{$key}=$numchildkey;
$husbkey{$key}=$hkeyin;
$wifekey{$key}=$wkeyin;
if ($numchildkey > 0) {
$i=0;
while ($i < $numchildkey) {
$i=$i+1;
$childkey{$key,$i}="";
if (defined $lineargs[$i+3]) { $childkey{$key,$i}=$lineargs[$i+3]; }
}
}
}
}
close FAM;
}
sub Checkdata {
Dprint("C","Checking IND data ...\n");
foreach $key (keys %rin) {
if (exists($famrin{$indfamc{$key,1}})) {
Dprint("K","IND $key: Found FAMC record $indfamc{$key,1}\n");
} else {
if ($indfamc{$key,1} ne "@@") {
Dprint("C","IND $key: Cannot find FAMC record $indfamc{$key,1}\n");
}
}
if ($indfamsnum{$key} > 0) {
$i=0;
while ($i < $indfamsnum{$key}) {
$i=$i+1;
if (exists($famrin{$indfams{$key,$i}})) {
Dprint("K","IND $key: Found FAMS record $indfams{$key,$i}\n");
} else {
Dprint("C","IND $key: Cannot find FAMS record $indfams{$key,$i}\n");
}
}
}
if (exists($fullnameplus{$key})) {
Dprint("K","IND $key: Found fullnameplus: $fullnameplus{$key}\n");
} else {
Dprint("C","IND $key: Cannot find fullnameplus\n");
}
}
Dprint("C","Checking NAM data ...\n");
foreach $key (keys %namrin) {
if (exists($preffamkey{$key})) {
Dprint("K","NAM $key: Found preffamkey: $preffamkey{$key}\n");
} else {
Dprint("C","NAM $key: Cannot find preffamkey\n");
}
if (exists($sexcolor{$key})) {
Dprint("K","NAM $key: Found sexcolor: $sexcolor{$key}\n");
} else {
Dprint("C","NAM $key: Cannot find sexcolor\n");
}
if (exists($fullnameplus{$key})) {
Dprint("K","NAM $key: Found fullnameplus: $fullnameplus{$key}\n");
} else {
Dprint("C","NAM $key: Cannot find fullnameplus\n");
}
}
Dprint("C","Checking FAM data ...\n");
foreach $key (keys %famrin) {
if (exists($rin{$husbkey{$key}})) {
Dprint("K","FAM $key: Found IND record for husband $husbkey{$key}\n");
} else {
if ($husbkey{$key} ne "@@") {
Dprint("C","FAM $key: Cannot find IND record for husband $husbkey{$key}\n");
}
}
if (exists($rin{$wifekey{$key}})) {
Dprint("K","FAM $key: Found IND record for wife $wifekey{$key}\n");
} else {
if ($wifekey{$key} ne "@@") {
Dprint("C","FAM $key: Cannot find IND record for wife $wifekey{$key}\n");
}
}
if ($childkeynum{$key} > 0) {
$i=0;
while ($i < $childkeynum{$key}) {
$i=$i+1;
if (exists($rin{$childkey{$key,$i}})) {
Dprint("K","FAM $key: Found IND record for child $childkey{$key,$i}\n");
} else {
Dprint("C","FAM $key: Cannot find IND record for child $childkey{$key,$i}\n");
}
}
}
}
}
# Starts out: $arg, 0, ""
sub Getrelatives {
my $fikey=$_[0];
my $flev=$_[1];
my $indent=$_[2];
# Get all ancestor families
$loopcntrf=0;
Flagafamily($fikey,0);
Dprint("L","Flagafamily loop count: $loopcntrf\n");
$loopcntra=0;
Getafamily($fikey,0);
Dprint("L","Getafamily loop count: $loopcntra\n");
Getinlaws($fikey);
}
# Flag all direct ancestors
# Starts out: $arg, 0
sub Flagafamily {
my $fikey=$_[0];
my $falev=$_[1];
my $fx;
my $fpkey;
my $fscolor;
$loopcntrf=$loopcntrf+1;
Dprint("l","loopcntrf=$loopcntrf, fikey=$fikey\n");
if ($loopcntrf > $loopmax) {
PrintHTML("<br>Flagafamily loopcntr exceeded $loopmax<br>");
PrintHTML("Inconsistent or invalid GED file, aborting<br>") ;
} else {
$falev=$falev+1;
# Check to see if we can find this individual
if (exists($rin{$fikey})) {
$fpkey=$preffamkey{$fikey};
$fscolor=$sexcolor{$fikey};
# Indicate is a direct ancestor
$isdirectind{$fikey}=1;
$indalev{$fikey}=$falev;
Dprint("F","F Individual $fikey alev=$falev $fullnameplus{$fikey}\n");
my $fi;
my $ffkey;
my $fskey;
my $fcnum;
my $fj;
my $fckey;
# Parents family key
$ffkey=$indfamc{$fikey,1};
# Check to see if we can find this family
if (exists($famrin{$ffkey})) {
# Indicate direct ancestor family
$isdirectfam{$ffkey}=1;
$famalev{$ffkey}=$falev+1; # This is alev of parents family
Dprint("F","F Family $ffkey alev=$falev\n");
$fskey=$husbkey{$ffkey};
if ($fskey ne "@@") {
Flagafamily($fskey,$falev); # Do husband
}
$fskey=$wifekey{$ffkey};
if ($fskey ne "@@") {
Flagafamily($fskey,$falev); # Do wife
}
} else {
# Cannot find this family
$fx=0;
}
} else {
# Cannot find this individual
$fx=0;
}
}
}
# Check to see if there is a common ancestor family
# Output is number of matches in indcom and famcom
sub Checkcommon {
my $fikey=$_[0];
$indcom=0;
$famcom=0;
if ($isdirectind{$fikey} == 1) {
Dprint("C","Common individual found in direct line $fikey indalev=$indalev{$fikey}: $fullnameplus{$fikey}\n");
$indcom=1;
$famcom=1;
$alevcomind{$indcom}=$indalev{$fikey};
$dlevcomind{$indcom}=1;
$alevcomfam{$famcom}=$indalev{$fikey};
$dlevcomfam{$famcom}=1;
} else {
$loopcntrc=0;
Checkafamily($fikey,0);
Dprint("L","Checkafamily loop count: $loopcntrc\n");
}
}
# Check all direct ancestors to see if has common direct ancestor family or individual
# Starts out: $arg, 0
sub Checkafamily {
my $fikey=$_[0];
my $falev=$_[1];
my $fx;
my $fpkey;
my $fscolor;
$loopcntrc=$loopcntrc+1;
Dprint("l","loopcntrc=$loopcntrc, fikey=$fikey\n");
if ($loopcntrc > $loopmax) {
PrintHTML("<br>Checkafamily loopcntr exceeded $loopmax<br>");
PrintHTML("Inconsistent or invalid GED file, aborting<br>") ;
} else {
$falev=$falev+1;
# Check to see if we can find this individual
if (exists($rin{$fikey})) {
$fpkey=$preffamkey{$fikey};
$fscolor=$sexcolor{$fikey};
# Direct ancestor found
# Check to see if this is the same direct individual
if ($isdirectind{$fikey} == 1) {
$indcom=$indcom+1;
Dprint("C","Common individual $indcom found fikey=$fikey falev=$falev indalev=$indalev{$fikey} $fullnameplus{$fikey}\n");
$alevcomind{$indcom}=$indalev{$fikey};
$dlevcomind{$indcom}=$falev;
} else {
my $fi;
my $ffkey;
my $fskey;
my $fcnum;
my $fj;
my $fckey;
$ffkey=$indfamc{$fikey,1};
# Check to see if we can find this family
if (exists($famrin{$ffkey})) {
# Check to see if this is the same direct family
if ($isdirectfam{$ffkey} == 1) {
$famcom=$famcom+1;
Dprint("C","Common family $famcom found ffkey=$ffkey falev=$falev famalev=$famalev{$ffkey} parents of: $fullnameplus{$fikey}\n");
$alevcomfam{$famcom}=$famalev{$ffkey};
$dlevcomfam{$famcom}=$falev+1;
}
$fskey=$husbkey{$ffkey};
if ($fskey ne "@@") {
Checkafamily($fskey,$falev);
}
$fskey=$wifekey{$ffkey};
if ($fskey ne "@@") {
Checkafamily($fskey,$falev);
}
} else {
# Cannot find this family
$fx=0;
}
}
} else {
# Cannot find this individual
$fx=0;
}
}
}
# Ancestors
# Starts out: $arg, 0
sub Getafamily {
my $fikey=$_[0];
my $falev=$_[1];
my $fx;
my $fpkey;
my $fscolor;
$loopcntra=$loopcntra+1;
Dprint("l","loopcntra=$loopcntra, fikey=$fikey\n");
if ($loopcntra > $loopmax) {
PrintHTML("<br>Getafamily loopcntr exceeded $loopmax<br>");
PrintHTML("Inconsistent or invalid GED file, aborting<br>") ;
} else {
$falev=$falev+1;
# Check to see if we can find this individual
if (exists($rin{$fikey})) {
$fpkey=$preffamkey{$fikey};
$fscolor=$sexcolor{$fikey};
# Direct ancestor
Dooneancestor($fikey,$falev);
Dprint("A","A alev=$falev $fullnameplus{$fikey}\n");
my $fi;
my $ffkey;
my $fskey;
my $fcnum;
my $fj;
my $fckey;
$ffkey=$indfamc{$fikey,1};
# Check to see if we can find this family
if (exists($famrin{$ffkey})) {
$fskey=$husbkey{$ffkey};
if ($fskey ne "@@") {
Getafamily($fskey,$falev);
}
$fskey=$wifekey{$ffkey};
if ($fskey ne "@@") {
Getafamily($fskey,$falev);
}
} else {
# Cannot find this family
$fx=0;
}
} else {
# Cannot find this individual
$fx=0;
}
}
}
sub Dooneancestor {
my $fikey=$_[0];
my $falev=$_[1];
$loopcntrd=0;
Getdfamily($fikey,$falev,0);
Dprint("L","Getdfamily loop count: $loopcntrd\n");
}
# Descendants
# Starts out: $fikey, $falev, 0
sub Getdfamily {
my $fikey=$_[0];
my $falev=$_[1];
my $fdlev=$_[2];
my $fx;
my $fpkey;
my $fscolor;
$loopcntrd=$loopcntrd+1;
Dprint("l","loopcntrd=$loopcntrd, fikey=$fikey\n");
if ($loopcntrd > $loopmax) {
PrintHTML("<br>Getdfamily loopcntr exceeded $loopmax<br>");
PrintHTML("Inconsistent or invalid GED file, aborting<br>") ;
} else {
$fdlev=$fdlev+1;
# Check to see if we can find this individual
if (exists($rin{$fikey})) {
$fpkey=$preffamkey{$fikey};
$fscolor=$sexcolor{$fikey};
# Do current individual
Doonedescendant($fikey,$falev,$fdlev,"");
Dprint("D","D alev=$falev,dlev=$fdlev $fullnameplus{$fikey}\n");
my $fnum=$indfamsnum{$fikey};
my $fi;
my $ffkey;
my $fskey;
my $fcnum;
my $fj;
my $fckey;
if ($fnum > 0) {
$fi=0;
# Process all families
while ($fi < $fnum) {
$fi=$fi+1;
$ffkey=$indfams{$fikey,$fi};
# Check to see if we can find this family
if (exists($famrin{$ffkey})) {
$fskey="@@";
if ($wifekey{$ffkey} eq $fikey) {
$fskey=$husbkey{$ffkey};
} elsif ($husbkey{$ffkey} eq $fikey) {
$fskey=$wifekey{$ffkey};
}
if ($fskey ne "@@") {
# Spouse
$fpkey=$preffamkey{$fskey};
$fscolor=$sexcolor{$fskey};
# Do all spouses
Doonedescendant($fskey,$falev,$fdlev,$fikey);
Dprint("D","D alev=$falev,dlev=$fdlev $fullnameplus{$fskey}\n");
}
# Number of children in this family
$fcnum=$childkeynum{$ffkey};
if ($fcnum > 0) {
$fj=0;
while ($fj < $fcnum) {
$fj=$fj+1;
$fckey=$childkey{$ffkey,$fj};
# Process each child
Getdfamily($fckey,$falev,$fdlev);
}
} else {
# No children
$fx=0;
}
} else {
# Cannot find this family
$fx=0;
}
}
} else {
# No families
$fx=0;
}
} else {
# Cannot find this individual
$fx=0;
}
}
}
# Process one descendant in the tree
sub Doonedescendant {
my $fikey=$_[0];
my $falev=$_[1];
my $fdlev=$_[2];
my $fskey=$_[3]; # Key of spouse
my $fnewrel;
if ($relation{$fikey} eq "") {
$relation{$fikey}=Determinerelation($fikey,$falev,$fdlev,$fskey);
}
}
# For this person, determine the relationship to the individual
sub Determinerelation {
my $fikey=$_[0]; # Key of individual
my $falev=$_[1]; # Ancestor level (up the tree)
my $fdlev=$_[2]; # Descendant level (down the tree)
my $fskey=$_[3]; # Key of spouse
my $fsprel; # Relation of spouse
my $frel="Unknown";
my $fprefix="";
my $gprefix="";
my $cprefix="";
my $rprefix="";
my $remlev;
my $sexcol;
my $multrels=0;
if ($relation{$fikey} eq "") {
# Compute $famcom, $indcom
Checkcommon($fikey);
# See if alevs match for common family
# If not, then use the first alevcomfam found in the Checkcommon routine
# This probably means that one of the relatives for this person was not a direct relation
if ($famcom > 0) {
if ($falev != $alevcomfam{1}) {
Dprint("R","R override falev=$falev alevcomfam{1}=$alevcomfam{1} dlevcomfam{1}=$dlevcomfam{1} $fullnameplus{$fikey}\n");
$falev=$alevcomfam{1};
$fdlev=$dlevcomfam{1};
$multrels=1;
}
}
$sortalev{$fikey}=$falev;
$sortdlev{$fikey}=$fdlev;
if ($fskey ne "") {
$fsprel=$relation{$fskey};
} else {
$fsprel="";
}
$sexcol=$sexcolor{$fikey};
# Indicate if there are more than one relationship for this individual
if ($famcom > 1) {
$multrels=1;
}
# Ancestor level 1
if ($falev == 1) {
if ($fdlev == 1) {
# alev dlev famcom indcom
# 1 1 x >0
if ($indcom > 0) {
$sortalev{$fikey}=0;
$frel="Self";
# 1 1 x 0
} else {
if ($sexcol eq "red") {
$frel="Wife";
} elsif ($sexcol eq "blue") {
$frel="Husband";
} else {
$frel="Spouse";
}
}
} elsif ($fdlev == 2) {
if ($indcom > 0) {
# 1 2 x >0
if ($sexcol eq "red") {
$frel="Daughter";
} elsif ($sexcol eq "blue") {
$frel="Son";
} else {
$frel="Child";
}
} else {
# 1 2 x 0
if ($sexcol eq "red") {
$frel="Daughter-in-law";
} elsif ($sexcol eq "blue") {
$frel="Son-in-law";
} else {
$frel="Child-in-law";
}
Parentsofinlaw($fikey,$falev,$fdlev,$frel);
}
} elsif ($fdlev == 3) {
if ($indcom >0) {
# 1 3 x >0
if ($sexcol eq "red") {
$frel="Granddaughter";
} elsif ($sexcol eq "blue") {
$frel="Grandson";
} else {
$frel="Grandchild";
}
} else {
# 1 3 x 0
if ($sexcol eq "red") {
$frel="Wife of Grandson";
} elsif ($sexcol eq "blue") {
$frel="Husband of Granddaughter";
} else {
$frel="Spouse of Grandchild";
}
}
} elsif ($fdlev > 3) {
if ($fdlev == 4) {
$fprefix="";
} elsif ($fdlev == 5) {
$fprefix="2nd ";
} elsif ($fdlev == 6) {
$fprefix="3rd ";
} else {
$fprefix=$fdlev-3 . "th ";
}
if ($indcom >0) {
# 1 >3 x >0
if ($sexcol eq "red") {
$frel="${fprefix}Great-granddaughter";
} elsif ($sexcol eq "blue") {
$frel="${fprefix}Great-grandson";
} else {
$frel="${fprefix}Great-grandchild";
}
} else {
# 1 >3 x 0
if ($sexcol eq "red") {
$frel="Wife of ${fprefix}Great-grandson";
} elsif ($sexcol eq "blue") {
$frel="Husband of ${fprefix}Great-granddaughter";
} else {
$frel="Spouse of ${fprefix}Great-grandchild";
}
}
}
# Ancestor level 2
} elsif ($falev == 2) {
if ($fdlev == 1) {
if ($indcom >0) {
# 2 1 x >0
if ($sexcol eq "red") {
$frel="Mother";
} elsif ($sexcol eq "blue") {
$frel="Father";
} else {
$frel="Parent";
}
} else {
# 2 1 x 0
if ($sexcol eq "red") {
$frel="Step-mother";
} elsif ($sexcol eq "blue") {
$frel="Step-father";
} else {
$frel="Step-parent";
}
}
} elsif ($fdlev == 2) {
if ($famcom >0) {
if ($indcom > 0) {
# 2 2 >0 >0
if ($sexcol eq "red") {
$frel="Sister";
} elsif ($sexcol eq "blue") {
$frel="Brother";
} else {
$frel="Sibling";
}
} else {
# 2 2 >0 0
if ($sexcol eq "red") {
$frel="UNK2210red";
} elsif ($sexcol eq "blue") {
$frel="UNK2210blue";
} else {
$frel="UNK2210black";
}
}
} else {
if ($indcom > 0) {
# 2 2 0 >0
if ($sexcol eq "red") {
$frel="Half-sister";
} elsif ($sexcol eq "blue") {
$frel="Half-brother";
} else {
$frel="Half-sibling";
}
} else {
# 2 2 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-brother";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-sister";
} else {
$frel="Spouse of half-sibling";
}
} else {
if ($sexcol eq "red") {
$frel="Sister-in-law";
} elsif ($sexcol eq "blue") {
$frel="Brother-in-law";
} else {
$frel="Sibling-in-law";
}
}
}
}
} elsif ($fdlev == 3) {
if ($famcom >0) {
if ($indcom > 0) {
# 2 3 >0 >0
if ($sexcol eq "red") {
$frel="Niece";
} elsif ($sexcol eq "blue") {
$frel="Nephew";
} else {
$frel="Nibling";
}
} else {
# 2 3 >0 0
if ($sexcol eq "red") {
$frel="UNK2310red";
} elsif ($sexcol eq "blue") {
$frel="UNK2310blue";
} else {
$frel="UNK2310black";
}
}
} else {
if ($indcom > 0) {
# 2 3 0 >0
if ($sexcol eq "red") {
$frel="Half-niece";
} elsif ($sexcol eq "blue") {
$frel="Half-nephew";
} else {
$frel="Half-nibling";
}
} else {
# 2 3 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-nephew";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-niece";
} else {
$frel="Spouse of half-nibling";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of nephew";
} elsif ($sexcol eq "blue") {
$frel="Husband of niece";
} else {
$frel="Spouse of nibling";
}
}
}
}
} elsif ($fdlev > 3) {
if ($fdlev == 4) {
$fprefix="";
} elsif ($fdlev == 5) {
$fprefix="Great ";
} elsif ($fdlev == 6) {
$fprefix="2nd Great ";
} elsif ($fdlev == 7) {
$fprefix="3rd Great ";
} else {
$fprefix=$fdlev-4 . "th Great ";
}
if ($famcom >0) {
if ($indcom > 0) {
# 2 >3 >0 >0
if ($sexcol eq "red") {
$frel="${fprefix}Grandniece";
} elsif ($sexcol eq "blue") {
$frel="${fprefix}Grandnephew";
} else {
$frel="${fprefix}Grandnibling";
}
} else {
# 2 >3 >0 0
if ($sexcol eq "red") {
$frel="Wife of ${fprefix}Grandnephew";
} elsif ($sexcol eq "blue") {
$frel="Husband of ${fprefix}Grandniece";
} else {
$frel="Spouse of ${fprefix}Grandnibling";
}
}
} else {
if ($indcom > 0) {
# 2 >3 0 >0
if ($sexcol eq "red") {
$frel="Half-${fprefix}Grandniece";
} elsif ($sexcol eq "blue") {
$frel="Half-${fprefix}Grandnephew";
} else {
$frel="Half-${fprefix}Grandnibling";
}
} else {
# 2 >3 0 0
if ($sexcol eq "red") {
$frel="Wife of half-${fprefix}Grandnephew";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-${fprefix}Grandniece";
} else {
$frel="Spouse of half-${fprefix}Grandnibling";
}
}
}
}
# Ancestor level 3
} elsif ($falev == 3) {
if ($fdlev == 1) {
if ($indcom >0) {
# 3 1 x >0
if ($sexcol eq "red") {
$frel="Grandmother";
} elsif ($sexcol eq "blue") {
$frel="Grandfather";
} else {
$frel="Grandparent";
}
} else {
# 3 1 x 0
if ($sexcol eq "red") {
$frel="Wife of Grandfather";
} elsif ($sexcol eq "blue") {
$frel="Husband of Grandmother";
} else {
$frel="Spouse of Grandparent";
}
}
} elsif ($fdlev == 2) {
if ($famcom >0) {
# 3 2 >0 x
if ($sexcol eq "red") {
$frel="Aunt";
} elsif ($sexcol eq "blue") {
$frel="Uncle";
} else {
$frel="Pibling";
}
} else {
# 3 2 0 >0
if ($indcom >0) {
if ($sexcol eq "red") {
$frel="Half-aunt";
} elsif ($sexcol eq "blue") {
$frel="Half-uncle";
} else {
$frel="Half-uncle/aunt";
}
} else {
# 3 2 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-uncle";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-aunt";
} else {
$frel="Spouse of half-uncle/aunt";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of uncle";
} elsif ($sexcol eq "blue") {
$frel="Husband of aunt";
} else {
$frel="Spouse of uncle/aunt";
}
}
}
}
}
}
# Ancestor level 4 and above
if ($falev > 3) {
if ($falev == 4) {
$fprefix="";
} elsif ($falev == 5) {
$fprefix="2nd ";
} elsif ($falev == 6) {
$fprefix="3rd ";
} else {
$fprefix=$falev-3 . "th ";
}
if ($falev == 5) {
$gprefix="";
} elsif ($falev == 6) {
$gprefix="2nd ";
} elsif ($falev == 7) {
$gprefix="3rd ";
} else {
$gprefix=$falev-4 . "th ";
}
if ($fdlev == 1) {
if ($indcom >0) {
# >3 1 x >0
if ($sexcol eq "red") {
$frel="${fprefix}Great-grandmother";
} elsif ($sexcol eq "blue") {
$frel="${fprefix}Great-grandfather";
} else {
$frel="${fprefix}Great-grandparent";
}
} else {
# >3 1 x 0
if ($sexcol eq "red") {
$frel="Wife of ${fprefix}Great-grandfather";
} elsif ($sexcol eq "blue") {
$frel="Husband of ${fprefix}Great-grandmother";
} else {
$frel="Spouse of ${fprefix}Great-grandparent";
}
}
} elsif (($falev == 4) && ($fdlev == 2)) {
if ($famcom >0) {
# 4 2 >0 x
if ($sexcol eq "red") {
$frel="Grandaunt";
} elsif ($sexcol eq "blue") {
$frel="Granduncle";
} else {
$frel="Granduncle/aunt";
}
} else {
if ($indcom >0) {
# 4 2 0 >0
if ($sexcol eq "red") {
$frel="Half-grandaunt";
} elsif ($sexcol eq "blue") {
$frel="Half-granduncle";
} else {
$frel="Half-granduncle/aunt";
}
} else {
# 4 2 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-granduncle";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-grandaunt";
} else {
$frel="Spouse of half-granduncle/aunt";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of granduncle";
} elsif ($sexcol eq "blue") {
$frel="Husband of grandaunt";
} else {
$frel="Spouse of granduncle/aunt";
}
}
}
}
} elsif (($falev >4) && ($fdlev == 2)) {
if ($famcom >0) {
# >4 2 >0 x
if ($sexcol eq "red") {
$frel="${gprefix}Great-grandaunt";
} elsif ($sexcol eq "blue") {
$frel="${gprefix}Great-granduncle";
} else {
$frel="${gprefix}Great-granduncle/aunt";
}
} else {
# >4 2 0 >0
if ($indcom >0) {
if ($sexcol eq "red") {
$frel="Half-${gprefix}great-grandaunt";
} elsif ($sexcol eq "blue") {
$frel="Half-${gprefix}great-granduncle";
} else {
$frel="Half-${gprefix}great-granduncle/aunt";
}
} else {
# >4 2 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-${gprefix}great-granduncle";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-${gprefix}great-grandaunt";
} else {
$frel="Spouse of half-${gprefix}great-granduncle/aunt";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of ${gprefix}great-granduncle";
} elsif ($sexcol eq "blue") {
$frel="Husband of ${gprefix}great-grandaunt";
} else {
$frel="Spouse of ${gprefix}great-granduncle/aunt";
}
}
}
}
}
}
# End of ancestor level 4 and above
# Cousins
if (($falev > 2) && ($fdlev > 2)) {
if ($falev == 3) {
$cprefix="1st";
} elsif ($falev == 4) {
$cprefix="2nd";
} elsif ($falev == 5) {
$cprefix="3rd";
} else {
$cprefix=$falev-2 . "th";
}
# Do cousins not removed
if ($falev == $fdlev) {
if ($famcom >0) {
# n n >0 x
$frel="${cprefix} cousin";
} else {
if ($indcom >0) {
# n n 0 >0
$frel="Half-${cprefix} cousin";
} else {
# n n 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-$cprefix cousin";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-$cprefix cousin";
} else {
$frel="Spouse of half-$cprefix cousin";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of $cprefix cousin";
} elsif ($sexcol eq "blue") {
$frel="Husband of $cprefix cousin";
} else {
$frel="Spouse of $cprefix cousin";
}
}
}
}
# Do cousins removed below
} elsif ($falev < $fdlev) {
$remlev=$fdlev-$falev;
if ($remlev == 1) {
$rprefix="once";
} elsif ($remlev == 2) {
$rprefix="twice";
} else {
$rprefix=$remlev . " times";
}
if ($famcom >0) {
$frel="${cprefix} cousin $rprefix removed";
} else {
if ($indcom >0) {
# m n>m 0 >0
$frel="Half-${cprefix} cousin $rprefix removed";
} else {
# m n>m 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-$cprefix cousin $rprefix removed";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-$cprefix cousin $rprefix removed";
} else {
$frel="Spouse of half-$cprefix cousin $rprefix removed";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of $cprefix cousin $rprefix removed";
} elsif ($sexcol eq "blue") {
$frel="Husband of $cprefix cousin $rprefix removed";
} else {
$frel="Spouse of $cprefix cousin $rprefix removed";
}
}
}
}
# Do cousins removed above
} elsif ($falev > $fdlev) {
if ($fdlev == 3) {
$cprefix="1st";
} elsif ($fdlev == 4) {
$cprefix="2nd";
} elsif ($fdlev == 5) {
$cprefix="3rd";
} else {
$cprefix=$fdlev-2 . "th";
}
$remlev=$falev-$fdlev;
if ($remlev == 1) {
$rprefix="once";
} elsif ($remlev == 2) {
$rprefix="twice";
} else {
$rprefix=$remlev . " times";
}
if ($famcom >0) {
$frel="${cprefix} cousin $rprefix removed";
} else {
if ($indcom >0) {
# n m<n 0 >0
$frel="Half-${cprefix} cousin $rprefix removed";
} else {
# n m<n 0 0
if (substr($fsprel,0,1) eq "H") {
if ($sexcol eq "red") {
$frel="Wife of half-$cprefix cousin $rprefix removed";
} elsif ($sexcol eq "blue") {
$frel="Husband of half-$cprefix cousin $rprefix removed";
} else {
$frel="Spouse of half-$cprefix cousin $rprefix removed";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of $cprefix cousin $rprefix removed";
} elsif ($sexcol eq "blue") {
$frel="Husband of $cprefix cousin $rprefix removed";
} else {
$frel="Spouse of $cprefix cousin $rprefix removed";
}
}
}
}
}
}
# End of cousins
# Check to see if more than one relation for this individual
if ($multrels == 1) {
$frel="$frel +";
}
Dprint("R","R alev dlev famcom indcom for $fikey\n");
Dprint("R","R $fikey $falev $fdlev $famcom $indcom fskey=$fskey relation=$frel $fullnameplus{$fikey}\n");
} else {
# Already determined relation
$frel=$relation{$fikey};
}
return $frel;
}
# Get parents of child-in-law
# 1 2 x 0
sub Parentsofinlaw {
my $fikey=$_[0];
my $falev=$_[1];
my $fdlev=$_[2];
my $frel=$_[3];
my $fpkey;
my $flkey;
my $fx;
# Look for family of parents of child
$fpkey=$indfamc{$fikey,1};
# Check to see if we can find this family
if (exists($famrin{$fpkey})) {
$flkey=$husbkey{$fpkey};
if ($flkey ne "@@") {
if ($relation{$flkey} eq "") {
$relation{$flkey}="Father of $frel";
$sortalev{$flkey}=$falev;
$sortdlev{$flkey}=$fdlev;
Dprint("I","$relation{$flkey} alev=$falev,dlev=$fdlev $fullnameplus{$flkey}\n");
}
}
$flkey=$wifekey{$fpkey};
if ($flkey ne "@@") {
if ($relation{$flkey} eq "") {
$relation{$flkey}="Mother of $frel";
$sortalev{$flkey}=$falev;
$sortdlev{$flkey}=$fdlev;
Dprint("I","$relation{$flkey} alev=$falev,dlev=$fdlev $fullnameplus{$flkey}\n");
}
}
} else {
# Cannot find this family
$fx=0;
}
}
# Look for all the in-laws
sub Getinlaws {
my $fikey=$_[0];
my $falev=1;
my $fdlev=0;
my $fx;
my $fpkey;
$fdlev=$fdlev+1;
# Check to see if we can find this individual
if (exists($rin{$fikey})) {
$fpkey=$preffamkey{$fikey};
Dprint("I","Check for spouses of alev=$falev,dlev=$fdlev $fullnameplus{$fikey}\n");
my $fnum=$indfamsnum{$fikey};
my $fi;
my $ffkey;
my $fskey;
my $fpkey;
my $flkey;
my $fcnum;
my $fj;
my $fckey;
# Find all the families for this person
if ($fnum > 0) {
$fi=0;
while ($fi < $fnum) {
$fi=$fi+1;
$ffkey=$indfams{$fikey,$fi};
# Check to see if we can find this family with a spouse
if (exists($famrin{$ffkey})) {
$fskey="@@";
if ($wifekey{$ffkey} eq $fikey) {
$fskey=$husbkey{$ffkey};
} elsif ($husbkey{$ffkey} eq $fikey) {
$fskey=$wifekey{$ffkey};
}
if ($fskey ne "@@") {
# Found a spouse
# Look for family of parents of spouse
$fpkey=$indfamc{$fskey,1};
# Check to see if we can find this family
if (exists($famrin{$fpkey})) {
$flkey=$husbkey{$fpkey};
if ($flkey ne "@@") {
if ($relation{$flkey} eq "") {
$relation{$flkey}="Father-in-law";
$sortalev{$flkey}=2;
$sortdlev{$flkey}=1;
Dprint("I","In-law $relation{$flkey} alev=2,dlev=1 $fullnameplus{$flkey}\n");
}
}
$flkey=$wifekey{$fpkey};
if ($flkey ne "@@") {
if ($relation{$flkey} eq "") {
$relation{$flkey}="Mother-in-law";
$sortalev{$flkey}=2;
$sortdlev{$flkey}=1;
Dprint("I","In-law $relation{$flkey} alev=2,dlev=1 $fullnameplus{$flkey}\n");
}
}
$fcnum=$childkeynum{$fpkey};
if ($fcnum > 0) {
$fj=0;
while ($fj < $fcnum) {
$fj=$fj+1;
$fckey=$childkey{$fpkey,$fj};
# Process child of parents of spouse
if ($relation{$fckey} eq "") {
$sortalev{$fckey}=2;
$sortdlev{$fckey}=4;
if ($sexcolor{$fckey} eq "red") {
$relation{$fckey}="Sister-in-law";
} elsif ($sexcolor{$fckey} eq "blue") {
$relation{$fckey}="Brother-in-law";
} else {
$relation{$fckey}="Sibling-in-law";
}
Dprint("I","In-law $relation{$fckey} alev=$falev,dlev=$fdlev $fullnameplus{$fckey}\n");
# Check to see if there is a spouse for this sibling-in-law
my $sfnum=$indfamsnum{$fckey};
my $sfi;
my $sffkey;
my $sfskey;
my $sfcnum;
my $sfj;
# Look for all the families
if ($sfnum > 0) {
$sfi=0;
while ($sfi < $sfnum) {
$sfi=$sfi+1;
$sffkey=$indfams{$fckey,$sfi};
# Check to see if we can find this family
if (exists($famrin{$sffkey})) {
$sfskey="@@";
if ($wifekey{$sffkey} eq $fckey) {
$sfskey=$husbkey{$sffkey};
} elsif ($husbkey{$sffkey} eq $fckey) {
$sfskey=$wifekey{$sffkey};
}
if ($sfskey ne "@@") {
# Spouse of sibling-in-law
$sortalev{$sfskey}=2;
$sortdlev{$sfskey}=4;
if ($sexcolor{$sfskey} eq "red") {
$relation{$sfskey}="Wife of $relation{$fckey}";
} elsif ($sexcolor{$sfskey} eq "blue") {
$relation{$sfskey}="Husband of $relation{$fckey}";
} else {
$relation{$sfskey}="Spouse of $relation{$fckey}";
}
Dprint("I","In-law $relation{$sfskey} alev=$falev,dlev=$fdlev $fullnameplus{$sfskey}\n");
}
}
}
}
}
}
} else {
# No children
$fx=0;
}
} else {
# Cannot find this family
$fx=0;
}
# Process all descendants for this spouse
$loopcntri=0;
Doinlawspouse($fskey,$falev,0,$fikey);
Dprint("L","Doinlawspouse loop count: $loopcntri\n");
}
} else {
# Cannot find this family
$fx=0;
}
}
} else {
# No families
$fx=0;
}
} else {
# Cannot find this individual
$fx=0;
}
}
sub Doinlawspouse {
my $fikey=$_[0];
my $falev=$_[1];
my $fdlev=$_[2];
my $fx;
$loopcntri=$loopcntri+1;
Dprint("l","loopcntri=$loopcntri, fikey=$fikey\n");
if ($loopcntri > $loopmax) {
PrintHTML("<br>Getfamily loopcntr exceeded $loopmax<br>");
PrintHTML("Inconsistent or invalid GED file, aborting<br>") ;
} else {
$fdlev=$fdlev+1;
# Check to see if we can find this individual
if (exists($rin{$fikey})) {
Dooneinlaw($fikey,$falev,$fdlev,"");
my $fnum=$indfamsnum{$fikey};
my $fi;
my $ffkey;
my $fskey;
my $fcnum;
my $fj;
my $fckey;
# Look for all the families
if ($fnum > 0) {
$fi=0;
while ($fi < $fnum) {
$fi=$fi+1;
$ffkey=$indfams{$fikey,$fi};
# Check to see if we can find this family
if (exists($famrin{$ffkey})) {
$fskey="@@";
if ($wifekey{$ffkey} eq $fikey) {
$fskey=$husbkey{$ffkey};
} elsif ($husbkey{$ffkey} eq $fikey) {
$fskey=$wifekey{$ffkey};
}
if ($fskey ne "@@") {
# Spouse of in-law
Dooneinlaw($fskey,$falev,$fdlev,$fikey);
}
$fcnum=$childkeynum{$ffkey};
if ($fcnum > 0) {
$fj=0;
while ($fj < $fcnum) {
$fj=$fj+1;
$fckey=$childkey{$ffkey,$fj};
Doinlawspouse($fckey,$falev,$fdlev);
}
} else {
# No children
$fx=0;
}
} else {
# Cannot find this family
$fx=0;
}
}
} else {
# No families
$fx=0;
}
} else {
# Cannot find this individual
$fx=0;
}
}
}
# Process one inlaw descendant in the tree
sub Dooneinlaw {
my $fikey=$_[0];
my $falev=$_[1];
my $fdlev=$_[2];
my $fskey=$_[3]; # Key of spouse
my $fnewrel;
if ($relation{$fikey} eq "") {
$relation{$fikey}=Determinlawrelation($fikey,$falev,$fdlev,$fskey);
}
}
# For this person, determine the relationship to the individual
sub Determinlawrelation {
my $fikey=$_[0];
my $falev=$_[1];
my $fdlev=$_[2];
my $fskey=$_[3]; # Key of spouse
my $frel="UNKNOWN";
my $sexcol;
my $fprefix="";
my $gprefix="";
$sortalev{$fikey}=2;
$sortdlev{$fikey}=5;
$sexcol=$sexcolor{$fikey};
# Level 1
if ($falev == 1) {
if ($fdlev == 1) {
# Ignore other spouses of spouse
$frel="";
} elsif ($fdlev == 2) {
# alev dlev
# 1 2
if ($fskey eq "") {
if ($sexcol eq "red") {
$frel="Stepdaughter";
} elsif ($sexcol eq "blue") {
$frel="Stepson";
} else {
$frel="Stepchild";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of stepson";
} elsif ($sexcol eq "blue") {
$frel="Husband of stepdaughter";
} else {
$frel="Spouse of stepchild";
}
}
} elsif ($fdlev == 3) {
# 1 3
if ($fskey eq "") {
if ($sexcol eq "red") {
$frel="Stepgranddaughter";
} elsif ($sexcol eq "blue") {
$frel="Stepgrandson";
} else {
$frel="Stepgrandchild";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of stepgrandson";
} elsif ($sexcol eq "blue") {
$frel="Husband of stepgranddaughter";
} else {
$frel="Spouse of stepgrandchild";
}
}
} elsif ($fdlev > 3) {
if ($fdlev == 4) {
$fprefix="";
} elsif ($fdlev == 5) {
$fprefix="2nd ";
} elsif ($fdlev == 6) {
$fprefix="3rd ";
} else {
$fprefix=$fdlev-3 . "th ";
}
if ($fskey eq "") {
# 1 >3
if ($sexcol eq "red") {
$frel="Step${fprefix}great-granddaughter";
} elsif ($sexcol eq "blue") {
$frel="Step${fprefix}great-grandson";
} else {
$frel="Step${fprefix}great-grandchild";
}
} else {
if ($sexcol eq "red") {
$frel="Wife of step${fprefix}great-grandson";
} elsif ($sexcol eq "blue") {
$frel="Husband of step${fprefix}great-granddaughter";
} else {
$frel="Spouse of step${fprefix}great-grandchild";
}
}
}
} else {
Dprint("I","ERROR alev=$falev,dlev=$fdlev for $fikey $fullnameplus{$fikey}\n");
}
Dprint("I","In-law alev=$falev,dlev=$fdlev,relation=$frel $fullnameplus{$fikey}\n");
return $frel;
}
# Output Relatives HTML page
sub Printpage {
if (($nogen == 0) && ($iscgi == 0)) {
open (HTML,">$htmlfile") or die "Can't open $htmlfile: $!";
Dprint("G","Generating $htmlfile ...\n");
} else {
Dprint("G","Generating CGI HTML output ...\n");
}
open(MOD,"<$modfile") or die "Can't open $modfile: $!";
Dprint("G","Reading $modfile ...\n");
$cntr=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 =~ /^<!DOCTYPE html>/) {
if ($iscgi == 1) {
$line=$cgihead;
}
PrintHTML("$line\n\n");
Dprint("G","Print header: $line\n");
} elsif ($line =~ /^.+xXx/) {
Dprint("G","Got xXx at line $cntr: $line\n");
if ($line =~ /^.+xRELLINEx/) {
$line =~ s/<!-- xXxRELLINEx -->//;
$rellsave=$line;
Dprint("G","Relative model line: $rellsave\n");
# Print all the lines in the relative table
Getrelatives($arg,0,"");
if ($sby eq "r") {
# Sort order is currently surname alphabetical order in @keysbyrel
# Change it to sort by relation type
@keysbyrel=sort(Sortbyrel keys(%rin));
Dprint("s","\nbyrel\n");
foreach $x (@keysbyrel) {
Dprint("s","$x $sorttyp{$x} $sortseq{$x} $sortalev{$x} $sortdlev{$x} $fullnameplus{$x}\n");
}
$numrin=scalar(keys(%rin));
$numkeysbyrel=@keysbyrel;
Dprint("L","numind=$numind numrin=$numrin numkeysbyrel=$numkeysbyrel numrelines=$numrelines\n");
}
if ($numrelines > 0) {
# Note that this array starts with index 0
$i=0;
while ($i < $numrelines) {
$key=$keysbyrel[$i];
if ($relation{$key} ne "") {
if ($preffamkey{$key} eq "") {
$j="@@";
} else {
$j=$preffamkey{$key};
}
Printrelline($sexcolor{$key},$j,$fullnameplus{$key},$relation{$key});
Dprint("S","$key $fullnameplus{$key}\n");
}
$i=$i+1;
}
}
} else {
# Modify line and then write it
$line =~ s/xXxRINx/$rin{$key}/;
$line =~ s/xXxFAMLINKx/$pfamlink/;
$line =~ s/xXxINDEXLINKx/href=\"..\/IDXSurname.html\"/;
$line =~ s/xXxRELRLINKx/href=\"genrel.cgi?ind=$arg&sby=r\"/;
$line =~ s/xXxRELALINKx/href=\"genrel.cgi?ind=$arg&sby=a\"/;
$line =~ s/xXxFULLNAMEx/$hindname/;
PrintHTML("$line\n");
Dprint("G","Modified model line: $line\n");
}
} else {
# If not inside relative table just write line
PrintHTML("$line\n");
Dprint("G","Copy model line: $line\n");
}
}
close MOD;
if (($nogen == 0) && ($iscgi == 0)) {
close HTML;
}
}
sub Printrelline {
my $dscolor=$_[0];
my $dpkey=$_[1];
my $dname=$_[2];
my $drel=$_[3];
my $dlink="href=\"..\/FAM$dpkey.html\"";
# Model line has been saved in rellsave
$line=$rellsave;
$line =~ s/xXxCOLORx/$dscolor/g;
$line =~ s/xXxRELLINKx/$dlink/;
$line =~ s/xXxRELNAMEx/$dname/;
$line =~ s/xXxRELATIONx/$drel/;
PrintHTML("$line\n");
Dprint("G","Modified relative table line: $line\n");
}
sub PrintHTML {
my $htmldata=$_[0];
if ($nogen == 0) {
if ($iscgi == 0) {
print HTML "$htmldata";
} else {
print "$htmldata";
}
}
}
sub Sortbyrel {
# Note: sorttyp and sortseq are currently not used
$sorttyp{$a} <=> $sorttyp{$b}
or
$sortseq{$a} <=> $sortseq{$b}
or
$sortalev{$a} <=> $sortalev{$b}
or
$sortdlev{$a} <=> $sortdlev{$b}
or
$a cmp $b;
}
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 "-check") {
$check=1;
++$i;
} elsif (($i+1) <= $#ARGV) {
if ($ARGV[$i] eq "-d") {
# enable debug mode
$debug = $ARGV[++$i];
++$i;
} elsif ($ARGV[$i] eq "-sby") {
# get sortby param
$sby = $ARGV[++$i];
++$i;
} else {
Usage();
}
} else {
if ($arg eq "") {
$arg=$ARGV[$i];
print "Not running CGI, argument is: $arg\n";
++$i;
} else {
Usage();
}
}
}
}
}
# 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] [-check] [-nogen] [-d <debuglevel>] <arg>\n";
print "-help = Display this help information\n";
print "-check = Check input files for validity\n";
print "-nogen = Suppress creating output HTML data\n";
print "-d <debuglevel> = Enable printout for various debug levels\n";
print "<arg> = input argument\n";
exit;
}