• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends a list of previously unlisted referrers for requests registered or amended
during past week
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 1; # 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 philip.keogh 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 referrers ($date_from to $date_to)"; # warn $subject; exit;

# get list of referrers registered or amended during $duration:
my $ref = _get_recent_referrers(); # warn Dumper $ref;
exit unless @$ref;

my @new; # list of referrer codes not previously used
{ 
    my $sql = $sql_lib->retr('seen_referrers');
    
    for my $code (@$ref) { # warn Dumper $code;
        next if $dbix->query($sql, $code, $duration)->list; # already seen
        push @new, $code; # national_code not previously used
    }
}
exit unless @new;

my @rows;
{
    my $sql = $sql_lib->retr('new_referrers'); # get new referrer details:
    my $query = $dbix->query($sql, @new);
    
    while ( my $row = $query->hash ) { # warn Dumper $row;
        my $entry = sprintf '%s, %s, %s, %s, %s',
            @{$row}{ qw/national_code name department parent_code organisation/ };
        push @rows, $entry;
    }
}

my $message_body = join "\n", @rows;

my %mail = (		
	config  => $config,
	message => $message_body,
	subject => $subject, 	
); # warn Dumper \%mail; # exit;
    
$tools->send_mail(\%mail, \@recipients);

# get list of referrers registered or amended during $duration:
sub _get_recent_referrers {
    my $sql = $sql_lib->retr('recent_referrers'); # needs $duration x 2:
    my $referrer_ids = $dbix->query($sql, $duration, $duration)->flat; # warn Dumper $referrer_ids;
    return $referrer_ids;
}