view release on metacpan or  search on metacpan

examples/logwatch  view on Meta::CPAN

   logfile => 'path/to/file',
   match => sub { my (\$line) = \@_; \$line =~ /some_regex/ },
   collecttime => 1200, # seconds
   report => report_mailto('system\@example\.com', 'admin\@example.com'),
  }

  Runs `@tailcmd -- \$\$config{logfile}`,
  collects all lines that match the given predicate, and after
  \$\$config{collecttime} seconds have passed since the first such
  line, passes a file path containing the lines to the subroutine in
  \$\$config{report}; 'report_mailto(\$from, \$to)' returns such a sub
  that then mails the contents of that file to the given \$to email
  address, with '$myname path/to/config.pl' as the subject and \$from
  as the sender.

";
    exit 1;
}

use Getopt::Long;
our $verbose = 0;
GetOptions("verbose" => \$verbose, "help" => sub {usage},) or exit 1;
usage unless @ARGV == 1;

our ($configpath) = @ARGV;

# move to lib?

use FP::IOStream qw(fh_to_stream);
use FP::Ops qw(the_method);

sub fh_to_linestream ($fh, $close) {
    fh_to_stream $fh, the_method("xreadline"), $close
}

use Time::HiRes qw(time sleep);

sub sleep_until($unixtime) {
    my $t       = time;
    my $seconds = $unixtime - $t;
    if ($seconds > 0.01) {
        sleep $seconds;
        tail sleep_until($unixtime);
    }
}

use Chj::xperlfunc;

sub forked (&) {
    my ($thunk) = @_;
    if (my $pid = xfork) {
        $pid
    } else {
        &$thunk();
        exit 0;
    }
}

# /lib

use Scalar::Util qw(weaken);
use Sys::Hostname qw(hostname);
use Chj::xopen;
use Chj::IO::Command;
use Chj::xpipe;
use Chj::singlequote;
use FP::Show;

#use FP::Repl::Trap; # or Chj::Backtrace
#use FP::Repl;

sub safe_for_mail($str) {
    $str =~ /^([^\r\n\t]*)\z/s ? $1 : die "not safe for mail: " . show($str);

    # (should really escape instead, but don't want to make it
    # complex)
}

# to be accessible by code at $configpath (hacky?)
sub report_mailto ($from, $to) {
    my $_from = safe_for_mail($from);
    my $_to   = safe_for_mail($to);
    sub($path) {
        my $sendmail = Chj::IO::Command->new_receiver("sendmail", "-t");
        my $in       = xopen_read($path);
        $sendmail->xprintln("From: $_from");
        $sendmail->xprintln("To: $_to");
        $sendmail->xprintln("Subject: "
                . safe_for_mail($myname) . " "
                . safe_for_mail($configpath));
        $sendmail->xprintln;
        $sendmail->xprintln(
            "$0 on " . hostname() . " found the following log messages:");
        $sendmail->xprintln;
        $sendmail->xflush;
        $in->xsendfile_to($sendmail);
        $in->xclose;
        $sendmail->xxfinish;
        unlink $path;
    }
}

sub require_config($path) {
    my $arg = untainted($path =~ m|^\.{0,2}/| ? $path : "./$path");
    require $arg
}

use Hash::Util 'lock_hash';
my $config = require_config $configpath;

# (btw unlike 'eval' this doesn't give the code in question access to
# lexicals, right?)
lock_hash %$config;

my $REPORTMSG = "REPORT-" . rand();    # XX not enough randomness

my ($r, $w) = xpipe;

use Chj::xtmpfile;

sub xtmpfile_noautoclean () {
    my $t = xtmpfile;
    $t->autoclean(0);
    $t
}

sub processlines_ ($lines, $out, $maybe_reporterpid) {
    weaken $_[0];
    my ($line, $rest) = $lines->first_and_rest;
    warn "line='$line', maybe_reporterpid=" . singlequote($maybe_reporterpid)
        if $verbose;
    if ($line =~ /^$REPORTMSG/) {
        warn "REPORT!" if $verbose;

        # XX is it really guaranteed that lines are never broken
        # apart?
        $out->xclose;
        $$config{report}->($out->path);
        xxwaitpid $maybe_reporterpid;
        tail processlines_($rest, xtmpfile_noautoclean, undef)
    } else {
        if ($$config{match}->($line)) {
            my $t_report = time + $$config{collecttime};
            $out->xprint($line);
            tail processlines_(
                $rest, $out,
                $maybe_reporterpid // forked {
                    $r->xclose;
                    sleep_until $t_report;
                    $w->xprintln($REPORTMSG);
                    $w->xclose;
                    warn "sent $REPORTMSG" if $verbose;
                }
            );
        } else {
            tail processlines_($rest, $out, $maybe_reporterpid)
        }
    }
}

sub processlines($lines) {
    weaken $_[0];
    processlines_($lines, xtmpfile_noautoclean, undef)
}

my $tailpid = forked {
    $r->xclose;
    $w->xdup2(1);
    xexec @tailcmd, "--", $$config{logfile};
};

my $lines = fh_to_linestream(
    $r,
    sub($fh) {
        $fh->xclose;
        xxwait $tailpid;
    }
);

processlines $lines;