• Files
• Commits
• Log
• Graph
• Stats

#!/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 = 0; # 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 Template;
use DateTime;
use Path::Tiny;
use Data::Dumper;
use DBIx::Simple;
use HTTP::BrowserDetect;
use DateTime::Format::Strptime;

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

my $q = CGI->new();
print $q->header(); # otherwise get "Premature end of script headers" if script exits

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

my $username = $vars->{username} || exit; # maybe not logged in
my $service  = $vars->{service} or die 'no service var passed'; # warn $service;

my $tt = $vars->{tt}; # warn Dumper $tt;
# exit if print-run or page where user can already see them:
exit if grep $tt =~ /\b$_\.tt\Z/, qw(do hello user_messages);

# set $ENV{CENTRE} *before* getting config:
$ENV{CENTRE} = $service;

my $config = LIMS::Local::Config->instance; # warn Dumper $config;
my $dbix   = DBIx::Simple->connect(@{ $config->{dbh_params} });
 # warn $dbix->dbh->{mysql_thread_id}; # cgi script so no point using cached dbh's

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 $path = path($RealBin, '..', '..', 'templates')->realpath;
    my %data = ( count => $i, app_url => $vars->{url} );
    my $tmpl = 'user/new_msg_alert.tt';
    my $msg;
    Template->new({ INCLUDE_PATH => $path })->process($tmpl, \%data, \$msg);
    print $msg;
}

if ($LOG_QUERIES) {
    my $logfile = path($RealBin, '..', '..', 'logs', 'new_msgs.log')->realpath; # warn $logfile;
    my $format  = DateTime::Format::Strptime->new(pattern => '%F %T');
    my $time    = DateTime->now(time_zone => 'Europe/London');

    $time->set_formatter($format); # warn $dt; exit;
      # alternative to DateTime::Format:
      # no warnings 'redefine';
      # sub DateTime::_stringify { shift->strftime('%F %T') }
    # warn DateTime->now->datetime . ':' . $username . '[' . $i . ']';
    my $msg = sprintf "%s : %s [%s|%s] : %s : %s\n", $time, uc $username,
        $service, $ENV{REMOTE_ADDR}, $i, get_user_agent();
    io($logfile)->append($msg);
}

sub get_user_agent {
    my $ua = HTTP::BrowserDetect->new($ENV{HTTP_USER_AGENT});
    return sprintf '%s/%s-%s', map $ua->$_(),
        qw(os_string browser_string public_version);
}