[inseparable changes from patch from perl5.003_10 to perl5.003_11]

 CORE LANGUAGE CHANGES

Subject: Fix precedence problems with subs as uniops or listops
From: Chip Salzenberg <chip@atlantic.net>
Files: perly.c perly.c.diff perly.h perly.y

Subject: Don't reset $. on open()
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_sys.c

Subject: Support *glob{IO} (eventually deprecate *glob{FILEHANDLE})
From: Chip Salzenberg <chip@atlantic.net>
Files: pod/perlref.pod pp_hot.c sv.c

Subject: Don't let expression context force return context
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c

Subject: Properly convert "1E2" et al to IV/UV
From: Chip Salzenberg <chip@atlantic.net>
Files: doio.c sv.c

Subject: Fix modulo operator in UV realm
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c

Subject: Fix stat(_) after stat(HANDLE)
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_sys.c

Subject: Fix: s/// and "$x =~ $y" under 'use locale'
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c toke.c

 LIBRARY AND EXTENSIONS

Subject: {in,ob}structive pods
Date: Sat, 30 Nov 1996 09:52:57 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Files: MANIFEST lib/Class/Template.pm lib/File/stat.pm lib/Net/hostent.pm lib/Net/netent.pm lib/Net/protoent.pm lib/Net/servent.pm lib/Time/gmtime.pm lib/Time/localtime.pm lib/Time/tm.pm lib/User/grent.pm lib/User/pwent.pm

    These "should" be ready for inclusion in 5.004, although I'd like to
    update Class::Template's doc for legibility.  Dean, may we please have
    your permission to include this in the distribution?
    
    (I did look a bit into using Class::MethodMaker, but it seemed
    a bit complicated.)
    
    I know: these all look remarkably similar on the inside.  I keep trying
    to find a way to abstract out some of it.  Hopefully, they're reasonably
    legible at least in code, if not in docs. :-)
    
    Chip/Tim, please check the stat function for proper use of Symbol.
    
    thanks,
    
    --tom
    
    #!/bin/sh
    # This is a shell archive (produced by GNU sharutils 4.2).
    # To extract the files from this archive, save it to some FILE, remove
    # everything before the `!/bin/sh' line above, then type `sh FILE'.
    #
    # Made on 1996-11-30 09:52 MST by <tchrist@toy.perl.com>.
    # Source directory was `/home/tchrist/hack'.
    #
    # Existing files will *not* be overwritten unless `-c' is specified.
    #
    # This shar contains:
    # length mode       name
    # ------ ---------- ------------------------------------------
    #   5024 -rw-r--r-- obstructs/Class/Template.pm
    #   2782 -rw-r--r-- obstructs/File/stat.pm
    #   3961 -rw-r--r-- obstructs/Net/hostent.pm
    #   4435 -rw-r--r-- obstructs/Net/netent.pm
    #   2973 -rw-r--r-- obstructs/Net/protoent.pm
    #   3424 -rw-r--r-- obstructs/Net/servent.pm
    #   2476 -rw-r--r-- obstructs/Time/gmtime.pm
    #   2307 -rw-r--r-- obstructs/Time/localtime.pm
    #    622 -rw-r--r-- obstructs/Time/tm.pm
    #   2848 -rw-r--r-- obstructs/User/grent.pm
    #   2899 -rw-r--r-- obstructs/User/pwent.pm
    #
    save_IFS="${IFS}"
    IFS="${IFS}:"
    gettext_dir=FAILED
    locale_dir=FAILED
    first_param="$1"
    for dir in $PATH
    do
      if test "$gettext_dir" = FAILED && test -f $dir/gettext \
         && ($dir/gettext --version >/dev/null 2>&1)
      then
        set `$dir/gettext --version 2>&1`
        if test "$3" = GNU
        then
          gettext_dir=$dir
        fi
      fi
      if test "$locale_dir" = FAILED && test -f $dir/shar \
         && ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
      then
        locale_dir=`$dir/shar --print-text-domain-dir`
      fi
    done
    IFS="$save_IFS"
    if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
    then
      echo=echo
    else
      TEXTDOMAINDIR=$locale_dir
      export TEXTDOMAINDIR
      TEXTDOMAIN=sharutils
      export TEXTDOMAIN
      echo="$gettext_dir/gettext -s"
    fi
    touch -am 1231235999 $$.touch >/dev/null 2>&1
    if test ! -f 1231235999 && test -f $$.touch; then
      shar_touch=touch
    else
      shar_touch=:
      echo
      $echo 'WARNING: not restoring timestamps.  Consider getting and'
      $echo "installing GNU \`touch', distributed in GNU File Utilities..."
      echo
    fi
    rm -f 1231235999 $$.touch
    #
    if mkdir _sh24166; then
      $echo 'x -' 'creating lock directory'
    else
      $echo 'failed to create lock directory'
      exit 1
    fi
    # ============= obstructs/Class/Template.pm ==============
    if test ! -d 'obstructs'; then
      $echo 'x -' 'creating directory' 'obstructs'
      mkdir 'obstructs'
    fi
    if test ! -d 'obstructs/Class'; then
      $echo 'x -' 'creating directory' 'obstructs/Class'
      mkdir 'obstructs/Class'
    fi
    if test -f 'obstructs/Class/Template.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Class/Template.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Class/Template.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Class/Template.pm' &&
    package Class::Template;
    require 5.000;
    require Exporter;
    X
    @ISA = qw(Exporter);
    @EXPORT = qw(members struct);
    use strict;
    X
    # Template.pm   --- struct/member template builder
    #   12mar95
    #   Dean Roehrich
    #
    # changes/bugs fixed since 28nov94 version:
    #  - podified
    # changes/bugs fixed since 21nov94 version:
    #  - Fixed examples.
    # changes/bugs fixed since 02sep94 version:
    #  - Moved to Class::Template.
    # changes/bugs fixed since 20feb94 version:
    #  - Updated to be a more proper module.
    #  - Added "use strict".
    #  - Bug in build_methods, was using @var when @$var needed.
    #  - Now using my() rather than local().
    #
    # Uses perl5 classes to create nested data types.
    # This is offered as one implementation of Tom Christiansen's "structs.pl"
    # idea.
    X
    =head1 NAME
    X
    Class::Template - struct/member template builder
    X
    =head1 EXAMPLES
    X
    =item * Example 1
    X
    X	use Class::Template;
    X	
    X	struct( rusage => {
    X		ru_utime => timeval,
    X		ru_stime => timeval,
    X	});
    X	
    X	struct( timeval => [
    X		tv_secs  => '$',
    X		tv_usecs => '$',
    X	]);
    X
    X	my $s = new rusage;
    X
    =item * Example 2
    X
    X	package OBJ;
    X	use Class::Template;
    X
    X	members OBJ {
    X		'a'	=> '$',
    X		'b'	=> '$',
    X	};
    X
    X	members OBJ2 {
    X		'd'	=> '@',
    X		'c'	=> '$',
    X	};
    X
    X	package OBJ2; @ISA = (OBJ);
    X
    X	sub new {
    X		my $r = InitMembers( &OBJ::InitMembers() );
    X		bless $r;
    X	}
    X
    =head1 NOTES
    X 
    Use '%' if the member should point to an anonymous hash.  Use '@' if the
    member should point to an anonymous array.
    X
    When using % and @ the method requires one argument for the key or index
    into the hash or array.
    X
    Prefix the %, @, or $ with '*' to indicate you want to retrieve pointers to
    the values rather than the values themselves.
    X
    =cut
    X
    Var: {
    X	$Class::Template::print = 0;
    X	sub printem { $Class::Template::print++ }
    }
    X
    X
    sub struct {
    X	my( $struct, $ref ) = @_;
    X	my @methods = ();
    X	my %refs = ();
    X	my %arrays = ();
    X	my %hashes = ();
    X	my $out = '';
    X
    X	$out = "{\n  package $struct;\n  sub new {\n";
    X	parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 0 );
    X	$out .= "      bless \$r;\n  }\n";
    X	build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );
    X	$out .= "}\n1;\n";
    X
    X	( $Class::Template::print ) ? print( $out ) : eval $out;
    }
    X
    sub members {
    X	my( $pkg, $ref ) = @_;
    X	my @methods = ();
    X	my %refs = ();
    X	my %arrays = ();
    X	my %hashes = ();
    X	my $out = '';
    X
    X	$out = "{\n  package $pkg;\n  sub InitMembers {\n";
    X	parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 1 );
    X	$out .= "      bless \$r;\n  }\n";
    X	build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes );
    X	$out .= "}\n1;\n";
    X
    X	( $Class::Template::print ) ? print( $out ) : eval $out;
    }
    X
    X
    sub parse_fields {
    X	my( $ref, $out, $methods, $refs, $arrays, $hashes, $member ) = @_;
    X	my $type = ref $ref;
    X	my @keys;
    X	my $val;
    X	my $cnt = 0;
    X	my $idx = 0;
    X	my( $cmt, $n );
    X
    X	if( $type eq 'HASH' ){
    X		if( $member ){
    X			$$out .= "      my(\$r) = \@_ ? shift : {};\n";
    X		}
    X		else{
    X			$$out .= "      my(\$r) = {};\n";
    X		}
    X		@keys = keys %$ref;
    X		foreach (@keys){
    X			$val = $ref->{$_};
    X			if( $val =~ /^\*(.)/ ){
    X				$refs->{$_}++;
    X				$val = $1;
    X			}
    X			if( $val eq '@' ){
    X				$$out .= "      \$r->{'$_'} = [];\n";
    X				$arrays->{$_}++;
    X			}
    X			elsif( $val eq '%' ){
    X				$$out .= "      \$r->{'$_'} = {};\n";
    X				$hashes->{$_}++;
    X			}
    X			elsif( $val ne '$' ){
    X				$$out .= "      \$r->{'$_'} = \&${val}::new();\n";
    X			}
    X			else{
    X				$$out .= "      \$r->{'$_'} = undef;\n";
    X			}
    X			push( @$methods, $_ );
    X		}
    X	}
    X	elsif( $type eq 'ARRAY' ){
    X		if( $member ){
    X			$$out .= "      my(\$r) = \@_ ? shift : [];\n";
    X		}
    X		else{
    X			$$out .= "      my(\$r) = [];\n";
    X		}
    X		while( $idx < @$ref ){
    X			$n = $ref->[$idx];
    X			push( @$methods, $n );
    X			$val = $ref->[$idx+1];
    X			$cmt = "# $n";
    X			if( $val =~ /^\*(.)/ ){
    X				$refs->{$n}++;
    X				$val = $1;
    X			}
    X			if( $val eq '@' ){
    X				$$out .= "      \$r->[$cnt] = []; $cmt\n";
    X				$arrays->{$n}++;
    X			}
    X			elsif( $val eq '%' ){
    X				$$out .= "      \$r->[$cnt] = {}; $cmt\n";
    X				$hashes->{$n}++;
    X			}
    X			elsif( $val ne '$' ){
    X				$$out .= "      \$r->[$cnt] = \&${val}::new();\n";
    X			}
    X			else{
    X				$$out .= "      \$r->[$cnt] = undef; $cmt\n";
    X			}
    X			++$cnt;
    X			$idx += 2;
    X		}
    X	}
    }
    X
    X
    sub build_methods {
    X	my( $ref, $out, $methods, $refs, $arrays, $hashes ) = @_;
    X	my $type = ref $ref;
    X	my $elem = '';
    X	my $cnt = 0;
    X	my( $pre, $pst, $cmt, $idx );
    X
    X	foreach (@$methods){
    X		$pre = $pst = $cmt = $idx = '';
    X		if( defined $refs->{$_} ){
    X			$pre = "\\(";
    X			$pst = ")";
    X			$cmt = " # returns ref";
    X		}
    X		$$out .= "  sub $_ {$cmt\n      my \$r = shift;\n";
    X		if( $type eq 'ARRAY' ){
    X			$elem = "[$cnt]";
    X			++$cnt;
    X		}
    X		elsif( $type eq 'HASH' ){
    X			$elem = "{'$_'}";
    X		}
    X		if( defined $arrays->{$_} ){
    X			$$out .= "      my \$i;\n";
    X			$$out .= "      \@_ ? (\$i = shift) : return \$r->$elem;\n";
    X			$idx = "->[\$i]";
    X		}
    X		elsif( defined $hashes->{$_} ){
    X			$$out .= "      my \$i;\n";
    X			$$out .= "      \@_ ? (\$i = shift) : return \$r->$elem;\n";
    X			$idx = "->{\$i}";
    X		}
    X		$$out .= "      \@_ ? (\$r->$elem$idx = shift) : $pre\$r->$elem$idx$pst;\n";
    X		$$out .= "  }\n";
    X	}
    }
    X
    1;
    SHAR_EOF
      $shar_touch -am 1108060296 'obstructs/Class/Template.pm' &&
      chmod 0644 'obstructs/Class/Template.pm' ||
      $echo 'restore of' 'obstructs/Class/Template.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Class/Template.pm:' 'MD5 check failed'
    4ccfb1ef6cb0ef795d19325556a78797  obstructs/Class/Template.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Class/Template.pm'`"
        test 5024 -eq "$shar_count" ||
        $echo 'obstructs/Class/Template.pm:' 'original size' '5024,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/File/stat.pm ==============
    if test ! -d 'obstructs/File'; then
      $echo 'x -' 'creating directory' 'obstructs/File'
      mkdir 'obstructs/File'
    fi
    if test -f 'obstructs/File/stat.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/File/stat.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/File/stat.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/File/stat.pm' &&
    package File::stat;
    use strict;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter);
    X    @EXPORT      = qw(stat lstat);
    X    @EXPORT_OK   = qw( $st_dev	   $st_ino    $st_mode 
    X		       $st_nlink   $st_uid    $st_gid 
    X		       $st_rdev    $st_size 
    X		       $st_atime   $st_mtime  $st_ctime 
    X		       $st_blksize $st_blocks
    X		    );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    use Class::Template qw(struct);
    struct 'File::stat' => [
    X     map { $_ => '$' } qw{
    X	 dev ino mode nlink uid gid rdev size
    X	 atime mtime ctime blksize blocks
    X     }
    ];
    X
    sub populate (@) {
    X    return unless @_;
    X    my $stob = new();
    X    @$stob = (
    X	$st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
    X        $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) 
    X	    = @_;
    X    return $stob;
    } 
    X
    sub lstat (*)  { populate(CORE::lstat(shift)) }
    X
    sub stat ($) {
    X    my $arg = shift;
    X    my $st = populate(CORE::stat $arg);
    X    return $st if $st;
    X    no strict 'refs';
    X    require Symbol;
    X    return populate(CORE::stat \*{Symbol::qualify($arg)});
    }
    X
    1;
    __END__
    X
    =head1 NAME
    X
    File::stat.pm - by-name interface to Perl's built-in stat() functions
    X
    =head1 SYNOPSIS
    X
    X use File::stat;
    X $st = stat($file) or die "No $file: $!";
    X if ( ($st->mode & 0111) && $st->nlink > 1) ) {
    X     print "$file is executable with lotsa links\n";
    X } 
    X
    X use File::stat qw(:FIELDS);
    X stat($file) or die "No $file: $!";
    X if ( ($st_mode & 0111) && $st_nlink > 1) ) {
    X     print "$file is executable with lotsa links\n";
    X } 
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core stat() 
    and lstat() functions, replacing them with versions that return 
    "File::stat" objects.  This object has methods that
    return the similarly named structure field name from the
    stat(2) function; namely,
    dev,
    ino,
    mode,
    nlink,
    uid,
    gid,
    rdev,
    size,
    atime,
    mtime,
    ctime,
    blksize,
    and
    blocks.  
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your stat() and lstat() functions.)  Access these fields as
    variables named with a preceding C<st_> in front their method names.
    Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
    the fields.
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1129130296 'obstructs/File/stat.pm' &&
      chmod 0644 'obstructs/File/stat.pm' ||
      $echo 'restore of' 'obstructs/File/stat.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/File/stat.pm:' 'MD5 check failed'
    4d121fbb2e918b7f35c2b6fa2df6ffed  obstructs/File/stat.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/File/stat.pm'`"
        test 2782 -eq "$shar_count" ||
        $echo 'obstructs/File/stat.pm:' 'original size' '2782,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/Net/hostent.pm ==============
    if test ! -d 'obstructs/Net'; then
      $echo 'x -' 'creating directory' 'obstructs/Net'
      mkdir 'obstructs/Net'
    fi
    if test -f 'obstructs/Net/hostent.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Net/hostent.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Net/hostent.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/hostent.pm' &&
    package Net::hostent;
    use strict;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter);
    X    @EXPORT      = qw(gethostbyname gethostbyaddr gethost);
    X    @EXPORT_OK   = qw(
    X			$h_name	    	@h_aliases
    X			$h_addrtype 	$h_length
    X			@h_addr_list 	$h_addr
    X		   );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    use Class::Template qw(struct);
    struct 'Net::hostent' => [
    X   name		=> '$',
    X   aliases	=> '@',
    X   addrtype	=> '$',
    X   'length'	=> '$',
    X   addr_list	=> '@',
    ];
    X
    sub addr { shift->addr_list->[0] }
    X
    sub populate (@) {
    X    return unless @_;
    X    my $hob = new();
    X    $h_name 	 =    $hob->[0]     	     = $_[0];
    X    @h_aliases	 = @{ $hob->[1] } = split ' ', $_[1];
    X    $h_addrtype  =    $hob->[2] 	     = $_[2];
    X    $h_length	 =    $hob->[3] 	     = $_[3];
    X    $h_addr 	 =                             $_[4];
    X    @h_addr_list = @{ $hob->[4] } =          @_[ (4 .. $#_) ];
    X    return $hob;
    } 
    X
    sub gethostbyname ($)  { populate(CORE::gethostbyname(shift)) } 
    X
    sub gethostbyaddr ($;$) { 
    X    my ($addr, $addrtype);
    X    $addr = shift;
    X    require Socket unless @_;
    X    $addrtype = @_ ? shift : Socket::AF_INET();
    X    populate(CORE::gethostbyaddr($addr, $addrtype)) 
    } 
    X
    sub gethost($) {
    X    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
    X	require Socket;
    X	&gethostbyaddr(Socket::inet_aton(shift));
    X    } else {
    X	&gethostbyname;
    X    } 
    } 
    X
    1;
    __END__
    X
    =head1 NAME
    X
    Net::hostent - by-name interface to Perl's built-in gethost*() functions
    X
    =head1 SYNOPSIS
    X
    X use Net::hostnet;
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core gethostbyname() and
    gethostbyaddr() functions, replacing them with versions that return
    "Net::hostent" objects.  This object has methods that return the similarly
    named structure field name from the C's hostent structure from F<netdb.h>;
    namely name, aliases, addrtype, length, and addresses.  The aliases and
    addresses methods return array reference, the rest scalars.  The addr
    method is equivalent to the zeroth element in the addresses array
    reference.
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your core functions.)  Access these fields as variables named
    with a preceding C<h_>.  Thus, C<$host_obj-E<gt>name()> corresponds to
    $h_name if you import the fields.  Array references are available as
    regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
    }> would be simply @h_aliases.
    X
    The gethost() funtion is a simple front-end that forwards a numeric
    argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
    to gethostbyname().
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 EXAMPLES
    X
    X use Net::hostent;
    X use Socket;
    X
    X @ARGV = ('netscape.com') unless @ARGV;
    X
    X for $host ( @ARGV ) {
    X
    X    unless ($h = gethost($host)) {
    X	warn "$0: no such host: $host\n";
    X	next;
    X    }
    X
    X    printf "\n%s is %s%s\n", 
    X	    $host, 
    X	    lc($h->name) eq lc($host) ? "" : "*really* ",
    X	    $h->name;
    X
    X    print "\taliases are ", join(", ", @{$h->aliases}), "\n"
    X		if @{$h->aliases};     
    X
    X    if ( @{$h->addr_list} > 1 ) { 
    X	my $i;
    X	for $addr ( @{$h->addr_list} ) {
    X	    printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr);
    X	} 
    X    } else {
    X	printf "\taddress is [%s]\n", inet_ntoa($h->addr);
    X    } 
    X
    X    if ($h = gethostbyaddr($h->addr)) {
    X	if (lc($h->name) ne lc($host)) {
    X	    printf "\tThat addr reverses to host %s!\n", $h->name;
    X	    $host = $h->name;
    X	    redo;
    X	} 
    X    }
    X }
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1129133896 'obstructs/Net/hostent.pm' &&
      chmod 0644 'obstructs/Net/hostent.pm' ||
      $echo 'restore of' 'obstructs/Net/hostent.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Net/hostent.pm:' 'MD5 check failed'
    27e11c684fe0e621da0109fa7ecef0d9  obstructs/Net/hostent.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/hostent.pm'`"
        test 3961 -eq "$shar_count" ||
        $echo 'obstructs/Net/hostent.pm:' 'original size' '3961,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/Net/netent.pm ==============
    if test -f 'obstructs/Net/netent.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Net/netent.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Net/netent.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/netent.pm' &&
    package Net::netent;
    use strict;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter);
    X    @EXPORT      = qw(getnetbyname getnetbyaddr getnet);
    X    @EXPORT_OK   = qw(
    X			$n_name	    	@n_aliases
    X			$n_addrtype 	$n_net
    X		   );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    use Class::Template qw(struct);
    struct 'Net::netent' => [
    X   name		=> '$',
    X   aliases	=> '@',
    X   addrtype	=> '$',
    X   net		=> '$',
    ];
    X
    sub populate (@) {
    X    return unless @_;
    X    my $nob = new();
    X    $n_name 	 =    $nob->[0]     	     = $_[0];
    X    @n_aliases	 = @{ $nob->[1] } = split ' ', $_[1];
    X    $n_addrtype  =    $nob->[2] 	     = $_[2];
    X    $n_net	 =    $nob->[3] 	     = $_[3];
    X    return $nob;
    } 
    X
    sub getnetbyname ($)  { populate(CORE::getnetbyname(shift)) } 
    X
    sub getnetbyaddr ($;$) { 
    X    my ($net, $addrtype);
    X    $net = shift;
    X    require Socket if @_;
    X    $addrtype = @_ ? shift : Socket::AF_INET();
    X    populate(CORE::getnetbyaddr($net, $addrtype)) 
    } 
    X
    sub getnet($) {
    X    if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
    X	require Socket;
    X	&getnetbyaddr(Socket::inet_aton(shift));
    X    } else {
    X	&getnetbyname;
    X    } 
    } 
    X
    1;
    __END__
    X
    =head1 NAME
    X
    Net::netent - by-name interface to Perl's built-in getnet*() functions
    X
    =head1 SYNOPSIS
    X
    X use Net::netent qw(:FIELDS);
    X getnetbyname("loopback") 		or die "bad net";
    X printf "%s is %08X\n", $n_name, $n_net;
    X
    X use Net::netent;
    X
    X $n = getnetbyname("loopback") 		or die "bad net";
    X { # there's gotta be a better way, eh?
    X     @bytes = unpack("C4", pack("N", $n->net));
    X     shift @bytes while @bytes && $bytes[0] == 0;
    X }
    X printf "%s is %08X [%d.%d.%d.%d]\n", $n->name, $n->net, @bytes;
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core getnetbyname() and
    getnetbyaddr() functions, replacing them with versions that return
    "Net::netent" objects.  This object has methods that return the similarly
    named structure field name from the C's netent structure from F<netdb.h>;
    namely name, aliases, addrtype, and net.  The aliases 
    method returns an array reference, the rest scalars.  
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your core functions.)  Access these fields as variables named
    with a preceding C<n_>.  Thus, C<$net_obj-E<gt>name()> corresponds to
    $n_name if you import the fields.  Array references are available as
    regular array variables, so for example C<@{ $net_obj-E<gt>aliases()
    }> would be simply @n_aliases.
    X
    The getnet() funtion is a simple front-end that forwards a numeric
    argument to getnetbyaddr(), and the rest
    to getnetbyname().
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 EXAMPLES
    X
    The getnet() functions do this in the Perl core:
    X
    X    sv_setiv(sv, (I32)nent->n_net);
    X
    The gethost() functions do this in the Perl core:
    X
    X    sv_setpvn(sv, hent->h_addr, len);
    X
    That means that the address comes back in binary for the
    host functions, and as a regular perl integer for the net ones.
    This seems a bug, but here's how to deal with it:
    X 
    X use strict;
    X use Socket;
    X use Net::netent;
    X 
    X @ARGV = ('loopback') unless @ARGV;
    X 
    X my($n, $net);
    X 
    X for $net ( @ARGV ) {
    X 
    X     unless ($n = getnetbyname($net)) {
    X 	warn "$0: no such net: $net\n";
    X 	next;
    X     }
    X 
    X     printf "\n%s is %s%s\n", 
    X 	    $net, 
    X 	    lc($n->name) eq lc($net) ? "" : "*really* ",
    X 	    $n->name;
    X 
    X     print "\taliases are ", join(", ", @{$n->aliases}), "\n"
    X 		if @{$n->aliases};     
    X 
    X     # this is stupid; first, why is this not in binary?
    X     # second, why am i going through these convolutions
    X     # to make it looks right
    X     {
    X 	my @a = unpack("C4", pack("N", $n->net));
    X 	shift @a while @a && $a[0] == 0;
    X 	printf "\taddr is %s [%d.%d.%d.%d]\n", $n->net, @a;
    X     }
    X 
    X     if ($n = getnetbyaddr($n->net)) {
    X 	if (lc($n->name) ne lc($net)) {
    X 	    printf "\tThat addr reverses to net %s!\n", $n->name;
    X 	    $net = $n->name;
    X 	    redo;
    X 	} 
    X     }
    X }
    X 
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1130091396 'obstructs/Net/netent.pm' &&
      chmod 0644 'obstructs/Net/netent.pm' ||
      $echo 'restore of' 'obstructs/Net/netent.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Net/netent.pm:' 'MD5 check failed'
    e75ca81b142c8df118f1cdddc285f71a  obstructs/Net/netent.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/netent.pm'`"
        test 4435 -eq "$shar_count" ||
        $echo 'obstructs/Net/netent.pm:' 'original size' '4435,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/Net/protoent.pm ==============
    if test -f 'obstructs/Net/protoent.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Net/protoent.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Net/protoent.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/protoent.pm' &&
    package Net::protoent;
    use strict;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter);
    X    @EXPORT      = qw(getprotobyname getprotobynumber getprotoent);
    X    @EXPORT_OK   = qw( $p_name @p_aliases $p_proto );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    use Class::Template qw(struct);
    struct 'Net::protoent' => [
    X   name		=> '$',
    X   aliases	=> '@',
    X   proto	=> '$',
    ];
    X
    sub populate (@) {
    X    return unless @_;
    X    my $pob = new();
    X    $p_name 	 =    $pob->[0]     	     = $_[0];
    X    @p_aliases	 = @{ $pob->[1] } = split ' ', $_[1];
    X    $p_proto	 =    $pob->[2] 	     = $_[2];
    X    return $pob;
    } 
    X
    sub getprotoent      ( )  { populate(CORE::getprotoent()) } 
    sub getprotobyname   ($)  { populate(CORE::getprotobyname(shift)) } 
    sub getprotobynumber ($)  { populate(CORE::getprotobynumber(shift)) } 
    X
    sub getproto ($;$) {
    X    no strict 'refs';
    X    return &{'getprotoby' . ($_[0]=~/^\d+$/ ? 'number' : 'name')}(@_);
    }
    X
    1;
    X
    __END__
    X
    =head1 NAME
    X
    Net::protoent - by-name interface to Perl's built-in getproto*() functions
    X
    =head1 SYNOPSIS
    X
    X use Net::protoent;
    X $p = getprotobyname(shift || 'tcp') || die "no proto";
    X printf "proto for %s is %d, aliases are %s\n",
    X    $p->name, $p->proto, "@{$p->aliases}";
    X
    X use Net::protoent qw(:FIELDS);
    X getprotobyname(shift || 'tcp') || die "no proto";
    X print "proto for $p_name is $p_proto, aliases are @p_aliases\n";
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core getprotoent(),
    getprotobyname(), and getnetbyport() functions, replacing them with
    versions that return "Net::protoent" objects.  They take default
    second arguments of "tcp".  This object has methods that return the
    similarly named structure field name from the C's protoent structure
    from F<netdb.h>; namely name, aliases, and proto.  The aliases method
    returns an array reference, the rest scalars.
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your core functions.)  Access these fields as variables named
    with a preceding C<p_>.  Thus, C<$proto_obj-E<gt>name()> corresponds to
    $p_name if you import the fields.  Array references are available as
    regular array variables, so for example C<@{ $proto_obj-E<gt>aliases()
    }> would be simply @p_aliases.
    X
    The getproto() function is a simple front-end that forwards a numeric
    argument to getprotobyport(), and the rest to getprotobyname().
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1130095196 'obstructs/Net/protoent.pm' &&
      chmod 0644 'obstructs/Net/protoent.pm' ||
      $echo 'restore of' 'obstructs/Net/protoent.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Net/protoent.pm:' 'MD5 check failed'
    c8e24414a4b93b93dab2b257e15bdd38  obstructs/Net/protoent.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/protoent.pm'`"
        test 2973 -eq "$shar_count" ||
        $echo 'obstructs/Net/protoent.pm:' 'original size' '2973,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/Net/servent.pm ==============
    if test -f 'obstructs/Net/servent.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Net/servent.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Net/servent.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/servent.pm' &&
    package Net::servent;
    use strict;
    X
    BEGIN {
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter);
    X    @EXPORT      = qw(getservbyname getservbyport getservent getserv);
    X    @EXPORT_OK   = qw( $s_name @s_aliases $s_port $s_proto );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    use Class::Template qw(struct);
    struct 'Net::servent' => [
    X   name		=> '$',
    X   aliases	=> '@',
    X   port		=> '$',
    X   proto	=> '$',
    ];
    X
    sub populate (@) {
    X    return unless @_;
    X    my $sob = new();
    X    $s_name 	 =    $sob->[0]     	     = $_[0];
    X    @s_aliases	 = @{ $sob->[1] } = split ' ', $_[1];
    X    $s_port	 =    $sob->[2] 	     = $_[2];
    X    $s_proto	 =    $sob->[3] 	     = $_[3];
    X    return $sob;
    }
    X
    sub getservent    (   ) { populate(CORE::getservent()) }
    sub getservbyname ($;$) { populate(CORE::getservbyname(shift,shift||'tcp')) }
    sub getservbyport ($;$) { populate(CORE::getservbyport(shift,shift||'tcp')) }
    X
    sub getserv ($;$) {
    X    no strict 'refs';
    X    return &{'getservby' . ($_[0]=~/^\d+$/ ? 'port' : 'name')}(@_);
    }
    X
    1;
    X
    __END__
    X
    =head1 NAME
    X
    Net::servent - by-name interface to Perl's built-in getserv*() functions
    X
    =head1 SYNOPSIS
    X
    X use Net::servent;
    X $s = getservbyname(shift || 'ftp') || die "no service";
    X printf "port for %s is %s, aliases are %s\n",
    X    $s->name, $s->port, "@{$s->aliases}";
    X
    X use Net::servent qw(:FIELDS);
    X getservbyname(shift || 'ftp') || die "no service";
    X print "port for $s_name is $s_port, aliases are @s_aliases\n";
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core getservent(),
    getservbyname(), and
    getnetbyport() functions, replacing them with versions that return
    "Net::servent" objects.  They take default second arguments of "tcp".  This object has methods that return the similarly
    named structure field name from the C's servent structure from F<netdb.h>;
    namely name, aliases, port, and proto.  The aliases
    method returns an array reference, the rest scalars.
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your core functions.)  Access these fields as variables named
    with a preceding C<n_>.  Thus, C<$serv_obj-E<gt>name()> corresponds to
    $s_name if you import the fields.  Array references are available as
    regular array variables, so for example C<@{ $serv_obj-E<gt>aliases()
    }> would be simply @s_aliases.
    X
    The getserv() function is a simple front-end that forwards a numeric
    argument to getservbyport(), and the rest to getservbyname().
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 EXAMPLES
    X
    X use Net::servent qw(:FIELDS);
    X
    X while (@ARGV) {
    X     my ($service, $proto) = ((split m!/!, shift), 'tcp');
    X     my $valet = getserv($service, $proto);
    X     unless ($valet) {
    X         warn "$0: No service: $service/$proto\n"
    X         next;
    X     }
    X     printf "service $service/$proto is port %d\n", $valet->port;
    X     print "alias are @s_aliases\n" if @s_aliases;
    X }
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1130094396 'obstructs/Net/servent.pm' &&
      chmod 0644 'obstructs/Net/servent.pm' ||
      $echo 'restore of' 'obstructs/Net/servent.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Net/servent.pm:' 'MD5 check failed'
    b09a8a3151b490a083236f84aae0e689  obstructs/Net/servent.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/servent.pm'`"
        test 3424 -eq "$shar_count" ||
        $echo 'obstructs/Net/servent.pm:' 'original size' '3424,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/Time/gmtime.pm ==============
    if test ! -d 'obstructs/Time'; then
      $echo 'x -' 'creating directory' 'obstructs/Time'
      mkdir 'obstructs/Time'
    fi
    if test -f 'obstructs/Time/gmtime.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Time/gmtime.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Time/gmtime.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Time/gmtime.pm' &&
    package Time::gmtime;
    use strict;
    use Time::tm;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter Time::tm);
    X    @EXPORT      = qw(gmtime gmctime);
    X    @EXPORT_OK   = qw(  
    X			$tm_sec $tm_min $tm_hour $tm_mday 
    X			$tm_mon $tm_year $tm_wday $tm_yday 
    X			$tm_isdst
    X		    );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    sub populate (@) {
    X    return unless @_;
    X    my $tmob = Time::tm->new();
    X    @$tmob = (
    X		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
    X		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
    X		$tm_isdst )
    X	    = @_;
    X    return $tmob;
    } 
    X
    sub gmtime (;$)    { populate CORE::gmtime(shift||time)}
    sub gmctime (;$)   { scalar   CORE::gmtime(shift||time)} 
    X
    1;
    __END__
    X
    =head1 NAME
    X
    Time::gmtime.pm - by-name interface to Perl's built-in gmtime() function
    X
    =head1 SYNOPSIS
    X
    X use Time::gmtime;
    X $gm = gmtime();
    X printf "The day in Greenwich is %s\n", 
    X    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm->wday() ];
    X
    X use Time::gmtime w(:FIELDS;
    X printf "The day in Greenwich is %s\n", 
    X    (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm_wday() ];
    X
    X $now = gmctime();
    X
    X use Time::gmtime;
    X use File::stat;
    X $date_string = gmctime(stat($file)->mtime);
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core gmtime() function,
    replacing it with a version that returns "Time::tm" objects.
    This object has methods that return the similarly named structure field
    name from the C's tm structure from F<time.h>; namely sec, min, hour,
    mday, mon, year, wday, yday, and isdst.
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this
    still overrides your core functions.)  Access these fields as variables
    named with a preceding C<tm_> in front their method names.  Thus,
    C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import the fields.
    X
    The gmctime() funtion provides a way of getting at the 
    scalar sense of the original CORE::gmtime() function.
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1129132196 'obstructs/Time/gmtime.pm' &&
      chmod 0644 'obstructs/Time/gmtime.pm' ||
      $echo 'restore of' 'obstructs/Time/gmtime.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Time/gmtime.pm:' 'MD5 check failed'
    8617e4442d682c2bc444e12b612f98e2  obstructs/Time/gmtime.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Time/gmtime.pm'`"
        test 2476 -eq "$shar_count" ||
        $echo 'obstructs/Time/gmtime.pm:' 'original size' '2476,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/Time/localtime.pm ==============
    if test -f 'obstructs/Time/localtime.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Time/localtime.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Time/localtime.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Time/localtime.pm' &&
    package Time::localtime;
    use strict;
    use Time::tm;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter Time::tm);
    X    @EXPORT      = qw(localtime ctime);
    X    @EXPORT_OK   = qw(  
    X			$tm_sec $tm_min $tm_hour $tm_mday 
    X			$tm_mon $tm_year $tm_wday $tm_yday 
    X			$tm_isdst
    X		    );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    sub populate (@) {
    X    return unless @_;
    X    my $tmob = Time::tm->new();
    X    @$tmob = (
    X		$tm_sec, $tm_min, $tm_hour, $tm_mday, 
    X		$tm_mon, $tm_year, $tm_wday, $tm_yday, 
    X		$tm_isdst )
    X	    = @_;
    X    return $tmob;
    } 
    X
    sub localtime (;$) { populate CORE::localtime(shift||time)}
    sub ctime (;$)     { scalar   CORE::localtime(shift||time) } 
    X
    1;
    X
    __END__
    X
    =head1 NAME
    X
    Time::localtime.pm - by-name interface to Perl's built-in localtime() function
    X
    =head1 SYNOPSIS
    X
    X use Time::localtime;
    X printf "Year is %d\n", localtime->year() + 1900;
    X
    X $now = ctime();
    X
    X use Time::localtime;
    X use File::stat;
    X $date_string = ctime(stat($file)->mtime);
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core localtime() function,
    replacing it with a version that returns "Time::tm" objects.
    This object has methods that return the similarly named structure field
    name from the C's tm structure from F<time.h>; namely sec, min, hour,
    mday, mon, year, wday, yday, and isdst.
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your core functions.)  Access these fields as
    variables named with a preceding C<tm_> in front their method names.
    Thus, C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import
    the fields.
    X
    The ctime() funtion provides a way of getting at the 
    scalar sense of the original CORE::localtime() function.
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1129132196 'obstructs/Time/localtime.pm' &&
      chmod 0644 'obstructs/Time/localtime.pm' ||
      $echo 'restore of' 'obstructs/Time/localtime.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Time/localtime.pm:' 'MD5 check failed'
    4f44256053f0573143e7f1b78e3db9b1  obstructs/Time/localtime.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Time/localtime.pm'`"
        test 2307 -eq "$shar_count" ||
        $echo 'obstructs/Time/localtime.pm:' 'original size' '2307,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/Time/tm.pm ==============
    if test -f 'obstructs/Time/tm.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/Time/tm.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/Time/tm.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Time/tm.pm' &&
    package Time::tm;
    use strict;
    X
    use Class::Template qw(struct);
    struct('Time::tm' => [
    X     map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst }
    ]);
    X
    1;
    __END__
    X
    =head1 NAME
    X
    Time::tm.pm - internal object used by Time::gmtime and Time::localtime
    X
    =head1 DESCRIPTION
    X
    This module is used internally as a base class by Time::localtime And
    Time::gmtime functions.  It creates a Time::tm struct object which is
    addressable just like's C's tm structure from F<time.h>; namely with sec,
    min, hour, mday, mon, year, wday, yday, and isdst.
    X
    This class is an internal interface only. 
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1129132696 'obstructs/Time/tm.pm' &&
      chmod 0644 'obstructs/Time/tm.pm' ||
      $echo 'restore of' 'obstructs/Time/tm.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/Time/tm.pm:' 'MD5 check failed'
    02859f003106bb6eb92cc91bb9b37666  obstructs/Time/tm.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Time/tm.pm'`"
        test 622 -eq "$shar_count" ||
        $echo 'obstructs/Time/tm.pm:' 'original size' '622,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/User/grent.pm ==============
    if test ! -d 'obstructs/User'; then
      $echo 'x -' 'creating directory' 'obstructs/User'
      mkdir 'obstructs/User'
    fi
    if test -f 'obstructs/User/grent.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/User/grent.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/User/grent.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/User/grent.pm' &&
    package User::grent;
    use strict;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter);
    X    @EXPORT      = qw(getgrent getgrgid getgrnam getgr);
    X    @EXPORT_OK   = qw($gr_name $gr_gid $gr_passwd $gr_mem @gr_members);
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    use Class::Template qw(struct);
    struct 'User::grent' => [
    X    name    => '$',
    X    passwd  => '$',
    X    gid	    => '$',
    X    members => '@',
    ];
    X
    sub populate (@) {
    X    return unless @_;
    X    my $gob = new();
    X    ($gr_name, $gr_passwd, $gr_gid) = @$gob[0,1,2] = @_[0,1,2];
    X    @gr_members = @{$gob->[3]} = split ' ', $_[3];
    X    return $gob;
    } 
    X
    sub getgrent ( ) { populate(CORE::getgrent()) } 
    sub getgrnam ($) { populate(CORE::getgrnam(shift)) } 
    sub getgrgid ($) { populate(CORE::getgrgid(shift)) } 
    sub getgr    ($) { ($_[0] =~ /^\d+/) ? &getgrgid : &getgrnam } 
    X
    1;
    __END__
    X
    =head1 NAME
    X
    User::grent.pm - by-name interface to Perl's built-in getgr*() functions
    X
    =head1 SYNOPSIS
    X
    X use User::grent;
    X $gr = getgrgid(0) or die "No group zero";
    X if ( $gr->name eq 'wheel' && @{$gr->members} > 1 ) {
    X     print "gid zero name wheel, with other members";
    X } 
    X
    X use User::grent qw(:FIELDS;
    X getgrgid(0) or die "No group zero";
    X if ( $gr_name eq 'wheel' && @gr_members > 1 ) {
    X     print "gid zero name wheel, with other members";
    X } 
    X
    X $gr = getgr($whoever);
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core getgrent(), getgruid(),
    and getgrnam() functions, replacing them with versions that return
    "User::grent" objects.  This object has methods that return the similarly
    named structure field name from the C's passwd structure from F<grp.h>; 
    namely name, passwd, gid, and members (not mem).  The first three
    return scalars, the last an array reference.
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your core functions.)  Access these fields as variables named
    with a preceding C<gr_>.  Thus, C<$group_obj-E<gt>gid()> corresponds
    to $gr_gid if you import the fields.  Array references are available as
    regular array variables, so C<@{ $group_obj-E<gt>members() }> would be
    simply @gr_members.
    X
    The getpw() funtion is a simple front-end that forwards
    a numeric argument to getpwuid() and the rest to getpwnam().
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1130094696 'obstructs/User/grent.pm' &&
      chmod 0644 'obstructs/User/grent.pm' ||
      $echo 'restore of' 'obstructs/User/grent.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/User/grent.pm:' 'MD5 check failed'
    9fbf4010f722f9bc493657ec56f8ce5d  obstructs/User/grent.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/User/grent.pm'`"
        test 2848 -eq "$shar_count" ||
        $echo 'obstructs/User/grent.pm:' 'original size' '2848,' 'current size' "$shar_count!"
      fi
    fi
    # ============= obstructs/User/pwent.pm ==============
    if test -f 'obstructs/User/pwent.pm' && test "$first_param" != -c; then
      $echo 'x -' SKIPPING 'obstructs/User/pwent.pm' '(file already exists)'
    else
      $echo 'x -' extracting 'obstructs/User/pwent.pm' '(text)'
      sed 's/^X//' << 'SHAR_EOF' > 'obstructs/User/pwent.pm' &&
    package User::pwent;
    use strict;
    X
    BEGIN { 
    X    use Exporter   ();
    X    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    X    @ISA         = qw(Exporter);
    X    @EXPORT      = qw(getpwent getpwuid getpwnam getpw);
    X    @EXPORT_OK   = qw(
    X			$pw_name   $pw_passwd 	$pw_uid	 
    X			$pw_gid	   $pw_quota    $pw_comment
    X			$pw_gecos  $pw_dir	$pw_shell
    X		   );
    X    %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @EXPORT_OK;
    X
    use Class::Template qw(struct);
    struct 'User::pwent' => [
    X    name    => '$',
    X    passwd  => '$',
    X    uid	    => '$',
    X    gid	    => '$',
    X    quota   => '$',
    X    comment => '$',
    X    gcos    => '$',
    X    dir	    => '$',
    X    shell   => '$',
    ];
    X
    sub populate (@) {
    X    return unless @_;
    X    my $pwob = new();
    X
    X    ( $pw_name,   $pw_passwd,   $pw_uid,  
    X      $pw_gid,    $pw_quota,    $pw_comment,
    X      $pw_gecos,  $pw_dir,      $pw_shell,   ) 	= @$pwob = @_;
    X
    X    return $pwob;
    } 
    X
    sub getpwent ( ) { populate(CORE::getpwent()) } 
    sub getpwnam ($) { populate(CORE::getpwnam(shift)) } 
    sub getpwgid ($) { populate(CORE::getpwgid(shift)) } 
    sub getpw    ($) { ($_[0] =~ /^\d+/) ? &getpwgid : &getpwnam } 
    X
    1;
    __END__
    X
    =head1 NAME
    X
    User::pwent.pm - by-name interface to Perl's built-in getpw*() functions
    X
    =head1 SYNOPSIS
    X
    X use User::pwent;
    X $pw = getpwnam('daemon') or die "No daemon user";
    X if ( $pw->uid == 1 && $pw->dir =~ m#^/(bin|tmp)?$# ) {
    X     print "gid 1 on root dir";
    X } 
    X
    X use User::pwent qw(:FIELDS);
    X getpwnam('daemon') or die "No daemon user";
    X if ( $pw_uid == 1 && $pw_dir =~ m#^/(bin|tmp)?$# ) {
    X     print "gid 1 on root dir";
    X } 
    X
    X $pw = getpw($whoever);
    X
    =head1 DESCRIPTION
    X
    This module's default exports override the core getpwent(), getpwuid(),
    and getpwnam() functions, replacing them with versions that return
    "User::pwent" objects.  This object has methods that return the similarly
    named structure field name from the C's passwd structure from F<pwd.h>; 
    namely name, passwd, uid, gid, quota, comment, gecos, dir, and shell.
    X
    You may also import all the structure fields directly into your namespace
    as regular variables using the :FIELDS import tag.  (Note that this still
    overrides your core functions.)  Access these fields as
    variables named with a preceding C<pw_> in front their method names.
    Thus, C<$passwd_obj-E<gt>shell()> corresponds to $pw_shell if you import
    the fields.
    X
    The getpw() funtion is a simple front-end that forwards
    a numeric argument to getpwuid() and the rest to getpwnam().
    X
    To access this functionality without the core overrides,
    pass the C<use> an empty import list, and then access
    function functions with their full qualified names.
    On the other hand, the built-ins are still available
    via the C<CORE::> pseudo-package.
    X
    =head1 NOTE
    X
    While this class is currently implemented using the Class::Template
    module to build a struct-like class, you shouldn't rely upon this.
    X
    =head1 AUTHOR
    X
    Tom Christiansen
    SHAR_EOF
      $shar_touch -am 1130094696 'obstructs/User/pwent.pm' &&
      chmod 0644 'obstructs/User/pwent.pm' ||
      $echo 'restore of' 'obstructs/User/pwent.pm' 'failed'
      if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
      && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
        md5sum -c << SHAR_EOF >/dev/null 2>&1 \
        || $echo 'obstructs/User/pwent.pm:' 'MD5 check failed'
    905033d579b32729f95a760e013dbde4  obstructs/User/pwent.pm
    SHAR_EOF
      else
        shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/User/pwent.pm'`"
        test 2899 -eq "$shar_count" ||
        $echo 'obstructs/User/pwent.pm:' 'original size' '2899,' 'current size' "$shar_count!"
      fi
    fi
    rm -fr _sh24166
    exit 0
    
    p5p-msgid: <199611301652.JAA24201@toy.perl.com>

Subject: FileHandle that 'ISA' IO::File
Date: Mon, 2 Dec 1996 17:18:02 GMT
From: Nick Ing-Simmons <nik@tiuk.ti.com>
Files: MANIFEST lib/FileHandle.pm

    Subject: FileHandle that 'is' and IO::File
    
    Andreas Koenig <k@anna.in-berlin.de> writes:
    >>>>>> Nick Ing-Simmons <nik@tiuk.ti.com> writes:
    >
    >  > The patch will serve till we can get derived version working.
    >
    >I'm putting much hope in the your patch, Nick, because I have another
    >problem pending. No test case yet, because I'm waiting for your
    >FileHandle.pm.
    >
    >I'll let you know more details as soon as I have a structured view of
    >the problem. Your patch will (hopefully) help me to get there,
    >
    >andreas
    
    Please try attached.
    
    Drop into lib/FileHandle.pm
    
    p5p-msgid: <199612021718.RAA04416@pluto>

Subject: 10+ debugger patch
Date: Sun, 1 Dec 1996 06:37:31 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: lib/perl5db.pl perl.c pod/perldebug.pod

    Bugs corrected:
      perl.c
    	a) Could have deadlocked debugging its own signal handler;
      lib/perl5db.pl
      pod/perldebug.pod
    	b) Documentation (internal and POD) updated;
    	c) NonStop now will not stop at end;
    	d) variable names more meaningful now;
    	e) Will not trace last line of itself now;
    	f) Dumping of looong lines in a program (see Config.pm) interruptable;
    	g) $@ not wiped by evalled expressions;
    
    While updating the docs I was forced to change some API (to make it
    documentable), which resulted in following improvements:
    
    	frame & 4 recognized: more verbose output;
    	frame changes style of TRACE;
    	Non-interruptable lines have no `:' in the listing;
    	frame outputs `require'd packages as well.
    	added Options AutoTrace inhibit_exit
    
    Though this may look a lot, all the changes are not in the main flow
    of execution (in frills which are usually disabled), so I think they
    may be added even this late in the cycle. Documentation would be quite
    messy without these changes.
    
    As well as I know, the documentation is complete now, so one can
    _really_ write a new debugger from scratch.
    
    Enjoy,
    
    p5p-msgid: <199612011137.GAA10864@monk.mps.ohio-state.edu>

Subject: DB_File 1.07
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t t/lib/db-recno.t

Subject: DB_File 1.08
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs

 OTHER CORE CHANGES

Subject: Eliminate spurious warning when splicing undefs
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c sv.h

Subject: Eliminate spurious warning from "x=" operator
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c

Subject: Fix line numbers near control structures
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c perly.c perly.c.diff perly.y proto.h

Subject: Don't let scalar unpack() underflow stack
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c

Subject: Fix core dump from precedence bug in "@foo" warning
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c

Subject: Move die() to utils.c; add varargs hack to croak()
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_ctl.c util.c

Subject: Avoid memcmp() for magnitude test if it thinks char is signed
From: Chip Salzenberg <chip@atlantic.net>
Files: Configure config_H config_h.SH doop.c ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.h handy.h hv.c perl.h pp_hot.c proto.h regexec.c sv.c toke.c util.c

Subject: Fully paramaterize locales; disable all if NO_LOCALE
From: Chip Salzenberg <chip@atlantic.net>
Files: ext/POSIX/POSIX.xs op.c perl.h pp.c pp_sys.c sv.c util.c

 PORTABILITY AND TESTING

Subject: Bitwise op fix for Alpha
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c

Subject: VMS patches for 5.003_10
Date: Wed, 04 Dec 1996 16:40:12 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: EXTERN.h INTERN.h old_perl_exp.SH perl.c perl.h perl_exp.SH pp.c pp_ctl.c pp_sys.c proto.h sv.c toke.c util.c utils/perldoc.PL vms/config.vms vms/descrip.mms vms/gen_shrfls.pl vms/genconfig.pl vms/vmsish.h

    private-msgid: <01ICMALO8NMS001A1D@hmivax.humgen.upenn.edu>

5 files changed, 119 insertions, 56 deletions

diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index f62de2ebc9..ea77c32366 100644
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -1,8 +1,13 @@
 # DB_File.pm -- Perl 5 interface to Berkeley DB 
 #
 # written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
-# last modified 27th Nov 1996
-# version 1.06
+# last modified 3rd Dec 1996
+# version 1.08
+#
+#     Copyright (c) 1995, 1996 Paul Marquess. All rights reserved.
+#     This program is free software; you can redistribute it and/or
+#     modify it under the same terms as Perl itself.
+
 
 package DB_File::HASHINFO ;
 
@@ -26,13 +31,11 @@ sub TIEHASH
 {
     my $pkg = shift ;
 
-    bless {   'bsize'     => 0,
-              'ffactor'   => 0,
-              'nelem'     => 0,
-              'cachesize' => 0,
-              'hash'      => undef,
-              'lorder'    => 0,
-        }, $pkg ;
+    bless { VALID => { map {$_, 1} 
+		       qw( bsize ffactor nelem cachesize hash lorder)
+		     }, 
+	    GOT   => {}
+          }, $pkg ;
 }
 
 
@@ -41,7 +44,7 @@ sub FETCH
     my $self  = shift ;
     my $key   = shift ;
 
-    return $self->{$key} if exists $self->{$key}  ;
+    return $self->{GOT}{$key} if exists $self->{VALID}{$key}  ;
 
     my $pkg = ref $self ;
     croak "${pkg}::FETCH - Unknown element '$key'" ;
@@ -54,9 +57,9 @@ sub STORE
     my $key   = shift ;
     my $value = shift ;
 
-    if ( exists $self->{$key} )
+    if ( exists $self->{VALID}{$key} )
     {
-        $self->{$key} = $value ;
+        $self->{GOT}{$key} = $value ;
         return ;
     }
     
@@ -69,9 +72,9 @@ sub DELETE
     my $self = shift ;
     my $key  = shift ;
 
-    if ( exists $self->{$key} )
+    if ( exists $self->{VALID}{$key} )
     {
-        delete $self->{$key} ;
+        delete $self->{GOT}{$key} ;
         return ;
     }
     
@@ -84,7 +87,7 @@ sub EXISTS
     my $self = shift ;
     my $key  = shift ;
 
-    exists $self->{$key} ;
+    exists $self->{VALID}{$key} ;
 }
 
 sub NotHere
@@ -110,14 +113,11 @@ sub TIEHASH
 {
     my $pkg = shift ;
 
-    bless {   'bval'      => 0,
-              'cachesize' => 0,
-              'psize'     => 0,
-              'flags'     => 0,
-              'lorder'    => 0,
-              'reclen'    => 0,
-              'bfname'    => "",
-            }, $pkg ;
+    bless { VALID => { map {$_, 1} 
+		       qw( bval cachesize psize flags lorder reclen bfname )
+		     },
+	    GOT   => {},
+          }, $pkg ;
 }
 
 package DB_File::BTREEINFO ;
@@ -130,15 +130,12 @@ sub TIEHASH
 {
     my $pkg = shift ;
 
-    bless {   'flags'	  => 0,
-              'cachesize'  => 0,
-              'maxkeypage' => 0,
-              'minkeypage' => 0,
-              'psize'      => 0,
-              'compare'    => undef,
-              'prefix'     => undef,
-              'lorder'     => 0,
-            }, $pkg ;
+    bless { VALID => { map {$_, 1} 
+		       qw( flags cachesize maxkeypage minkeypage psize 
+			   compare prefix lorder )
+	    	     },
+	    GOT   => {},
+          }, $pkg ;
 }
 
 
@@ -149,7 +146,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ;
 use Carp;
 
 
-$VERSION = "1.06" ;
+$VERSION = "1.08" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -462,7 +459,7 @@ values when you only want to change one. Here is an example:
      $a->{'cachesize'} =  12345 ;
      tie %y, 'DB_File', "filename", $flags, 0777, $a ;
 
-A few of the values need extra discussion here. When used, the C
+A few of the options need extra discussion here. When used, the C
 equivalent of the keys C<hash>, C<compare> and C<prefix> store pointers
 to C functions. In B<DB_File> these keys are used to store references
 to Perl subs. Below are templates for each of the subs:
@@ -497,6 +494,9 @@ to Perl subs. Below are templates for each of the subs:
 See L<Changing the BTREE sort order> for an example of using the
 C<compare> template.
 
+If you are using the DB_RECNO interface and you intend making use of
+C<bval>, you should check out L<The bval option>.
+
 =head2 Default Parameters
 
 It is possible to omit some or all of the final 4 parameters in the
@@ -893,6 +893,33 @@ negative indexes. The index -1 refers to the last element of the array,
 -2 the second last, and so on. Attempting to access an element before
 the start of the array will raise a fatal run-time error.
 
+=head2 The bval option
+
+The operation of the bval option warrants some discussion. Here is the
+definition of bval from the Berkeley DB 1.85 recno manual page:
+
+    The delimiting byte to be used to mark  the  end  of  a
+    record for variable-length records, and the pad charac-
+    ter for fixed-length records.  If no  value  is  speci-
+    fied,  newlines  (``\n'')  are  used to mark the end of
+    variable-length records and  fixed-length  records  are
+    padded with spaces.
+
+The second sentence is wrong. In actual fact bval will only default to
+C<"\n"> when the openinfo parameter in dbopen is NULL. If a non-NULL
+openinfo parameter is used at all, the value that happens to be in bval
+will be used. That means you always have to specify bval when making
+use of any of the options in the openinfo parameter. This documentation
+error will be fixed in the next release of Berkeley DB.
+
+That clarifies the situation with regards Berkeley DB itself. What
+about B<DB_File>? Well, the behavior defined in the quote above is
+quite useful, so B<DB_File> conforms it.
+
+That means that you can specify other options (e.g. cachesize) and
+still have bval default to C<"\n"> for variable length records, and
+space for fixed length records.
+
 =head2 A Simple Example
 
 Here is a simple example that uses RECNO.
@@ -1522,6 +1549,14 @@ is installed.
 
 Minor namespace cleanup: Localized C<PrintBtree>.
 
+=item 1.07
+
+Fixed bug with RECNO, where bval wasn't defaulting to "\n".
+
+=item 1.08
+
+Documented operation of bval.
+
 =back
 
 =head1 BUGS
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index f7dc37824d..821eaaef3b 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -3,11 +3,15 @@
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
  written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
- last modified 27th Nov 1996
- version 1.06
+ last modified 3rd Dec 1996
+ version 1.08
 
  All comments/suggestions/problems are welcome
 
+     Copyright (c) 1995, 1996 Paul Marquess. All rights reserved.
+     This program is free software; you can redistribute it and/or
+     modify it under the same terms as Perl itself.
+
  Changes:
 	0.1 - 	Initial Release
 	0.2 - 	No longer bombs out if dbopen returns an error.
@@ -28,6 +32,8 @@
 	1.05 -  Added logic to allow prefix & hash types to be specified via
 		Makefile.PL
 	1.06 -  Minor namespace cleanup: Localized PrintBtree.
+	1.07 -  Fixed bug with RECNO, where bval wasn't defaulting to "\n". 
+	1.08 -  No change to DB_File.xs
 
 */
 
@@ -270,7 +276,7 @@ RECNOINFO * recno ;
     printf ("  psize     = %d\n", recno->psize) ;
     printf ("  lorder    = %d\n", recno->lorder) ;
     printf ("  reclen    = %d\n", recno->reclen) ;
-    printf ("  bval      = %d\n", recno->bval) ;
+    printf ("  bval      = %d 0x%x\n", recno->bval, recno->bval) ;
     printf ("  bfname    = %d [%s]\n", recno->bfname, recno->bfname) ;
 }
 
@@ -361,7 +367,11 @@ SV *   sv ;
         if (! SvROK(sv) )
             croak ("type parameter is not a reference") ;
 
-        action = (HV*)SvRV(sv);
+        svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
+        if (svp && SvOK(*svp))
+            action  = (HV*) SvRV(*svp) ;
+	else
+	    croak("internal error") ;
 
         if (sv_isa(sv, "DB_File::HASHINFO"))
         {
@@ -476,10 +486,12 @@ SV *   sv ;
 	    }
          
             svp = hv_fetch(action, "bfname", 6, FALSE); 
-            if (svp) {
+            if (svp && SvOK(*svp)) {
 		char * ptr = SvPV(*svp,na) ;
-                info->recno.bfname = (char*) na ? ptr : 0 ;
+                info->recno.bfname = (char*) na ? ptr : NULL ;
 	    }
+	    else
+		info->recno.bfname = NULL ;
 
             PrintRecno(info) ;
         }
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index e4aa293948..e5f9b2f947 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -2736,7 +2736,7 @@ setlocale(category, locale = 0)
     CODE:
 	RETVAL = setlocale(category, locale);
 	if (RETVAL) {
-#ifdef LC_CTYPE
+#ifdef USE_LOCALE_CTYPE
 	    if (category == LC_CTYPE
 #ifdef LC_ALL
 		|| category == LC_ALL
@@ -2752,8 +2752,8 @@ setlocale(category, locale = 0)
 		    newctype = RETVAL;
 		perl_new_ctype(newctype);
 	    }
-#endif /* LC_CTYPE */
-#ifdef LC_COLLATE
+#endif /* USE_LOCALE_CTYPE */
+#ifdef USE_LOCALE_COLLATE
 	    if (category == LC_COLLATE
 #ifdef LC_ALL
 		|| category == LC_ALL
@@ -2769,8 +2769,8 @@ setlocale(category, locale = 0)
 		    newcoll = RETVAL;
 		perl_new_collate(newcoll);
 	    }
-#endif /* LC_COLLATE */
-#ifdef LC_NUMERIC
+#endif /* USE_LOCALE_COLLATE */
+#ifdef USE_LOCALE_NUMERIC
 	    if (category == LC_NUMERIC
 #ifdef LC_ALL
 		|| category == LC_ALL
@@ -2786,7 +2786,7 @@ setlocale(category, locale = 0)
 		    newnum = RETVAL;
 		perl_new_numeric(newnum);
 	    }
-#endif /* LC_NUMERIC */
+#endif /* USE_LOCALE_NUMERIC */
 	}
     OUTPUT:
 	RETVAL
@@ -3102,7 +3102,7 @@ strtod(str)
 	double num;
 	char *unparsed;
     PPCODE:
-	NUMERIC_LOCAL();
+	SET_NUMERIC_LOCAL();
 	num = strtod(str, &unparsed);
 	PUSHs(sv_2mortal(newSVnv(num)));
 	if (GIMME == G_ARRAY) {
diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c
index a02c73f28f..23bbfe9a67 100644
--- a/ext/SDBM_File/sdbm/pair.c
+++ b/ext/SDBM_File/sdbm/pair.c
@@ -231,7 +231,7 @@ register int siz;
 
 	for (i = 1; i < n; i += 2) {
 		if (siz == off - ino[i] &&
-		    memcmp(key, pag + ino[i], siz) == 0)
+		    memEQ(key, pag + ino[i], siz))
 			return i;
 		off = ino[i + 1];
 	}
diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h
index 11967ecdc9..c9b28f5c66 100644
--- a/ext/SDBM_File/sdbm/sdbm.h
+++ b/ext/SDBM_File/sdbm/sdbm.h
@@ -185,10 +185,6 @@ extern long sdbm_hash proto((char *, int));
 #include <memory.h>
 #endif
 
-#if defined(mips) && defined(ultrix) && !defined(__STDC__)
-#   undef HAS_MEMCMP
-#endif
-
 #ifdef HAS_MEMCPY
 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 #    ifndef memcpy
@@ -222,24 +218,44 @@ extern long sdbm_hash proto((char *, int));
 #   endif
 #endif /* HAS_MEMSET */
 
-#ifdef HAS_MEMCMP
+#if defined(mips) && defined(ultrix) && !defined(__STDC__)
+#   undef HAS_MEMCMP
+#endif
+
+#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 #    ifndef memcmp
 	extern int memcmp _((char*, char*, int));
 #    endif
 #  endif
+#  ifdef BUGGY_MSC
+  #  pragma function(memcmp)
+#  endif
 #else
 #   ifndef memcmp
-#	define memcmp 	my_memcmp
+#	/* maybe we should have included the full embedding header... */
+#	ifdef NO_EMBED
+#	    define memcmp my_memcmp
+#	else
+#	    define memcmp Perl_my_memcmp
+#	endif
+	extern int memcmp _((char*, char*, int));
 #   endif
 #endif /* HAS_MEMCMP */
 
-/* we prefer bcmp slightly for comparisons that don't care about ordering */
 #ifndef HAS_BCMP
 #   ifndef bcmp
 #	define bcmp(s1,s2,l) memcmp(s1,s2,l)
 #   endif
-#endif /* HAS_BCMP */
+#endif /* !HAS_BCMP */
+
+#ifdef HAS_MEMCMP
+#  define memNE(s1,s2,l) (memcmp(s1,s2,l))
+#  define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
+#else
+#  define memNE(s1,s2,l) (bcmp(s1,s2,l))
+#  define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
+#endif
 
 #ifdef I_NETINET_IN
 #   include <netinet/in.h>