#!/usr/bin/env perl

#-------------------------------------------------------------------------------
# request-for-change web form
# query params contain encrypted username & centre in initial request from HILIS:
# script/cgi/rfc.cgi?u=53616c7465645f5ff9[...]&c=53616c7465645f5f[...]
#-------------------------------------------------------------------------------

package RequestForChange;

use lib '/home/raj/perl5/lib/perl5';
use Web::Simple; # imports strict & warnings so don't repeat or it breaks

use IO::All;
use Template;
use Path::Tiny;
use Data::Dumper;
use HTML::FillInForm;
use Data::FormValidator;
use Data::FormValidator::Constraints qw(:closures);

# use CGI::Carp qw(fatalsToBrowser); # use for devel
use CGI::HTMLError (trace => 1); # use in production

use FindBin qw($RealBin); # warn $RealBin;
use lib $RealBin . '/../../lib';
use LIMS::Local::Config;
use LIMS::Model::Email;
use LIMS::Local::Utils;
use LIMS::Local::ScriptHelpers;
use LIMS::Local::IssueTracker;

my $config = LIMS::Local::Config->instance;
my $tools  = LIMS::Local::ScriptHelpers->new;
my $dbix   = $tools->dbix;

my $SERVICE = $config->{settings}->{service_email};
my $ADMIN   = $config->{settings}->{admin_contact};
my $debug   = path($RealBin, 'debug.txt')->realpath;
io($debug)->print(); # reset

# template src:
use constant TMPL_DIR => path($RealBin, '..', '..', 'templates')->realpath;
use constant TMPL => 'user/rfc.tt';

my $today = LIMS::Local::Utils::today; # datetime object
my $NOW   = 'NOW()'; # mysql function

sub dispatch_request {
    # just return empty form to fill in:
    sub (GET + ?:u=&:c=) { # collect query params 'u' & 'c' as hashref
        my ($self, $ref) = @_; # _debug($ref);
        [ 200, [ 'Content-type', 'text/html' ], [ $self->render_view($ref) ] ]
    },
    sub (POST + %*) { # collect all body params as hashref
        my ($self, $params) = @_; # _debug($params);
        [ 200, [ 'Content-type', 'text/html' ], [ $self->process($params) ] ]
    },
    sub () { # something else submitted:
        [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not recognised' ] ]
    }
}

# if submitted form:
sub process {
    my ($self, $vars) = @_; # _debug($vars);

    my $dfv = _dfv();
    my $dfv_profile = _dfv_profile(); # DEBUG($dfv_profile);
    my $results = $dfv->check($vars, $dfv_profile); # DEBUG($results);

    if ( $results->has_invalid or $results->has_missing ) { # DEBUG($results);
        $vars->{errs} = $results->msgs;
    }
    else { # no validation errors:
        my $rtn = $self->send_application($vars);
        if ($rtn) { # sendmail error:
            $vars->{msg} = $rtn;
        }
        else { # messages sent OK:
            $vars->{send_success} = 1;
        }
    }
    return $self->render_view($vars);
}

sub render_view {
    my ($self, $vars) = @_; # _debug($vars);

    my $key = $today->ymd; # so url only valid on same day
    # u contains encrypted username in initial request from HILIS:
    if ( my $tkn = $vars->{u} ) { # _debug($tkn);
        my $username = LIMS::Local::Utils::decrypt($tkn, $key);
        $vars->{username} = $username;
    }
    # c contains encrypted centre in initial request from HILIS:
    if ( my $tkn = $vars->{c} ) { # _debug($tkn);
        my $centre = LIMS::Local::Utils::decrypt($tkn, $key);
        # save var as 'app_name' NOT centre to avoid confusion with settings._centre
        $vars->{app_name} = $centre; # for use in email lookup
    } # _debug($vars);
    # add settings to $vars:
	$vars->{settings} = $config->{settings}; # _debug($vars);

    # get TT object:
    my $t = Template->new({ INCLUDE_PATH => TMPL_DIR });

    my $template_output;
    $t->process(TMPL, $vars, \$template_output)
    || die "Template process failed: ", $t->error(), "\n";

    my $output = HTML::FillInForm->fill( \$template_output, $vars );
    return $output;
}

sub send_application {
    my ($self, $vars) = @_; # _debug($vars);

    my $username = $vars->{username};

    my @recipients = ($ADMIN); # $vars->{email}
    # add service email if different to admin address:
    push @recipients, $SERVICE if $SERVICE ne $ADMIN;

    # maybe change database?
    unless ( $vars->{app_name} eq 'leeds' ) { # _debug($vars->{db_name});
        $dbix->dbh->do('USE ' . $vars->{app_name});
    }

    my $user = $dbix->select('users', ['id', 'email'],
        { username => $username })->hash;

    if ( my $cc = $user->{email} ) {
        push @recipients, $cc;
    }
    else {
        warn "no email address for $username";
    }

    my %db_data = (
        details => $vars->{details},
        reason  => $vars->{reason},
        status  => $vars->{status},
        user_id => $user->{id},
        created => \$NOW,
    );
# not sure if mysql_insertid will lead to race condition but not a real problem given scale
    $dbix->insert('rfc', \%db_data ); # need to get id back
    my $rfc_id = $vars->{rfc_id} = $dbix->dbh->{mysql_insertid};

    my $service_suffix =  uc substr( $vars->{app_name}, 0, 1 ); 
    my $message_body   = _message_body($vars);

    my $subject = sprintf 'HILIS RfC%s%s [%s]',
        $rfc_id, $service_suffix, uc $username;

	my %mail = (
		config  => $config->{settings},
		message => $message_body,
		subject => $subject,
	); # _debug(\%mail); return 0; # 'some reason for mail failure';

    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';
    }
# create new issue in issue tracker

    eval {
        my $t = LIMS::Local::IssueTracker->new;
        my $res = $t->create_rfc(
                { name => $subject, desc => $message_body, reason => $vars->{reason} } )
        or die "couldn't add issue in issue tracker: $!";

        $dbix->update('rfc', {remote_id => $res}, {id => $rfc_id } );
    };
    warn $@ if $@; # log failure in apache logs
    return 0; # messages sent OK
}

sub _dfv_profile {
    return {
        required => [ qw(username centre reason details status) ],
    }
}

sub _message_body {
    my $vars = shift;

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

sub _dfv {
    my $defaults = $config->{dfv_defaults}; # DEBUG($defaults);
    my $dfv = Data::FormValidator->new({}, $defaults);
    return $dfv;
}

sub _debug {
    my $obj = shift;
    io($debug)->append(Dumper $obj);
}

RequestForChange->run_if_script;