use strict;
use warnings;
use Gedcom;
use Gedcom::LifeLines;

# usable as filter ? submit a patch
# Gedcom.pm line 56. test if ref $$self{file} is a GLOB
# (only if STDIN is seekable)

sub dot_header {
    print "digraph familly {
	node [ shape=box ]
    ";
}

sub dot_footer {
    print "}";
}

sub dot_individual_id {
    my $i = shift || $_ || return;
    'id'.$i->{xref};
}

sub dot_guilt_id { join '', sort @_ }

sub dot_add_person {
    my ($person) = @_;
    my ( $sn, $given ) = map { s/"/\\"/g; $_ }
	$person->surname
	, $person->given_names
    ;

    my $not_found = 'NA';
    my $birth = ($_ = $person->birth) ? $_->date : $not_found;
    $birth ||= $not_found; 

    my $death = ($_ = death($person)) ? $_->date : $not_found;
    $death ||= $not_found; 


    print dot_individual_id($person)
    , qq( [label="$given $sn\\n($birth - $death)"]\n);
    ; 

}

my $ged = Gedcom->new(shift) or die $!;

# my $jp = $ged->get_individual('Jean-Pierre');
# print "\t$_: $$jp{$_}\n" for keys %$jp;
# exit;
# for ( $jp->parents ) {
#     print "\t",$_->given_names,"\n";
# }

# print $jp->birth->date,"\n";

my %childs = ();
my %monoparental;

my $pcount=0;

sub build_tree {

    # the child and his id ($c)
    my $i = shift;
    my $c = dot_individual_id($i);

    # parents's ids 
    my ( $p1, $p2 ) = sort map {dot_individual_id} $i->parents;

    # orphan ? we don't carre about orphans ! 
    return unless $p1; 
    unless ( $p2 ) {
	$monoparental{$p1} = $c;
	return;
    }

    if (defined ($_ = $childs{$p1}{$p2})) {
	push @$_, $c;
    } else {
	$_ = $childs{$p1}{$p2} = [ $c ]
    }

}

my %sexual_results;

sub sexual_partners {
    print '{
	edge [ arrowhead=none ]
	node [ shape=point ]',"\n";

    for my $i ( keys %childs ) {
	for my $j ( keys %{$childs{$i}} ){
	    my $have_sex  = "${i}X${j}"; 
	    print "{ $i $j } -> $have_sex \n"; 
	    $sexual_results{$have_sex} = $childs{$i}{$j};
	}
	# delete $childs{$i};
    }
    print "}\n";

}

dot_header;
for my $i ( $ged->individuals ) {
    dot_add_person($i);
    build_tree($i);
}
sexual_partners;
while ( my ( $p, $c ) = each %sexual_results ) {
    print "$p -> $_\n" for @$c;
}
print "{ edge [ color=red ]\n"; 
while ( my ( $p, $c ) = each %monoparental ) {
    print "$p -> $c\n";
}
print "}\n"; 

dot_footer;

=end

digraph Nussbaum {

    Marie [label="Marie Nussbaum" ]
    Louis [label="Louis Nussbaum" ]

    // unions

    {
	edge [ arrowhead=none ]
	node [ shape=point ]
	{ Marie Louis } -> m123123 
    }
    
    m123123 -> { Jean_Louis Francoise Raymonde }
    Francoise -> { Marc Alexandra }
    Marc -> { Guillaume Alixe }

}