[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>

1 files changed, 1 insertions, 9 deletions

diff --git a/doop.c b/doop.c
index dd162de1a1..836027ef4d 100644
--- a/doop.c
+++ b/doop.c
@@ -18,14 +18,6 @@
 #include <signal.h>
 #endif
 
-#ifdef BUGGY_MSC
- #pragma function(memcmp)
-#endif /* BUGGY_MSC */
-
-#ifdef BUGGY_MSC
- #pragma intrinsic(memcmp)
-#endif /* BUGGY_MSC */
-
 I32
 do_trans(sv,arg)
 SV *sv;
@@ -507,7 +499,7 @@ register SV *sv;
 		    goto nope;
 		len -= rslen - 1;
 		s -= rslen - 1;
-		if (memcmp(s, rsptr, rslen))
+		if (memNE(s, rsptr, rslen))
 		    goto nope;
 		count += rslen;
 	    }