RSS Git Download  Clone
Raw Blame History
#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends a list of previously unlisted request referrers registered during past week
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 1; # email to ra.jones only

############ recipients from contacts.lib ######################################
my @recipients = qw( katie.wheatley tim.branch raj );
my $duration = 7; # over past number of days
my $date_from = DateTime->today->subtract(days => $duration)->dmy;
my $date_to   = DateTime->today->subtract(days => 1)->dmy; # yesterday
################################################################################

BEGIN {
    use FindBin qw($Bin); # warn $Bin;
    use lib "$Bin/../../../lib";
}

use Data::Dumper;
use LIMS::Local::ScriptHelpers;

my $tools = LIMS::Local::ScriptHelpers->new();

# get tools from LIMS::Local::ScriptHelpers:
my $contacts = $tools->get_contacts();
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; 

# 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;
    
RECIPIENT:
foreach my $recipient (@recipients) {
	my $email = $contacts->{$recipient} or next RECIPIENT; # in case doesn't exist
    next RECIPIENT if $JUST_TESTING && $email !~ /ra\.jones/;
	$mail{recipient} = $email; # warn Dumper $mail{recipient}; next;

	my $rtn = LIMS::Model::Email->send_message(\%mail);
	warn "Error in $0: $rtn" if $rtn;
}

# 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;
}