File Coverage

blib/lib/Gedcom/Family.pm
Criterion Covered Total %
statement 33 52 63.4
branch 6 20 30.0
condition n/a
subroutine 9 14 64.2
pod 2 11 18.1
total 50 97 51.5


line stmt bran cond sub pod time code
1             # Copyright 1998-2013, Paul Johnson (paul@pjcj.net)
2              
3             # This software is free. It is licensed under the same terms as Perl itself.
4              
5             # The latest version of this software should be available from my homepage:
6             # http://www.pjcj.net
7              
8             # documentation at __END__
9              
10 11     11   68 use strict;
  11         21  
  11         459  
11              
12             require 5.005;
13              
14             package Gedcom::Family;
15              
16 11     11   57 use Gedcom::Record 1.20;
  11         152  
  11         239  
17              
18 11     11   44 use vars qw($VERSION @ISA);
  11         18  
  11         5245  
19             $VERSION = "1.20";
20             @ISA = qw( Gedcom::Record );
21              
22             sub husband {
23 1788     1788 0 2174 my $self = shift;
24 1788         3222 my @a = $self->resolve($self->tag_value("HUSB"));
25 1788 50       4095 wantarray ? @a : $a[0]
26             }
27              
28             sub wife {
29 1788     1788 0 2158 my $self = shift;
30 1788         2973 my @a = $self->resolve($self->tag_value("WIFE"));
31 1788 50       4087 wantarray ? @a : $a[0]
32             }
33              
34             sub parents {
35 0     0 0 0 my $self = shift;
36 0         0 ($self->husband, $self->wife)
37             }
38              
39             sub number_of_children {
40 0     0 1 0 my ($self) = @_;
41 0         0 my $nchi = $self->tag_value("NCHI");
42 0 0       0 defined $nchi ? $nchi : ($#{[$self->children]} + 1)
  0         0  
43             }
44              
45             sub children {
46 1764     1764 0 2095 my $self = shift;
47 1764         3053 my @a = $self->resolve($self->tag_value("CHIL"));
48 1764 50       4684 wantarray ? @a : $a[0]
49             }
50              
51             sub boys {
52 0     0 0 0 my $self = shift;
53 0         0 my @a = grep { $_->tag_value("SEX") !~ /^F/i } $self->children;
  0         0  
54 0 0       0 wantarray ? @a : $a[0]
55             }
56              
57             sub girls {
58 0     0 0 0 my $self = shift;
59 0         0 my @a = grep { $_->tag_value("SEX") !~ /^M/i } $self->children;
  0         0  
60 0 0       0 wantarray ? @a : $a[0]
61             }
62              
63             sub add_husband {
64 1     1 0 2 my $self = shift;
65 1         3 my ($husband) = @_;
66 1 50       5 $husband = $self->{gedcom}->get_individual($husband)
67             unless UNIVERSAL::isa($husband, "Gedcom::Individual");
68 1         8 $self->add("husband", $husband);
69 1         4 $husband->add("fams", $self->{xref});
70             }
71              
72             sub add_wife {
73 2     2 0 5 my $self = shift;
74 2         4 my ($wife) = @_;
75 2 50       7 $wife = $self->{gedcom}->get_individual($wife)
76             unless UNIVERSAL::isa($wife, "Gedcom::Individual");
77 2         7 $self->add("wife", $wife);
78 2         8 $wife->add("fams", $self->{xref});
79             }
80              
81             sub add_child {
82 2     2 0 4 my $self = shift;
83 2         5 my ($child) = @_;
84 2 50       9 $child = $self->{gedcom}->get_individual($child)
85             unless UNIVERSAL::isa($child, "Gedcom::Individual");
86 2         9 $self->add("child", $child);
87 2         5 $child->add("famc", $self->{xref});
88             }
89              
90             sub print {
91 0     0 1   my $self = shift;
92 0 0         $self->_items if shift;
93 0           $self->SUPER::print; $_->print for @{$self->{items}};
  0            
  0            
94             }
95              
96             1;
97              
98             __END__