• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
compiles list of number of cases registered vs frequency of error code A, by user
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 0; # emails just raj

##########################################
my @recipients = qw(douglas raj blythe); #
my $duration   = 2; # months             #
##########################################

use lib '/home/raj/perl5/lib/perl5';
use IO::All;
use Data::Dumper;

use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;

my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings;

my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib();
my $config  = $tools->config();
my $dbix    = $tools->dbix();

# get date 1 month ago:
my $ref_date = $tools->date_subtract(months => $duration);
my $subject = sprintf 'HILIS register log & error codes [%s.%s]',
    $ref_date->month_name, $ref_date->year; # warn $subject;
# template:
my $tt_file  = 'cron/register_and_error_log.tt';

# get register log for previous month:
my $register_log = do {
    my $sql = $sql_lib->retr('register_log');
    $dbix->query($sql, $ref_date->year, $ref_date->month)->hashes;
}; # warn Dumper $register_log;

# get request_id's with error code A or deletion for previous month:
my $request_id = do {
    my $sql = $sql_lib->retr('error_code_A_requests');
    $dbix->query($sql, $ref_date->year, $ref_date->month)->flat;
}; # warn Dumper $request_id;

# get map of registration users for requests { user_id => frequency }
my $registration_user = do {
    my $sql = $sql_lib->retr('registration_user_map');
    $dbix->query($sql, @$request_id)->map;
}; # warn Dumper $registration_user;

# get breakdown of error code frequencies for month:
my $error_codes = do {
    my $sql = $sql_lib->retr('error_codes');
    $dbix->query($sql, $ref_date->year, $ref_date->month)->arrays;
};

my @rows;

{ # write out register log data to rows:
    for my $user (@$register_log) {
        my $id = $user->{id};
        # get frequency of error code A's for this user:
        my $err_freq = $registration_user->{$id} || 0;
		# get percentage:
		my $err_percent = $err_freq
			? ( sprintf "%.2f%%", 100 * $err_freq / $user->{f} ) : '---';

        my @data = (
            uc $user->{username},
            $user->{f},   # total number records registered by user
            $err_freq,    # no. of error code A / deleted records
			$err_percent, # err_freq as percentage
        );
        push @rows, \@data;
    }
}

exit unless @rows || @$error_codes; # unlikely

# get total number of requests for month:
my %h = ( year => $ref_date->year, 'MONTH(created_at)' => $ref_date->month );
$dbix->select('requests', 'count(*)', \%h)->into(my $n); # warn $n;

my $message = do{
    my %h = (
        users => \@rows,
        errs  => $error_codes,
        total => $n,
        ref_date => $ref_date,
    );
    $tools->process_template($tt_file, \%h);
};

if ($JUST_TESTING) {
	open my $fh, '>', "$Bin/register_and_error_log.html";
	print $fh $message;
}

my %mail = (
    content => 'html',
	config  => $config,
    subject => $subject,
    message => $message,
); # warn Dumper \%mail;

$tools->send_mail(\%mail, \@recipients);