• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
sends list of histopathology samples received from Scunthorpe/Grimbsy/Lincoln
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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

################################################################################
my @parent_codes = qw(RJL RWD);
my @recipients = qw( raj hmds.secure );
################################################################################

use lib '/home/raj/perl5/lib/perl5';
use Data::Dumper;

use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;

# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

#-------------------------------------------------------------------------------
my $date    = $tools->time_now->dmy;
my $subject = "PathLinks requests authorised week ending $date";
#-------------------------------------------------------------------------------

my $sql_lib  = $tools->sql_lib();
my $config   = $tools->config();
my $dbix     = $tools->dbix();

my $query = $sql_lib->retr('pathlinks_samples'); # warn $query;

my $result = $dbix->query($query, @parent_codes);

my @rows = ();
while (my $ref = $result->array) { # warn Dumper $ref; next;
    push @rows, $ref;
}
exit unless @rows;

my $header = [ qw(LabNo Yr Location AuthDate Sample) ];

my $msg = join "\n", map {
	sprintf "%5s/%-4s %-25s %-12s %s", map $_ ||= 'NULL', @{$_};
} ( $header, @rows ); # print $msg; exit;

my %mail = (
	config  => $config,
	message => $msg,
	subject => $subject,
); # warn Dumper \%mail;

$tools->send_mail(\%mail, \@recipients);