#!/usr/bin/perl
=begin -------------------------------------------------------------------------
sends a list of previously unlisted request referrers registered during past week
=cut ---------------------------------------------------------------------------
use strict;
use warnings;
my $JUST_TESTING = 0; # email to ra.jones only
BEGIN {
use FindBin qw($Bin); # warn $Bin;
use lib (
"$Bin/../../../lib",
'/home/raj/perl5/lib/perl5',
);
}
use Data::Dumper;
use LIMS::Local::ScriptHelpers;
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);
############ recipients from contacts.lib ######################################
my @recipients = qw( katie.wheatley tim.branch raj );
my $duration = 7; # over past number of days
my $date_from = $tools->date_subtract(days => $duration)->dmy;
my $date_to = $tools->date_subtract(days => 1)->dmy; # yesterday
################################################################################
# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib();
my $config = $tools->config();
my $dbix = $tools->dbix();
# email subject line:
my $subject = "New HILIS entries ($date_from to $date_to)"; # warn $subject; exit;
# create map of unqiue referrers (excluding past 7d):
my $referrer_department_map = _get_referrer_department_map();
my $query = $sql_lib->retr('new_referrers');
my $result = $dbix->query($query, $duration);
my @rows;
while (my $ref = $result->hash) { # warn Dumper $vars; next;
my $referrer_department_id = $ref->{referrer_department_id};
next if $referrer_department_map->{$referrer_department_id}; # if already seen
my $row = sprintf '%s, %s, %s, %s, %s',
$ref->{national_code},
$ref->{name},
$ref->{department},
$ref->{parent_code},
$ref->{organisation};
push @rows, $row; # print Dumper $ref;
}
my $message_body = join "\n", @rows;
my %mail = (
config => $config,
message => $message_body,
subject => $subject,
); # warn Dumper \%mail; # next;
$tools->send_mail(\%mail, \@recipients);
# get list of referrers used since start, excluding current week:
sub _get_referrer_department_map {
my $sql = $sql_lib->retr('referrer_department_map');
my $map = $dbix->query($sql, $duration )->map;
return $map;
}