#!/usr/bin/perl
#
# Written by Dave Yearke, dave@yearke.net
#
#
# Use the GEDCOM package:
#
use Gedcom;
#
# Make sure the name of the GEDCOM file is passed to the script:
#
die "Usage: $0 <GEDCOM file>\n" if ($#ARGV < 0);
#
# Make sure the file exists and open it:
#
$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);
#
# This section deals with records for individuals:
#
print "Now scanning individual records ...\n\n";
foreach my $person ($gedcom->individuals) {
    my $name = $person->name;
    $name =~ s#/##g;  # Get rid of the slashes around the surname.
    #
    # Basic Information:
    #
    if ($person->birth) {
        if ($person->birth->date) {
            my $birthyear = $person->birth->date;
            $birthyear = 9999 unless ($birthyear =~ s/.*([0-9]{4}).*/\1/);
            print "$name: No death date for person born prior to 1900.\n"
                if (($birthyear < 1900) &&
                    !($person->death && $person->death->date));
        } else {
            print "$name: Missing birth date.\n";
        }
    } else {
        print "$name: Missing birth field.\n";
    }
    #
    # Census information:
    #
    my @census = $person->record("census");

    next if (@census == 0);  # Skip the rest if no census fields

    print "$name: Missing reference number field.\n" if (!$person->reference);

    foreach my $census (@census) {
        print "$name: Missing census place.\n" if (!$census->place);
        print "$name: Missing census source.\n" if (!$census->source);
        print "$name: Missing census note.\n" if (!$census->note);
        
        if ($census->date) {
            if ($person->reference) {
                my $shortyear = substr($census->date, 2, 2);
                print "$name: Missing census date $shortyear in " .
                      "reference number field.\n"
                    if (!grep(/$shortyear/, split(m#/#, $person->reference)));
            }
            if (!$person->birth || !$person->birth->date) {
                print "$name: Birth year can be obtained from " .
                      $census->date . " census.\n";
            } else {
                print "$name: Birth month can be obtained from 1900 census.\n"
                    if (($person->birth->date !~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/i) &&
                        ($census->date =~ /1900/) &&
                        ($person->birth->note !~ /illegible/));
            }
        } else {
            print "$name: Missing census date.\n";
        }
    }

}
#
# This section deals with records for families:
#
print "\n\nNow scanning family records ...\n\n";

foreach my $family ($gedcom->families) {
    my $famname, $husband, $wife;

    if ($family->husband) {
        $husband = ($family->husband)[0]->name;
        $husband =~ s#/##g;  # Get rid of the slashes around the surname.
    } else {
        $husband = "?";
    }
    if ($family->wife) {
        $wife = ($family->wife)[0]->name;
        $wife =~ s#/##g;  # Get rid of the slashes around the surname.
    } else {
        $wife = "?";
    }
    print "$famname: Missing spouse name.\n"
        if (($famname = "$husband --- $wife") =~ /\?/);

    if ($family->marriage) {
        print "$famname: Missing marriage date.\n"
            if (!$family->marriage->date);
    } else {
        print "$famname: Missing marriage field.\n";
    }
}