• 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);     #
#######################################

use lib '/home/raj/perl5/lib/perl5';
use IO::All;
use Data::Dumper;
use SQL::Abstract::More;
use DateTime::Format::MySQL;

use FindBin qw($Bin); # warn $Bin; exit;
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();

my $year = $tools->date_subtract( years => 1 )->year; # warn $year;
my $sqla = SQL::Abstract::More->new;

my $subject = "HILIS register log & error codes for $year"; # warn $subject;
# template:
my $tt_file  = 'cron/register_and_error_log.tt';

# get register log:
my $register_log = do {
    my ($sql, @bind) = register_log(); # $sql_lib->retr('register_log');
    $dbix->query($sql, @bind)->hashes; # warn Dumper [$sql, \@bind];
}; # warn Dumper $register_log;

# get request_id's with error code A or deletion:
my $request_id = do {
    my ($sql, @bind) = error_codeA_requests(); # $sql_lib->retr('error_code_A_requests');
    $dbix->query($sql, @bind)->flat; # warn Dumper [$sql, \@bind];
}; # warn Dumper $request_id;

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

# get breakdown of error code frequencies for month:
my $error_codes = do {
    my ($sql, @bind) = error_codes(); # $sql_lib->retr('error_codes');
    $dbix->query($sql, @bind)->arrays; # warn Dumper [$sql, \@bind];
}; # warn Dumper $error_codes;

my @rows;
{ # write out register log data to rows:
    for my $user (@$register_log) { # warn Dumper $user;
        my $user_id = $user->{id};
        # get frequency of error code A's for this user:
        my $err_freq = $registration_user->{$user_id};
		# 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 || 0, # no. of error code A / deleted records
            $err_percent,   # err_freq as percentage
        );
        push @rows, \@data;
    }
}

# get total number of requests for year:
$dbix->select('requests', 'count(*)', { year => $year })->into(my $n); # warn $n;

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

if ($JUST_TESTING) { # warn $Bin;
	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);

sub register_log {
    my @tbl_rels  = ( 'request_history|rh' => 'rh.user_id=u.id' => 'users|u' );
	my @params = (
		-columns  => [ 'u.id', 'u.username', 'COUNT(*)|f'] ,
		-where    => { action => 'registered', 'YEAR(rh.time)' => $year },
		-from     => [ -join => @tbl_rels ],
        -order_by => [ '-f' ], # f DESC
        -group_by => 'u.username',
	);
	my ($sql, @bind) = $sqla->select(@params); # p $sql; p \@bind;
    return ($sql, @bind);
}

sub error_codes {
    my @tbl_rels  = (
        'request_error_code|t1' => 't1.error_code_id=t2.id' => 'error_codes|t2'
    );
	my @params = (
		-columns  => [ 'UCASE(t2.code)', 't2.description', 'count(*)' ],
		-where    => { 'YEAR(t1.time)' => $year },
		-from     => [ -join => @tbl_rels ],
        -order_by => [ 't2.code' ],
        -group_by => 't2.id',
	);
	my ($sql, @bind) = $sqla->select(@params); # p $sql; p \@bind;
    return ($sql, @bind);
}

sub error_codeA_requests {
    my %where = (
        'YEAR(time)' => $year,
        action => [ {'=' => 'recorded error code A'}, { like => 'deleted%'} ],
    );
	my @params = (
		-columns  => [ 'DISTINCT(request_id)' ],
		-where    => \%where,
		-from     => 'request_history',
	);
	my ($sql, @bind) = $sqla->select(@params); # p $sql; p \@bind;
    return ($sql, @bind);
}

sub registration_user_map {
	my @params = (
		-columns  => [ 'user_id', 'COUNT(*)' ],
		-where    => { action => 'registered', request_id => { -in => $request_id } },
		-from     => 'request_history',
        -group_by => 'user_id',
	);
	my ($sql, @bind) = $sqla->select(@params); # p $sql; p \@bind;
    return ($sql, @bind);
}