File Coverage

blib/lib/Net/NIS.pm

Criterion	Covered	Total	%
statement	44	98	44.9
branch	5	38	13.1
condition	1	6	16.6
subroutine	13	22	59.0
pod			n/a
total	63	164	38.4

# -*- perl -*-
#
# Net::NIS::Tied - interface to YP^H^HNIS
#
# $Id: 104 $
#
package Net::NIS;

use strict;
use 5.006;
use warnings;			# Sigh, only available in 5.6 and above
use Carp;

###############################################################################
# BEGIN user-configurable section

# Linux and Solaris seem to have this file.  It contains a number of
# lines, each with a key/value pair (separated by spaces).
my $Nicknames_File = '/var/yp/nicknames';

# For those systems who don't have a nicknames file, here are some
# reasonable defaults.
my %Nicknames_Default =
  (
   passwd    => 'passwd.byname',
   group     => 'group.byname',
   networks  => 'networks.byaddr',
   hosts     => 'hosts.byname',
   protocols => 'protocols.bynumber',
   services  => 'services.byname',
   aliases   => 'mail.aliases',
   ethers    => 'ethers.byname',
  );


# Special case: this magic map acts as a front end to yp_master()
our $Magic_ypmaster_map = '__YPMASTER';

# Ouch.  It really hurts to enumerate these here, manually, instead of
# somehow relying on the autogenerated list made by h2xs.  But at least
# we have a test (t/15yperr_num.t) that should catch inconsistencies.
#
# Please be sure to keep these in numerical order, starting with 0.  If
# There are ever gaps in the YPERR_xxx sequence, or duplicates, we will
# have to rethink this approach.  But until then, let's not worry.
use vars qw(@YPERRS);
@YPERRS = map { "YPERR_$_" }
  qw(
     SUCCESS
     BADARGS
     RPC
     DOMAIN
     MAP
     KEY
     YPERR
     RESRC
     NOMORE
     PMAP
     YPBIND
     YPSERV
     NODOM
     BADDB
     VERS
     ACCESS
     BUSY
    );

# Magic!  This variable is magically tied to a global in our .xs which
# keeps track of the status returned from the last yp_xxx() function.
#
# This variable is exported by default.  I'm not too happy with its
# name, but it seems like the best out of all the possibilities I
# considered.  The primary benefit is that, given the fixed nature
# of the YPERR_xxx constant names, '$yperr' will be easier for someone
# to remember than $yp_status, $ypstatus, $yp_err, or anything like that.
#
# Any other suggestions, before it's too late to change it?
use vars qw($yperr);

# END   user-configurable section
###############################################################################

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $PKG);

require Exporter;
require DynaLoader;
require AutoLoader;

@ISA = qw(Exporter DynaLoader);

%EXPORT_TAGS = ( all => [ '$yperr', @YPERRS ] );
@EXPORT_OK   = (          '$yperr', @YPERRS   );
@EXPORT      = (          '$yperr'            );

$VERSION = '0.44';

$PKG = __PACKAGE__;		# For interpolating into error messages

#############
#  DESTROY  #  Not really used, but needed so AUTOLOAD doesn't trap it
#############
sub DESTROY {}

##############
#  AUTOLOAD  #  from h2xs
##############
sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    my $constname;
    use vars qw($AUTOLOAD);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "& not defined" if $constname eq 'constant';
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	if ($! =~ /Invalid/) {
	  if ($constname =~ /^YP/) {
	    croak "No such constant, ${PKG}::$constname";
	  } else {
	    croak "No such function, ${PKG}::$constname()";
	  }
	}
	else {
		croak "Your vendor has not defined Net::NIS macro $constname";
	}
    }

    {
	no strict 'refs';
	*$AUTOLOAD = sub { $val };
    }
    goto &$AUTOLOAD;
}

bootstrap Net::NIS $VERSION;

# Magic: The $yperr variable will now have the YP status, int & string form
_yp_tie_status ($yperr);


######################
#  _expand_nickname  #  Look for a string in the /var/yp/nicknames file
######################
sub _expand_nickname($) {
    my $map = shift;

    use vars '%nickname';

    # First time through?  Read the nicknames file, or initialize to a
    # reasonable default (hardcoded above).
    if (keys %nickname == 0) {
	if (open NICKNAMES, '<', $Nicknames_File) {
	    while (defined (my $line = )) {
		$line =~ /^\s*(\S+)\s+(\S+)$/
		    or next;
		$nickname{$1} = $2;
	    }
	    close NICKNAMES;
	} else {
	    # No nicknames file
	    %nickname = %Nicknames_Default;
	}
    }

    # If there's a nickname defined for this map, return it... otherwise,
    # the map name itself.
    $nickname{$map} || $map;
}


#############
#  TIEHASH  #  establish the relationship between a hash and a YP map.
#############
sub TIEHASH {
    my $class = shift;

    # Second argument must be a map name (passwd, mail.aliases, etc)
    my $map = shift
	or croak "Usage: tie \%hash, $PKG, 'MAP NAME' [, 'DOMAIN' ]\n";

    # Third argument (optional) is the NIS domain.  If unset, bail out
    # now, setting error to NODOM ("Local domain name not set").  Otherwise,
    # if we try the yp_match, it fails with the less-than-helpful BADARGS.
    my $domain = shift || yp_get_default_domain()
	or do {
	    $yperr = YPERR_NODOM();
	    return undef;
	};

    # Check validity of map name.
    # As a special case, use '__YPMASTER' to act as a front end to yp_master()
    $map = _expand_nickname($map);
    unless ($map eq $Magic_ypmaster_map) {
	if (! Net::NIS::yp_master( $domain, $map )) {
	    $yperr = YPERR_MAP();
	    return undef;
	}
    }

    # All OK.  Force $yperr to OK, and return a blessed object
    $yperr = YPERR_SUCCESS();
    bless { map => $map, domain => $domain }, $class;
}


###########
#  FETCH  #  read-only access to a key.
###########
sub FETCH {
    my $self = shift;
    my $key  = shift;

    # Special case for magic yp_master map
    if ($self->{map} eq $Magic_ypmaster_map) {
	return Net::NIS::yp_master($self->{domain}, $key);
    }

    # Have we slurped in all keys using yp_all() ?  Look up our key therein.
    if (exists $self->{_alldata} && exists $self->{_alldata}->{$key}) {
	return $self->{_alldata}->{$key};
    }

    # Haven't called yp_all(), or key not found there.  Do a real YP lookup.
    if (defined (my $val = yp_match($self->{domain}, $self->{map}, $key))) {
	return $val;
    }

    # Error... is it 'no such key in map'?  That's OK
    if ($yperr == YPERR_KEY()) {
	return undef;
    }

    # Any other error: fatal
    croak sprintf("Unable to find '%s' in %s.  Reason: %s",
		  $key, $self->{map}, $yperr);
}


############
#  EXISTS  #  Does a key exist?  This isn't cheap, it still incurs a yp_match
############
sub EXISTS {
    my $self = shift;

    defined $self->FETCH (@_);
}


##############
#  FIRSTKEY  #  For iterating with each() or keys()
##############
#
# Important note: this uses the yp_all() mechanism to slurp in a complete
# hash containing all the key/value pairs.  It is delayed until here,
# because our caller could simply want to perform lookups (via FETCH)
# without iterating over all keys.
#
sub FIRSTKEY {
    my $self = shift;

    # Special case when called with magic yp_master key
    if ($self->{map} eq $Magic_ypmaster_map) {
	my %master;

	for my $map (Net::NIS::yp_maplist( $self->{domain} )) {
	    $master{$map} = Net::NIS::yp_master( $self->{domain},$map );
	}
	$self->{_alldata} = \%master;
    }
    else {
	# Each time we get called, slurp across again... just in case any
	# values have changed.  This is suboptimal: in effect, we're keeping
	# a cache around for who-knows-how-long.  Suggestions welcome for
	# improving it (perhaps keeping a {_last_updated} time??)
	$self->{_alldata} = yp_all ($self->{domain}, $self->{map});

	# Returned value must be a hash.  If it isn't, something bad happened.
	if (ref $self->{_alldata} ne 'HASH') {
	    croak sprintf("No such map '%s'.  Reason: %s",
			  $self->{map}, $yperr);
	}
    }

    # Reset the each() operator, and let it do the rest.
    my $trashme = keys %{ $self->{_alldata} };
    return scalar each %{ $self->{_alldata} };
}

#############
#  NEXTKEY  #  no-brainer, just lets each() do the work on our internal hash
#############
sub NEXTKEY {
    my $self    = shift;

    return each %{ $self->{_alldata} };
}


# ------NO WRITE ACCESS ALLOWED------
sub _read_only(@) {
    croak "$PKG provides read-only access";
}

sub STORE  { _read_only(@_); }
sub DELETE { _read_only(@_); }

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

1;

__END__