#!/usr/bin/perl -T

# ima_sessions.pl
# Pauli Borodulin <pauli.borodulin@uta.fi>, 2009-02-26
# Gets a listing of user sessions in local Ingres DBMS
#
# Requirements (may also work with others, but not tested):
# - Ingres 9.2
# - Perl 5.8
# - DBD-Ingres-0.52
#

# v1.0 / 2009-02-26

# Changelog
#
# v1.0	2009-02-26  Initial version.
#

########

use DBI;
use POSIX qw(strftime);
use File::Basename;
use strict;

use constant BOOL_TRUE => 1;
use constant BOOL_FALSE => 0;

use constant SCRIPTNAME => basename($0);

########

# process command line parameters
my (%cmd_params) = process_params();

my @sessions = get_sessions();
if (@sessions ne 0) {
    print_sessionlist_short(@sessions);
    print "\n";
    print_sessionlist_long(@sessions);
}

exit 0;

########################################################################
# subroutines                                                          #
########################################################################

sub print_sessionlist_short {
    my @sessions = @_;

    print "Open sessions (short listing)\n";
    print "+----------+------------+------------+-----------------------------------------+\n";
    print "| id       | user       | dbname     | query                                   |\n";
    print "+----------+------------+------------+-----------------------------------------+\n";

    foreach my $session (@sessions) {
        my %session_arr = %{$session};

        printf "| %08lX | %-11s| %-11s| %-40s|\n",
            $session_arr{'session_id'},
            $session_arr{'effective_user'},
            $session_arr{'db_name'},
            $session_arr{'session_query'};
    }

    print "+----------+------------+------------+-----------------------------------------+\n";
}

sub print_sessionlist_long {
    my @sessions = @_;

    print "Open sessions (long listing, \"iimonitor show user sessions formatted\" alike)\n";
    print "--------------------------------------------------------------------------------\n";

    foreach my $session (@sessions) {
        my %session_arr = %{$session};

        printf "Session %08lX (%s) cs_state: %s (%s) cs_mask: %s\n"
            . "    DB Name: %s (Owned by: %s)\n"
            . "    User: %s\n"
            . "    User Name at Session Startup: %s\n"
            . "    Terminal: %s\n"
            . "    Group Id: %s\n"
            . "    Role Id: %s\n"
            . "    Application Code: %08d Current Facility: %s\n"
            . "    Client user: %s\n"
            . "    Client host: %s\n"
            . "    Client tty: %s\n"
            . "    Client pid: %s\n"
            . "    Client connection target: %s\n"
            . "    Client information: %s\n"
            . "    Session started: %s\n"
            . "    Description: %s\n"
            . "    Query: %s\n",
            $session_arr{'session_id'}, $session_arr{'effective_user'},
                $session_arr{'session_state'}, $session_arr{'session_wait_reason'},
                $session_arr{'session_mask'},
            $session_arr{'db_name'}, $session_arr{'db_owner'},
            $session_arr{'effective_user'},
            $session_arr{'real_user'},
            $session_arr{'session_terminal'},
            $session_arr{'session_group'},
            $session_arr{'session_role'},
            $session_arr{'application_code'}, $session_arr{'server_facility'},
            $session_arr{'client_user'},
            $session_arr{'client_host'},
            $session_arr{'client_terminal'},
            $session_arr{'client_pid'},
            $session_arr{'client_connect_string'},
            $session_arr{'client_info'},
            scalar localtime($session_arr{'session_time'}),
            $session_arr{'session_desc'},
            $session_arr{'session_query'};
        print "\n";
    }
}

sub process_params {
    my (%cmd_params);

    # param defaults
    $cmd_params{'quiet'} = BOOL_FALSE;
    $cmd_params{'outfile'} = BOOL_FALSE;

    while (scalar @ARGV > 0) {
        my $param = shift @ARGV;

        if ($param eq "-h" || $param eq "--help") {
            print_help();
            exit 0;

        } else {
            print STDERR SCRIPTNAME . ": invalid option -- $param\n";
            print STDERR "Try `" . SCRIPTNAME . " --help` for more information.\n";
            exit 1;
        }
    }

    return %cmd_params;
}

sub print_help {
    print "Usage: " . SCRIPTNAME . " [OPTION]...\n";
    print "Gets a listing of user sessions in a local Ingres DBMS.\n";
    print "\n";
    print "Options:\n";
    print "  -h        --help           display this help and exit\n";
    print "\n";
    print "Returns 0 on success, 1 on error/failure.\n\n";
}

sub get_sessions {
    my @sessions;

    my $dbh = DBI->connect('DBI:Ingres:imadb', '', '',
        { PrintError => 0, AutoCommit => 1 }) or db_error();

    my $sqlstr = "SELECT * FROM ima_server_sessions AS i "
        . "JOIN ima_server_sessions_desc AS id "
            . "ON i.server = id.server AND i.session_id = id.session_id " 
        . "JOIN ima_server_sessions_extra AS ie "
            . "ON i.server = ie.server AND i.session_id = ie.session_id " 
        . "WHERE i.session_id <> (SELECT DBMSINFO('ima_session')) "
        . "AND i.client_user != ''";
    my $sth = $dbh->prepare($sqlstr) or db_error($dbh);
    $sth->execute() or db_error($dbh);

    my $column_names_ref = $sth->{NAME};

    while (my @data = $sth->fetchrow_array()) {
        my (%session_info);

        my $i = 0;
        foreach my $column_name (@{$column_names_ref}) {
            $session_info{$column_name} = trim($data[$i++]);
        }

        push(@sessions, \%session_info);
    }

    $sth->finish;
    $dbh->disconnect;

    return @sessions;
}

sub db_error {
    my $dbconn = shift;
    my $errstr = $DBI::errstr;

    if (defined $dbconn) {
        $dbconn->disconnect();
    }

    print STDERR SCRIPTNAME . ": ima database error: $errstr\n";
    exit 1;
}

sub trim($) {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+//;
    return $string;
}