# -*- perl -*-
#
# Net::NIS::Tied - interface to YP^H^HNIS
#
# $Id: NIS.pm,v 1.10 2003/03/19 12:32:07 esm Exp $
#
package Net::NIS;

use strict;
# 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',
  );


# 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/yperr_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.34';

$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 = <NICKNAMES>)) {
	$line =~ /^\s*(\S+)\s+(\S+)$/
	  or next;
	$nickname{$1} = $2;
      }
      close NICKNAMES;
    } else {
      %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.
  #
  # We can't do "ypwhich -m", because that seems to be magic... so let's
  # just try to look up a bogus key in this map.  If we get "no such key"
  # (or, improbably, success!), it means this map exists.  Anything else,
  # and we return failure.
  $map = _expand_nickname($map);
  yp_match ($domain, $map, '__SlArTiBaRtFaSt?');
  $yperr == YPERR_SUCCESS() || $yperr == YPERR_KEY()
    or 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;

  # 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.
  my $val = yp_match($self->{domain}, $self->{map}, $key);
  defined $val
    and return $val;

  # Error... is it 'no such key in map'?  That's OK
  $yperr == YPERR_KEY()
    and 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;

  # 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 very 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__