P3X GitList

#!/usr/bin/perl

=begin
* provides same function as LIMS::Controller::Ajax::seek_new_messages
* used for interval queries because HILIS function updates session atime so
    prevents idle timeout
* doesn't work when called on port :8000 ??
* requires symlink in script/cgi -> logs
=cut

#-------------------------------------------------------------------------------
my $LOG_QUERIES = 1; # logs/new_msgs.log
#-------------------------------------------------------------------------------

use strict;
use warnings;

use lib '/home/raj/perl5/lib/perl5';

# use CGI::Carp qw(fatalsToBrowser); # use for devel
# use CGI::HTMLError (trace => 1); # don't want errs returning to browser ??

use CGI;
use IO::All;
use DateTime;
use Path::Tiny;
use Data::Dumper;
use DBIx::Simple;

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

my $q = CGI->new();
my $vars = $q->Vars(); # warn Dumper $vars;

# set $ENV{CENTRE} if required, BEFORE getting config:
if ( $vars->{service} ) { # warn $vars->{service};
    $ENV{CENTRE} = $vars->{service}; # other centres
}

my $config = LIMS::Local::Config->instance; # warn Dumper $config;
my $dbix   = DBIx::Simple->connect(@{ $config->{dbh_params} });

print $q->header(); # warn DateTime->now->datetime;

my $tt = $vars->{tt}; # warn Dumper $tt;
exit if grep $tt =~ /$_\.tt\Z/, qw(hello user_messages); # can already see them!!

my $username = $vars->{username} || exit; # maybe not logged in
my $logfile  = path($RealBin, 'logs', 'new_msgs.log')->realpath; # warn $log;

my $sql = q!
    SELECT COUNT(*)
    FROM
      user_message t1
      JOIN users t2 ON (t1.recipient_id = t2.id)
      /* JOIN sessions t3 ON (t3.userid = t2.username) */
    WHERE
      t1.`acknowledged` IS NULL AND
      /* t3.`time` >= DATE_SUB(NOW(), INTERVAL 10 MINUTE) AND */
      t2.`username` = ?!;
$dbix->query($sql, $username)->into(my $i); # warn $i;

if ($i) {
    my $url = $vars->{url} . '/resources/user_messages';
    my $msg = sprintf q!:: you have %s unacknowledged message%s :: %s!, $i,
        $i > 1 ? 's' : '',
        $q->a({href => $url}, 'view &#187;'); # warn $msg;
    print $msg;
}

if ($LOG_QUERIES) {
    # warn DateTime->now->datetime . ':' . $username . '[' . $i . ']';
    my $msg = sprintf "%s : %s [%s] : %s\n",
        DateTime->now->strftime('%F %T'), uc $username, $vars->{service}, $i;
    io($logfile)->append($msg);
}