use strict;
use warnings;

use Test::More tests => 126;

use Gedcom;

{
  my $gedcom_file = "gedcompm.ged";

  my $ged = Gedcom->new;
  isa_ok( $ged, 'Gedcom' );

  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("First line");
  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 my $n2 = $ged->add_note({ xref => "N100" }, "Note 2");

  ok $i4->add("note", "This is a note on one line");
  ok $i4->add("note", $n2);

  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");

  my $obj1 = $i5->add("OBJE", 12);
  my $obj2 = $i5->add("OBJE");
  $obj2->add("FORM", "qqq");
  $obj2->add("FILE", "rrr");

  ok $f1->add_wife($i5);

  ok $f1->delete;

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

  $ged->write($gedcom_file);

  {
    my $w = 0;
    local $SIG{ __WARN__ } = sub { $w++ };

    ok !$ged->validate, 'Gedcom file is not valid';
    is $w, 2, '2 warnings thrown';
  }

  ok -e $gedcom_file, "$gedcom_file exists";

  # check the gedcom file is correct
  ok open F1, $gedcom_file;
  my @ged_data = <DATA>;
  for (@ged_data)
  {
    my $f = <F1>;
    is $f, $_, "line $. matches" unless m{Ignore};
  }

  ok eof, 'No more lines to compare';
  ok close F1;
  ok unlink $gedcom_file;
}

__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-2013, Paul Johnson (paul@pjcj.net)
1   NOTE
2     CONT This output was generated by Gedcom.pm.
2     CONT Gedcom.pm is Copyright 1999-2013, Paul Johnson (paul@pjcj.net)
2     CONT Version 1.18 - 24th January 2013
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
1   NOTE This is a note on one line
1   NOTE @N2@

0 @I5@ INDI
1   NAME Susan /Bloggs/
1   CHR
2     DATE 11 May 1778
1   SEX F
1   OBJE 12
1   OBJE
2     FORM qqq
2     FILE rrr
1   FAMS F1

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

0 @N2@ NOTE Note 2

0 TRLR