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