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