#!/usr/bin/perl -w
# @(#) add html to allow a gedcom file to be used in a browser
#
#..# systems:
#..# sites:
#..# level:
#..# publish: y
#..# keys:
#..# date: Fri Aug 4 12:07:59 BST 2006
#..# vers: 1.1 15/Aug/2006-14:59
$comment = q(
Many most-likely unconnected names are included here, linked to a father with a forename consisting of dots. This is so that their details are recorded for later discovery.
Entries such as
NOTE D 1 9c 306
mean 'From Ancestry Death record, vol 9c, page 306, aged 1'.
);
my $debug;
my $verbose;
my $this = $0;
my $tag = $this; $tag =~ s!^.*/!!;
my $usage = "Usage:\t$tag ";
my $help = qq{$tag creates an html version of a gedcom file on stdout.
The resulting file can be opened in a web browser and can be 'walked' by
clicking internal reference links.
The resulting page is in three parts:
i) A comments area that you may set by editing the script before use.
ii) The gedcom data. This is unchanged from the original, except that the
different gedcom levels are indented accordingly, and the wherever an
gedcom internal code is used as a reference it appears as a clickable
link to the place in the file where it is defined.
iii) A clickable list of names that are defined in the file. As part (ii) is
generated all person names are accumulated along with their internal
code. Clicking on these links takes you to the apprpriate definition.
};
sub vi() {
qx(/usr/bin/ksh -c ". ~/.profile; \
lockvi $this" /dev/tty 2>&1);
}
sub dbg() {
qx(/usr/bin/perl -d $this @ARGV /dev/tty 2>&1);
}
use Data::Dumper;
while (defined($ARGV[0]) && ($_ = $ARGV[0], /^-/)) {
shift;
last if /^--$/;
vi, exit if /^-vi/;
dbg, exit if /^-dbg/;
if (/^-D(.*)/) { $debug = $1 }
if (/^-v/) { $verbose++ }
if (/^-h/) { print STDERR "$usage\n\n$help\n"; exit }
# ... # other switches
}
$gedfile = $_;
$webfile = $_;
$webfile =~ s/\.ged$//;
$webfile .= '.html';
#print Dumper(%x) if $debug;
$nl='';
$head = '
gedcom
';
print $head;
print $comment;
#print " Start of gedcom data
";
#print " Go to Names table
\n";
print "\n";
$level = 0;
open(GED, $gedfile) or die "Can't open $gedfile";
while () {
chomp;
($l, $k, @rest) = split;
$v = "@rest";
if ($l == 0) {
$class = defined($v) ? $v : "";
$IDinClass = $k;
next;
}
if ($l < 2) { $sect = "" }
if ($class eq 'INDI' && $k eq 'NAME') {
$ind{$IDinClass} = "$v";
push @{ $fulln{$v} }, $IDinClass;
($fnames, $sname) = split(/\//, $v);
push @{ $surn{$sname} }, $IDinClass;
push @{ $forns{$fnames} }, $IDinClass;
next;
}
if ($class eq 'INDI' && $k eq 'BIRT') {
$sect = $k;
next;
}
if ($class eq 'INDI' && $k eq 'DATE' && $sect eq 'BIRT') {
$birth{$IDinClass} = $v;
next;
}
if ($class eq 'INDI' && $k eq 'DEAT') {
$sect = $k;
next;
}
if ($class eq 'INDI' && $k eq 'DATE' && $sect eq 'DEAT') {
$death{$IDinClass} = $v;
next;
}
if ($class eq 'FAM' && $k eq 'HUSB') {
$ind{$IDinClass} = "$ind{$v}" if defined($ind{$v});
next;
}
if ($class eq 'FAM' && $k eq 'WIFE') {
$ind{$IDinClass} = sprintf("(%s) +=+ (%s)",
defined($ind{$IDinClass}) ? $ind{$IDinClass} : "?",
defined($ind{$v}) ? $ind{$v} : "?"
);
next;
}
}
close(GED);
print Dumper(%surn) if $debug;
print "\n";
open(GED, $gedfile) or die "Can't re-open $gedfile";
while () {
last if $debug;
chomp;
($l, $k, @rest) = split;
$v = "@rest";
while ($level > $l) {
print "";
$level--;
}
while ($level < $l) {
print "