File Coverage

blib/lib/Gedcom/Date/Approximated.pm

Criterion	Covered	Total	%
statement	31	38	81.5
branch	7	10	70.0
condition			n/a
subroutine	8	11	72.7
pod	5	7	71.4
total	51	66	77.2

package Gedcom::Date::Approximated;

use strict;

use vars qw($VERSION @ISA);

our $VERSION = '0.10';
@ISA = qw/Gedcom::Date/;

use Gedcom::Date;
use Params::Validate qw/validate OBJECT SCALAR/;

sub new {
    my $class = shift;
    my %p = validate( @_,
                      { date => {type => OBJECT,
                                 isa  => 'Gedcom::Date::Simple',
                                },
                        type => {type => SCALAR,
                                 regex => qr/(?ix)(?:   ab(?:ou)?t      |
                                                        cal(?:culated)? |
                                                        est(?:imated)? )/,
                                 default => 'ABT',
                                },
                      } );

    my $type = uc $p{type};
    if ($type eq 'ABOUT') {
        $type = 'ABT';
    } elsif (length $type > 3) {
        $type = substr $type, 0, 3;
    }

    my $self = {
                    date => $p{date}->clone,
                    abt => $type,
    };
    return bless $self, $class;
}

sub parse {
    my $class = shift;
    my ($str) = @_;

    my ($abt, $date) = $str =~ /^(ABT|CAL|EST) (.*)$/
        or return;

    my $date_s = Gedcom::Date::Simple->parse($date)
        or return;

    my $self = bless {
        date => $date_s,
        abt => $abt
    }, $class;

    return $self;
}

sub gedcom {
    my $self = shift;

    if (!defined $self->{gedcom}) {
        $self->{gedcom} = $self->{abt} . ' ' . $self->{date}->gedcom();
    }
    $self->{gedcom};
}

sub latest {
    my ($self) = @_;

    return $self->{date}->latest;
}

sub earliest {
    my ($self) = @_;

    return $self->{date}->earliest;
}

sub sort_date {
    my ($self) = @_;

    return $self->{date}->sort_date;
}

my %text = (
    en => 'about %0',
    nl => 'rond %0',
);

sub text_format {
    my ($self, $lang) = @_;

    return ($text{$lang}, $self->{date});
}

1;

__END__