# Copyright 2001-2013, Paul Johnson (paul@pjcj.net)

# This software is free.  It is licensed under the same terms as Perl itself.

# The latest version of this software should be available from my homepage:
# http://www.pjcj.net

# documentation at __END__

use strict;

require 5.005;

package Gedcom::CGI;

use CGI qw(:cgi :html);

use Gedcom 1.20;

use vars qw($VERSION);
$VERSION = "1.20";

sub gedcom {
    my ($gedcom_file) = @_;
    $gedcom_file = "/var/www/Gedcom/$gedcom_file.ged";
    Gedcom->new(gedcom_file => $gedcom_file, read_only => 1);
}

sub dates {
    my ($i) = @_;
    "(" . ($i->get_value("birth date") || "") . " - "
    . ($i->get_value("death date") || "") . ")"
}

sub indi_link {
    my ($g, $i) = @_;
    return p("Unknown") unless $i;
    p(
        a({-href => "/cgi-bin/gedcom.cgi?op=indi&gedcom=$g&indi=" . $i->xref},
            $i->cased_name) .
        " " . dates($i)
    )
}

sub main {
    my $gedcom = param("gedcom");
    my $ged = gedcom($gedcom);
    print header,
          start_html,
          h1($gedcom),
          map(indi_link($gedcom, $_), $ged->individuals),
          end_html;
}

sub event_row {
    my ($n, @e) = @_;
    map td([
        $n,
        $_->get_value("date")  || "-",
        $_->get_value("place") || "-",
    ]), @e
}

sub indi_row {
    my ($g, $n, @i) = @_;
    map td([
        $n,
        a(
            {-href => "/cgi-bin/gedcom.cgi?op=indi&gedcom=$g&indi=" . $_->xref},
            $_->cased_name
        ),
        $_->get_value("birth date") || "-",
        $_->get_value("death date") || "-",
    ]), @i
}

sub indi {
    my $gedcom = param("gedcom");
    my $indi   = param("indi");
    my $ged    = gedcom($gedcom);
    my $i      = $ged->get_individual($indi);
    my $name   = $i->cased_name;
    my $sex    = uc $i->sex;
    my $spouse = $sex eq "M" ? "wife" : $sex eq "F" ? "husband" : "spouse";

    print
        header,
        start_html(-title => $name),
        h1($name),
        table(
            { -border => undef },
            Tr(
                { align => "CENTER", valign => "TOP" },
                [
                    th([ "Event", "Date", "Place"]),
                    event_row("Birth",       $i->birth),
                    event_row("Christening", $i->christening),
                    event_row("Baptism",     $i->baptism),
                    event_row("Baptism",     $i->bapl),
                    event_row("Endowment",   $i->endowment),
                    event_row("Death",       $i->death),
                    event_row("Burial",      $i->burial),
                    event_row("Marriage",    $i->get_record(qw(fams marriage))),
                ]
            )
        ),
        p,
        table(
            { -border => undef },
            Tr(
                { align => "CENTER", valign => "TOP" },
                [
                    th([ "Relation", "Name", "Birth", "Death"]),
                    indi_row($gedcom, ucfirst $spouse ,$i->$spouse()),
                    indi_row($gedcom, "Father", $i->father),
                    indi_row($gedcom, "Mother", $i->mother),
                    indi_row($gedcom, "Child",  $i->children),
                ]
            )
        ),
        p(a({-href => "/cgi-bin/gedcom.cgi?op=main&gedcom=$gedcom"}, $gedcom)),
        end_html;
}

1;

__END__

=head1 NAME

Gedcom::CGI - Basic CGI routines for Gedcom.pm

Version 1.20 - 17th September 2017

=head1 SYNOPSIS

  use Gedcom::CGI;

=head1 DESCRIPTION

=head1 METHODS

=cut