#!/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 douglas sinclair bagguley ); ################################################################################ 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);