#!/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 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(); # flag to Local::Mail::_verify_service_status() that msg safe to send: $config->{_safe_message} = 1 if ! $config->{is_in_production_mode}; my $year = $tools->date_subtract( days => 1 )->year; # warn $year; exit; 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);