touch_if

#! /usr/bin/perl

use strict;
use warnings;

use Errno qw();
use Getopt::Long;
use Pod::Usage;

our $VERSION = '0.01';

my (
    $opt_help, $opt_version, $opt_touch_file, $opt_ignore_case, $opt_match_str,
    $opt_pipe);
my $opt_span = 0;
my $opt_threshold = 1;

GetOptions(
    help          => \$opt_help,
    version       => \$opt_version,
    'file=s'      => \$opt_touch_file,
    'ignore-case' => \$opt_ignore_case,
    'match=s'     => \$opt_match_str,
    'pipe'        => \$opt_pipe,
    'span=i'      => \$opt_span,
    'threshold=i' => \$opt_threshold,
) or pod2usage(1);
if ($opt_help) {
    pod2usage(0);
} elsif ($opt_version) {
    print "$VERSION\n";
    exit 0;
}
die "mandatory option: --file (-f) is missing\n"
    unless defined $opt_touch_file;
die "mandatory option: --match (-m) is missing\n"
    unless defined $opt_match_str;

# prepare compiled expr
my $match;
eval {
    $match = $opt_ignore_case ? qr/$opt_match_str/i : qr/$opt_match_str/;
};
die $@ if $@;

# prepare output handle
my $fh;
if ($opt_pipe) {
    die "no command\n"
        unless @ARGV;
    pipe my $rfh, $fh
        or die "failed to create pipe:$!";
    unless (my $pid = fork) {
        die "fork failed:$!"
            unless defined $pid;
        # child process
        close $fh;
        open STDIN, '<&', $rfh
            or die "failed to redirect piped input to stdin:$!";
        exec @ARGV;
        die "failed to execute:$ARGV[0]:$!";
    }
} else {
    die "too many arguments\n"
        if @ARGV > 1;
    if (@ARGV == 0 || $ARGV[0] eq '-') {
        $fh = \*STDOUT;
    } else {
        open $fh, '>>', $ARGV[0]
            or die "failed to open file:$ARGV[0]:$!";
    }
}

# main loop
$| = 1;
my @match_at = map { 0 } (1 .. $opt_threshold);
while (my $l = <STDIN>) {
    print $fh $l;
    if ($l =~ /$match/) {
        my $now = time;
        shift @match_at;
        push @match_at, $now;
        if ($match_at[0] + $opt_span >= $now) {
            utime undef, undef, $opt_touch_file or do {
                if ($! == Errno::ENOENT) {
                    open my $fh, '>', $opt_touch_file
                        or die "failed to create file:$opt_touch_file:$!";
                } else {
                    die "failed to touch file:$opt_touch_file:$!";
                }
            };
        }
    }
}

__END__

=head1 NAME

touch_if - touch another file if regexp matches, while writing STDIN to file

=head1 SYNOPSIS

    touch_if [options] out_file
    touch_if [options] -p -- pipe_cmd pipe_args...
    
    # common usage (in httpd.conf)
    CustomLog "| touch_if -m ' 50[23] [^ ]+$' -f is_down access_log" common

=over 4

=item -f file_to_touch, --file=file_to_touch (mandatory)

file to be touched when a match (or matches) has been found

=item -m regexp, --match=regexp (mandatory)

regular expression to be applied against each line of input

=item -i, --ignore-case

ignore case

=item -p, --pipe

if not set, touch_if writes the input into out_file.  If set, arguments are treated as a command to spawn to handle the input.

=item -s seconds, --span=seconds (default: 0)

=item -t count, --threshold=count (default: 1)

touches file if and only if the match has been found more than `count' times within `seconds' seconds

=head1 DESCRIPTION

Touch_if is a script that writes input from STDIN to file, but while doing so, tests each line of the input against given regular expression, and if it matches, touches another file.

It is useful for detecting errors from log output.  Other processes (like crontab tasks) should be used to check the last-modified date of the touched file and send alerts to administrators.

=head1 AUTHOR

Kazuho Oku

=cut