#!/usr/local/bin/perl
# The gendesc.cgi script is used to display the descendant 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 $key="";
my $iscgi=0;
my $check=0;
my $nogen=0;
my $debug="";
my $modfile="desmodel.html";
my $htmlfile="gendesc.html";
my $debugfile="gendesc.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 $pfamlink="";
my $hindname="";

my $indfile;
my $famfile;
my $namfile;
my @lineargs;

my %rin;
my %famrin;
my %namrin;
my %indfamsnum;
my %indfamc;
my %indfams;
my %sexcolor;
my %fullnameplus;
my %preffamkey;
my %childkeynum;
my %husbkey;
my %wifekey;
my %childkey;

my $desclsave;
my $loopcntr;
my $loopmax;

# The sequence of called subroutines is:
# Getopts
# Getdatafiles
# Checkdata
# Printpage
#  Getfamily *
#   Printdescline
#   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;
}
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;
          $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]; }
             }
          }
       }
   }
   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;
   while (<NAM>) {
       s/\r[\n]*/\n/gm;  # get rid of carriage returns, we only want line feeds
       chomp;
       $line=$_;
       $cntr=$cntr+1;
       Dprint("2","$cntr: $line\n");
       $key="";
       $preffamin="";
       $scolorin="";
       $fnamein="";
       @lineargs = split(/\s/,$line,4);
       if (defined $lineargs[0]) { $key=$lineargs[0]; }
       if (defined $lineargs[1]) { $preffamin=$lineargs[1]; }
       if (defined $lineargs[2]) { $scolorin=$lineargs[2]; }
       if (defined $lineargs[3]) { $fnamein=$lineargs[3]; }
       Dprint("2","key: $key\n");
       Dprint("2","fnamein: $fnamein\n");
       if ($key ne "") { 
           $namrin{$key}=$key;
           $preffamkey{$key}=$preffamin;
           $sexcolor{$key}=$scolorin;     
           $fullnameplus{$key}=$fnamein; 
       }
   }
   close NAM;

# <key> <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;
           $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");
            }
         }
      }
   }
} 

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 =~ /^.+xDESCLINEx/) {
                 $line =~ s/<!-- xXxDESCLINEx -->//;
                 $desclsave=$line;
                 Dprint("G","Descendant model line: $desclsave\n");
                 # Print all the lines in the descendant table
                 $loopcntr=0;
                 Getfamily($arg,0,"");
                 Dprint("L","Getfamily loop count: $loopcntr\n");
             } else {
                # Modify line and then write it
                $line =~ s/xXxRINx/$rin{$key}/;
                $line =~ s/xXxFAMLINKx/$pfamlink/;
                $line =~ s/xXxINDEXLINKx/href=\"..\/IDXSurname.html\"/;
                $line =~ s/xXxFULLNAMEx/$hindname/;
                PrintHTML("$line\n");
                Dprint("G","Modified model line: $line\n");
             }
          } else {
             # If not inside descendent table just write line
             PrintHTML("$line\n");
             Dprint("G","Copy model line: $line\n");
          }
      }
      close MOD;
      if (($nogen == 0) && ($iscgi == 0)) {
         close HTML;
      }
}

sub Getfamily {
    my $fikey=$_[0];
    my $flev=$_[1];
    my $indent=$_[2];
    my $fx;
    my $fpkey;
    my $fscolor;
    my $ftext;
  $loopcntr=$loopcntr+1;
  Dprint("l","loopcntr=$loopcntr, fikey=$fikey\n"); 
  if ($loopcntr > $loopmax) {
     PrintHTML("<br>Getfamily loopcntr exceeded $loopmax<br>");
     PrintHTML("Inconsistent or invalid GED file, aborting<br>") ;
  } else {
    $flev=$flev+1;
    my $pindent=$indent;
    $indent=$indent . "::::::";
    # Check to see if we can find this individual
    if (exists($rin{$fikey})) {
       $fpkey=$preffamkey{$fikey};
       $fscolor=$sexcolor{$fikey};
       $ftext=$pindent . "$flev-$fullnameplus{$fikey}";
       Printdescline($fscolor,$fpkey,$ftext);
       Dprint("F","$ftext\n");
       Dprint("S","$fikey $fullnameplus{$fikey}\n");
       my $fnum=$indfamsnum{$fikey};
       my $fi;
       my $ffkey;
       my $fskey;
       my $fcnum;
       my $fj;
       my $fckey;
       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 "@@") {
                    $fpkey=$preffamkey{$fskey};
                    $fscolor=$sexcolor{$fskey};
                    $ftext=$pindent . ":+$fullnameplus{$fskey}";
                    Printdescline($fscolor,$fpkey,$ftext);
                    Dprint("F","$ftext\n");
                    Dprint("S","$fskey $fullnameplus{$fskey}\n");
                 }   
                 $fcnum=$childkeynum{$ffkey};
                 if ($fcnum > 0) {
                    $fj=0;         
                    while ($fj < $fcnum) {
                        $fj=$fj+1;
                        $fckey=$childkey{$ffkey,$fj};
                        Getfamily($fckey,$flev,$indent);
                    }
                 } else {
                    # No children
                    $fx=0;
                 }
              } else {
                 # Cannot find this family
                 $fx=0;
              }
          }
       } else {
          # No families
          $fx=0;
       }
    } else {
       # Cannot find this individual
       $fx=0;
    }
  }
} 

sub Printdescline {
    my $dscolor=$_[0];
    my $dpkey=$_[1];
    my $dtext=$_[2];
    my $dlink="href=\"..\/FAM$dpkey.html\"";
    # Model line has been saved in desclsave
    $line=$desclsave;
    $line =~ s/xXxCOLORx/$dscolor/;
    $line =~ s/xXxDESCLINKx/$dlink/;
    $line =~ s/xXxDESCTEXTx/$dtext/;
    $line =~ s/:/ /g;
    PrintHTML("$line\n");
    Dprint("G","Modified descendant table line: $line\n");
}

sub PrintHTML {
    my $htmldata=$_[0];
    if ($nogen == 0) {
       if ($iscgi == 0) {
          print HTML "$htmldata";
       } else {
          print "$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 "-check") {
              $check=1;
              ++$i;
          } elsif (($i+1) <= $#ARGV) { 
              if ($ARGV[$i] eq "-d") {
                  # enable debug mode
                  $debug = $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;
}