#!/usr/bin/perl -wT
#
# $Id: lprng-stall-report.pl,v 1.11 2003/01/13 05:28:43 jmates Exp $
#
# Copyright (c) 2001-2002, Jeremy Mates.  This script is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;         # better error reporting
use Getopt::Std;  # command line option processing

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.11 $ ') =~ s/[^0-9.]//g;

my (%opts, $queue, $stalls, $filter_status, $has_printable);

my @in = qw(lpq -a);

my @out = qw(logger -p lpr.alert --);

# regex diescribing what filter status messages are okay
# these were developed for LPRng 3.7.4 and IFHP 3.4.4; other
# versions may need adjusting for
my $false_positive_filter =
qr/(end of job detected|done at|getting sync|Warming Up|getting end|sent job file|transferring \d+|Self Test)/;

######################################################################
#
# MAIN

# parse command-line options
getopts('h?', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

$stalls = 0;

open INPUT, "-|" or exec {$in[0]} @in or die $!;
while (<INPUT>) {
  if (/^Printer:\s+([\w@-]+)/) {
    if ($stalls > 0) {
      report("error: $queue has $stalls stalled jobs");
    }
    if (defined $filter_status and defined $has_printable) {
      report("$queue has unknown filter status: $filter_status");
    }

    $queue  = $1;
    $stalls = 0;
    undef $filter_status;
    undef $has_printable;
  }

  $stalls++ if m/^stalled\(/;

  if (/^ Queue:/) {
    $has_printable = 1 unless /no printable jobs in queue/;
  }

  if (/^ Filter_status:\s+(.*)/) {
    $filter_status = $1;

    # trim out known messages, otherwise, sanitize input
    if ($filter_status =~ /$false_positive_filter/) {
      undef $filter_status;
    } else {
      $filter_status =~ s/[^A-Za-z0-9_= ,-]/_/g;
    }
  }
}
close INPUT;

if ($stalls > 0) {
  report("error: $queue has $stalls stalled jobs");
}
if (defined $filter_status) {
  report("unknown filter status: $filter_status");
}

exit;

######################################################################
#
# SUBROUTINES

sub report {
  my $msg = shift;
  my @msg;

  push @msg, @out, split /\s+/, $msg;

  open OUT, "|-" or exec {$msg[0]} @msg;
  close OUT;
}

# clean up env settings for taint mode (see perlsec documentation)
sub BEGIN {
  delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
}

# a generic help blarb
sub help {
  print <<"HELP";
Usage: $0 [opts]

Script to report on various LPRng queue problems.

Options for version $VERSION:
  -h/-?  Display this message

Run perldoc(1) on this script for additional documentation.

HELP
  exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

lprng-stall-report.pl - reports on various LPRng queue problems.

=head1 SYNOPSIS

To provide stall reporting to syslog during working hours from cron:

  */5 7-20 * * * /usr/local/bin/lprng-stall-report.pl

=head1 DESCRIPTION

=head2 Overview

Script to parse output of lpq(1) under LPRng, and report on any
stalled jobs found to syslog via logger(1).

=head2 Normal Usage

  $ lprng-stall-report.pl [options]

See L<"OPTIONS"> for details on the command line switches supported.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=back

=head1 ENVIRONMENT

Requires LPRng to be installed:

http://www.lprng.com/

Or any print daemon whose lpq(1) produces compatible output.

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 SEE ALSO

crontab(5), logger(1), lpq(1), perl(1)

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2001-2002, Jeremy Mates.  This script is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=head1 VERSION

  $Id: lprng-stall-report.pl,v 1.11 2003/01/13 05:28:43 jmates Exp $

=cut