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