#!/usr/bin/perl
$id = shift @ARGV;
$opt_v = 0;
$dir = $ENV{'HOME'}.'/etc/genea/';
@date = gmtime((stat("${dir}person.db"))[9]);
$date[5] += 1900 if $date[5] < 1900;
$date = sprintf("%s, %02d %s %d %02d:%02d:%02d GMT",
substr('SunMonTueWedThuFriSat', 3*$date[6], 3), $date[3],
substr('JanFebMarAprMayJunJulAugSepOctNovDec', 3*$date[4], 3),
@date[5,2,1,0]);
$sfmt = "HTTP/1.0 %d %s\r\nContent-Type: text/html\r\nLast-Modified: $date\r\n\r\n";
$hfmt = "".
"
%s%s
";
$tfmt = "";
sub fmt { local($v,@ids) = @_;
local($id, @fmt, $i, @p, $s);
for $id (@ids) {
if ($id == 0) { push(@fmt, "?
"); next; }
@p = split(/\|/, $person{$id}, 12);
$_ = "" . join(' ', @p[1,0]) . "";
if ($v > 0) {
$_ .= "
$p[2]" if length($p[2]);
for $i (3..6) { $p[$i] =~ s/ /\ /g; }
if ($opt_v == 1 || $p[5] ne 'alive') {
$s = "* $p[3] $p[4]";
$_ .= "
$s" if length($s) > 3;
}
if ($p[5] ne 'alive') {
$s = "+ $p[5] $p[6]";
$_ .= "
$s" if length($s) > 3;
}
}
push(@fmt, "$_
");
}
@fmt;
}
sub fmtc { local($id, @cs) = @_;
local(@fmt, $c, $p,@p);
for $c (@cs) {
$_ = '' . &name($c);
@p = split(/\|/, $parent{$c});
for $p (@p) {
if ($p != $id) { $_ .= ' (' . &name($p) . ')'; last; }
}
push(@fmt, $_);
}
@fmt;
}
sub fmtm { local($id, @ms) = @_;
local(@f, @fmt, $m);
for $m (@ms) {
@f = split(/\|/, $m, 10);
$_ = '' . &name($f[0]);
$_ .= ", $f[1]" if length($f[1]);
$_ .= ", $f[2]" if length($f[2]);
$_ .= '. ';
if (length($f[4]) || $f[3] !~ /^$|^not$/) {
$_ .= 'Divorced';
$_ .= ", $f[3]" if length($f[3]);
$_ .= ", $f[4]" if length($f[4]);
$_ .= '. ';
}
push(@fmt, $_);
}
@fmt;
}
sub name {
local($id) = @_;
return '?' unless $id && defined $person{$id};
local(@f) = split(/\|/, $person{$id});
"" . join(' ', @f[1,0]) . "";
}
if (!defined $id) {
printf $sfmt, 400, 'Missing search key';
printf $hfmt, ('Error: missing search key') x 2;
print 'This URL requires a search key.';
printf $tfmt;
}
elsif ($id !~ /^\d+$/) {
printf $sfmt, 400, 'Bad search key';
printf $hfmt, ('Error: bad search key') x 2;
print "`$id' is not a valid search key.";
printf $tfmt;
}
else {
dbmopen(person, "${dir}person", 0600);
dbmopen(parent, "${dir}parent", 0600);
dbmopen(child, "${dir}child", 0600);
dbmopen(marriage, "${dir}marriage", 0600);
if (!defined $person{$id}) {
printf $sfmt, 400, 'Unknown person';
printf $hfmt, ('Error: unknown person') x 2;
print "`$id' does not correspond to a known person.";
}
else {
$title = "Genealogical Record: " . &name($id);
@ancs = ($id);
for $i (0..7)
{ @ancs[$i+$i+1, $i+$i+2] = (split(/\|/, $parent{$ancs[$i]}),0,0)[0..1]; }
$m = $marriage{$id}; @marriages = defined $m ? split(/\n/, $m) : ();
$c = $child{$id}; @children = defined $c ? split(/\|/, $c) : ();
printf $sfmt, 200, 'Ok';
printf $hfmt, ($title) x 2;
print
"Parents, Grandparents and Great-grandparents
".
"".
join(' | ', &fmt(0, @ancs[7..14])).
" |
".
join(' | ', &fmt(1, @ancs[3..6])).
' |
'.
join(' | ', &fmt(1, @ancs[1..2])).
' |
'. (&fmt(1, $id))[0].
' |
';
print "Married
" . join('', &fmtm($id, @marriages)) . '
'
if $#marriages >= 0;
print "Children (and their parents)
" . join('', &fmtc($id, @children)) . '
'
if $#children >= 0;
print
'