App::OpenVZ::BCWatch - Monitor the OpenVZ user_beancounters file

 use App::OpenVZ::BCWatch;

 $watch = App::OpenVZ::BCWatch->new;
 $watch->process;

 $watch = App::OpenVZ::BCWatch->new;

 $watch->process;

package App::OpenVZ::BCWatch;

use strict;
use warnings;
use boolean qw(true false);

use Carp qw(croak);
use File::Basename qw(basename);
use File::HomeDir ();
use File::Spec ();
use Mail::Sendmail qw(sendmail);
use Storable qw(store retrieve);
use Sys::Hostname qw(hostname);

our $VERSION = '0.03';

sub new
{
    my $class = shift;
    my %args = @_;

    my $defined_or = sub { defined $_[0] ? $_[0] : $_[1] };

    my $self = bless {
        Config => {
            input_file      => $args{input_file} || '/proc/user_beancounters',
            data_file       => $args{data_file}  || File::Spec->catfile(File::HomeDir->my_home, 'vzwatchd.dat'),
            _field_names    => [ qw(uid resource held maxheld barrier limit failcnt) ],
            _exclude_fields => [ qw(uid resource) ],
            monitor_fields  => $args{monitor_fields} || [ qw(failcnt) ],
            mail => {
                from    => $args{mail}->{from}    || 'root@localhost',
                to      => $args{mail}->{to}      || 'root@localhost',
                subject => $args{mail}->{subject} || 'vzwatchd: NOTICE',
            },
            sleep   => $defined_or->($args{sleep}, 60),
            verbose => $defined_or->($args{verbose}, false),
            _tests  => $defined_or->($args{_tests}, false),
        }
    }, ref($class) || $class;

    $self->_init;

    return $self;
}

sub process
{
    my $self = shift;

    delete @$self{qw(data stored)};

    $self->_get_data_running;
    $self->_get_data_file;
    $self->_compare_data;
    $self->_put_data_file;
}

sub _init
{
    my $self = shift;

    eval { store({}, $self->{Config}->{data_file}) }
      or croak "Cannot store to $self->{Config}->{data_file}: $!";

    my $pkg_tmpl = join '::', (__PACKAGE__, '_template');
    no strict 'refs';

    if (defined ${$pkg_tmpl}) {
        $self->{template} = ${$pkg_tmpl};
    }
    else {
        ${$pkg_tmpl} = $self->{template} = do {
            local $/ = '__END__';
            local $_ = <DATA>;
            chomp;
            s/^\s+//;
            s/\s+\z//;
            $_
        };
    }

    $self->{excluded} = {
        map {
          my $field = $_;
            (scalar grep $_ eq $field, @{$self->{Config}->{_exclude_fields}})
              ? ($field => true)
              : ($field => false)
        } @{$self->{Config}->{_field_names}}
    };

    my $i;
    $self->{index} = { map { $_ => $i++ } @{$self->{Config}->{_field_names}} };
}

sub _get_data_running
{
    my $self = shift;

    open(my $fh, '<', $self->{Config}->{input_file})
      or croak "Cannot read $self->{Config}->{input_file}: $!";
    my $output = do { local $/; <$fh> };
    close($fh);

    my $valid_format = join '\s+', @{$self->{Config}->{_field_names}};

    unless ($output =~ /$valid_format/) {
        croak "Format of $self->{Config}->{input_file} not recognized";
    }

    my $re = qr{
                                            \s*?
                  (?:\d+?\:)?  \s+?
                  (?:\w+?)     \s+?
                  (?:(?:\d+?)  \s*?){5}
        }x;

    my $uid;

    my @names = grep {
      !$self->{excluded}->{$_}
        ? $_ : ()
    } @{$self->{Config}->{_field_names}};

    local $1;
    while ($output =~ /^($re)$/gm) {
        my $line = $1;
        if ($line =~ /^ \s+? (\d+?)\:/gx) {
            $uid = $1;
        }
        my $res;
        if ($line =~ /\G \s+? (\w+)/gx) {
            $res = $1;
        }
        my @fields;
        if ($line =~ /\G \s+ (.*) $/x) {
            @fields = split /\s+/, $1;
        }
        push @{$self->{data}{$uid}{$res}},
          { map { $names[$_] => $fields[$_] } (0 .. $#fields) };
    }
}

sub _get_data_file
{
    my $self = shift;

    eval { $self->{stored} = retrieve($self->{Config}->{data_file}) }
      or croak "Cannot retrieve from $self->{Config}->{data_file}: $!";
}

sub _compare_data
{
    my $self = shift;

    my $has_changed = sub
    {
        my ($uid, $res, $i) = @_;

        my ($data, $stored) = map {
          my $type = $_; sub { $self->{$type}{$uid}{$res}->[$i]->{$_[0]} || 0 }
        } qw(data stored);

        return scalar grep { $data->($_) > $stored->($_) } @{$self->{Config}->{monitor_fields}};
    };

    foreach my $uid (keys %{$self->{stored}}) {
        foreach my $res (keys %{$self->{stored}{$uid}}) {
            foreach my $index (0 .. $#{$self->{stored}{$uid}{$res}}) {
                if ($has_changed->($uid, $res, $index)) {
                    $self->_create_report($uid, $res, $index);
                }
            }
        }
    }
}

sub _create_report
{
    my $self = shift;
    my ($uid, $res, $index) = @_;

    if ($self->{Config}->{_tests}) {
        push @{$self->{tests}->{report}}, $self->_prepare_report($uid, $res, $index);
    }
    else {
        my $report = $self->_prepare_report($uid, $res, $index);
        $self->_send_mail($report);

        if ($self->{Config}->{verbose}) {
            print "Report for \"$uid: $res\" sent to '$self->{Config}->{mail}->{to}'\n";
        }
    }
}

sub _put_data_file
{
    my $self = shift;

    eval { store($self->{data}, $self->{Config}->{data_file}) }
      or croak "Cannot store to $self->{Config}->{data_file}: $!";
}

sub _prepare_report
{
    my $self = shift;
    my ($uid, $res, $index) = @_;

    my @fixed_fields = ($uid, $res) x 2;
    my @mapping = (
        [
          { map {
            $_ => shift @fixed_fields,
          } @{$self->{Config}->{_exclude_fields}} },
          { map {
            $_ => $self->{stored}{$uid}{$res}->[$index]->{$_},
          } grep !$self->{excluded}->{$_}, @{$self->{Config}->{_field_names}} }
        ],
        [
          { map {
            $_ => shift @fixed_fields,
          } @{$self->{Config}->{_exclude_fields}} },
          { map {
            $_ => $self->{data}{$uid}{$res}->[$index]->{$_},
          } grep !$self->{excluded}->{$_}, @{$self->{Config}->{_field_names}} }
        ],
    );

    my @values;
    foreach my $map (@mapping) {
        my @v;
        foreach my $entry (@$map) {
            push @v, map $entry->{$_}, sort {
              $self->{index}->{$a} <=> $self->{index}->{$b}
            } keys %$entry;
        }
        push @values, [ @v ];
    }

    my %changed;
    foreach my $field (keys %{$mapping[0]->[1]}) {
        if ($mapping[0]->[1]->{$field} != $mapping[1]->[1]->{$field}) {
            $changed{$self->{index}->{$field}} = true;
        }
    }

    my $tmpl = \@values;
    my $report = $self->{template};

    local $1;

    while (my ($var) = $report =~ /(\$\S+)/) {
        unless ($report =~ /\Q$var\E$/m) {
            my $len = length($var) - length do { eval $var };
            $report =~ s/(?<=\Q$var\E)/' ' x $len/e;
        }
        $report =~ s/(\Q$var\E)/$1/ee;
    }

    while (my ($pos) = $report =~ /\((\d+)\)/) {
        my $marked = $changed{$pos} ? '*' : ' ';
        $report =~ s/\($pos\)/  $marked/;
    }

    return $report;
}

sub _send_mail
{
    my $self = shift;
    my ($report) = @_;

    my %mail = (
        From    => $self->{Config}->{mail}->{from},
        To      => $self->{Config}->{mail}->{to},
        Subject => $self->{Config}->{mail}->{subject},
        Message => <<EOT,
${\hostname}

$report

-- 
${\basename($0)} v$VERSION - ${\scalar localtime}
EOT
);
    sendmail(%mail)
      or croak "Cannot send mail: $Mail::Sendmail::error";
}

1;
__DATA__

Old:                          New:
----                          ----
Uid: $tmpl->[0][0]        (0) Uid: $tmpl->[1][0]
Res: $tmpl->[0][1]        (1) Res: $tmpl->[1][1]
Held: $tmpl->[0][2]       (2) Held: $tmpl->[1][2]
Maxheld: $tmpl->[0][3]    (3) Maxheld: $tmpl->[1][3]
Barrier: $tmpl->[0][4]    (4) Barrier: $tmpl->[1][4]
Limit: $tmpl->[0][5]      (5) Limit: $tmpl->[1][5]
Failcnt: $tmpl->[0][6]    (6) Failcnt: $tmpl->[1][6]

__END__