This page generated by the Net-Print server. Send page-related comments to Net-Print Administrators.";
print "
\n";
print "\n";
print "\n";
}
############################################################
# Use sidecar and "permits" table to authenticate and authorize user
# $dbhx Database handle or 'undef' (connect and disconnect)
# $access_level undef Obtain NetID via Sidecar if possible
# Return "$NOUSER" if authentication not possible
# $access_level == 0 Require NetID via Sidecar
# Error if Sidecar not running or authentication fails
# $access_level != 0 Require NetID via Sidecar plus given perms
# Error if Sidecar not running or authentication fails
# Error if inadequate perms
# return value NetID which was authenticated, or $NOUSER
sub nplogin {
my($dbhx, $access_level) = @_;
my($dbh, $msg);
if ( ! defined($dbh = $dbhx) ) {
($dbh, $msg) = dbconnect();
if ( ! defined($dbh) ) {
html_header("Unable to connect to accounting system. Please contact an Operator.", 0);
exit_error($msg);
}
}
my($remote) = $ENV{"REMOTE_ADDR"};
my($port) = $ENV{"REMOTE_PORT"};
my($cmd) = "$FCARCMD -h $remote:$SIDECARPORT \"\" $port 2>&1";
my($rc, $msg1, $msg2, $netid) = split(/:/,`$cmd`,4);
chop $rc;
chop $netid;
if ( $rc ) {
if ( defined($access_level) ) {
$dbh->disconnect() if ! defined($dbhx);
html_header("Sidecar Authorization Error", 0);
exit_error("You must be running SideCar and have a valid NetID to use this service. RC: $rc Msg: $msg1");
}
else {
return $NOUSER;
}
}
my($select_permit);
if ( ! ($select_permit = $dbh->prepare("SELECT * FROM permits WHERE netid = ?")) ) {
html_header("Authorization Error", 0);
exit_error("Preparing select_permit (".$dbh->errstr.")");
}
if ( ! ($select_permit->execute($netid)) ) {
html_header("Authorization Error", 0);
exit_error("Selecting permit (".$dbh->errstr.")");
}
my($pdata) = $select_permit->fetchrow_hashref;
$select_permit->finish;
my(%permitbits) = ( 'operator' => $OPRBIT, 'cashier' => $CSHBIT, 'refunder' => $RFDBIT, 'coordinator' => $CRDBIT, 'manager' => $MGRBIT );
$authorization = 0;
if ( defined($pdata) ) {
foreach ( keys(%permitbits) ) {
if ( $pdata->{$_} eq 'Y' ) {
$authorization |= $permitbits{$_};
}
}
}
my($sinfo);
($sinfo, $msg) = get_subscription_info($dbh, $netid);
if ( defined($sinfo) ) {
$authorization |= $SUBBIT;
}
$dbh->disconnect() if ! defined($dbhx);
if ( $access_level and (($access_level & $authorization) == 0) ) {
html_header("Authorization Error", 0);
exit_error("You are not authorized to view this page.");
}
return ($netid);
}
sub has_manager_priv {
return($authorization & $MGRLEVEL);
}
sub has_coordinator_priv {
return($authorization & $CRDLEVEL);
}
sub has_refunder_priv {
return($authorization & $RFDLEVEL);
}
sub has_cashier_priv {
return($authorization & $CSHLEVEL);
}
sub has_operator_priv {
return($authorization & $OPRLEVEL);
}
sub has_subscriber_priv {
return($authorization & $SUBLEVEL);
}
############################################################
sub getoprprm {
my($netid) = $_[0];
my($rc,@errtxt) = split(/:/,`$PERMITCLIENT -cgetPermit -n$netid $OPRPERMIT 2>&1`);
return ($rc eq '0');
}
############################################################
sub getmgrprm {
my($netid) = $_[0];
my($rc,@errtxt) = split(/:/,`$PERMITCLIENT -cgetPermit -n$netid $MGRPERMIT 2>&1`);
return ($rc eq '0');
}
############################################################
sub getezpprm {
my($netid) = $_[0];
my($rc,@errtxt) = split(/:/,`$PERMITCLIENT -cgetPermit -n$netid $EZPPERMIT 2>&1`);
return ($rc eq '0');
}
############################################################
# Given unix time, return formatted DBMS time.
sub get_datetime {
my($uxtime) = @_;
my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($uxtime);
my($time) = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec);
return($time);
}
############################################################
# Given unix time, return DBMS time as an array.
sub get_datetime_array {
my($uxtime) = @_;
my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($uxtime);
return(($year+1900, $mon+1, $mday, $hour, $min, $sec));
}
############################################################
# Get the information that was passed to us from the previous form
sub parse_form_vars {
my(%FORM);
my(@pairs);
my($buffer, $pair, $fieldname, $value);
# Grab Content-length bytes (length of input stream) from stdin
# and store in $query
if ( $ENV{'REQUEST_METHOD'} eq "GET" ) {
$buffer = $ENV{'QUERY_STRING'};
}
elsif ( $ENV{'REQUEST_METHOD'} eq "POST" ) {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
@pairs = split(/&/, $buffer); # Split fields into an array. Delim is &
foreach $pair (@pairs) {
# Split into the fieldname and value
# Translate +'s to spaces. Could use s/\+ /g (substitute all)
$pair =~ tr/+/ /;
# Unescape the special characters
$pair =~ s/%(..)/pack("c", hex($1))/ge;
#$pair =~ s/%(a-fA-F0-9][a-fA-f0-9])/pack("C",hex($1))/eg;
# Mac browsers have quotes, remove for platform compatability
$pair =~ s/\'//g;
# store in FORM pairs
($fieldname, $value) = split(/=/, $pair, 2);
$FORM{$fieldname} = $value;
}
return(%FORM);
}
############################################################
# If $AUTHORIZATION < MGRLEVEL splash an error message and exit
sub mgr_only {
if ( ! has_manager_priv() ) {
html_header("Authorization Error",0);
exit_error("You need a manager permit to access this page.");
}
}
############################################################
# Display error message and exit
sub exit_error {
my($message) = @_;
display_error($message);
html_footer();
exit();
}
############################################################
# Display error message
sub display_error {
my($message) = @_;
$message =~ s/\n/ \n/g;
print "
\n";
print "
\n";
print "
$message
\n";
print "
\n";
}
############################################################
# Calls display_error and log_error on the string
sub display_and_log_error {
my($msg) = @_;
log_error($msg);
display_error($msg);
}
############################################################
# Print the time, date and String to the global NetPrint log specified
# by the NPparams ERRORLOG variable
sub log_error {
if ( ! (-e $ERRORLOG) ) {
system "touch $ERRORLOG";
system "chmod 666 $ERRORLOG";
}
if ( ! open(DALOGFILE, ">$ERRORLOG") ) {
print "
Problems opening error log! Please report this to a lab administrator";
print " or via the feadback feature\n";
exit;
} else {
my($time) = get_datetime(time());
chomp $_[0];
print DALOGFILE "$time#$_[0]\n";
close DALOGFILE;
}
}
############################################################
# CreateHtmlSelect(Select's Name, Option Selected, Height, *Hash of
# displayed value -> Returned value);
sub CreateHtmlSelect {
my($SelName, $OptSel, $height, $isHash, $rest) = @_;
my($key, $value);
print "\n";
}
############################################################
# phcache($dbh, $netid) - retrieve NetID info from qi via local cache
# Returns hash containing qi data. Current keys are:
# name
# campus_phone
# campus_address
# valid ('Y' if there is currently an entry in qi)
sub phcache {
my($dbh, $netid) = @_;
my(%phnull) = ('netid' => $netid, 'name' => '', 'campus_phone' => '', 'campus_address' => '', 'valid' => 'N');
my($select_qidata);
$select_qidata = $dbh->prepare(q{SELECT * FROM qidata WHERE netid = ?})
or return(%phnull);
$select_qidata->execute($netid)
or return(%phnull);
my($qidata);
$qidata = $select_qidata->fetchrow_hashref;
$select_qidata->finish;
if ( defined($qidata) ) {
# Null fields are undefined
foreach ( keys %phnull ) {
if ( ! defined($qidata->{$_}) ) {
$qidata->{$_} = '';
}
}
return(%{$qidata});
}
my(%qidata);
%qidata = phlookup($netid);
if ( ! %qidata ) {
# carp "PH lookup failed for '$netid'\n";
return(%phnull);
}
my($insert_qidata);
$insert_qidata = $dbh->prepare(q{INSERT INTO qidata (netid, name, campus_phone, campus_address, valid) VALUES (?, ?, ?, ?, ?)})
# or carp "Preparing insert_qidata (".$dbh->errstr.")\n";
or return(%qidata);
$insert_qidata->execute($netid, $qidata{name}, $qidata{campus_phone}, $qidata{campus_address}, 'Y');
# or carp "Inserting qidata (".$dbh->errstr.")\n";
$dbh->commit;
return(%qidata);
}
############################################################
# phlookup($netid) - query the qi server for info on a NetID
# Returns hash containing qi data. Current keys are:
# name
# type
# home_phone
# campus_phone
# univ_title
# default_po
# first_name
# email
# alias
# home_address
# campus_address
# middle_name
# send_email_to
# last_name
# department
# slip
# last_updated_second_stamp
# last_updated
# web_page
# fax
sub phlookup {
my($netid) = @_;
use Net::PH;
my(%phdata) = ();
my($qi_server, $ph, $handle, $field, $f, $t);
my $ph_debug = 0;
# connect
foreach $qi_server ( qw(qi.cornell.edu postoffice.mail.cornell.edu) ) {
$ph = Net::PH->new($qi_server, Debug=>$ph_debug);
last if $ph;
}
carp "PH connect failed\n" if ! $ph;
return(undef) if ! $ph;
# query info for a netid (alias)
my $q = $ph->query({alias => $netid}, [qw(all)]);
# carp "PH query failed\n" if ! $q;
return(undef) if ! $q;
foreach $handle ( @{$q} ) {
foreach $field (keys %{$handle}) {
$f = ${$handle}{$field}->field;
$t = ${$handle}{$field}->text;
$phdata{$f} = $t;
}
}
return(%phdata);
}
######################################################################
sub dollars {
my($amt) = @_;
if ( ! defined($amt) ) {
$amt = 0;
}
return(sprintf("\$%.2f", $amt/100));
}
######################################################################
# Generate HTML date selector
# $name Name to use in "form" variable
# $idate Ref to array containing default date, eg. (1997, 5, 20)
# $year_range Year range relative to current year (eg. '+2-0')
sub select_datetime {
my($name, $idate, $year_range) = @_;
my(@months) = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
my($cyear) = (localtime(time()))[5] + 1900;
my($end, $start) = $year_range =~ /^\+(\d+)-(\d+)$/;
my($i);
print "";
print "";
print "";
}
######################################################################
# Process date/time data returned by a form into an Informix 'DATETIME'
sub process_formdate {
my($yr, $mon, $day, $hr, $min, $sec) = @_;
my(@monthdays) = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
# Crude leap-year kludge
if ( $yr % 4 == 0 ) {
$monthdays[2]++;
}
while ( $day > $monthdays[$mon] ) {
$day--;
}
return( sprintf("%04d-%02d-%02d %02d:%02d:%02d", $yr, $mon, $day, $hr, $min, $sec) );
}
############################################################################
# Set subscription parameters (designated account and banner option), creating
# the subscription if it doesn't already exist. Returns current data values.
# Adds appropriate account transactions.
# $dbh Database handle
# $oprnetid Operator's NetID
# $usernetid Account-holder's NetID
# $desig_fundsource Designated fundsource (unchanged if undef)
# $banner Banner page option (unchanged if undef)
# Return value:
# $sinfo Reference to hash containing 'desig_fundsource',
# 'banner', ...
# $action 'S' => created subscription, 'D' => set designated
# account, 'd' => changed designated account.
# $msg undef or error message
sub set_subscription_parameters {
my($dbh, $oprnetid, $usernetid, $desig_fundsource, $banner) = @_;
my($change_desig) = defined($desig_fundsource);
my($change_banner) = defined($banner);
my($select_subscription);
$select_subscription = $dbh->prepare(q{SELECT * FROM subscriptions WHERE usernetid = ?})
or return(undef, undef, "Preparing select_subscription (".$dbh->errstr.")");
$select_subscription->execute($usernetid)
or return(undef, undef, "Selecting subscription (".$dbh->errstr.")");
my($action) = '';
my($sdata);
if ( $sdata = $select_subscription->fetchrow_hashref ) {
# Subscription exists: set desig_fundsource, banner
$desig_fundsource = $change_desig ? $desig_fundsource : $sdata->{desig_fundsource};
$banner = $change_banner ? $banner : $sdata->{banner};
my($update_subscription);
$update_subscription = $dbh->prepare("UPDATE subscriptions SET desig_fundsource = ?, banner = ? WHERE usernetid = ?")
or return(undef, undef, "Preparing update_subscription (".$dbh->errstr.")");
$update_subscription->execute($desig_fundsource, $banner, $usernetid)
or return(undef, undef, "Updating subscription (".$dbh->errstr.")");
if ( $change_desig ) {
$action .= (defined($sdata->{desig_fundsource}) ? 'd' : 'D');
}
}
else {
# Subscription doesn't exist: create it and set default banner option
$banner = 'W';
$change_banner = 1;
my($insert_subscription);
$insert_subscription = $dbh->prepare("INSERT INTO Subscriptions VALUES (?, ?, ?)")
or return(undef, undef, "Preparing insert_subscription (".$dbh->errstr.")");
$insert_subscription->execute($usernetid, $desig_fundsource, $banner)
or return(undef, undef, "Inserting subscription (".$dbh->errstr.")");
$action .= 'S';
}
$select_subscription->finish;
my($msg);
if ( $change_desig ) {
if ( defined($msg = add_account_trans($dbh, $usernetid, $usernetid, $desig_fundsource, 'Set Designated Account', 0, 0)) ) {
$dbh->rollback;
return(undef, undef, $msg);
}
}
if ( $change_banner ) {
if ( defined($msg = add_account_trans($dbh, $usernetid, $usernetid, undef, "Set Banner Page Option to $banner", 0, 0)) ) {
$dbh->rollback;
return(undef, undef, $msg);
}
}
return({ 'banner' => $banner, 'desig_fundsource' => $desig_fundsource }, $action, undef);
}
######################################################################
# Retrieve information about user's subscription and designated account
# $dbh Database handle
# $usernetid Account-holder's NetID
# return values:
# $sinfo Reference to hash containing 'desig_fundsource', 'banner', ...
# $msg undef or error message
# Not subscribed if both $sinfo and $msg are undef
sub get_subscription_info {
my($dbh, $usernetid) = @_;
my($select_account, $sinfo);
$select_account = $dbh->prepare("SELECT * FROM subscriptions S, OUTER (accounts A, fundsources F) WHERE S.usernetid = ? AND A.usernetid = S.usernetid AND A.fundsource = S.desig_fundsource AND F.fundsource = A.fundsource")
or return( (undef, "Preparing select_account (".$dbh->errstr.")") );
$select_account->execute($usernetid)
or return( (undef, "Selecting account (".$dbh->errstr.")") );
$sinfo = $select_account->fetchrow_hashref;
$select_account->finish;
return( ($sinfo, undef) );
}
######################################################################
# Retrieve information about user's accounts
# $dbh Database handle
# $usernetid Account-holder's NetID
# $fundsource Fundsource (if '*', then retrieve info for all accounts)
# Return values:
# $ainfo Reference to array containing hashes containing
# 'fundsource', 'name', 'ftype', etc. (or undef if error)
# $msg undef or error message
sub get_acctinfo {
my($dbh, $fundsource, $usernetid) = @_;
my($select_account, $adata, $ainfo);
if ( $fundsource eq '*' ) {
$select_account = $dbh->prepare("SELECT * FROM accounts A, fundsources F WHERE A.usernetid = ? AND F.fundsource = A.fundsource")
or return( (undef, "Preparing select_account (".$dbh->errstr.")") );
$select_account->execute($usernetid)
or return( (undef, "Selecting account (".$dbh->errstr.")") );
}
else {
$select_account = $dbh->prepare("SELECT * FROM accounts A, fundsources F WHERE A.usernetid = ? AND A.fundsource = ? AND F.fundsource = A.fundsource")
or return( (undef, "Preparing select_account (".$dbh->errstr.")") );
$select_account->execute($usernetid, $fundsource)
or return( (undef, "Selecting account (".$dbh->errstr.")") );
}
$ainfo = undef;
while ( $adata = $select_account->fetchrow_hashref ) {
push(@{$ainfo}, $adata);
}
$select_account->finish;
return( ($ainfo, undef) );
}
######################################################################
# Charge or credit an account without checking balance
# $dbh Database handle
# $action 'Charge' or 'Credit'
# $usernetid Account-holder's NetID
# $fundsource Fundsource to charge (numeric index) (Use "designated
# fundsource" if $fundsource < 0)
# $amount Amount to be charged, credited, or refunded in deci-cents
sub modify_account {
my($dbh, $action, $usernetid, $fundsource, $amount) = @_;
my($adata, $msg);
if ( $amount <= 0 ) {
return("Amount must be greater than zero ($amount)");
}
if ( $fundsource < 0 ) {
my($sinfo);
($sinfo, $msg) = get_subscription_info($dbh, $usernetid);
if ( ! defined($sinfo) ) {
return(defined($msg) ? "Unable to get designated account ($msg)" : 'Not subscribed');
}
$fundsource = $sinfo->{desig_fundsource};
if ( ! defined($fundsource) ) {
return("No designated account");
}
}
my($select_account);
$select_account = $dbh->prepare("SELECT * FROM accounts WHERE usernetid = ? AND fundsource = ? FOR UPDATE")
or return("Preparing select_account (".$dbh->errstr.")\n");
$select_account->execute($usernetid, $fundsource)
or return("Selecting account (".$dbh->errstr.")\n");
if ( ! ($adata = $select_account->fetchrow_hashref) ) {
$select_account->finish;
return("No account found for NetID $usernetid and fundsource '$fundsource'");
}
if ( $action eq 'Charge' ) {
$adata->{charge} += $amount;
}
elsif ( $action eq 'Credit' ) {
$adata->{charge} -= $amount;
}
elsif ( $action eq 'CreditCap' ) {
$adata->{cap} += $amount;
}
else {
return("Invalid action in modify_account");
}
if ( ! $dbh->do("UPDATE accounts SET charge = $adata->{charge}, cap = $adata->{cap} WHERE CURRENT OF $select_account->{CursorName}") ) {
$select_account->finish;
return("Update account (".$dbh->errstr.")");
}
$select_account->finish;
return(undef);
}
######################################################################
sub create_index {
my($dbh, $name, $table, $column) = @_;
# indexes are dropped when table is dropped
# $dbh->do("DROP INDEX $name")
# or carp "Unable to DROP INDEX $name (".$dbh->errstr.")\n";
$dbh->do("CREATE INDEX $name ON $table ($column)")
or carp "Unable to CREATE INDEX $name for table $table column $column (".$dbh->errstr.")\n";
}
######################################################################
# Drop a table if it exists
sub drop_table {
my($dbh, $table) = @_;
my($select_tabname);
if ( ! ($select_tabname = $dbh->prepare("select tabname from systables where tabname = ?")) ) {
carp "Preparing select_tabname (".$dbh->errstr.")\n";
return(0);
}
if ( ! $select_tabname->execute($table) ) {
carp "Selecting tabname (".$dbh->errstr.")\n";
return(0);
}
my($tabname);
if ( ($tabname) = $select_tabname->fetchrow_array ) {
if ( ! $dbh->do("DROP TABLE $table") ) {
carp "Unable to DROP TABLE $table (".$dbh->errstr.")\n";
return(0);
}
}
return(1);
}
######################################################################
sub add_account_trans {
my($dbh, $oprnetid, $usernetid, $fundsource, $description, $dcharge, $dcap) = @_;
my($insert_account_trans);
if ( defined($fundsource) and ($fundsource < 0) ) {
my($sinfo, $msg) = get_subscription_info($dbh, $usernetid);
if ( ! defined($sinfo) ) {
return(defined($msg) ? "Unable to get designated account ($msg)" : 'Not subscribed');
}
$fundsource = $sinfo->{desig_fundsource};
}
$insert_account_trans = $dbh->prepare(q{INSERT INTO account_trans VALUES (0, CURRENT, ?, ?, ?, ?, ?, ?)})
or return("Unable to prepare INSERT INTO trans (".$dbh->errstr.")");
if ( ! $insert_account_trans->execute($oprnetid, $usernetid, $fundsource, $description, $dcharge, $dcap) ) {
return("Unable to insert trans (".$dbh->errstr.")");
}
return(undef);
}
######################################################################
# Add a print transaction to the database
# $dbhx Database handle or 'undef' (connect and disconnect)
# $fundsource Fundsource to charge (numeric index) (Use "designated
# fundsource" if $fundsource < 0)
# return value null string or error message
sub add_print_trans {
my($dbhx, $time, $usernetid, $fundsource, $description, $queue, $workstation, $pages, $lagtime, $rate, $tariff, $banner) = @_;
my($dbh, $msg, $insert_print_trans);
if ( ! defined($dbh = $dbhx) ) {
($dbh, $msg) = dbconnect();
return($msg) if ! defined($dbh);
}
if ( $fundsource < 0 ) {
my($sinfo);
($sinfo, $msg) = get_subscription_info($dbh, $usernetid);
if ( ! defined($sinfo) ) {
return(defined($msg) ? "Unable to get designated account ($msg)" : 'Not subscribed');
}
$fundsource = $sinfo->{desig_fundsource};
}
if ( ! ($insert_print_trans = $dbh->prepare("INSERT INTO print_trans VALUES (0, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)")) ) {
$dbh->disconnect() if ! defined($dbhx);
return("Unable to prepare INSERT INTO trans (".$dbh->errstr.")");
}
if ( $time eq '' ) {
$time = 'CURRENT';
}
if ( ! $insert_print_trans->execute($time, $usernetid, $fundsource, $description, $queue, $workstation, $pages, $lagtime, $rate, $tariff, $banner) ) {
$dbh->disconnect() if ! defined($dbhx);
return("Unable to insert trans (".$dbh->errstr.")");
}
if ( ! defined($dbhx) ) {
$dbh->commit;
$dbh->disconnect();
}
return(undef);
}
######################################################################
# Get printer information from database
# $dbhx Database handle or 'undef' (connect and disconnect)
# $queue Queue name or '*' for all queues
# return values:
# $qinfo If $queue = queue name: Reference to hash containing 'queue',
# 'name', etc.
# If $queue = '*': Reference to hash of hashes
# (or undef if error)
# $msg undef or error message
sub get_queueinfo {
my($dbhx, $queue) = @_;
my(%qhash);
my($dbh, $msg, $select_queue, $qdata, $qinfo);
if ( ! defined($dbh = $dbhx) ) {
($dbh, $msg) = dbconnect();
return( (undef, $msg) ) if ! defined($dbh);
}
my($where) = "WHERE disabled <> 'Y'" . ($queue eq '*' ? '' : "AND name = '$queue'");
if ( ! ($select_queue = $dbh->prepare("SELECT * FROM queues $where")) ) {
$dbh->disconnect() if ! defined($dbhx);
return( (undef, "Preparing select_queue (".$dbh->errstr.")") );
}
if ( ! $select_queue->execute ) {
$dbh->disconnect() if ! defined($dbhx);
return( (undef, "Selecting queue (".$dbh->errstr.")\n") );
}
while ( $qdata = $select_queue->fetchrow_hashref ) {
if ( $queue eq '*' ) {
$qhash{$qdata->{name}} = $qdata;
}
else {
$qinfo = $qdata;
}
}
$dbh->disconnect() if ! defined($dbhx);
if ( $queue eq '*' ) {
return( (\%qhash, undef) );
}
else {
return( ($qinfo, undef) );
}
}
######################################################################
# Get printer status information from database
# $dbhx Database handle or 'undef' (connect and disconnect)
# $queue Queue name or '*' for all queues
# return values:
# $qinfo If $queue = queue name: printer status code
# If $queue = '*': Reference to hash of printer status codes
# (or undef if error)
# $msg undef or error message
sub get_statusinfo {
my($dbhx, $queuearg) = @_;
if ( $queuearg ne '*' ) {
return( (read_queue_status($queuearg), undef) );
}
my($qinfo, $msg) = get_queueinfo($dbhx, $queuearg);
if ( defined($msg) ) {
return(undef, $msg);
}
my(%stathash);
my($qname);
foreach $qname ( keys %{$qinfo} ) {
$stathash{$qname} = read_queue_status($qinfo->{$qname}{name});
}
return( (\%stathash, undef) );
}
######################################################################
# read_queue_status
sub read_queue_status {
my($queue) = @_;
if ( open(STATUS, "$SPOOLDIR/$queue/STATUS") ) {
my($status);
if ( $status = ) {
chomp($status);
}
else {
$status = 0;
}
close(STATUS);
return($status);
}
return(0);
}
######################################################################
# Connect to DBMS
# return value ($dbh, $msg)
# $dbh is database handle or 'undef' for error
# $msg is null or error message
sub dbconnect {
my($dbspec, $user, $password) = dbparams();
my($dbh);
$ENV{INFORMIXDIR} = '/usr/informix';
$ENV{INFORMIXSERVER} = $HOST;
$dbh = DBI->connect($dbspec, $user, $password, { AutoCommit => 0, ChopBlanks => 1 })
or return( (undef, "Unable to connect to '$dbspec' ($DBI::errstr)") );
# This potentially keeps us out of trouble while doing "update statistics"
$dbh->do("SET LOCK MODE TO WAIT 120")
or return( (undef, "Setting lock mode to wait 120 (".$dbh->errstr.")") );
return($dbh, '');
}
######################################################################
sub commify {
local $_ = shift;
$_ = int($_);
1 while s/^(-?\d+)(\d{3})/$1,$2/;
return $_;
}
######################################################################
sub commify_money {
local $_ = shift;
$_ = sprintf("%.2f", $_);
1 while s/^(-?\d+)(\d{3})/$1,$2/;
return $_;
}
######################################################################
sub commify_money3 {
local $_ = shift;
$_ = sprintf("%.3f", $_);
1 while s/^(-?\d+)(\d{3})/$1,$2/;
return $_;
}
######################################################################
# accumulate(\@sums, @items)
# Accumulate an array of data (@items) into an array of sums (@sums).
sub accumulate {
my($sums, @items) = @_;
my($i);
$i = 0;
foreach ( @items ) {
$sums->[$i++] += zero_if_undef($_);
}
}
######################################################################
sub zero_if_undef {
my($x) = @_;
return($x) if defined($x);
return(0);
}
######################################################################
# Wrap a string to 'maxline' character maximum per line
sub wrap_line {
my($l, $maxline) = @_;
use Text::Wrap qw(fill $columns $huge);
$columns = 70;
$huge = 'wrap';
return(fill('', '', $l));
}
######################################################################
# Replace a string with an HTML "non-breaking space" if it is blank
sub blankfill {
my($str) = @_;
return($str =~ /^\s*$/ ? ' ' : $str);
}
1;
.
![](\"/netprint-images/rule600.gif\")
![](\"/netprint/sublogo.gif\")
print "![](\"/netprint-images/sublogo.gif\")
![\"Net-Print\"](\"/netprint-images/footer.gif\")
Home Page";
print " | Accounts";
print " | Printers";
print " | Sign-up Form";
print " | Troubleshooting";
print "