#!/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);