#!/usr/bin/perl
#
# Written by Dave Yearke, dave@yearke.net
#

use Gedcom;
use Getopt::Std;

@censusyears = ("1850", "1860", "1870", "1880", "1900", "1910", "1920", "1930");

die "Usage: $0 <GEDCOM file>\n" if ($#ARGV < 0);

getopts("s");
$gedcom_file = @ARGV[0];
die "Can't find GEDCOM file \"$gedcom_file\"" if (! -f $gedcom_file);
print "Using GEDCOM file: $gedcom_file\n\n";

$gedcom = Gedcom->new(gedcom_file => $gedcom_file);

foreach my $person ($gedcom->individuals) {
    my $name = $person->name;
    my $surname = $person->surname;
    my @census = $person->record("census");
    my @censusdates;
    my $birthyear = 0, $deathyear = 9999, $emigyear = 0, $printline = "";

    next if (@census == 0);

    $name =~ s#/##g;  # Get rid of the slashes around the surname.

    if ($person->birth) {
        $birthyear = $person->birth->date;
        $birthyear = 0 unless ($birthyear =~ s/.*([0-9]{4}).*/\1/);
    }
    if ($person->death) {
        $deathyear = $person->death->date;
        $deathyear = 9999 unless ($deathyear =~ s/.*([0-9]{4}).*/\1/);
    }
    if ($person->emig) {
        $emigyear = $person->emig->date;
        $emigyear = 0 unless ($emigyear =~ s/.*([0-9]{4}).*/\1/);
    }

    foreach my $census (@census) {
        if (grep($census->date, @censusyears)) {
            push(@censusdates, $census->date);
        } else {
            warn "Unknown census date " . $census->date . " for $name.\n";
        }
    }
    $printline = sprintf("%-35s ", "$name:");
    foreach my $year (@censusyears) {
        if (grep(/$year/, @censusdates)) {
            $printline .= sprintf("%4s ", $year);
        } elsif ($year > $birthyear && $year <= $emigyear) {
            $printline .= "x" x 4 . " ";
        } elsif ($year < $birthyear || $year > $deathyear) {
            $printline .= "-" x 4 . " ";
        } else {
            $printline .= " " x 5;
        }
    }
    $printline .= "\n";
    push(@printlines, "$surname:$printline");
}
foreach $line (sort @printlines) {
    my ($surname, $printline) = split(/:/, $line, 2);
    print $printline
        if (!($opt_s && substr($printline, 35) !~ /    /));
}