#!/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

    ' if $#marriages >= 0; print "

    Children (and their parents)

    ' if $#children >= 0; print ''; } } exit 0;