Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: perl-5.003_11
Commits on Dec 6, 1996
  1. [inseparable changes from patch from perl5.003_10 to perl5.003_11]

    Perl 5 Porters authored Chip Salzenberg committed
     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>
  2. @hfuru

    Re: Namespace cleanup: Does SDBM need binary compatibility?

    hfuru authored Chip Salzenberg committed
    private-msgid: <199612031445.PAA19056@bombur2.uio.no>
  3. Don't call CORE::close in file handle DESTROY method

    Chip Salzenberg authored
  4. Make IO::File::import use its parameters

    Chip Salzenberg authored
  5. [dummy merge]

    Chip Salzenberg authored
    This merge exists so that the p5p version of the patch and the applied
    version are both in the history
  6. _10+ under OS/2

    Chip Salzenberg authored
    (this is the same change as commit ed7f835, but as applied)
  7. _10+ under OS/2

    Ilya Zakharevich authored Chip Salzenberg committed
    _10+ under OS/2 is almost clean: below is a minor patch to malloc.c
    which makes compilation of x2p possible with -DEMERGENCY_SBRK in
    ccflags, and the patch which reduces os2/diff.configure twice:
    
    p5p-msgid: <199612011107.GAA10805@monk.mps.ohio-state.edu>
  8. BUG in hints/hpux.sh

    Jeff McDougal authored Chip Salzenberg committed
    Tom, I was not able to run the Configure script on my new HP D-server running HP-UX 10.01.  
    The problem was a single line in the hints/hpux.sh file:
    
    xxcontext=`grep $(printf %#x $(getconf CPU_VERSION)) /usr/include/sys/unistd.h`
    
    I commented this line out and inserted the following to get a clean execution under the 
    Bourne shell:
    
    DECCPU=`getconf CPU_VERSION`                       
    HEXCPU=`printf %#x ${DECCPU}`                      
    xxcontext=`grep $HEXCPU /usr/include/sys/unistd.h`
    
    I am very happy to have Perl 5.003 on my new development box.
    
    Jeff McDougal
    
    p5p-msgid: <32A42C11.7FA2@cris.com>
  9. hints/dgux.sh update

    Roderick Schertler authored Chip Salzenberg committed
    Here's an update for the dgux hints file.
    
    p5p-msgid: <24178.849309616@eeyore.ibcinc.com>
  10. Re: 5.003_09: PADTMP fix

    Ilya Zakharevich authored Chip Salzenberg committed
    Nick Ing-Simmons writes:
    > >Here is the better fix: We mark PADTMPs as STEALABLE when they are
    > >created, and unset this if they are put on fake array @_:
    > >
    > >Nick, please check it with Tk, this fixes the test case you sent.
    > >
    > >A much simplified test case is included into op/misc.t.
    > 
    > Seems to work here. My other testcases and Tk continue to work.
    > 
    > I still don't really understand what PADTEMPs are - care to explain
    > goal of the enhancement?
    
    Chip, please apply this:
    
    p5p-msgid: <199611281150.GAA06884@monk.mps.ohio-state.edu>
  11. Less malloc in magic

    Chip Salzenberg authored
  12. [shell changes from patch from perl5.003_10 to perl5.003_11]

    Chip Salzenberg authored
    Change from running these commands:
    
     # new directories for new modules
     test -d lib/Class || mkdir lib/Class
     test -d lib/User  || mkdir lib/User
     
     # get rid of old extension
     rm -rf ext/FileHandle
     
     exit 0
Commits on Nov 29, 1996
  1. [inseparable changes from patch from perl5.003_09 to perl5.003_10]

    Perl 5 Porters authored Chip Salzenberg committed
     CORE LANGUAGE CHANGES
    
    Subject: Allow &{sub {...}} without warning
    From: Chip Salzenberg <chip@atlantic.net>
    Files: toke.c
    
    Subject: Make parens optional on [gs]ethost and [gs]et{pw,gr} function
    From: Chip Salzenberg <chip@atlantic.net>
    Files: toke.c
    
    Subject: Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}"
    From: Chip Salzenberg <chip@atlantic.net>
    Files: toke.c
    
     DOCUMENTATION
    
    Subject: Improve documentation for sysread() and syswrite()
    From: Chip Salzenberg <chip@atlantic.net>
    Files: pod/perlfunc.pod
    
    Subject: Document how to use $SIG{ALRM} and alarm()
    Date: Tue, 26 Nov 1996 11:42:49 -0500
    From: Roderick Schertler <roderick@ibcinc.com>
    Files: pod/perlfunc.pod
    Msg-ID: <5898.849026569@eeyore.ibcinc.com>
    
        (applied based on p5p patch as commit 5fa5e7d)
    
     OTHER CORE CHANGES
    
    Subject: Hash key memory corruption fix and naming cleanup
    From: Chip Salzenberg <chip@atlantic.net>
    Files: hv.c hv.h perl.h
    
    Subject: Undo broken perf. patch (PADTMP stealing)
    From: Chip Salzenberg <chip@atlantic.net>
    Files: sv.c
    
    Subject: Make SV unstudied in sv_gets()
    From: Chip Salzenberg <chip@atlantic.net>
    Files: sv.c
    
    Subject: Better support for UVs
    From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
    Files: global.sym old_global.sym perl.h pp.c pp.h proto.h sv.c sv.h
    
    Subject: Minor locale cleanups
    From: Chip Salzenberg <chip@atlantic.net>
    Files: t/lib/posix.t util.c
    
        Accept "POSIX" locale as standard like "C". Reset locale to
        'C' when testing strtod() in t/lib/posix.t.
    
    Subject: Always taint result of sprintf() on float
    From: Chip Salzenberg <chip@atlantic.net>
    Files: doop.c
    
    Subject: Fix spurious warning from bitwise string ops
    From: Chip Salzenberg <chip@atlantic.net>
    Files: doop.c
    
    Subject: Eliminate warning on {,sys}read(,$newvar,)
    From: Chip Salzenberg <chip@atlantic.net>
    Files: doop.c pp_sys.c
    
    Subject: Namespace cleanup
    From: Chip Salzenberg <chip@atlantic.net>
    Files: global.sym old_global.sym perl.h
    
    Subject: Modify perl_exp.SH; create old_perl_exp.SH; document old_*
    From: Chip Salzenberg <chip@atlantic.net>
    Files: Configure INSTALL MANIFEST old_perl_exp.SH perl_exp.SH
    
     PORTABILITY
    
    Subject: Reliable signal patch
    Date: Tue, 26 Nov 1996 05:40:50 -0500 (EST)
    From: Kenneth Albanowski <kjahds@kjahds.com>
    Files: global.sym mg.c old_global.sym perl.h pp_sys.c proto.h util.c
    Msg-ID: <Pine.LNX.3.93.961126053209.294J-100000@kjahds.com>
    
        (applied based on p5p patch as commit 679728958e74b0ccd6d61567d84851f1ef994e1f)
    
    Subject: Emulate missing flock() with either fcntl() or lockf()
    From: Chip Salzenberg <chip@atlantic.net>
    Files: pp_sys.c
    
    Subject: 3_09: minor patches for OS/2
    Date: Wed, 27 Nov 1996 03:30:05 -0500 (EST)
    From: Ilya Zakharevich <ilya@math.ohio-state.edu>
    Files: doio.c global.sym malloc.c old_global.sym os2/Makefile.SHs os2/OS2/ExtAttr/Makefile.PL os2/OS2/PrfDB/Makefile.PL os2/OS2/Process/Makefile.PL os2/OS2/REXX/Makefile.PL os2/os2.c os2/os2ish.h perl.h
    
        Subject: 3_09: minor patches
        
        This patches mostly enable commpilation under OS/2, and fix malloc.c.
        
        Enjoy,
        
        p5p-msgid: <199611270830.DAA04985@monk.mps.ohio-state.edu>
    
    Subject: Re: 5.003_09 and QNX
    Date: Wed, 27 Nov 96 13:36:06 est
    From: Norton Allen <nort@bottesini.harvard.edu>
    Files: Configure MANIFEST README.qnx hints/qnx.sh qnx/ar qnx/cpp t/TEST toke.c util.c x2p/proto.h
    Msg-ID: <9611271836.AA14460@bottesini.harvard.edu>
    
        (applied based on p5p patch as commit c511749)
  2. @rosche

    Document how to use $SIG{ALRM} and alarm()

    rosche authored Chip Salzenberg committed
    Subject: Re: reliable signal patch (was Re: Reliable signals)
    
    On Tue, 26 Nov 1996 11:14:03 -0500 (EST), Kenneth Albanowski <kjahds@kjahds.com> said:
    >
    > Thus with restarting being the default, you can restart, if you want,
    > by returning normally from the signal handler, or interrupt by dying.
    
    Thanks, now I get it.  This is even inferred in perlipc(1).  Here's some
    more explicit documentation.
    
    p5p-msgid: <5898.849026569@eeyore.ibcinc.com>
  3. Diagnostic cleanup

    Chip Salzenberg authored
  4. Re: 5.003_09 and QNX

    Norton Allen authored Chip Salzenberg committed
    [editor's note: original messages may not have been delivered:
    the included message may be the only remaining trace.
    see note on <9611271732.AA17020@bottesini.harvard.edu>:
    --- |3
      [ There was a set of quite minor patches posted on 11/20; I got 
      them, but who knows who else did, the list being what it is...
      I am also nearly ready to submit a QNX hints file together with
      a couple auxilliary support files.]
    ...
    ]
    
    Subject: QNX Port
    
    Greetings,
    
      QNX is now compiling 5.003_08 successfully and passing all 
      tests except for two which have been identified as library 
      errors and are in the process of being fixed by the vendor.
      
      I'd like to submit a few small patches which makes this 
      work. The patches are accompanied by text describing their 
      motivation.
      
      If I am moving too fast, please tell me slow down. If you have 
      suggestions for other/better approaches, please let me know.
      
      I will follow up with a hints file and a (possibly more 
      controversial) Configure change.
      
        -Norton Allen
    
    Under QNX, I need to include <sys/wait.h> in util.c to prototype
    waitpid(). This appears straightforward to me, but if it causes
    trouble, it could be made OS-dependent.
    
    This patch is against perl5.003_08
    
    p5p-msgid: <9611201749.AA11327@bottesini.harvard.edu>
    private-msgid: <9611271836.AA14460@bottesini.harvard.edu>
  5. AutoLoader::AUTOLOAD optimization

    Nick Ing-Simmons authored Chip Salzenberg committed
    I notice that although *.al are right alongside autosplit.ix the 
    trick AutoLoader::import uses to speed looking for the latter
    is not used to find the *.al files - anyone know why?
    
    On NFS mounted file systems at least, all the failed stats/opens are expensive.
    (Sadly I am testing this at home where everything is local...)
    
    p5p-msgid: <199611231954.TAA09921@ni-s.u-net.com>
  6. Reliable signal patch

    Kenneth Albanowski authored Chip Salzenberg committed
    Subject: reliable signal patch (was Re: Reliable signals)
    
    On Tue, 26 Nov 1996, Kenneth Albanowski wrote:
    
    > > I found that 2 places in perl still use unreliable signals:
    > > 	my_pclose() in util.c
    > > 	pp_system() in pp_sys.c
    > > 
    > > Is this working as designed, or an omission?
    > I guess a new set of signal macros are needed, to reliably save and
    > restore signal settings.
    
    Here is a patch that accomplishes this. It replaces the rsignal
    construction in mg.c with a generalized set of functions: rsignal,
    rsignalsave, rsignalrestore, and rsignalstate. 
    
    Note that global.sym is patched to accomodate the new globally accessible
    functions. They probably will be of use to XSUBs too. 
    
    This was diffed from a slightly messy 5.003_08, but should apply
    acceptably over any 5.003_* series.
    
    p5p-msgid: <Pine.LNX.3.93.961126053209.294J-100000@kjahds.com>
  7. [dummy merge]

    Chip Salzenberg authored
    This merge exists so that the p5p version of the patch and the applied
    version are both in the history
  8. Minor patch to debugger

    Chip Salzenberg authored
    (this is the same change as commit 9e0ff5e, but as applied)
  9. Minor patch to debugger

    Ilya Zakharevich authored Chip Salzenberg committed
    This makes the new behaviour a little bit more transparent (now you
    need q to quit), and avoids one malloc/free pair in the signal handler.
    
    p5p-msgid: <199611290533.AAA08053@monk.mps.ohio-state.edu>
  10. Re: updated patch on the sysread, syswrite for VMS

    Charles Bailey authored Chip Salzenberg committed
    Subject: Re: updated patch on the sysread, syswrite
    
    > Based on feedback I got, here is an updated patch.  I would appreciate
    > even more feedback as I added a t/op test that exercises the sysread,
    > syswrite.  Especially appreciated experiences on non-UNIX systems like
    > OS/2, VMS, we'll see how portable my very UNIXish ideas of what those
    > two calls should do are... to be applied on top of 3_08.
    
    Looks OK under VMS.  Appended is a patch to the test, which works around
    the fact that file size as returned by -s isn't updated until a file is
    closed.
    
    p5p-msgid: <01ICB648K2XG001A1D@hmivax.humgen.upenn.edu>
  11. Save message when calling __DIE__ hook

    Chip Salzenberg authored
  12. Don't call fcntl(fileno(rsfp)) if !rsfp

    Chip Salzenberg authored
  13. Fix regex matching of chars with high bit set

    Chip Salzenberg authored
  14. [shell changes from patch from perl5.003_09 to perl5.003_10]

    Chip Salzenberg authored
    Change from running these commands:
    
     # We'll create new scripts, but patch won't automatically make them
     # executable.
     test -d qnx || mkdir qnx
     touch qnx/ar qnx/cpp
     chmod +x qnx/ar qnx/cpp
     touch old_perl_exp.SH
     chmod +x *.SH *.pl
     exit 0
Commits on Nov 26, 1996
  1. [inseparable changes from patch from perl5.003_08 to perl5.003_09]

    Perl 5 Porters authored Chip Salzenberg committed
     CORE LANGUAGE CHANGES
    
    Subject: Lexical locales
    From: Chip Salzenberg <chip@atlantic.net>
    Files: too many to list
    
        make effectiveness of locales depend on C<use locale>
    
    Subject: Lexical scoping cleanup
    From: Chip Salzenberg <chip@atlantic.net>
    Files: many... but mostly perly.y and toke.c
    
        tighten scoping of lexical variables, somewhat on the
        new constructs and somewhat on the old
    
    Subject: memory corruption / security bug in sysread,syswrite + patch
    Date: Mon, 25 Nov 1996 21:46:31 +0200 (EET)
    From: Jarkko Hietaniemi <jhi@cc.hut.fi>
    Files: MANIFEST pod/perldiag.pod pod/perlfunc.pod pp_sys.c t/op/sysio.t
    Msg-ID: <199611251946.VAA30459@alpha.hut.fi>
    
        (applied based on p5p patch as commit d7090df)
    
     DOCUMENTATION
    
    Subject: perldiag documentation patch.
    Date: Wed, 20 Nov 96 16:07:28 GMT
    From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
    Files: pod/perldiag.pod
    
        private-msgid: <9611201607.AA12729@claudius.bfsec.bt.co.uk>
    
    Subject: a missing perldiag entry
    Date: Thu, 21 Nov 1996 15:24:02 -0500
    From: Gurusamy Sarathy <gsar@engin.umich.edu>
    Files: pod/perldiag.pod
    
        private-msgid: <199611212024.PAA15758@aatma.engin.umich.edu>
    
    Subject: perlfunc patch
    Date: Wed, 20 Nov 96 14:04:08 GMT
    From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
    Files: pod/perlfunc.pod
    
        Following on from the patch to make uc, lc etc default to $_ (as per
        Camel II), here is a followup patch to perlfunc that documents the
        change. I think I have documented all the other cases where $_
        defaulting works as well.
        
        p5p-msgid: <9611201404.AA12477@claudius.bfsec.bt.co.uk>
    
     OTHER CORE CHANGES
    
    Subject: Properly prototype safe{malloc,calloc,realloc,free}.
    From: Chip Salzenberg <chip@atlantic.net>
    Files: proto.h
    
    Subject: UnixWare 2.1 fix for perl5.003_08 - cope with fp->_cnt < -1, allow debugging
    Date: Wed, 20 Nov 1996 14:27:06 +0100
    From: John Hughes <john@AtlanTech.COM>
    Files: sv.c
    
        UnixWare 2.1 has no fp->_base so most of the debugging stuff in sv_gets just
        core dumps.
        
        Also, for some unknown reason fp->_cnt is sometimes < -1, screwing up the
        initial SvGROW in svgets.
        
        Appart from that its io is std.
        
        p5p-msgid: <01BBD6EE.E915C860@malvinas.AtlanTech.COM>
    
    Subject: die -> croak
    Date: Thu, 21 Nov 1996 16:11:21 -0500
    From: Gurusamy Sarathy <gsar@engin.umich.edu>
    Files: pp_ctl.c
    
        private-msgid: <199611212111.QAA17070@aatma.engin.umich.edu>
    
    Subject: Cleanup of {,un}pack('w').
    From: Chip Salzenberg <chip@atlantic.net>
    Files: pp.c
    
    Subject: Cleanups from Ilya.
    From: Chip Salzenberg <chip@atlantic.net>
    Files: gv.c malloc.c pod/perlguts.pod pp_ctl.c
    
    Subject: Fix for unpack('w') on 64-bit systems.
    From: Chip Salzenberg <chip@atlantic.net>
    Files: pp.c
    
    Subject: Re: LC_NUMERIC support is ready + performance
    Date: Mon, 25 Nov 1996 22:08:27 -0500 (EST)
    From: Ilya Zakharevich <ilya@math.ohio-state.edu>
    Files: sv.c
    
        Chip Salzenberg writes:
        > 
        > Having thought about the use of our own gcvt() and atof(), I've run
        > away in horror.  It's just too hairy.
        > 
        > So I've implemented the only viable alternative I know of: Toggling
        > LC_NUMERIC to/from "C" as needed.
        > 
        > Patch follows.
        > 
        > I think _09 is *very* close.
        
        Since _09 is going to be alpha anyway, I reiterate my question:
        	Is there any reason to not include my hash/array performance
        		patches in _09?
        
        Btw, here is the next performance patch. It makes PADTMP values
        stealable too. I do not do by setting TEMP flags on them, since it
        would be a very distributed patch, and it would break some places
        which check for TEMP for some other reasons (yes, I checked ;-).
        
        This patch decreases *twice* the memory usage of
        	perl -e '$a = "a" x 1e6; 1'
        
        Enjoy,
        
        p5p-msgid: <199611260308.WAA02677@monk.mps.ohio-state.edu>
    
    Subject: Hash key sharing improvements from Ilya.
    From: Chip Salzenberg <chip@atlantic.net>
    Files: hv.c hv.h proto.h
    
    Subject: Mortal stack pre-allocation from Ilya.
    From: Chip Salzenberg <chip@atlantic.net>
    Files: pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c
    
     PORTABILITY
    
    Subject: VMS patches post-5.003_08
    Date: Fri, 22 Nov 1996 18:16:31 -0500 (EST)
    From: Charles Bailey <bailey@hmivax.humgen.upenn.edu>
    Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm lib/File/Path.pm mg.c pp_ctl.c utils/h2xs.PL vms/config.vms vms/descrip.mms vms/gen_shrfls.pl vms/genconfig.pl vms/perlvms.pod vms/vms.c vms/vmsish.h
    
        Here're diffs to bring a base 5.003_08 up to the current VMS working
        sources.  Nearly all of the changes are VMS-specific, and comprise
        miscellaneous bugfixes accumulated since 5.003_07, rather than any
        particular problem with 5.003_08.  I'm posting them here since some
        of the patches change core files, and I'd like to insure that I
        haven't accidentally created problems for anyone else.
        
        With these and a couple of of the small patches already send to p5p,
        5.003_08 builds clean and passes all tests under VMS.
        
        Thanks, Chip, for all the work.
        
        p5p-msgid: <1996Nov22.181631.1603238@hmivax.humgen.upenn.edu>
  2. memory corruption / security bug in sysread,syswrite + patch

    Jarkko Hietaniemi authored Chip Salzenberg committed
    Using a negative offset in sysread() gives interesting results.
    I get either
    
    	assertion botched: OV_MAGIC(op, bucket) == MAGIC
    	zsh: 22828 abort      perl xp1 < /etc/passwd
    
    if the offset is 'mild' or
    
    	panic: realloc at xp2 line 1.
    
    if the offset is 'wild'.
    
    Using a negative offset in syswrite() opens up interesting vistas,
    like, say, your stack :-)
    
    A patch follows. 'Reasonably' small negative values are accepted,
    they count from the end of the data. One possible point of debate:
    should that be +1? That is, if the offset is negative, should that
    mean 1) at the point 2) after the point? For sysread(), "after" might
    sometimes be a better choice?
    
    p5p-msgid: <199611231705.TAA02671@alpha.hut.fi>
    private-msgid: <199611251946.VAA30459@alpha.hut.fi>
  3. Fix type mismatches in x2p's safe{alloc,realloc,free}.

    Chip Salzenberg authored
  4. Update locale documentation.

    Chip Salzenberg authored
  5. Patch for pod/perlpod.pod

    Joseph S. Myers authored Chip Salzenberg committed
    This patch documents the E<lt> and E<gt> pod escapes, and adds a section
    on common pod pitfalls (in particular the text that translators add around
    L<> links, since these seem very commonly to be used incorrectly).
    
    p5p-msgid: <Pine.LNX.3.95.961120235016.6666A-100000@hammer.chu.cam.ac.uk>
    private-msgid: <Pine.LNX.3.95.961120235016.6666A-100000@hammer.chu.cam.ac.uk
  6. [dummy merge]

    Chip Salzenberg authored
    This merge exists so that the p5p version of the patch and the applied
    version are both in the history
Something went wrong with that request. Please try again.