• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

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

use strict;
use warnings;

my $JUST_TESTING = 1; # emails just raj

#######################################
my @recipients = qw(douglas raj);     #
#######################################

use lib '/home/raj/perl5/lib/perl5';

use IO::All;
use Data::Dumper;
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->time_now->subtract(days => 1)->year; # warn $year;

my $subject = "HILIS register log & error codes for $year"; # warn $subject;
    
# get register log:
my $register_log = do {
    my $sql = $sql_lib->retr('register_log');
	$sql =~ s/AND MONTH\(rh.time\) = \?//; # warn $sql;
    $dbix->query($sql, $year)->hashes;
}; # warn Dumper $register_log;

# get request_id's with error code A or deletion:
my $request_id = do {
    my $sql = $sql_lib->retr('error_code_A_requests');
	$sql =~ s/and MONTH\(`time`\) = \?//; # warn $sql;
    $dbix->query($sql, $year)->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');
	$sql =~ s/and MONTH\(t1.`time`\) = \?//; # warn $sql;
    $dbix->query($sql, $year)->arrays;    
};

my $message = "Cases registered on HILIS and error rate by UserID for $year:\n";

{ # write out register log data to rows:
    for my $user (@$register_log) {
        my $user_id = $user->{id};
        # get frequency of error code A's for this user:
        my $err_freq = $registration_user->{$user_id};        
        
        my @data = (
            uc $user->{username},
            $user->{f},     # total number records registered by user
            $err_freq || 0, # no. of error code A / deleted records
        );
        
        if ($err_freq) {
            my $err_percent = sprintf "%.2f%%", 100 * $err_freq / $user->{f};
            push @data, $err_percent;
        }
        no warnings 'uninitialized'; # $err_percent missing unless $err_freq
        $message .= sprintf "  %-15s %-4s %-3s %s\n", @data;
    } # warn $message;
}

$message .= "\nError code frequencies for $year:\n";

{ # add error code frequencies:
    $message .= sprintf "  %s %-45s %s\n", @$_ for @$error_codes;
} # warn $message;

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

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