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