#!/usr/bin/perl -w
use strict;
use lib "$ENV{'HOME'}/lib/perl";
require 'http.pl';
use vars qw(%gChild %gMarriage %gParent %gPerson);
sub children ($$);
sub fmt ($$);
sub Main ();
sub name ($$);
my $opt_v = ($0 =~ /\/private\//);
my $dir = $ENV{'HOME'}.'/etc/genea/';
my $mod_time = (stat("${dir}person.db"))[9];
my $slfmt = '
%s';
my $spfmt = q(
%s
); Main; # children $generation, $id # # list descendants of person $id who is in generation $generation sub children ($$) { my($generation, $id) = @_; my (%mData); my (@rows); # return value if (defined $gMarriage{$id}) { for my $s (split(/\n/, $gMarriage{$id})) { my @f = split(/\|/, $s); my $spouse = shift @f; $mData{$spouse} = '' unless defined $mData{$spouse}; my $i = "$f[0] $f[1]"; $mData{$spouse} .= sprintf($slfmt, "m. $i") if length($i) > 1; $i = "$f[2] $f[3]"; $mData{$spouse} .= sprintf($slfmt, "div. $i") if $i !~ /^(not)? $/; } } else { %mData = (); } if (defined $gChild{$id}) { my $s = $gChild{$id}; my $lastOtherParent = -1; my $otherParentIndex = $id % 2; my $nFullSibs = 0; for my $kid (split(/\|/, $s)) { my $nKidRows = 1; my $thisOtherParent = (split(/\|/, $gParent{$kid}))[$otherParentIndex]; { my $s = fmt -2*($generation+1), $kid; if ($generation < 1) { my @kidrows = children $generation+1, $kid; $nKidRows = $#kidrows + 1; if ($nKidRows > 0) { $kidrows[0] = "(.*?)
!$1
!g || ($notes = sprintf($spfmt, $notes)); $out .= $notes; } # add reference counts { my $refs = ''; $refs .= qq($id); if ($level > 0) { # descendants $refs .= " <$p[10]:$p[11]" if $gChild{$id} =~ /\|/; # ancestors $refs .= " >$p[8]:$p[9]" if $level == 4 && $p[8] > 0; } elsif ($level < 0) { # ancestors $refs .= " <$p[8]:$p[9]" if $level % 2 && $p[8] > 0; # descendants $refs .= " >$p[10]:$p[11]" if $level == -4 && $p[10] > 0; } $refs .= qq(); $out .= sprintf($level > 2 ? $slfmt : $spfmt, $refs); } } $out; # $out . " ($level)"; } # name $v, $id # return formatted string representing name corresponding to ID $id # $v - include tags pointing to person's page # $id - genealogical ID of subject sub name ($$) { my ($v, $id) = @_; return '?' unless (defined $id) && defined $gPerson{$id}; my (@f) = split(/\|/, $gPerson{$id}); my $n = join(' ', @f[1,0]); $v ? "$n" : $n; } sub Main () { my $id = shift @ARGV; if (defined $ENV{'HTTP_IF_MODIFIED_SINCE'}) { my $ims_time = $ENV{'HTTP_IF_MODIFIED_SINCE'}; $ims_time =~ s/;.*//; if (&http'canon_time($mod_time) le &http'parse_http_time($ims_time)) { print &http'format_http_header(304, 'Not Modified', undef, ''); warn "http cache hit\n"; exit 0; } } if (!defined $id) { print &http'format_http_reply(400, 'Missing search key', undef, '', 'Error: missing search key', 'Spouse | Children | Children-in-Law | Grandchildren |
---|---|---|---|
Self | Parents | Grandparents | GGParents | GGGParents". " |
---|---|---|---|---|
". &fmt(0,$ancs[0]) . " | ". &fmt(1,$ancs[1]) . " | ". &fmt(2,$ancs[3]) . " | ". &fmt(3,$ancs[7]) . " | ". &fmt(4,$ancs[15]) . " |
". &fmt(4,$ancs[16]) . " | ||||
". &fmt(3,$ancs[8]) . " | " . &fmt(4,$ancs[17]) . " | |||
". &fmt(4,$ancs[18]) . " | ||||
". &fmt(2,$ancs[4]) . " | " . &fmt(3,$ancs[9]) . " | " . &fmt(4,$ancs[19]) . " | ||
". &fmt(4,$ancs[20]) . " | ||||
". &fmt(3,$ancs[10]) . " | " . &fmt(4,$ancs[21]) . " | |||
". &fmt(4,$ancs[22]) . " | ||||
". &fmt(1,$ancs[2]) . " | ".&fmt(2,$ancs[5]). " | ". &fmt(3,$ancs[11]) . " | " . &fmt(4,$ancs[23]) . " | |
". &fmt(4,$ancs[24]) . " | ||||
". &fmt(3,$ancs[12]) . " | " . &fmt(4,$ancs[25]) . " | |||
". &fmt(4,$ancs[26]) . " | ||||
". &fmt(2,$ancs[6]) . " | " . &fmt(3,$ancs[13]) . " | " . &fmt(4,$ancs[27]) . " | ||
". &fmt(4,$ancs[28]) . " | ||||
". &fmt(3,$ancs[14]) . " | " . &fmt(4,$ancs[29]) . " | |||
". &fmt(4,$ancs[30]) . ' |
'. $kids); } } exit 0; }