From: nagel@Cigna.COM (Mark Nagel)
Subject: why does this leak?
Organization: CIGNA FIRST, Irvine, CA
Date: Thu, 16 Apr 1992 17:33:35 GMT

I wrote a simple script to hang around in the background and monitor
our printers.  Problem is it keeps growing!  After some time it
exceeds swap space.  I could get around this by having cron run it
once per minute or something, but I'd like to find out whether I'm
doing something wrong.

Here's the version info:

This is perl, version 4.0

$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45 $
Patch level: 19

This is running on a Sun 4/SunOS 4.1.1.

Thanks in advance to anyone who can point out the error of my ways :)

Mark

#! /usr/bin/perl

#
# lpck
#
# $Id: lpck,v 1.2 1992/03/27 20:19:24 nagel Exp nagel $
#
# Mark Nagel
#

require "getopts.pl";

$CONFIG = "$ENV{'HOME'}/.lpckcf";

%defsilent = ();
@defignore = (
    '^no entries$',
    'starting job',
    'sending file',
    '^\S+ is ready and printing$',
    'spooler terminated communication',
    'warning: no daemon present',
    'communications ended normally'
);
$sleeptime = 15;
$cftime = undef;

&Getopts("mps:") || exit;

$sleeptime = $opt_s if (defined($opt_s) && $opt_s > 0);

if ($opt_m) {
    exit unless (fork == 0);
    print STDERR "$$\n" if $opt_p;
    setpgrp(0,0);
    open(STDOUT, ">/dev/console");
} else {
    print STDERR "$$\n" if $opt_p;
}

###############################################################################

for (;;) {
    #
    # re-read configuration file if it has changed
    #
    &readcf;

    #
    # display suspicious status messages
    #
    &readstat;
    while (($p, $s) = each status) {
	&output($p,$s);
    }

    sleep $sleeptime;
}

exit;

###############################################################################

sub output {
    local($p,$s) = @_;
    local($re);

    unless ($silent{$p}) {
	for $re (@ignore) {
	    return if eval("\$s =~ /$re/");
	}
	print "[$p] $s\n";
    }
}

sub readstat {
    local($printer, $ignore);
    local($_);

    #
    # NOTE: SunOS lpstat is broken -- if run as /usr/bin/lpstat
    # it revokes setuid
    #
    undef %status;
    open(STAT, "PATH=/usr/bin lpstat -o|") || die "lpstat: $!\n";
    while (<STAT>) {
	chop;
	if (/^$/) {			# blank lines between printers
	    $printer = "";
	    $ignore = 0;
	} elsif (/(.*):$/) {		# grab canonical printer name
	    $printer = &canon($1);
	} elsif (/^Rank/) {		# ignore queue listing
	    $ignore = 1;
	} else {
	    y/A-Z/a-z/;
	    $status{$printer} .= $_ if ($printer && !$ignore);
	}
    }
    close(STAT);
}

###############################################################################

# sample QMS Imagen 6320 "good" status
#
# Thu Feb 13 07:08:57 1992   Job in Progress,
# Status: IMAGEN X320 status: Engine {,,}ready; job in progress (for 00:24:42)

sub readcf {
    local(@stat);
    
    if (@stat = stat($CONFIG)) {
	return if ($cftime >= $stat[9]);
	$cftime = $stat[9];
    }
    %silent = %defsilent;
    @ignore = @defignore;
    if (open(CF, $CONFIG)) {
	while (<CF>) {
	    chop;
	    next if /^#/;
	    s/^\s*//;
	    next if /^$/;
	    if (/^silent\s+(.*)/) {
		$silent{$1}++;
	    } elsif (/^ignore\s+(.*)/) {
		push(@ignore, $1);
	    }
	}
	close(CF);
    }
}

sub canon {
    local($name) = @_;
    local($real);

    unless ($canon{$name}) {
	open(PC, "/etc/printcap") || die "/etc/printcap: $!\n";
	while (<PC>) {
	    next if /^#/;
	    if ((($real) = /^[^|]+\|([^|]+)\|/) && /\b$name\b/) {
		$canon{$name} = $real;
		last;
	    }
	}
	close(PC);
    }
    $canon{$name} || $name;
}
-- 
Mark Nagel
  Network Administrator                 UUCP: {uupsi,ucivax}!cigna!nagel
  CIGNA FIRST                           INET: nagel@cigna.com

Newsgroups: comp.lang.perl