#!/usr/bin/perl

#------------------------------
# Copyright (C) 2007 XWave GmbH
# http://www.xwave.ch
# -------------------
# Steven Schubiger
# steven.schubiger@xwave.ch
# -------------------------
# Last modified: 2007/01/30
#------------------------------

use strict;
use warnings;

use FindBin qw($Bin);
use Getopt::Long qw(:config no_ignore_case);
use IO::File ();
use Mail::Sendmail;

my $VERSION = '0.4';

my ($DEBUG, $DUMP, $NOMAIL);

my %data;

#****************
# start of config
#----------------

#--------------
# system config
#--------------

# XXX - use filename only
my $file_track   = 'monbean.dat';

my $input_source = '/proc/user_beancounters';

#------------
# mail config
#------------

my $from    = 'email@mydomain.com';

my @to      = qw(
                  myemail@mydomain.com
                  myemail2@mydomain.com
		 );
		  
my $subject = 'User Beancounters - Notice'; 

#--------------
# end of config
#**************

#----------
# INTERNALS
#----------

$file_track = "$Bin/$file_track";
my $output  = `cat $input_source`;

my $to = join q{,}, @to;

my %mail = (
            From    => $from,
            To      => $to,
            Subject => $subject,
           ); 

getopts();
run();

sub getopts {
    my %opts;
    GetOptions(\%opts, 'd|dump', 
                       'h|help',
                       'n|nomail', 
                       'v|verbose', 
                       'V|version') or usage();

    usage()    if $opts{h};
    version()  if $opts{V};

    $DUMP   = $opts{d} || 0;
    $NOMAIL = $opts{n} || 0;
    $DEBUG  = $opts{v} || 0;
}

sub usage {
    print <<USAGE;
$0 [-dhnvV]
    -d, --dump    \tdump data representation
    -h, --help    \tthis help screen
    -n, --nomail  \ttest mode
    -v, --verbose \tverbose mode
    -V, --version \tprint version
USAGE
    exit;
}

sub version {
    print "$0 $VERSION\n";
    exit;
}

sub dumpdata {
    use Data::Dumper;
    print Dumper \%data;
    exit;
}

sub run {
    _get_stats_running();

    if (!$DUMP) {
        my $members = _get_stats_file();
        _cmp_stats($members);
        _put_stats_file() unless $NOMAIL;
    } else {
        dumpdata();
    }
}

sub _get_stats_running {
    my ($uid, $res);

    foreach my $line (split /\n/, $output) {
        my @elems = split /\s+/, $line;
        shift @elems;

        $uid = shift @elems and $uid =~ tr/://d if $elems[0] =~ /:/;
        $res = shift @elems;

        next unless defined($uid) && defined($res);

        push @{$data{$uid}{$res}}, { held    => $elems[0],
                                     maxheld => $elems[1],
                                     barrier => $elems[2],
                                     limit   => $elems[3],
                                     failcnt => $elems[4] }; #if $elems[4] > 0;
    }
}

sub _get_stats_file {
    my $fh = IO::File->new($file_track, '<') or die "Can't open $file_track: $!\n";
    my @members = <$fh>;
    $fh->close;

    return \@members;
}

sub _cmp_stats {
    my ($members) = @_;

    my $output_data = do { local $/; <DATA> };

    foreach my $member (@$members) {
        chomp $member;
        my @elems = split ';', $member;

        my %have_multiples;
	
        foreach my $resource (@{$data{$elems[0]}{$elems[1]}}) {
	    my $stringified = _stringify($resource, \@elems);
	    
	    next if $have_multiples{$stringified};
	    $have_multiples{$stringified} = 1;
            
	    if ($resource->{failcnt} > $elems[6]) {
                _create_mail($member, $resource, \@elems, $output_data);
            }
        }
    }

    if (defined $mail{Message} && !$NOMAIL) {
        sendmail(%mail) or die $Mail::Sendmail::error;
        warn "$Mail::Sendmail::log\n" if $DEBUG;
    }
}

sub _stringify {
    my ($resource, $elems) = @_;
    
    return join ';', ($elems->[0],
                      $elems->[1],
                      $resource->{held},
                      $resource->{maxheld},
		      $resource->{barrier},
		      $resource->{limit},
		      $resource->{failcnt});
}

sub _create_mail {
    my ($member, $resource, $elems, $output_data) = @_;

    warn "Differing $member\n\n" if $DEBUG;

    my ($mail_message, @output_elems);

    my $timestr  =  scalar localtime;
    my $hostname = `hostname -f`;
    
    chomp $hostname;

    unless (defined $mail{Message}) {
        $mail_message .= "$timestr\n\n";
        $mail_message .= "$hostname\n\n";
    }

    $output_data =~ s/(\$.*?)(?=\s+)/$1/eeg;

    my @output_data = map { split /(?<!:)\s+/, $_ } split /\n/, $output_data;

    while (@output_data) {
        push @output_elems, [ splice(@output_data, 0, 2) ]; 
    }

    foreach my $output_elem (@output_elems) {
        _iter_values($output_elem, \$mail_message);
    }

    warn "$mail_message\n" if $DEBUG; 

    $mail{Message} .= "$mail_message\n\n";
}

sub _iter_values {
    my ($output_elem, $mail_message) = @_;

    my $indent = '  ';

    if ($output_elem->[0] =~ /: [-\d]+/ and 
        $output_elem->[1] =~ /: [-\d]+/) {
        my ($value1) = $output_elem->[0] =~ /: ([-\d]+)/;
        my ($value2) = $output_elem->[1] =~ /: ([-\d]+)/;

        $value1 ||= 0;
        $value2 ||= 0;

        $indent = '* ' if $value1 < $value2;
    }

    {
        $$mail_message .= sprintf("%-30s", $output_elem->[0]);
        $$mail_message .= "$indent$output_elem->[1]\n";
    }
}
    
sub _put_stats_file {
    my $fh = IO::File->new($file_track, '>') or die "Can't open $file_track: $!\n";

    foreach my $uid (keys %data) {
        foreach my $res (keys %{$data{$uid}}) {
            foreach my $member (@{$data{$uid}{$res}}) {
                print {$fh} join ';', $uid, $res, $member->{held}, 
                                                  $member->{maxheld}, 
                                                  $member->{barrier}, 
                                                  $member->{limit}, 
                                                  $member->{failcnt}, 
                                                  "\n";
            }
        }
    }

    $fh->close;
}

__DATA__

Old:                    New:
----                    ----
Uid: $elems->[0]        Uid: $elems->[0]
Res: $elems->[1]        Res: $elems->[1]
Held: $elems->[2]       Held: $elems->[2]
Maxheld: $elems->[3]    Maxheld: $resource->{maxheld}
Barrier: $elems->[4]    Barrier: $resource->{barrier}
Limit: $elems->[5]      Limit: $resource->{limit}
Failcnt: $elems->[6]    Failcnt: $resource->{failcnt}