#!/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.
