package LIMS::Model::Roles::Outreach;

use Moose::Role;
use Data::Dumper;

has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
	for qw(pain_options_map nodal_options_map followup_options_map);

has overdue_notification => (
    is        => 'ro',
    isa       => 'HashRef[LIMS::DB::Outreach::RequestNotification]',
    default   => sub { {} },
    lazy      => 1,
    traits    => ['Hash'],
    handles   => {
        set_notifications => 'set',
        get_notification_event => 'get',
        has_notification_event => 'exists',
    },
);

has notification_events => (
    is          => 'ro',
    isa         => 'ArrayRef[Str]',
    lazy_build  => 1,
    traits      => ['Array'],
    handles => {
        all_events  => 'elements',
        get_event   => 'get',
        # final_event => 'pop', # can't do this in a loop !!
    },
);

use Lingua::EN::Words2Nums;

#-------------------------------------------------------------------------------
sub do_outreach_request_pack_dispatch {
    my ($self, $data) = @_;

    my $followup_option_id = $data->{followup_option_id};
    my $request_id         = $data->{_request_id};

    { # request_followup table:
        my @args = (
            followup_option_id => $followup_option_id,
            request_id         => $request_id,
        ); # warn Dumper \@args;
        LIMS::DB::Outreach::RequestFollowup->new(@args)->save;
    }

    # returns { period => duration } if option_id is a chronological one (eg six_week):
    my $pack_dispatch_args = $self->get_pack_dispatch_args($followup_option_id); # href
    if ( $pack_dispatch_args ) { # warn Dumper $pack_dispatch_args;
        my $request = LIMS::DB::Request->new(id => $request_id)->load;
            # warn $request->created_at->ymd;
		# add ref_date:
		$pack_dispatch_args->{ref_date} = $request->created_at;
		my $pack_dispatch_date = 
			$self->calculate_pack_dispatch_date($pack_dispatch_args);
            # warn $pack_dispatch_date->ymd;
        do {
            my %h = (
                request_id => $request_id,
                pack_due   => $pack_dispatch_date,
            );
            LIMS::DB::Outreach::RequestPackDispatch->new(%h)->save;
        };
    }
}

#-------------------------------------------------------------------------------
# returns { duration_type => number } if option_id is a chronological one (eg six_week)
sub get_pack_dispatch_args {
    my ($self, $option_id) = @_;

    my $options_map = $self->followup_options_map; # warn Dumper $options_map;

    my $followup_option_name = $options_map->{$option_id}->{option};
        # warn $followup_option_name; # eg six_month

    my ($numerical_word, $duration_type)
        = $followup_option_name =~ /^(\w+)_(week|month)$/;
        # warn Dumper [$numerical_word, $duration_type]; # eg six, month

    return 0 unless $numerical_word && $duration_type
        && grep $duration_type =~ /$_\Z/, qw(week month);

    $duration_type .= 's'; # week => weeks, month => months

    my $number = words2nums($numerical_word); # warn $number;
    die qq!cannot extract a number from "$numerical_word"!
        unless defined $number; # could be 0 (zero_month)
    return { duration_type => $duration_type, number => $number };
}

# shared with do_outreach_request_pack_dispatch() & M::Outreach::update_followup 
sub calculate_pack_dispatch_date {
    my $self = shift;
    my $args = shift; # href of ref_date, period & integer

    # duration_type = weeks / months, ref_date = datetime, num = 0, 1, 2, 3, etc
	my ($duration_type, $ref_date, $number)	= map $args->{$_},
		qw(duration_type ref_date number);

    my $dispatch_due_date = $ref_date->clone # clone to avoid changing it
        ->add($duration_type => $number)  # + no. of weeks / months (could be 0)
        ->subtract(days => 14); # - 14 days
    return $dispatch_due_date;
}

#-------------------------------------------------------------------------------
sub calculate_pack_return_date { # returns datetime object
    my ($self, $ref_date) = @_; # datetime object

    # return date = pack dispatch date + 40 days:
    my $return_date = $ref_date->clone->add(days => 40); # clone otherwise updates orig!!
    return $return_date;
}

=begin
#------------------------------------------------------------------------
sub get_followup_option_duration { # no longer in use
    my ($self, $option_id) = @_;

    my $options_map = $self->followup_options_map;
    my $followup_durations = $self->followup_durations_map;

    my $followup_option_name = $options_map->{$option_id}->{option}; # eg six_month
    my $int = $followup_durations->{$followup_option_name}; # eg 0, 3, 6, etc

    return $int;
}

#------------------------------------------------------------------------
sub followup_durations_map { # no longer in use
    my $self = shift;

    my $opts = $self->followup_options_map;

    # get list of 'option' col:
    my @follow_up_opts = map $opts->{$_}->{option}, keys %$opts;
    # warn Dumper \@follow_up_opts;

    my %map;
    for my $option (@follow_up_opts) {
        if ( $option =~ /(\w+)_month/ ) {
            my $num = words2nums($1); # warn Dumper $num;
            $map{$option} = $num if defined $num; # could be zero
        }
    } # warn Dumper \%map;

    return \%map;
}
=cut

#-------------------------------------------------------------------------------
sub get_overdue_pack_notifications {
    my $self = shift;

	my $o = LIMS::DB::Outreach::RequestNotification::Manager
		->get_request_notifications( require_objects => 'event' );
	return $o;
}

#-------------------------------------------------------------------------------
# skip notification if final notification already sent, or less overdue than next event date:
sub skip_notification {
    my ($self, $data) = @_;

    my $today = LIMS::Local::Utils::time_now();
    my $dfm   = DateTime::Format::MySQL->new();

    my $notification_event = $self->get_notification_event($data->{request_id});
    my $pack_sent_date     = $dfm->parse_date($data->{pack_sent});
    my $event_id           = $notification_event->event_id;

    my $prev_event  = $notification_event->event->days; # most recent notification
    my $next_event  = $self->get_event($event_id) || 0; # works due to array pos
    my $final_event = $self->get_event(-1); # last entry in events list
    my $delta_days  = $pack_sent_date->delta_days($today)->delta_days;
        # warn Dumper [$delta_days, $prev_event, $next_event, $final_event];

    return ( $prev_event == $final_event || $delta_days < $next_event );
}

#-------------------------------------------------------------------------------
sub questionnaire_options {
	my $self = shift;

	my %h = (
		followup_options => $self->followup_options_map,
		nodal_options    => $self->nodal_options_map,
		pain_options     => $self->pain_options_map,
	);
	return \%h;
}

#-------------------------------------------------------------------------------
# method shared by C::Outreach::edit_followup & M::Outreach (get_menu_options & update_followup)
sub _build_followup_options_map {
    my $self = shift;
    my $db_name = $self->lims_db->database eq 'lims_test' ? 'outreach_test' : 'outreach';
    return $self->lims_dbix->select("${db_name}.followup_options", # backtick keywords:
        [ qw(id label `option` `position`) ] )->map_hashes('id');
}

#-------------------------------------------------------------------------------
sub _build_pain_options_map {
    my $self = shift;

    my $dbix = $self->lims_dbix;

	my $sql = q!select id, `option` from outreach.pain_options!;
    my $map = $dbix->query($sql)->map;
    return $map;
}

#-------------------------------------------------------------------------------
sub _build_nodal_options_map {
    my $self = shift;

    my $dbix = $self->lims_dbix;

	my $sql = q!select id, `option` from outreach.nodal_options!;
    my $map = $dbix->query($sql)->map;
    return $map;
}

#-------------------------------------------------------------------------------
sub _build_notification_events {
    my $self = shift;

    my $dbix = $self->lims_dbix;

    my $sql = 'select `days` from outreach.notification_events order by id';
    my $o = $dbix->query($sql)->flat; # warn Dumper $o;
    return $o;
}

1;