File Coverage

NPAdmin.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package SNMP::NPAdmin;
#
# prerequisites:
#  UCD SNMP v4.2.0
#  SNMP module v4.2.0
#  Printer MIB and HP MIB (provided)
#
# assumptions
#  1. only SNMPv1 will be supported initially
#  2. only mib-2 and printmib will be supported initially
#  3. SNMPv2 support will be added later
#  4. private mib support will be added after printmib support is complete
#
#  a. incorporated an HP JETDIRECT MIB that I found
#
# types of queries
#	boolean
#	max/min
#	data, list format, i.e. a hash
#	data, table format, i.e. a list of hashes

require 5.005_03;

use strict;
use vars qw/ $VERSION $CVSver @ISA $AUTOLOAD
	$DEBUG
	$VERBOSE
	%vendors
	%language_map
	$language_code
	%filter_map
	$filter_code
	%answer_map
	@paper_sizes
	$paper_sizes_indexed
	$answer_code
	/;

$VERSION = '1.0';
$CVSver= '$Id: NPAdmin.pm,v 1.23 2002/11/15 03:57:23 bozzio Exp $';

use SNMP::NPAdmin::Neon;

##################################### PODs

=pod

=head1 NAME

SNMP::NPAdmin - high-level API to query printers via SNMP

=head1 SYNOPSIS

  # object-oriented
  $p= SNMP::NPAdmin->new(
	printer		=> 'porky',
	community	=> 'corpslp'
	);
  printf "Your printer, %s, does%s support PCL.\n",
	$printer, ( $p->pcl() ? "" : " not");

  # procedural
  $p= npa_connect(
	printer		=> 'porky',
	community	=> 'corpslp'
	);
  printf "Your printer, %s, does%s support PCL.\n",
	$printer, ( npa_pcl( $p) ? "" : " not");

=head1 DESCRIPTION

The C package is a complete port of a SNMP/printer utility called C that provides a high-level interface to query printers via SNMP
without specific knowledge of SNMP MIBs or the printer's vendor-specific configuration.

The original C was written in C++ by Ben Woodard who continues to maintain it on SourceForge.

The primary objective in this port is to have a B and B version of the same functionality that the original C provides.

It is B optimized for performance at all; it is optimized for B and B.
The original C is very much extremely performance, the idea being to query many printers very quickly, especially since SNMP can be quite slow.

To be fair, C might even be slow by Perl standards due to the extensive use of run-time compilation through the AUTOLOAD subroutine.
I don't necessarily believe this since a programmer/sys-admin frequently will not use all of the available methods/subroutines which would typically
be compiled during startup; given that only a few methods/subroutines will be called, then only a few will be compiled during the process's lifetime.
Probably the difference in speed due to this will be insignificant either way.

The design was chosen in order to get as much information into a maintainable table format and make the logic as generic as possible; not for speed.

So this is your choice.  If you have some unsupported printers and you want to be able to modify the code to support them then use C.
If you need to support B of printers continuously with this kind of utility then you should use Ben Woodard's C.

=head1 THE PACKAGE

The C package is composed of a module, C, and a script, C.
The heart of this package is the C module.
Everything happens in the module.
All that the script does is parse command-line arguments, call the C module and report the results.
Actually, two modules are provided; but only one is publicly available.
I will not even tell you its name; you can find it yourself if you're so curious.

The script is provide for two reasons.
The first is to fulfill the original objective of writing a Perl-version of C which is a command-line utility.
The second is to provide an example script.

=head1 THE INTERFACE:  OBJECT-ORIENTED OR PROCEDURAL?  BOTH!

While writing this module, I received a lot a negative feedback about using OO techniques.
Therefore I decided to ensure that it could be used by using both OO and procedural techniques.

It is probably true that most modules/classes are similarly Janus-faced since Perl always passes the object-reference (or class name) as the first argument.
That is not so different from the way many procedural libraries work, particularly those that establish some kind of state such as network connections:
initiate a connection and pass the returned struct to future library calls as the first argument.

B   B   B   B   B

The procedural API is not been fully implemented yet.  But it is the current task and should be complete soon.

=cut

##################################### class method POD: new

=pod

=head1 CLASS METHODS

=head2 THE CONSTRUCTOR

=over 4

=item Bnew()>>

This is the constructor (duh!).  It returns an C object which can then be queried with the object methods that are described below.
For arguments, a hash is used which can include values for five keys: C, C, C, C and C.  The C
key is required; the constructor B fail without it.

	$P= SNMP::NPAdmin->new(
		printer		=> 'mega-print',
		community	=> 'myhouse',
		);

=item B>

This is the procedural call to start a C session for a specific printer.  It accepts the same arguments and returns the same results as
the constructor.  I didn't bother B blessing the reference just for a procedural call.  It will still work when it is passed to the query subroutines.

	$P= npa_connect(
		printer		=> 'mega-print',
		community	=> 'myhouse',
		);

=back

=cut

##################################### new

sub new
{
#warn "new";
  my $class= shift;
  my %options= @_;
  my $self;

  $self->{boolean}= $options{boolean}
     ? delete $options{boolean}
     : [ qw/ 0 1 / ]
     ;

  $self->{Neon}= SNMP::NPAdmin::Neon->new( @_);

  return undef if ! $self->{Neon};

  bless $self, $class;
  return $self;
}

##################################### class method POD: version

=pod

=over 4

=item Bversion()>> or B>

This method returns the version of SNMP::NPAdmin that is being used.

=back

=cut

##################################### version

sub version
{
#warn "version";
  return $VERSION;
}

##################################### class method POD: verbose

=pod

=over 4

=item Bverbose()>> or B>

This method toggles the 'verbose' flag for the entire class.
All objects will verbosely report its progress during execution of any methods.
The previous value of the 'verbose' flag is returned.
Currently, the 'verbose' flag is ineffectual.

=back

=cut

##################################### verbose

sub verbose
{
#warn "verbose";
  my $class= shift;
  my $value= shift;

  if ( defined $value )
  {
    $VERBOSE= $value;
  }
  else
  {
    $VERBOSE |= 1;
  }
}

##################################### class method POD: debug

=pod

=over 4

=item Bdebug()>> or  B>

This method toggles the 'debug' flag for the entire class.
All objects will report in painful detail everything that is happening during a SNMP::NPAdmin method call.
The previous value of the 'debug' flag is returned.
Currently, the 'debug' flag is ineffectual.

=back

=cut

##################################### debug

sub debug
{
#warn "debug";
  my $class= shift;
  my $value= shift;

  if ( defined $value )
  {
    $DEBUG= $value;
  }
  else
  {
    $DEBUG |= 1;
  }
}

##################################### class method POD: debugsnmp

=pod

=over 4

=item Bdebugsnmp()>> or B>

This method toggles the 'debugsnmp' flag for all objects/sessions.
All objects will report in excruciating detail everything that happens during all actual SNMP transactions.
This flag is actually used by the underlying SNMP module.  It does work and very well.

=back

=cut

##################################### debugsnmp

*debugsnmp= *SNMP::NPAdmin::Neon::debugsnmp;

##################################### DESTROY

sub DESTROY {};

##################################### object PODs

=pod

=head1 OBJECT METHODS

=head2 MIB queries

The MIB queries determine whether or not the queried printer supports the MIB in question.
Currently, SNMP::NPAdmin only asks about the Printer-MIB and the Host-Resources-MIB.

=over 4

=item Bprintmib()>> or B>

 Answers the question, "Does the printer support the Printer-MIB?"

=item Bhostmib()>> or B>

 Answers the question, "Does the printer support the Host-Resources-MIB?"

=back

=over 4

=head2 Information queries

The information queries provide information that requires additional processing in addition to merely querying the printer for data.
For most of these, this does involve simply querying the printer and reporting the results.
The ones that do require this kind of heuristics are C, C, C, C, C, C.

=item Bcontact()>> or B>

Retrieves contact and location information as contained in C and C.

=item Bvendor()>> or B>

Attempts to determine the vendor/manufacturer of the printer.
Currently, only a few vendors can be reliably detected:  HP, Tektronix, Lexmark, IBM, Xerox, EFI, Fuji and QMS.
If a device can be determined to not be a printer then 'not_a_printer' is returned.
If the vendor cannot be determined then 'unknown is returned.
If you are able to determine an unsupported vendor then please send the information to me (see below).

=item Bmodel()>> or B>

Attempts to determine the model of the printer.
The vendor is determined as the first step.  So, this will only work for printers that are supported
by the vendor() method.  Even then, the module only guarantees its best-effort.
If you are able to determine an unsupported model then please send the information to me (see below).

=item Bcfgsrc()>> or B>

The configuration source or method is determined as given by the HP private MIB OID
C<.iso.org.dod.internet.private.enterprises.hp.nm.interface.npCard.npCfg.npCfgSource>.

=item Bstatus()>> or B>

Attempts to determine the status of the printer from the Host-Resources-MID OID C.

=item Bmemory()>> or B>

Attempts to determine the amount memory in the printer from the Host-Resources-MID OID C.

=item Bnetconfig()>> or B>

Attempts to determine the network configuration of the printer from these MIB-2 OIDs: C, C, C, C.

=item Bpagecount()>> or B>

Attempts to number of pages printed by the printer from the Printer-MIB OIDs C and C.

=item Bcolors()>> or B>

Attempts to determine the number of colors supported by the printer from the Printer-MIB OID C.

=item Bresolution()>> or B>

This returns the values for the Printer-MIB OIDs C and C.

??? I am not sure what they mean.

=item Bminmargin()>> or B>

This really should be just C since it is determined from the C and most printers in use only have one marker.
Nonetheless, this merely returns the margins for all of the markers in the printer from the Printer-MIB OIDs C,
C, C and C.

=item Benginespeed()>> or B>

Determines the maximum speed that one of the media-paths provides from the Printer-MIB OID C.

=item Bmaxpapersize()>> or B>

Determines the largest paper-size that is supported by the printer.
This does not reflect the largest size paper that is actually in the printer.
By "largest" and "max", we mean the paper-size with the most area, as determined from the Printer-MIB OIDs C and
C.

=item Bminpapersize()>> or B>

Determines the smallest paper-size that is supported by the printer.
This does not reflect the smallest size paper that is actually in the printer.
By "smallest" and "min", we mean the paper-size with the least area, as determined from the Printer-MIB OIDs C and
C.


=back

=over 4

=head2 SNMP table queries

The next set of queries merely return the contents of the Printer-MIB tables.
Just for brevity, I will only list the method/subroutine names and the respective table OIDs.

=item Bdisplay()>> or B>

	printmib.prtConsoleDisplayBuffer.prtConsoleDisplayBufferTable

=item Blanguages()>> or B>

	printmib.prtInterpreter.prtInterpreterTable

=item Bcovers()>> or B>

	printmib.prtCover.prtCoverTable

=item Binputtray()>> or B>

	printmib.prtInput.prtInputTable

=item Bmarker()>> or B>

	printmib.prtMarker.prtMarkerTable

=item Bprotocol()>> or B>

	printmib.prtChannel.prtChannelTable

=item Bsupplies()>> or B>

	printmib.prtMarkerSupplies.prtMarkerSuppliesTable

=item Bmediapath()>> or B>

	printmib.prtMediaPath.prtMediaPathTable

=item Balerts()>> or B>

	printmib.prtAlert.prtAlertTable


=back

=over 4

=head2 Truth queries

The truth queries answer a "Yes or No" question about the capabilities of the printer.
The questions fall into one of several categories: languages (prtInterpreter), paper-size (prtMediaPath) or protocol (prtChannel).

=item Bpjl()>> or B>

	supports PJL printer language?

=item Bpcl()>> or B>

	supports PCL printer language?

=item Bhpgl()>> or B>

	supports HPGL printer language?

=item Bpsprint()>> or B>

	supports PSPRINT printer language?

=item Bpostscript()>> or B>

	supports Postscript printer language?

=item Bautolang()>> or B>

	automatically selects the appropriate language?

=item Bduplex()>> or B>

	supports duplex printing?

=item Bletter()>> or B>

	supports letter papersize?

=item Blegal()>> or B>

	supports legal papersize?

=item Bexecutive()>> or B>

	supports executive papersize?

=item Btabloid()>> or B>

	supports tabloid papersize?

=item Ba3()>> or B>

	supports a3 papersize?

=item Ba4()>> or B>

	supports a4 papersize?

=item Bb3()>> or B>

	supports b4 papersize?

=item Bb5()>> or B>

	supports b5 papersize?

=item Bappletalk()>> or B>

	supports Appletalk protocol?

=item Blpd()>> or B>

	supports LPD protocol?

=item Bnetware()>> or B>

	supports Netware protocol?

=item Bport9100()>> or B>

	supports port 9100 bidirectional connections?

=over

=cut

##################################### vendor

use constant Xerox230_1	=> '131;C1H011131;';
use constant Xerox230_2	=> ';C1H017730;';
use constant Xerox265	=> '3UP060485';

%vendors= (
	HP		=> qr/JETDIRECT/o,
	Lexmark		=> qr/Lexmark/o,
	Tektronix	=> qr/Tektronix/o,
	Xerox		=> qr/ Xerox | @{[Xerox230_1]} | @{[Xerox230_2]} | @{[Xerox265]} /ox,
	QMS		=> qr/qms/o,
	IBM		=> qr/IBM/o,
	EFI		=> qr/EFI FieryColor Printer Server|EFI Fiery Server ZX/o,
	Fuji		=> qr/Able Model-PRII/o,
	not_a_printer	=> qr/HP-UX|HPUX|Windows NT|Sun SNMP Agent|SunOS|Macintosh|UNIX/o,
	);

sub vendor
{
#warn "vendor";
  my $self= shift;

  my $x;
  $x= $self->{Neon}->mib2_system();

  while ( my( $k, $v)= each %vendors )
  {
    if ( $x->{sysDescr} =~ $v )
    {
      $self->{vendor}= $k;
      last;
    }
    $self->{vendor} |= 'unknown';
  }

  return { vendor => $self->{vendor} };
}

##################################### model

sub model
{
#warn "model";
  my $self= shift;

  for ( $self->vendor()->{vendor} )
  {
    /^EFI$/ && do {
	last;
	};

    /^Fuji$/ && do {
	$self->{model}= 'Able PRII';
	last;
	};

    /^HP$/ && do {
	my $str= $self->{Neon}->hp_gdStatusId()->{gdStatusId};
	$self->{model}= ( $str =~ /;(?:MODEL|MDL):\s*(.+?)\s*;/ )[0];
	last;
	};

    /^Lexmark$/ && do {
	my $x;
	$x= $self->{Neon}->mib2_system()->{sysDescr};
	$self->{model}= ( $x =~ /Lexmark\s+(.+?)  / )[0];
	last;
	};

    /^Xerox$/ && do {
	my( $x, $y);
	$x= $self->{Neon}->mib2_system()->{sysDescr};
	if ( $x =~ /[?]{3}/ )
	{
		;
	}
	elsif ( $x =~ / @{[Xerox230_1]} | @{[Xerox230_2]} /ox )
	{
		$self->{model}= 'Document Centre 230ST';
	}
	elsif ( $x =~ / @{[Xerox265]} /ox )
	{
		$self->{model}= 'Document Centre 265';
	}
	else
	{
		$x =~ /\s*(?:(.+?),|(.+))/;
		$self->{model}= $1 || $2;
	}
	last;
	}

#	/^IBM$/ && do { };

#	/^QMS$/ && do { };

#	/^Tektronix$/ && do { };
  }

  return { model => $self->{model} };
}

##################################### final PODs

=pod

=head1 AUTHOR

Robert Lehr, [e-mail]

I certainly would appreciate any feedback from people that use it, including complaints, suggestions or patches.
Even people that don't use it are welcome to send comments.

=head1 COPYRIGHT

Copyright (c) 2001 Robert Lehr. All rights reserved.  This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

Caveat emptor.  Use this module at your own risk.  I will accept no responsibility for any loss of any kind
that is the direct or indirect result of the use of this module.

=head1 SEE ALSO

the SNMP module v3.1.0; the UCD SNMP library v4.2.0  at http://www.net-snmp.org/; RFC 1759 - The Printer MIB

=cut

##################################### _check_paper_size

use constant Name			=> 0;
use constant Units			=> 1;
use constant DimA			=> 2;
use constant DimB			=> 3;

use constant null			=> 'null';
use constant tenThousandthsOfInches	=> 'tenThousandthsOfInches';
use constant micrometers		=> 'micrometers';

@paper_sizes= (
	[ 'other',	null,				-1,	-1	],
	[ 'unknown',	null,				-2,	-2	],
	[ 'letter',	tenThousandthsOfInches,		85000,	110000	],
	[ 'letter',	micrometers,			215900,	279400	],	#bw#
	[ 'legal',	tenThousandthsOfInches,		85000,	140000	],
	[ 'legal',	micrometers,			215900,	355600	],	#bw#
	[ 'tabloid',	tenThousandthsOfInches,		110000,	170000	],	#bw#
	[ 'tabloid',	micrometers,			279400,	431800	],	#bw#
	[ 'executive',	tenThousandthsOfInches,		75000,	105000	],	#bw#
	[ 'executive',	micrometers,			190500,	266700	],	#bw#
	[ 'a3',		tenThousandthsOfInches,		109842,	165354	],	#bw#
	[ 'a3',		micrometers,			297000,	420000	],
	[ 'a4',		tenThousandthsOfInches,		82677,	116929	],	#bw#
	[ 'a4',		micrometers,			210000,	297000	],
	[ 'b3',		micrometers,			353000,	500000	],
	[ 'b3',		tenThousandthsOfInches,		-1,	-1	],
	[ 'b5',		micrometers,			176000,	250000	],
	[ 'b5',		tenThousandthsOfInches,		-1,	-1	],
	);
#bw# == Ben Woodard, extracted from npadmin, file=npaconsts.h

map {
  $paper_sizes_indexed->{$_->[Name]}->{$_->[Units]}= [ undef, undef, $_->[DimA], $_->[DimB] ]
  } @paper_sizes;

##################################### language_code	(this points the question at the answer)

use constant check_language	=> '_check_language';
use constant check_paper_size	=> '_check_paper_size';
use constant check_protocol	=> '_check_protocol';

%language_map= (
	pcl		=> check_language,
	postscript	=> check_language,
	psprint		=> check_language,
	pjl		=> check_language,
	hpgl		=> check_language,
	autolang	=> check_language,
	legal		=> check_paper_size,
	letter		=> check_paper_size,
	b5		=> check_paper_size,
	a3		=> check_paper_size,
	executive	=> check_paper_size,
	b4		=> check_paper_size,
	a4		=> check_paper_size,
	tabloid		=> check_paper_size,
	port9100	=> check_protocol,
	netware		=> check_protocol,
	lpd		=> check_protocol,
	appletalk	=> check_protocol,
	);

$language_code= q[
	sub ##SUBNAME##
	{
#warn '##SUBNAME##';
	  my $self= shift;

	  return $self->##HANDLER##( '##SUBNAME##');
	}
	];

##################################### filter_code	(this fetches data and translates field names)

%filter_map= (
	status => [
		'hrPrinterStatus',
		{
		"hrPrinterStatus"			=> 'status',
		}],
	memory => [
		'hrMemorySize',
		{
		'hrMemorySize'				=> 'memsize',
		}],
	netconfig => [
		'netconfig',
		{
		'ipAdEntAddr'				=> 'ipaddr',
		'ifPhysAddress'				=> 'hwaddr',
		'ipRouteNextHop'			=> 'gateway',
		'ipAdEntNetMask'			=> 'netmask',
		}],
	cfgsrc => [
		'hp_npCfgSource',
		{
		'npCfgSource'				=> 'cfgsrc',
		}],
	storage => [
		'hrStorage',
		{
		'hrStorageDescr'			=> 'descr',
		'hrStorageSize'				=> 'size',
		'hrStorageUsed'				=> 'used',
		'hrStorageAllocationUnits'		=> 'allocunits',
		'hrStorageAllocationFailures'		=> 'allocfail',
		}],
	display => [
		'prtConsoleDisplayBuffer',
		{
		'prtConsoleDisplayBufferText'		=> 'displayBufferText',
		}],
	languages => [
		'prtInterpreter',
		{
		'prtInterpreterLangFamily'		=> 'langFamily',
		'prtInterpreterLangLevel'		=> 'langLevel',
		'prtInterpreterLangVersion'		=> 'langVersion',
		'prtInterpreterDescription'		=> 'description',
		'prtInterpreterVersion'			=> 'version',
		'prtInterpreterDefaultOrientation'	=> 'orientation',
		'prtInterpreterFeedAddressability'	=> 'feedAddressability',
		'prtInterpreterXFeedAddressability'	=> 'xFeedAddressability',
		'prtInterpreterTwoWay'			=> 'twoWay',
		}],
	protocol => [
		'prtChannel',
		{
		'prtChannelType'			=> 'type',
		'prtChannelProtocolVersion'		=> 'version',
		'prtChannelState'			=> 'state',
		'prtChannelStatus'			=> 'status',
		'prtChannelDefaultPageDescLangIndex'	=> 'defaultPageDescLang',
		'prtChannelCurrentJobCntlDescLangIndex'	=> 'currentJobControlLang',
		}],
	covers => [
		'prtCover',
		{
		'prtCoverDescription'			=> 'description',
		'prtCoverStatus'			=> 'status',
		}],
	mediapath => [
		'prtMediaPath',
		{
		'prtMediaPathType'			=> 'type',
		'prtMediaPathDescription'		=> 'description',
		'prtMediaPathStatus'			=> 'status',
		'prtMediaPathMediaSizeUnit'		=> 'mediaSizeunit',
		'prtMediaPathMaxMediaFeedDir'		=> 'maxMediaFeedDir',
		'prtMediaPathMaxMediaXFeedDir'		=> 'maxMediaXFeedDir',
		'prtMediaPathMinMediaFeedDir'		=> 'minMediaFeedDir',
		'prtMediaPathMinMediaXFeedDir'		=> 'minMediaXFeedDir',
		'prtMediaPathMaxSpeed'			=> 'maxSpeed',
		'prtMediaPathMaxSpeedPrintUnit'		=> 'maxSpeedPrintUnit',
		}],
	alerts => [
		'prtAlert',
		{
		'prtAlertTrainingLevel'			=> 'trainingLevel',
		'prtAlertGroup'				=> 'group',
		'prtAlertGroupIndex'			=> 'groupIndex',
		'prtAlertLocation'			=> 'location',
		'prtAlertCode'				=> 'code',
		'prtAlertDescription'			=> 'description',
		'prtAlertTime'				=> 'time',
		}],
	supplies => [
		'prtMarkerSupplies',
		{
		'prtMarkerSuppliesType'			=> 'type',
		'prtMarkerSuppliesSupplyUnit'		=> 'supplyunit',
		'prtMarkerSuppliesClass'		=> 'class',
		'prtMarkerSuppliesDescription'		=> 'desc',
		'prtMarkerSuppliesMaxCapacity'		=> 'maxcap',
		'prtMarkerSuppliesLevel'		=> 'level',
		}],
	marker => [
		'prtMarker',
		{
		'prtMarkerMarkTech'			=> 'markerTechnology',
		'prtMarkerCounterUnit'			=> 'counterUnits',
		'prtMarkerLifeCount'			=> 'lifeCount',
		'prtMarkerProcessColorants'		=> 'processColorants',
		'prtMarkerAddressabilityUnit'		=> 'addressabilityUnit',
		'prtMarkerAddressabilityFeedDir'	=> 'addressabilityFeedDir',
		'prtMarkerAddressabilityXFeedDir'	=> 'addressabilityXFeedDir',
		'prtMarkerNorthMargin'			=> 'northMargin',
		'prtMarkerSouthMargin'			=> 'southMargin',
		'prtMarkerEastMargin'			=> 'eastMargin',
		'prtMarkerWestMargin'			=> 'westMargin',
		'prtMarkerStatus'			=> 'status',
		}],
	inputtray => [
		'prtInput',
		{
		'prtInputType'				=> 'type',
		'prtInputDimUnit'			=> 'dimUnit',
		'prtInputMediaDimFeedDirChosen'		=> 'dimFeedDir',
		'prtInputMediaDimXFeedDirChosen'	=> 'dimXFeedDir',
		'prtInputCapacityUnit'			=> 'capUnit',
		'prtInputMaxCapacity'			=> 'maxCap',
		'prtInputCurrentLevel'			=> 'curLevel',
		'prtInputMediaName'			=> 'mediaName',
		'prtInputName'				=> 'name',
		'prtInputDescription'			=> 'description',
		'prtInputStatus'			=> 'status',
		}],
	contact => [
		'mib2_system',
		{
		"sysContact"				=> 'contact',
		"sysLocation"				=> 'location',
		}],
	pagecount => [
		'prtMarker',
		{
		"prtMarkerLifeCount"			=> 'pagecount',
		"prtMarkerCounterUnit"			=> 'countUnits',
		}],
	colors => [
		'prtMarker',
		{
		"prtMarkerProcessColorants"		 => 'processColorants',
		}],
	resolution => [
		'prtMarker',
		{
		"prtMarkerAddressabilityUnit"		=> 'addressabilityUnit',
		"prtMarkerAddressabilityFeedDir"	=> 'addressabilityFeedDir',
		"prtMarkerAddressabilityXFeedDir"	=> 'addressabilityXFeedDir',
		}],
	minmargin => [
		'prtMarker',
		{
		"prtMarkerAddressabilityUnit"		=> 'addressabilityUnit',
		"prtMarkerNorthMargin"			=> 'northMargin',
		"prtMarkerSouthMargin"			=> 'southMargin',
		"prtMarkerEastMargin"			=> 'eastMargin',
		"prtMarkerWestMargin"			=> 'westMargin',
		}],
	minpapersize => [
		'prtMediaPath',
		{
		"prtMediaPathMediaSizeUnit"		=> 'minMediaUnit',
		"prtMediaPathMinMediaFeedDir"		=> 'minMediaFeedDir',
		"prtMediaPathMinMediaXFeedDir"		=> 'minMediaXFeedDir',
		},
		[
		sub { my $x= shift; $x->{prtMediaPathMinMediaFeedDir} * $x->{prtMediaPathMinMediaXFeedDir} },
		sub { my @x= @_; $x[0] < ( $x[1] || 1e99 ) },
		],
		],
	maxpapersize => [
		'prtMediaPath',
		{
		"prtMediaPathMediaSizeUnit"		=> 'maxMediaUnit',
		"prtMediaPathMaxMediaFeedDir"		=> 'maxMediaFeedDir',
		"prtMediaPathMaxMediaXFeedDir"		=> 'maxMediaXFeedDir',
		},
		[
		sub { my $x= shift; $x->{prtMediaPathMaxMediaFeedDir} * $x->{prtMediaPathMaxMediaXFeedDir} },
		sub { my @x= @_; ( $x[0] > $x[1]) },
		],
		],
	enginespeed => [
		'prtMediaPath',
		{
		"prtMediaPathMaxSpeedPrintUnit"		=> 'maxSpeedUnit',
		"prtMediaPathMaxSpeed"			=> 'maxSpeed',
		},
		[
		sub { my $x= shift; $x->{prtMediaPathMaxSpeed} },
		sub { my @x= @_; ( $x[0] > $x[1] ) },
		],
		],
	);

$filter_code= q{
	sub ##SUBNAME##
	{
#warn '##SUBNAME##';
	  my $self= shift;
	  my( $x, $y, $z);

	  $x= $self->{Neon}->##SNMPTABLE##();
	  $x= $self->_munge_it( $x, $filter_map{##SUBNAME##}->[2]) if $filter_map{##SUBNAME##}->[2];

	  $z= $filter_map{##SUBNAME##}->[1];

	  if ( ref $x eq 'ARRAY' )
	  {
	    foreach my $var (( ref $x eq 'ARRAY' ) ? @$x : $x )
	    {
	      my %M;
	      %M= map { ( $z->{$_}, $var->{$_}) } ( grep { my $a= $_; grep { $a eq $_ } keys %$z } keys %$var );
	      push @$y, \%M if %M;
	    }
	  }
	  else
	  {
	    $y= { map { ( $z->{$_}, $x->{$_}) } ( grep { my $a= $_; grep { $a eq $_ } keys %$z } keys %$x ) };
	  }

	  return $y;
	}
	};

##################################### answer_code	(this answers boolean questions)

%answer_map= (
	duplex => [
		'prtMediaPath',
		[ 'longEdgeBindingDuplex', 'shortEdgeBindingDuplex'],
		sub { my @x= @_; grep { $x[0]->{prtMediaPathType} eq $_ } @{$x[1]} },
		],
	_check_language => [
		'prtInterpreter',
		{	pcl		=> 'langPCL',
			postscript	=> 'langPS',
			psprint		=> 'langPSPrinter',
			pjl		=> 'langPCL',
			hpgl		=> 'langHPGL',
			autolang	=> 'langAutomatic',
			},
		sub { my @x= @_; $x[0]->{prtInterpreterLangFamily} eq $x[1]->{$x[2]} },
		],
	_check_protocol => [
		'prtChannel',
		{	appletalk	=> [ qw/ chAppleTalkPAP / ],
			lpd		=> [ qw/ chLPDServer / ],
			port9100	=> [ qw/ chPort9100 chAppSocket chBidirPortTCP / ],
			},
		sub { my @x= @_; grep { $x[0]->{prtChannelType} eq $_ } @{$x[1]->{$x[2]}} },
		],
	_check_paper_size => [
		'prtInput',
		{},
		sub { my @x= @_;
			my $a= $x[0]->{prtInputMediaDimFeedDirChosen};
			my $b= $x[0]->{prtInputMediaDimXFeedDirChosen};
			my $c= $x[0]->{prtInputDimUnit};
			my $y= $paper_sizes_indexed->{$x[2]}->{$c}->[DimA];
			my $z= $paper_sizes_indexed->{$x[2]}->{$c}->[DimB];

			(( $a == $y ) && ( $b == $z ))
					||
			(( $a == $z ) && ( $b == $y ))
  			},
		],
	printmib => [
		'printmib',
                undef,
                sub { shift()->{printmib} },
		],
	hostmib => [
		'hostmib',
                undef,
                sub { shift()->{hostmib} },
		],
	);

$answer_code= q{
	sub ##SUBNAME##
	{
#warn "##SUBNAME##";
	  my( $self, $a)= @_;
	  my $answer= 0;
	  my( $x, $y, $z);

	  $x= $self->{Neon}->##SNMPTABLE##();
	  $y= $answer_map{##SUBNAME##}->[2];
	  $z= $answer_map{##SUBNAME##}->[1];

          if( ref $y =~ '^CODE(.+)' )
          {
	    foreach my $var ( @$x )
	    {
	      $answer++ if $y->( $var, $z, $a);
	    }
          }
          else
          {
	    $answer= $x;
          }

	  return { ##VALNAME## => $self->{boolean}->[$answer?1:0] };
	}
	};

##################################### AUTOLOAD

sub AUTOLOAD
{
#warn "AUTOLOAD";
  my $autoload= ( $AUTOLOAD =~ /.*::(\w+)/ )[0];

  my( $sub, %tags);
  if ( defined $language_map{$autoload} )
  {
    $sub= $language_code;
    %tags= (
	'##SUBNAME##'	=> $autoload,
	'##HANDLER##'	=> $language_map{$autoload},
	);
  }
  elsif ( defined $filter_map{$autoload} )
  {
    $sub= $filter_code;
    %tags= (
	'##SUBNAME##'	=> $autoload,
	'##SNMPTABLE##'	=> $filter_map{$autoload}->[0],
	'##MUNGE_FILTER##'	=> $filter_map{$autoload}->[1],
	);
  }
  elsif ( defined $answer_map{$autoload} )
  {
    $sub= $answer_code;
    %tags= (
	'##SUBNAME##'	=> $autoload,
	'##SNMPTABLE##'	=> $answer_map{$autoload}->[0],
	'##VALNAME##'	=> ( ref $answer_map{$autoload}->[1] eq 'HASH' ) ? '$a' : $autoload,
	);
  }

  if ( $sub )
  {
      map { $sub=~ s/\Q$_/$tags{$_}/g } keys %tags;
      eval $sub;
      die $@ if $@;
      goto &$autoload;
  }

  printf STDERR "Unimplemented method:\t'%s()'\n", $autoload;
  return undef;
}

##################################### _munge_it

sub _munge_it
{
#warn '_munge_it';
  my( $self, $x, $F)= @_;

  my( $M, $m);
  foreach my $var ( @$x )
  {
    my $a= $F->[0]->( $var);

    if (( ! $m ) || ( $F->[1]->( $a, $m) ))
    {
      $M= $var;
      $m= $a;
    }
  }

  return $M;
}

##################################### the end
#
# $Id: NPAdmin.pm,v 1.23 2002/11/15 03:57:23 bozzio Exp $
#

1;