#!/usr/local/bin/perl -w

# Copyright 2002-2009, 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

# Version 1.16 - 24th April 2009

use strict;

use lib -d "t" ? "t" : "..";

require 5.005;

use Test;

use Gedcom 1.16;

$SIG{__WARN__} = sub {};

sub main()
{
  plan tests => 115;

  ok my $gedcom_file = "gedcompm.ged";
  $| = 1;
  ok my $ged = Gedcom->new;

  ok my $i1 = $ged->add_individual("O5");
  ok $i1->add("name", "Fred /Bloggs/");
  ok $i1->add("birth date", "20 Dec 1775");
  ok $i1->add("birth", ["date", 2], "21 Dec 1775");
  ok $i1->add(["birth", 2], "date", "22 Dec 1775");
  ok $i1->add("sex", "M");

  ok my $ix = $ged->add_individual("O");
  ok $ix->add("name", "John /Smith/");
  ok $ix->add("christening date", "15 July 1954");
  ok $ix->add("christening date", "25 July 1954");
  ok $ix->add("sex", "F");

  ok my $i2 = $ged->add_individual;
  ok $i2->add("name", "Betty /Bloggs/");
  ok $i2->add("christening date", "11 May 1777");
  ok $i2->add("sex", "F");

  ok my $i3 = $ged->add_individual;
  ok $i3->add("name", "Jane /Bloggs/");

  ok my $i4 = $ged->add_individual;
  ok $i4->add("name", "Joe /Bloggs/");
  ok $i4->add("birth date", "2 Feb 1802");
  ok $i4->set("birth date", "3 Feb 1802");
  ok $i4->add("sex", "M");

  ok my $f1 = $ged->add_family;
  ok $f1->add_husband($i1);
  ok $f1->add_wife($i2);
  ok $f1->add_child($i3);
  ok $f1->add_child($i4);

  ok my $n1 = $ged->add_note;
  ok $n1->add("cont", "This is a note.");
  ok $n1->add("cont", "Please take notice.");
  ok $n1->add("conc", "There's more.  O");
  ok $n1->add("conc", "k, that's it.");

  ok $i2->delete;

  ok my $i5 = $ged->add_individual;
  ok $i5->add("name", "Susan /Bloggs/");
  ok $i5->add("christening date", "11 May 1778");
  ok $i5->add("sex", "F");

  ok $f1->add_wife($i5);

  ok $f1->delete;

  ok $ged->renumber;
  ok $ged->order;

  $ged->write($gedcom_file);

  ok !$ged->validate;
  ok -e $gedcom_file;

  # check the gedcom file is correct
  ok open F1, $gedcom_file;
  my @ged_data = <DATA>;
  for (@ged_data)
  {
    my $f = <F1>;
    ok $f, $_ unless /Ignore/;
  }
  ok eof;
  ok close F1;
  ok unlink $gedcom_file;
}

main

__DATA__
0 HEAD
1   SOUR Gedcom.pm
2     NAME Gedcom.pm
2     VERS Ignore
2     CORP Paul Johnson
3       ADDR http://www.pjcj.net
2     DATA
3       COPR Copyright 1998-2009, Paul Johnson (paul@pjcj.net)
1   NOTE
2     CONT This output was generated by Gedcom.pm.
2     CONT Gedcom.pm is Copyright 1999-2009, Paul Johnson (paul@pjcj.net)
2     CONT Version 1.16 - 24th April 2009
2     CONT
2     CONT Gedcom.pm is free.  It is licensed under the same terms as Perl itself.
2     CONT
2     CONT The latest version of Gedcom.pm should be available from my homepage:
2     CONT http://www.pjcj.net
1   GEDC
2     VERS 5.5
2     FORM LINEAGE-LINKED
1   DATE Ignore
1   CHAR ANSEL
1   SUBM @SUBM1@

0 @SUBM1@ SUBM
1   NAME Ignore

0 @I1@ INDI
1   NAME Fred /Bloggs/
1   BIRT
2     DATE 20 Dec 1775
2     DATE 21 Dec 1775
1   BIRT
2     DATE 22 Dec 1775
1   SEX M
1   FAMS F1

0 @I2@ INDI
1   NAME John /Smith/
1   CHR
2     DATE 15 July 1954
2     DATE 25 July 1954
1   SEX F

0 @I3@ INDI
1   NAME Jane /Bloggs/
1   FAMC F1

0 @I4@ INDI
1   NAME Joe /Bloggs/
1   BIRT
2     DATE 3 Feb 1802
1   SEX M
1   FAMC F1

0 @I5@ INDI
1   NAME Susan /Bloggs/
1   CHR
2     DATE 11 May 1778
1   SEX F
1   FAMS F1

0 @N1@ NOTE
1   CONT This is a note.
1   CONT Please take notice.
1   CONC There's more.  O
1   CONC k, that's it.

0 TRLR