#!/usr/bin/env perl
#===============================================================================
#
#  DESCRIPTION:
#
# RFC.cgi uses different database for each centre but the same Trello board.
# Need to use database as source and then query Trello for updates. Then it
# wont get confused about cards from different centres.
#
# features
# updates status of records
# reinstates deleted records
# creates trello cards for rfcs with no associated card
# emails user when complete or rejected (live only)
#
#===============================================================================
package LIMS::Local::RfC;
our $VERSION = "0.01";
use Modern::Perl;
use utf8;
use Moose;
use namespace::autoclean;

use DDP;
use Try::Tiny;
use LIMS::Local::ScriptHelpers;
use LIMS::Local::IssueTracker;
use LIMS::Local::Utils;
use LIMS::Model::Email;
use FindBin qw($RealBin);

my $config  = LIMS::Local::Config->instance;
my $SERVICE = $config->{settings}->{service_email};
my $ADMIN   = $config->{settings}->{admin_contact};

my $tools = LIMS::Local::ScriptHelpers->new;
my $today = LIMS::Local::Utils::today;         # datetime object

has 'centre' => (
    is      => 'ro',
    isa     => 'Str',
    default => "leeds",
);

has 'tracker' => (
    is      => 'ro',
    isa     => 'LIMS::Local::IssueTracker',
    default => sub {
        LIMS::Local::IssueTracker->new();
    },
);

has 'database' => (
    is      => 'ro',
    isa     => 'DBIx::Simple',
    default => sub { $tools->dbix },
);

with 'LIMS::Local::Role::NotTestable' =>
  { unsafe => [qw/_send_acknowledgement/] };

# all rfc cardIDs that are neither complete or rejected
# param optional date range?
sub find_incomplete_rfcs {
    my $self = shift;

    my @results = $self->database->query( <<'EOS')->hashes;
SELECT r.id, username, reason, details, email, status, created, remote_id
FROM
  rfc r 
JOIN 
  users u ON r . user_id = u . id 
WHERE 
  status NOT IN( 'complete', 'rejected' )
  AND remote_id IS NOT NULL
EOS
    return @results;
}

# takes list of RfCs and updates their status in database
sub update_rfcs {
    my ( $self, @list ) = @_;

    foreach my $rfc (@list) {
        $rfc->{status} =
          ( $self->tracker->get_status_config_name( $rfc->{remote_id} ) )
          // "userdefinedlist";
        next
          unless $rfc->{status} =~
              /complete|rejected/;    # only update if finished
        $self->database->update(
            'rfc',
            { status => $rfc->{status} },
            { id     => $rfc->{id} }
        ) or die "couldn't update rfc table: $!";
        $self->_send_acknowledgement($rfc);
    }
    return 1;
}

# returns list of incomplete RfCs that are not on Trello
sub find_orphans {
    my $self    = shift;
    my @results = $self->database->query( <<'EOS')->hashes;
SELECT r.id, username, reason, details, email, status, created
FROM
  rfc r 
JOIN 
  users u ON r . user_id = u . id 
WHERE 
  status NOT IN( 'complete', 'rejected' )
  AND remote_id IS NULL
EOS
    return @results;
}

sub get_rfc {
    my $self   = shift;
    my $id     = shift;
    my $result = $self->database->query( <<'EOS', $id )->hash;
SELECT r.id, username, reason, details, email, status, created
FROM 
  rfc r 
JOIN 
  users u ON r.user_id = u.id 
  WHERE
r.id = ?
EOS
    return $result;
}

# relist on trello incase it is deleted. Tries to recover from archive first
sub recreate_issue {
    my $self = shift;
    my $rfc;
    if ( ref $_[0] eq 'HASH' ) {    # defined
        $rfc = shift;
    }
    else {
        my $id = shift;
        $rfc = $self->get_rfc($id);
    }
    my $not_found = 0;
    try {

        # does it exist bubble up
        $self->tracker->get_status( $rfc->{remote_id} );

        # if so, unarchive it so we can see it
        $self->tracker->unarchive_card( $rfc->{remote_id} );
    }
    catch {
        my $cardID = $self->tracker->create_issue(
            {
                name   => $self->_rfc_string($rfc),
                desc   => $self->_message_body($rfc),
                reason => $rfc->{reason}
            }
        );
        $self->database->update(
            'rfc',
            { remote_id => $cardID },
            { id        => $rfc->{id} }
        ) or die "couldn't update rfc table: $!";
    };

    return 1;

    # TODO better look in archive first so we dont loose any comments
}

# future
# read comments on possibly archived card to review its history
sub review_issue {
    my $self = shift;
}

# _send_acknowledgement only runs under production
sub _send_acknowledgement {
    my $self = shift;
    my $rfc  = shift;
    #say "LIVE CODE";

    my %mail = (
        config  => $config->{settings},
        subject => $self->_rfc_string($rfc) . ' ' . uc $rfc->{status},
    );    # _debug(\%mail); return 0; # 'some reason for mail failure';
    if ( $rfc->{status} eq 'complete' ) {
        $mail{message} = "Your request has been completed.\n";
    }
    elsif ( $rfc->{status} eq 'rejected' ) {
        $mail{message} = "Your request has been rejected. Please ask a member of the HILIS team for further details.\n";
    }
    $mail{message} .= "\n$mail{subject}\n" . "$rfc->{details}\n" . "\n";
    my @recipients = ( $ADMIN, $rfc->{email} );

    for my $addr (@recipients) {
        $mail{recipient} = $addr;    # DEBUG(\%mail);
        my $rtn = LIMS::Model::Email->send_message( \%mail )
          ;                          # returns Return::Value object
        return $rtn->string if $rtn->type ne 'success';
    }
}

sub _testing_send_acknowledgement {
    my $self = shift;
    my $rfc  = shift;
    say "TEST CODE";

    #$DB::single=1;

    my %mail = (
        config  => $config->{settings},
        subject => $self->_rfc_string($rfc),
    );    # _debug(\%mail); return 0; # 'some reason for mail failure';
    if ( $rfc->{status} eq 'complete' ) {
        $mail{message} = "Your request is now complete\n";
    }
    elsif ( $rfc->{status} eq 'rejected' ) {
        $mail{message} = "Your request has been rejected\n";
    }
    $mail{message} = "$mail{subject}\n" . "$rfc->{details}\n" . "\n";
    my @recipients = ( $ADMIN, $rfc->{email} );

    for my $addr (@recipients) {
        $mail{recipient} = $addr;    # DEBUG(\%mail);
        p \$addr;
    }
}

sub _rfc_string {
    my $self = shift;
    my $rfc  = shift;

    my $service_suffix = uc substr( $self->centre, 0, 1 );
    my $subject = sprintf 'HILIS RfC%s%s [%s]',
      $rfc->{id}, $service_suffix, uc $rfc->{username};

    return $subject;
}

sub _message_body {
    my $self = shift;
    my $vars = shift;
    my $date = $vars->{created} // $today->dmy;

    my $content = sprintf "Date: %s\nUsername: %s [%s]\nRFC ID: %s\n"
      . "Reason: %s\nStatus: %s\n\nDetails:  %s\n",
      $date, uc $vars->{username},
      $self->centre, @{$vars}{qw(id reason status details)};
    return $content;
}
__PACKAGE__->meta->make_immutable;

1;

__END__

=head1 NAME

LIMS::Local::RfC

=head1 VERSION

This documentation refers to LIMS::Local::RfC version 0.01

=head1 SYNOPSIS

    use LIMS::Local::RfC;

    my $rfc = LIMS::Local::RfC->new( database => $dbix );
    $rfc->find_incomplete_rfcs;
    my @orphans = $rfc->find_orphans;
    $rfc->recreate_issue($_) for @orphans;

=head1 DESCRIPTION

Interface between database and issuetracker to manage RfC issues

=head1 DIAGNOSTICS

=over 2

=item find_orphans()

get all RfCs from database without a remote_id (no tracker info)

return ARRAY of HashRefs

=item find_incomplete_rfcs()

get all RfCs from database who's status is neither complete nor rejected

return ARRAY of HashRefs 

=item get_rfc("id")

Get database record of rfc

return HashRef 

=item recreate_issue(HashRef)

creates a new issue in tracker from database record

returns True

=item update_rfcs(HashRef,HashRef,...)

updates status (list name) from tracker to database

returns True

=back


=head1 CONFIGURATION AND ENVIRONMENT

Issuetracker configuration required as documented in LIMS::Local::IssueTracker
initialise with correct DBIX::Simple object and centre name via LIMS::DB

    LIMS::Local::RfC->new( database => $dbix, centre => 'antarctica' );
    
It will always use the leeds centre for the tracker

=head1 DEPENDENCIES

    LIMS::Local::IssueTracker


=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.
Please report problems to Garry Quested (garry.quested@nhs.net)
Patches are welcome.

=head1 AUTHOR

Garry Quested (garry.quested@nhs.net)

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2017 Garry Quested (garry.quested@nhs.net). All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.