File Coverage

blib/lib/Date/Pregnancy.pm

Criterion	Covered	Total	%
statement	101	103	98.0
branch	24	28	85.7
condition	18	27	66.6
subroutine	17	17	100.0
pod	3	3	100.0
total	163	178	91.5

package Date::Pregnancy;

use strict;
use warnings;
use DateTime;
use Carp;
use Clone qw(clone);
use POSIX qw(ceil);
use vars qw($VERSION @ISA @EXPORT_OK);
require Exporter;
use POSIX qw(floor);
use 5.008;    #5.8.0

$VERSION = '0.04';
@ISA     = qw(Exporter);

@EXPORT_OK = qw(
    calculate_birthday calculate_week calculate_month
    _countback _266days _40weeks
);

use constant AVG_CYCLE => 28;
use constant DAY       => ( 60 * 60 * 24 );

sub _40weeks {
    my $dt = shift
        || carp "first_day_of_last_period parameter is mandatory";
    return undef unless ( ref $dt );

    my $birthday = clone($dt);
    $birthday->add( weeks => 40 );

    return $birthday;
}

sub _266days {
    my ( $dt, $period_cycle_length ) = @_;

    unless ( ref $dt ) {
        carp "first_day_of_last_period parameter is mandatory";
        return undef;
    }

    if ( !$period_cycle_length ) {
        carp "period_cycle_length parameter is mandatory";
        return undef;
    }

    my $birthday = clone($dt);
    if ( $period_cycle_length > 28 ) {
        $birthday->add( seconds =>
                ( DAY * floor( $period_cycle_length * 0.85 * ( 2 / 3 ) ) ) );

    } elsif ( $period_cycle_length < 29 ) {
        $birthday->add( seconds => ( DAY * ( $period_cycle_length / 2 ) ) );
    }
    $birthday->add( days => 266 );

    return $birthday;
}

sub _countback {
    my $dt = shift
        || carp "first_day_of_last_period parameter is mandatory";
    return undef unless ( ref $dt );

    my $birthday = clone($dt);

    $birthday->add( days => 7 );
    $birthday->subtract( months => 3 );
    $birthday->add( years => 1 );

    #if ($dt->month < 3) {
    #}

    return $birthday;
}

sub calculate_birthday {
    my %params = @_;

    my $method = $params{'method'} || '266days';

    my $period_cycle_length = $params{'period_cycle_length'} || AVG_CYCLE;

    my $first_day_of_last_period = $params{'first_day_of_last_period'}
        || carp "first_day_of_last_period parameter is mandatory";
    return undef unless ( ref $first_day_of_last_period );

    my $calculation = "_$method";
    my @methods     = qw(_countback _266days _40weeks);

    unless ( grep {/$method/} @methods ) {
        croak "Unknown method: $params{'method'}";
    }

    $calculation .= '($first_day_of_last_period';

    if ( $method eq '266days' ) {
        $calculation .= ', $period_cycle_length';
    }
    $calculation .= ');';

    my $birthday = eval("$calculation");
    croak $@ if $@;

    return $birthday;
}

sub calculate_week {
    my %params = @_;

    my $period_cycle_length = $params{'period_cycle_length'} || AVG_CYCLE;

    my $now = $params{'date'} || DateTime->now;
    $now->set_time_zone('UTC');

    my $method = $params{'method'} || '40weeks';

    my $birthday;
    if ( $params{'birthday'} ) {
        $birthday = $params{'birthday'};

    } else {
        $birthday = calculate_birthday(
            first_day_of_last_period => $params{'first_day_of_last_period'},
            period_cycle_length      => $period_cycle_length,
            method                   => $method,
        );
        return undef unless ( ref $birthday );
    }
    $birthday->set_time_zone('UTC');

    $birthday->subtract( months => 9 );

    my $duration = $birthday->delta_days($now);

    return ( $duration->weeks + 1 );
}

sub calculate_month {
    my %params = @_;

    my $period_cycle_length = $params{'period_cycle_length'} || AVG_CYCLE;

    my $now = $params{'date'} || DateTime->now;
    $now->set_time_zone('UTC');

    my $method = $params{'method'} || '40weeks';

    my $birthday;
    if ( $params{'birthday'} ) {
        $birthday = $params{'birthday'};

    } else {
        $birthday = calculate_birthday(
            first_day_of_last_period => $params{'first_day_of_last_period'},
            period_cycle_length      => $period_cycle_length,
            method                   => $method,
        );
        return undef unless ( ref $birthday );
    }
    $birthday->set_time_zone('UTC');

    $birthday->subtract( months => 9 );

    my $duration = $birthday->delta_md($now);

    return ( $duration->months + 1 );
}

1;

__END__