This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate changes #8689,8697,8724,8726,8731,8742,8754,8755,
authorJarkko Hietaniemi <jhi@iki.fi>
Fri, 2 Mar 2001 18:51:25 +0000 (18:51 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Fri, 2 Mar 2001 18:51:25 +0000 (18:51 +0000)
8763,8767,8770,8772,8795,8796,8813,8822,8823 from mainline
to maintperl.

Subject: Re: [PATCH lots of pod/] s/chop/chomp/g

Subject: [DOC PATCH] overload.pm nits

Add header for LIB$ prototypes (C. Berry)

Convert fwrite()s to sockets to write()s, since some socket stacks
don't take kindly to stdio.
Ignore "expected" SS$_NOLOGNAM when doing internal LNM lookups
(for often optional LNMs)
Correct a few typos
(C. Bailey)

Subject: [PATCH: 5.6.1 trial2 && perl@8671] provide EBCDIC CGI::Util::escape() and test

De-cut-and-pasto.

Subject: Re: [PATCH embed.pl] Forgot to add ./lib to @INC for File::Glob

Upgrade to Text-Tabs+Wrap-2001.0131 from David Muir Sharnoff.

Upgrade to CPAN 1.59_54, from Andreas König.

Bogus shebang.

Subject: [PATCH] Document makepatch in Porting/patching

UTF-8 documentation.

Subject: Re: [PATCH] pod/perlclib.pod - Replacements for C library functions

Sort the MANIFEST.

Subject: [ID 20010210.002] perldiag doesn't include the "Scalars leaked" message

Subject: [PATCH @8807] toke.c cleanup: scan_str()

Subject: [PATCH perl.c] Fixing PERL5OPT (was Re: Warnings, strict, and CPAN)

Add run/*.t to testables.

TODO: integrate #8784.

p4raw-link: @8731 on //depot/perl: cbe1151c894397456eb4168363b69bdac01b932b
p4raw-link: @8726 on //depot/perl: 92dffb52e8549d6a194db47a2e5b989b8338a19a
p4raw-link: @8724 on //depot/perl: 95fb165d43723d070af25e235b49380c9424c185
p4raw-link: @8697 on //depot/perl: 1fd1692502b045dcc304cd3af66d445dd84df577
p4raw-link: @8689 on //depot/perl: 5b3eff12f7c4ea0bd1324f2fe0a16edec8764c93

p4raw-id: //depot/maint-5.6/perl@8986
p4raw-branched: from //depot/perl@8984 'branch in' t/lib/cgi-esc.t
p4raw-integrated: from //depot/perl@8984 'copy in' Porting/patching.pod
(@4007..) lib/Text/Tabs.pm (@4946..) pod/perlutil.pod (@6872..)
pod/perlfaq8.pod (@7585..) lib/CPAN/FirstTime.pm (@7946..)
vms/vmsish.h (@8257..) lib/Text/Wrap.pm t/lib/textwrap.t
(@8573..) pod/perltoc.pod (@8730..) 'merge in' lib/overload.pm
(@8545..) utf8.h (@8647..) lib/CPAN.pm (@8717..)
pod/buildtoc.PL (@8730..) pod/perl.pod (@8731..)
p4raw-integrated: from //depot/perl@8823 'merge in' t/TEST (@8821..)
p4raw-branched: from //depot/perl@8822 'branch in' t/run/runenv.t
p4raw-integrated: from //depot/perl@8822 'edit in' MANIFEST (@8821..)
'merge in' perl.c (@8815..)
p4raw-integrated: from //depot/perl@8813 'merge in' toke.c (@8792..)
p4raw-integrated: from //depot/perl@8796 'edit in' pod/perldiag.pod
(@8689..)
p4raw-branched: from //depot/perl@8772 'branch in' pod/perlclib.pod
p4raw-integrated: from //depot/perl@8772 'copy in' pod/perlguts.pod
(@8547..)
p4raw-integrated: from //depot/perl@8763 'copy in' t/lib/texttabs.t
(@8754..)
p4raw-integrated: from //depot/perl@8742 'merge in' embed.pl (@8713..)
p4raw-integrated: from //depot/perl@8726 'copy in' lib/CGI/Util.pm
(@6580..)
p4raw-integrated: from //depot/perl@8724 'copy in'
ext/Devel/DProf/DProf.xs (@7984..) 'merge in' vms/vms.c
(@8257..)
p4raw-integrated: from //depot/perl@8689 'merge in' pod/perlport.pod
(@7597..) pod/perlop.pod (@8485..) pod/perlfunc.pod (@8670..)

31 files changed:
MANIFEST
Porting/patching.pod
embed.pl
ext/Devel/DProf/DProf.xs
lib/CGI/Util.pm
lib/CPAN.pm
lib/CPAN/FirstTime.pm
lib/Text/Tabs.pm
lib/Text/Wrap.pm
lib/overload.pm
perl.c
pod/buildtoc.PL
pod/perl.pod
pod/perlclib.pod [new file with mode: 0644]
pod/perldiag.pod
pod/perlfaq8.pod
pod/perlfunc.pod
pod/perlguts.pod
pod/perlop.pod
pod/perlport.pod
pod/perltoc.pod
pod/perlutil.pod
t/TEST
t/lib/cgi-esc.t [new file with mode: 0644]
t/lib/texttabs.t
t/lib/textwrap.t
t/run/runenv.t [new file with mode: 0644]
toke.c
utf8.h
vms/vms.c
vms/vmsish.h

index 9e0dc55..8ca08c0 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1140,6 +1140,7 @@ pod/perlbook.pod  Perl book information
 pod/perlboot.pod       Beginner's Object-oriented Tutorial
 pod/perlbot.pod                Object-oriented Bag o' Tricks
 pod/perlcall.pod       Callback info
+pod/perlclib.pod       Internal replacements for standard C library functions
 pod/perlcompile.pod    Info on using the Compiler suite
 pod/perldata.pod       Data structure info
 pod/perldbmfilter.pod  Info about DBM Filters
@@ -1292,6 +1293,7 @@ t/lib/bigfloat.t  See if bigfloat.pl works
 t/lib/bigfltpm.t       See if BigFloat.pm works
 t/lib/bigint.t         See if bigint.pl works
 t/lib/bigintpm.t       See if BigInt.pm works
+t/lib/cgi-esc.t                See if CGI.pm works
 t/lib/cgi-form.t       See if CGI.pm works
 t/lib/cgi-function.t   See if CGI.pm works
 t/lib/cgi-html.t       See if CGI.pm works
@@ -1586,6 +1588,7 @@ t/pragma/warn/universal   Tests for universal.c for warnings.t
 t/pragma/warn/utf8     Tests for utf8.c for warnings.t
 t/pragma/warn/util     Tests for util.c for warnings.t
 t/pragma/warnings.t    See if warning controls work
+t/run/runenv.t         Test if perl honors its environment variables.
 taint.c                        Tainting code
 thrdvar.h              Per-thread variables
 thread.h               Threading header
index 5659f23..7fd376b 100644 (file)
@@ -94,12 +94,7 @@ diffs.  Some examples using GNU diff:
     # show function name in every hunk (safer, more informative)
     % diff -u -F '^[_a-zA-Z0-9]+ *(' old/file new/file
 
-
-=item Directories
-
-IMPORTANT: Patches should be generated from the source root directory, not
-from the directory that the patched file resides in.  This ensures that the
-maintainer patches the proper file.
+=item Derived Files
 
 Many files in the distribution are derivative--avoid patching them.
 Patch the originals instead.  Most utilities (like perldoc) are in
@@ -120,6 +115,31 @@ If you are submitting patches that affect multiple files then you should
 backup the entire directory tree (to $source_root.old/ for example).  This
 will allow C<diff -ruN old-dir new-dir> to create all the patches at once.
 
+=item Directories
+
+IMPORTANT: Patches should be generated from the source root directory, not
+from the directory that the patched file resides in.  This ensures that the
+maintainer patches the proper file.
+
+For larger patches that are dealing with multiple files or
+directories, Johan Vromans has written a powerful utility: makepatch.
+See the JV directory on CPAN for the current version. If you have this
+program available, it is recommended to create a duplicate of the perl
+directory tree against which you are intending to provide a patch and
+let makepatch figure out all the changes you made to your copy of the
+sources. As perl comes with a MANIFEST file, you need not delete
+object files and other derivative files from the two directory trees,
+makepatch is smart about them.
+
+Say, you have created a directory perl-5.7.1@8685/ for the perl you
+are taking as the base and a directory perl-5.7.1@8685-withfoo/ where
+you have your changes, you would run makepatch as follows:
+
+    makepatch -oldman perl-5.7.1@8685/MANIFEST \
+              -newman perl-5.7.1@8685-withfoo/MANIFEST \
+              -diff "diff -u" \
+              perl-5.7.1@8685 perl-5.7.1@8685-withfoo
+
 =item Try it yourself
 
 Just to make sure your patch "works", be sure to apply it to the Perl
index 823039f..820e9ad 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1,5 +1,9 @@
 #!/usr/bin/perl -w
 
+BEGIN {
+    unshift @INC, "./lib";
+}
+
 require 5.003; # keep this compatible, an old perl is all we may have before
                 # we build the new one
 
index 8f28c6e..e75e732 100644 (file)
@@ -23,6 +23,7 @@
 #  define HZ ((I32)CLK_TCK)
 #  define DPROF_HZ HZ
 #  include <starlet.h>  /* prototype for sys$gettim() */
+#  include <lib$routines.h>
 #  define Times(ptr) (dprof_times(aTHX_ ptr))
 #else
 #  ifndef HZ
index ac7376d..0049667 100644 (file)
@@ -1,7 +1,7 @@
 package CGI::Util;
 
 use strict;
-use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E';
+use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E','@E2A';
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(rearrange make_attributes unescape escape expires);
@@ -10,6 +10,7 @@ $VERSION = '1.1';
 
 $EBCDIC = "\t" ne "\011";
 if ($EBCDIC) {
+# (ord('^') == 95) for codepage 1047 as on os390, vmesa
 @A2E = (
   0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
  16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
@@ -28,6 +29,44 @@ if ($EBCDIC) {
  68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
 140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
       );
+@E2A = (
+  0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19,157, 10,  8,135, 24, 25,146,143, 28, 29, 30, 31,
+128,129,130,131,132,133, 23, 27,136,137,138,139,140,  5,  6,  7,
+144,145, 22,147,148,149,150,  4,152,153,154,155, 20, 21,158, 26,
+ 32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
+ 38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
+ 45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
+248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
+216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
+176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
+181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
+172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
+123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
+125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
+ 92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
+ 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
+      );
+if (ord('^') == 106) { # as in the BS2000 posix-bc coded character set
+    $A2E[91] = 187;   $A2E[92] = 188;  $A2E[94] = 106;  $A2E[96] = 74;
+    $A2E[123] = 251;  $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
+    $A2E[162] = 176;  $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
+    $A2E[175] = 161;  $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
+    $A2E[249] = 192;
+
+    $E2A[74] = 96;   $E2A[95] = 159;  $E2A[106] = 94;  $E2A[121] = 168;
+    $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
+    $E2A[187] = 91;  $E2A[188] = 92;  $E2A[192] = 249; $E2A[208] = 166;
+    $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
+    $E2A[255] = 126;
+}
+elsif (ord('^') == 176) { # as in codepage 037 on os400
+    $A2E[10] = 37;  $A2E[91] = 186;  $A2E[93] = 187; $A2E[94] = 176;
+    $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
+
+    $E2A[21] = 133; $E2A[37] = 10;  $E2A[95] = 172; $E2A[173] = 221;
+    $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
+}
 }
 
 # Smart rearrangement of parameters to allow named parameter
@@ -114,7 +153,11 @@ sub escape {
   shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
   my $toencode = shift;
   return undef unless defined($toencode);
-  $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+    if ($EBCDIC) {
+      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
+    } else {
+      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+    }
   return $toencode;
 }
 
index fce7dc4..73225e0 100644 (file)
@@ -1,11 +1,11 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN;
-$VERSION = '1.59_51';
-# $Id: CPAN.pm,v 1.381 2000/12/01 08:13:05 k Exp $
+$VERSION = '1.59_54';
+# $Id: CPAN.pm,v 1.385 2001/02/09 21:37:57 k Exp $
 
 # only used during development:
 $Revision = "";
-# $Revision = "[".substr(q$Revision: 1.381 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.385 $, 10)."]";
 
 use Carp ();
 use Config ();
@@ -229,6 +229,10 @@ package CPAN::FTP;
 use vars qw($Ua $Thesite $Themethod);
 @CPAN::FTP::ISA = qw(CPAN::Debug);
 
+package CPAN::LWP::UserAgent;
+use vars qw(@ISA $USER $PASSWD $SETUPDONE);
+# we delay requiring LWP::UserAgent and setting up inheritence until we need it
+
 package CPAN::Complete;
 @CPAN::Complete::ISA = qw(CPAN::Debug);
 @CPAN::Complete::COMMANDS = sort qw(
@@ -238,10 +242,10 @@ package CPAN::Complete;
 ) unless @CPAN::Complete::COMMANDS;
 
 package CPAN::Index;
-use vars qw($last_time $date_of_03);
+use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
 @CPAN::Index::ISA = qw(CPAN::Debug);
-$last_time ||= 0;
-$date_of_03 ||= 0;
+$LAST_TIME ||= 0;
+$DATE_OF_03 ||= 0;
 # use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
 sub PROTOCOL { 2.0 }
 
@@ -1249,19 +1253,17 @@ sub h {
     } else {
        $CPAN::Frontend->myprint(q{
 Display Information
- a                                    authors
- b         string           display   bundles
- d         or               info      distributions
- m         /regex/          about     modules
- i         or                         anything of above
- r         none             reinstall recommendations
- u                          uninstalled distributions
+ command  argument          description
+ a,b,d,m  WORD or /REGEXP/  about authors, bundles, distributions, modules
+ i        WORD or /REGEXP/  about anything of above
+ r        NONE              reinstall recommendations
+ ls       AUTHOR            about files in the author's directory
 
 Download, Test, Make, Install...
  get                        download
  make                       make (implies get)
- test      modules,         make test (implies make)
- install   dists, bundles   make install (implies test)
+ test      MODULES,         make test (implies make)
+ install   DISTS, BUNDLES   make install (implies test)
  clean                      make clean
  look                       open subshell in these dists' directories
  readme                     display these dists' README files
@@ -1281,7 +1283,7 @@ sub a {
   my($self,@arg) = @_;
   # authors are always UPPERCASE
   for (@arg) {
-    $_ = uc $_;
+    $_ = uc $_ unless /=/;
   }
   $CPAN::Frontend->myprint($self->format_result('Author',@arg));
 }
@@ -1289,10 +1291,15 @@ sub a {
 #-> sub CPAN::Shell::ls ;
 sub ls      {
     my($self,@arg) = @_;
+    my @accept;
     for (@arg) {
-        $_ = uc $_;
+        unless (/^[A-Z\-]+$/i) {
+            $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author");
+            next;
+        }
+        push @accept, uc $_;
     }
-    for my $a (@arg){
+    for my $a (@accept){
         my $author = $self->expand('Author',$a) or die "No author found for $a";
         $author->ls;
     }
@@ -1310,7 +1317,7 @@ sub local_bundles {
             if ($dh = DirHandle->new($bdir)) { # may fail
                 my($entry);
                 for $entry ($dh->read) {
-                    next if $entry =~ /^\./; # 
+                    next if $entry =~ /^\./;
                     if (-d MM->catdir($bdir,$entry)){
                         push @bbase, "$bbase\::$entry";
                     } else {
@@ -1963,7 +1970,7 @@ sub rematein {
        }
        if (ref $obj) {
             $obj->color_cmd_tmps(0,1);
-            CPAN::Queue->new($s);
+            CPAN::Queue->new($obj->id);
             push @qcopy, $obj;
        } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
            $obj = $CPAN::META->instance('CPAN::Author',$s);
@@ -2054,6 +2061,60 @@ sub look   { shift->rematein('look',@_); }
 #-> sub CPAN::Shell::cvs_import ;
 sub cvs_import   { shift->rematein('cvs_import',@_); }
 
+package CPAN::LWP::UserAgent;
+
+sub config {
+    return if $SETUPDONE;
+    if ($CPAN::META->has_usable('LWP::UserAgent')) {
+        require LWP::UserAgent;
+        @ISA = qw(Exporter LWP::UserAgent);
+        $SETUPDONE++;
+    } else {
+        $CPAN::Frontent->mywarn("LWP::UserAgent not available\n");
+    }
+}
+
+sub get_basic_credentials {
+    my($self, $realm, $uri, $proxy) = @_;
+    return unless $proxy;
+    if ($USER && $PASSWD) {
+    } elsif (defined $CPAN::Config->{proxy_user} &&
+        defined $CPAN::Config->{proxy_pass}) {
+        $USER = $CPAN::Config->{proxy_user};
+        $PASSWD = $CPAN::Config->{proxy_pass};
+    } else {
+        require ExtUtils::MakeMaker;
+        ExtUtils::MakeMaker->import(qw(prompt));
+        $USER = prompt("Proxy authentication needed!
+ (Note: to permanently configure username and password run
+   o conf proxy_user your_username
+   o conf proxy_pass your_password
+ )\nUsername:");
+        if ($CPAN::META->has_inst("Term::ReadKey")) {
+            Term::ReadKey::ReadMode("noecho");
+        } else {
+            $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n");
+        }
+        $PASSWD = prompt("Password:");
+        if ($CPAN::META->has_inst("Term::ReadKey")) {
+            Term::ReadKey::ReadMode("restore");
+        }
+        $CPAN::Frontend->myprint("\n\n");
+    }
+    return($USER,$PASSWD);
+}
+
+sub mirror {
+    my($self,$url,$aslocal) = @_;
+    my $result = $self->SUPER::mirror($url,$aslocal);
+    if ($result->code == 407) {
+        undef $USER;
+        undef $PASSWD;
+        $result = $self->SUPER::mirror($url,$aslocal);
+    }
+    $result;
+}
+
 package CPAN::FTP;
 
 #-> sub CPAN::FTP::ftp_get ;
@@ -2163,9 +2224,10 @@ sub localize {
     # Inheritance is not easier to manage than a few if/else branches
     if ($CPAN::META->has_usable('LWP::UserAgent')) {
        unless ($Ua) {
-           eval {$Ua = LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
+            CPAN::LWP::UserAgent->config;
+           eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
             if ($@) {
-                $CPAN::Frontent->mywarn("LWP::UserAgent->new dies with $@")
+                $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@")
                     if $CPAN::DEBUG;
             } else {
                 my($var);
@@ -2173,6 +2235,20 @@ sub localize {
                     if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
                 $Ua->proxy('http', $var)
                     if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
+
+
+# >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" <jrobiso2@visteon.com> said:
+# 
+#  > I note that although CPAN.pm can use proxies, it doesn't seem equipped to
+#  > use ones that require basic autorization.
+#  
+#  > Example of when I use it manually in my own stuff:
+#  
+#  > $ua->proxy(['http','ftp'], http://my.proxy.server:83');
+#  > $req->proxy_authorization_basic("username","password");
+#  > $res = $ua->request($req);
+# 
+
                 $Ua->no_proxy($var)
                     if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
             }
@@ -2275,6 +2351,7 @@ sub hosteasy {
                                                     # meant
                                                     # file://localhost
                $l =~ s|^/||s unless -f $l;         # e.g. /P:
+               $self->debug("without URI::URL we try local file $l") if $CPAN::DEBUG;
            }
            if ( -f $l && -r _) {
                $Thesite = $i;
@@ -2295,8 +2372,11 @@ sub hosteasy {
   $url
 ");
          unless ($Ua) {
-           require LWP::UserAgent;
-           $Ua = LWP::UserAgent->new;
+              CPAN::LWP::UserAgent->config;
+              eval { $Ua = CPAN::LWP::UserAgent->new; };
+              if ($@) {
+                  $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@");
+              }
          }
          my $res = $Ua->mirror($url, $aslocal);
          if ($res->is_success) {
@@ -2318,12 +2398,17 @@ sub hosteasy {
              return $aslocal;
            }
          } else {
+              $CPAN::Frontend->myprint(sprintf(
+                                               "LWP failed with code[%s] message[%s]\n",
+                                               $res->code,
+                                               $res->message,
+                                              ));
            # Alan Burlison informed me that in firewall environments
            # Net::FTP can still succeed where LWP fails. So we do not
            # skip Net::FTP anymore when LWP is available.
          }
        } else {
-         $self->debug("LWP not installed") if $CPAN::DEBUG;
+            $CPAN::Frontend->myprint("LWP not available\n");
        }
         return if $CPAN::Signal;
        if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
@@ -2763,7 +2848,7 @@ sub cpl {
     my @return;
     if ($pos == 0) {
        @return = grep /^$word/, @CPAN::Complete::COMMANDS;
-    } elsif ( $line !~ /^[\!abcdhimorutl]/ ) {
+    } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
        @return = ();
     } elsif ($line =~ /^(a|ls)\s/) {
        @return = cplx('CPAN::Author',uc($word));
@@ -2773,7 +2858,7 @@ sub cpl {
     } elsif ($line =~ /^d\s/) {
        @return = cplx('CPAN::Distribution',$word);
     } elsif ($line =~ m/^(
-                          [mru]|make|clean|dump|test|install|readme|look|cvs_import
+                          [mru]|make|clean|dump|get|test|install|readme|look|cvs_import
                          )\s/x ) {
         if ($word =~ /^Bundle::/) {
             CPAN::Shell->local_bundles;
@@ -2850,7 +2935,7 @@ package CPAN::Index;
 #-> sub CPAN::Index::force_reload ;
 sub force_reload {
     my($class) = @_;
-    $CPAN::Index::last_time = 0;
+    $CPAN::Index::LAST_TIME = 0;
     $class->reload(1);
 }
 
@@ -2875,9 +2960,9 @@ sub reload {
     }
     if ( $CPAN::META->{PROTOCOL} < PROTOCOL  ) {
         # warn "Setting last_time to 0";
-        $last_time = 0; # No warning necessary
+        $LAST_TIME = 0; # No warning necessary
     }
-    return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
+    return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time
        and ! $force;
     if (0) {
         # IFF we are developing, it helps to wipe out the memory
@@ -2887,7 +2972,7 @@ sub reload {
     }
     {
         my($debug,$t2);
-        local $last_time = $time;
+        local $LAST_TIME = $time;
         local $CPAN::META->{PROTOCOL} = PROTOCOL;
 
         my $needshort = $^O eq "dos";
@@ -2927,7 +3012,7 @@ sub reload {
         $time = $t2;
         CPAN->debug($debug) if $CPAN::DEBUG;
     }
-    $last_time = $time;
+    $LAST_TIME = $time;
     $CPAN::META->{PROTOCOL} = PROTOCOL;
 }
 
@@ -2999,12 +3084,12 @@ sub rd_modpacks {
        push @lines, @ls;
     }
     # read header
-    my $line_count;
+    my($line_count,$last_updated);
     while (@lines) {
        my $shift = shift(@lines);
-       $shift =~ /^Line-Count:\s+(\d+)/;
-       $line_count = $1 if $1;
        last if $shift =~ /^\s*$/;
+       $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1;
+        $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1;
     }
     if (not defined $line_count) {
 
@@ -3024,6 +3109,41 @@ CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
 $index_target, $line_count, scalar(@lines);
 
     }
+    if (not defined $last_updated) {
+
+       warn qq{Warning: Your $index_target does not contain a Last-Updated header.
+Please check the validity of the index file by comparing it to more
+than one CPAN mirror. I'll continue but problems seem likely to
+happen.\a
+};
+
+       sleep 5;
+    } else {
+
+       $CPAN::Frontend
+            ->myprint(sprintf qq{  Database was generated on %s\n},
+                      $last_updated);
+        $DATE_OF_02 = $last_updated;
+
+        if ($CPAN::META->has_inst(HTTP::Date)) {
+            require HTTP::Date;
+            my($age) = (time - HTTP::Date::str2time($last_updated))/3600/24;
+            if ($age > 30) {
+
+                $CPAN::Frontend
+                    ->mywarn(sprintf
+                             qq{Warning: This index file is %d days old.
+  Please check the host you chose as your CPAN mirror for staleness.
+  I'll continue but problems seem likely to happen.\a\n},
+                             $age);
+
+            }
+        } else {
+            $CPAN::Frontend->myprint("  HTTP::Date not available\n");
+        }
+    }
+
+
     # A necessity since we have metadata_cache: delete what isn't
     # there anymore
     my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
@@ -3145,8 +3265,8 @@ sub rd_modlist {
     while (@eval) {
        my $shift = shift(@eval);
        if ($shift =~ /^Date:\s+(.*)/){
-           return if $date_of_03 eq $1;
-           ($date_of_03) = $1;
+           return if $DATE_OF_03 eq $1;
+           ($DATE_OF_03) = $1;
        }
        last if $shift =~ /^\s*$/;
     }
@@ -3177,7 +3297,8 @@ sub write_metadata_cache {
        $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok
     }
     my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
-    $cache->{last_time} = $last_time;
+    $cache->{last_time} = $LAST_TIME;
+    $cache->{DATE_OF_02} = $DATE_OF_02;
     $cache->{PROTOCOL} = PROTOCOL;
     $CPAN::Frontend->myprint("Going to write $metadata_file\n");
     eval { Storable::nstore($cache, $metadata_file) };
@@ -3196,7 +3317,7 @@ sub read_metadata_cache {
     eval { $cache = Storable::retrieve($metadata_file) };
     $CPAN::Frontend->mywarn($@) if $@;
     if (!$cache || ref $cache ne 'HASH'){
-        $last_time = 0;
+        $LAST_TIME = 0;
         return;
     }
     if (exists $cache->{PROTOCOL}) {
@@ -3237,14 +3358,17 @@ sub read_metadata_cache {
     $CPAN::META->{PROTOCOL} ||=
         $cache->{PROTOCOL}; # reading does not up or downgrade, but it
                             # does initialize to some protocol
-    $last_time = $cache->{last_time};
+    $LAST_TIME = $cache->{last_time};
+    $DATE_OF_02 = $cache->{DATE_OF_02};
+    $CPAN::Frontend->myprint("  Database was generated on $DATE_OF_02\n");
+    return;
 }
 
 package CPAN::InfoObj;
 
 # Accessors
 sub cpan_userid { shift->{RO}{CPAN_USERID} }
-sub id { shift->{ID} }
+sub id { shift->{ID}; }
 
 #-> sub CPAN::InfoObj::new ;
 sub new {
@@ -3352,13 +3476,25 @@ sub dump {
 
 package CPAN::Author;
 
+#-> sub CPAN::Author::id
+sub id {
+    my $self = shift;
+    my $id = $self->{ID};
+    $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
+    $id;
+}
+
 #-> sub CPAN::Author::as_glimpse ;
 sub as_glimpse {
     my($self) = @_;
     my(@m);
     my $class = ref($self);
     $class =~ s/^CPAN:://;
-    push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
+    push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
+                     $class,
+                     $self->{ID},
+                     $self->fullname,
+                     $self->email);
     join "", @m;
 }
 
@@ -3377,31 +3513,49 @@ sub ls {
     my $id = $self->id;
 
     # adapted from CPAN::Distribution::verifyMD5 ;
-    my(@chksumfile);
-    @chksumfile = $self->id =~ /(.)(.)(.*)/;
-    $chksumfile[1] = join "", @chksumfile[0,1];
-    $chksumfile[2] = join "", @chksumfile[1,2];
-    push @chksumfile, "CHECKSUMS";
-    print join "", map {
+    my(@csf); # chksumfile
+    @csf = $self->id =~ /(.)(.)(.*)/;
+    $csf[1] = join "", @csf[0,1];
+    $csf[2] = join "", @csf[1,2];
+    my(@dl);
+    @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0);
+    unless (grep {$_->[2] eq $csf[1]} @dl) {
+        $CPAN::Frontend->myprint("No files in the directory of $id\n");
+        return;
+    }
+    @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0);
+    unless (grep {$_->[2] eq $csf[2]} @dl) {
+        $CPAN::Frontend->myprint("No files in the directory of $id\n");
+        return;
+    }
+    @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1);
+    $CPAN::Frontend->myprint(join "", map {
         sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2])
-    } sort { $a->[2] cmp $b->[2] } $self->dir_listing(\@chksumfile);
+    } sort { $a->[2] cmp $b->[2] } @dl);
 }
 
+# returns an array of arrays, the latter contain (size,mtime,filename)
 #-> sub CPAN::Author::dir_listing ;
 sub dir_listing {
     my $self = shift;
     my $chksumfile = shift;
+    my $recursive = shift;
     my $lc_want =
        MM->catfile($CPAN::Config->{keep_source_where},
                     "authors", "id", @$chksumfile);
     local($") = "/";
+    # connect "force" argument with "index_expire".
+    my $force = 0;
+    if (my @stat = stat $lc_want) {
+        $force = $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
+    }
     my $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
-                                      $lc_want,1);
+                                      $lc_want,$force);
     unless ($lc_file) {
         $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
        $chksumfile->[-1] .= ".gz";
        $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
-                                      "$lc_want.gz",1);
+                                       "$lc_want.gz",1);
        if ($lc_file) {
            $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
            CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file);
@@ -3430,12 +3584,16 @@ sub dir_listing {
     my(@result,$f);
     for $f (sort keys %$cksum) {
         if (exists $cksum->{$f}{isdir}) {
-            my(@dir) = @$chksumfile;
-            pop @dir;
-            push @dir, $f, "CHECKSUMS";
-            push @result, map {
-                [$_->[0], $_->[1], "$f/$_->[2]"]
-            } $self->dir_listing(\@dir);
+            if ($recursive) {
+                my(@dir) = @$chksumfile;
+                pop @dir;
+                push @dir, $f, "CHECKSUMS";
+                push @result, map {
+                    [$_->[0], $_->[1], "$f/$_->[2]"]
+                } $self->dir_listing(\@dir,1);
+            } else {
+                push @result, [ 0, "-", $f ];
+            }
         } else {
             push @result, [
                            ($cksum->{$f}{"size"}||0),
@@ -3461,8 +3619,12 @@ sub undelay {
 sub normalize {
     my($self,$s) = @_;
     $s = $self->id unless defined $s;
-    if ($s =~ tr|/|| == 1) {
-        return $s if $s =~ m|^N/A|;
+    if (
+        $s =~ tr|/|| == 1
+        or
+        $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/|
+       ) {
+        return $s if $s =~ m:^N/A|^Contact Author: ;
         $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or
             $CPAN::Frontend->mywarn("Strange distribution name [$s]");
         CPAN->debug("s[$s]") if $CPAN::DEBUG;
@@ -3540,7 +3702,7 @@ sub called_for {
     return $self->{CALLED_FOR};
 }
 
-#-> sub CPAN::Distribution::my_chdir ;
+#-> sub CPAN::Distribution::safe_chdir ;
 sub safe_chdir {
     my($self,$todir) = @_;
     # we die if we cannot chdir and we are debuggable
@@ -3581,9 +3743,16 @@ sub get {
                    );
 
     $self->debug("Doing localize") if $CPAN::DEBUG;
-    $local_file =
-       CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
-              or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
+    unless ($local_file =
+            CPAN::FTP->localize("authors/id/$self->{ID}",
+                                $local_wanted)) {
+        my $note = "";
+        if ($CPAN::Index::DATE_OF_02) {
+            $note = "Note: Current database in memory was generated ".
+                "on $CPAN::Index::DATE_OF_02\n";
+        }
+        $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note");
+    }
     $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
     $self->{localfile} = $local_file;
     return if $CPAN::Signal;
@@ -3684,12 +3853,14 @@ sub get {
     my($mpl) = MM->catfile($packagedir,"Makefile.PL");
     my($mpl_exists) = -f $mpl;
     unless ($mpl_exists) {
-        # Steffen's stupid NFS has problems to see an existing
-        # Makefile.PL such a short time after the directory was
-        # renamed. Maybe this trick helps
-        $dh = DirHandle->new($packagedir)
+        # NFS has been reported to have racing problems after the
+        # renaming of a directory in some environments.
+        # This trick helps.
+        sleep 1;
+        my $mpldh = DirHandle->new($packagedir)
             or Carp::croak("Couldn't opendir $packagedir: $!");
-        $mpl_exists = grep /^Makefile\.PL$/, $dh->read;
+        $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
+        $mpldh->close;
     }
     unless ($mpl_exists) {
         $self->debug(sprintf("makefilepl[%s]anycwd[%s]",
@@ -3808,14 +3979,22 @@ Please define it with "o conf shell <your shell>"
        return;
     }
     my $dist = $self->id;
-    my $dir  = $self->dir or $self->get;
-    $dir = $self->dir;
+    my $dir;
+    unless ($dir = $self->dir) {
+        $self->get;
+    }
+    unless ($dir ||= $self->dir) {
+       $CPAN::Frontend->mywarn(qq{
+Could not determine which directory to use for looking at $dist.
+});
+       return;
+    }
     my $pwd  = CPAN::anycwd();
-    chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!});
+    $self->safe_chdir($dir);
     $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
     system($CPAN::Config->{'shell'}) == 0
        or $CPAN::Frontend->mydie("Subprocess shell error");
-    chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!});
+    $self->safe_chdir($pwd);
 }
 
 # CPAN::Distribution::cvs_import ;
@@ -4613,59 +4792,65 @@ sub as_string {
 
 #-> sub CPAN::Bundle::contains ;
 sub contains {
-  my($self) = @_;
-  my($parsefile) = $self->inst_file || "";
-  my($id) = $self->id;
-  $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
-  unless ($parsefile) {
-    # Try to get at it in the cpan directory
-    $self->debug("no parsefile") if $CPAN::DEBUG;
-    Carp::confess "I don't know a $id" unless $self->cpan_file;
-    my $dist = $CPAN::META->instance('CPAN::Distribution',
-                                    $self->cpan_file);
-    $dist->get;
-    $self->debug($dist->as_string) if $CPAN::DEBUG;
-    my($todir) = $CPAN::Config->{'cpan_home'};
-    my(@me,$from,$to,$me);
-    @me = split /::/, $self->id;
-    $me[-1] .= ".pm";
-    $me = MM->catfile(@me);
-    $from = $self->find_bundle_file($dist->{'build_dir'},$me);
-    $to = MM->catfile($todir,$me);
-    File::Path::mkpath(File::Basename::dirname($to));
-    File::Copy::copy($from, $to)
-       or Carp::confess("Couldn't copy $from to $to: $!");
-    $parsefile = $to;
-  }
-  my @result;
-  my $fh = FileHandle->new;
-  local $/ = "\n";
-  open($fh,$parsefile) or die "Could not open '$parsefile': $!";
-  my $in_cont = 0;
-  $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
-  while (<$fh>) {
-    $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
-       m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
-    next unless $in_cont;
-    next if /^=/;
-    s/\#.*//;
-    next if /^\s+$/;
-    chomp;
-    push @result, (split " ", $_, 2)[0];
-  }
-  close $fh;
-  delete $self->{STATUS};
-  $self->{CONTAINS} = \@result;
-  $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
-  unless (@result) {
-    $CPAN::Frontend->mywarn(qq{
-The bundle file "$parsefile" may be a broken
+    my($self) = @_;
+    my($inst_file) = $self->inst_file || "";
+    my($id) = $self->id;
+    $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
+    unless ($inst_file) {
+        # Try to get at it in the cpan directory
+        $self->debug("no inst_file") if $CPAN::DEBUG;
+        my $cpan_file;
+        $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
+              $cpan_file = $self->cpan_file;
+        if ($cpan_file eq "N/A") {
+            $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
+  Maybe stale symlink? Maybe removed during session? Giving up.\n");
+        }
+        my $dist = $CPAN::META->instance('CPAN::Distribution',
+                                         $self->cpan_file);
+        $dist->get;
+        $self->debug($dist->as_string) if $CPAN::DEBUG;
+        my($todir) = $CPAN::Config->{'cpan_home'};
+        my(@me,$from,$to,$me);
+        @me = split /::/, $self->id;
+        $me[-1] .= ".pm";
+        $me = MM->catfile(@me);
+        $from = $self->find_bundle_file($dist->{'build_dir'},$me);
+        $to = MM->catfile($todir,$me);
+        File::Path::mkpath(File::Basename::dirname($to));
+        File::Copy::copy($from, $to)
+              or Carp::confess("Couldn't copy $from to $to: $!");
+        $inst_file = $to;
+    }
+    my @result;
+    my $fh = FileHandle->new;
+    local $/ = "\n";
+    open($fh,$inst_file) or die "Could not open '$inst_file': $!";
+    my $in_cont = 0;
+    $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
+    while (<$fh>) {
+        $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 :
+            m/^=head1\s+CONTENTS/ ? 1 : $in_cont;
+        next unless $in_cont;
+        next if /^=/;
+        s/\#.*//;
+        next if /^\s+$/;
+        chomp;
+        push @result, (split " ", $_, 2)[0];
+    }
+    close $fh;
+    delete $self->{STATUS};
+    $self->{CONTAINS} = \@result;
+    $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
+    unless (@result) {
+        $CPAN::Frontend->mywarn(qq{
+The bundle file "$inst_file" may be a broken
 bundlefile. It seems not to contain any bundle definition.
 Please check the file and if it is bogus, please delete it.
 Sorry for the inconvenience.
 });
-  }
-  @result;
+    }
+    @result;
 }
 
 #-> sub CPAN::Bundle::find_bundle_file
@@ -5017,8 +5202,11 @@ sub as_string {
             # warn "dist[$dist]";
             # mff=manifest file; mfh=manifest handle
             my($mff,$mfh);
-            if ($dist->{build_dir} and
-                -f ($mff = MM->catfile($dist->{build_dir}, "MANIFEST")) and
+            if (
+                $dist->{build_dir}
+                and
+                (-f  ($mff = MM->catfile($dist->{build_dir}, "MANIFEST")))
+                and
                 $mfh = FileHandle->new($mff)
                ) {
                 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
@@ -5091,7 +5279,8 @@ sub manpage_headline {
 }
 
 #-> sub CPAN::Module::cpan_file ;
-sub cpan_file    {
+# Note: also inherited by CPAN::Bundle
+sub cpan_file {
     my $self = shift;
     CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
     unless (defined $self->{RO}{CPAN_FILE}) {
@@ -5797,6 +5986,13 @@ displays the README file of the associated distribution. C<Look> gets
 and untars (if not yet done) the distribution file, changes to the
 appropriate directory and opens a subshell process in that directory.
 
+=item ls author
+
+C<ls> lists all distribution files in and below an author's CPAN
+directory. Only those files that contain modules are listed and if
+there is more than one for any given module, only the most recent one
+is listed.
+
 =item Signals
 
 CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are
@@ -6420,6 +6616,8 @@ defined:
   prerequisites_policy
                      what to do if you are missing module prerequisites
                      ('follow' automatically, 'ask' me, or 'ignore')
+  proxy_user         username for accessing an authenticating proxy
+  proxy_pass         password for accessing an authenticating proxy
   scan_cache        controls scanning of cache ('atstart' or 'never')
   tar                location of external program tar
   term_is_latin      if true internal UTF-8 is translated to ISO-8859-1
@@ -6766,7 +6964,7 @@ becomes stable with regard to charset issues.
 
 We should give coverage for B<all> of the CPAN and not just the PAUSE
 part, right? In this discussion CPAN and PAUSE have become equal --
-but they are not. PAUSE is authors/, modules/ and scripts/. CPAN is 
+but they are not. PAUSE is authors/, modules/ and scripts/. CPAN is
 PAUSE plus the clpa/, doc/, misc/, ports/, and src/.
 
 Future development should be directed towards a better integration of
@@ -6781,6 +6979,11 @@ traditional method of building a Perl module package from a shell.
 
 Andreas Koenig E<lt>andreas.koenig@anima.deE<gt>
 
+=head1 TRANSLATIONS
+
+Kawai,Takanori provides a Japanese translation of this manpage at
+http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm
+
 =head1 SEE ALSO
 
 perl(1), CPAN::Nox(3)
index 7cf01cd..0429db1 100644 (file)
@@ -17,7 +17,7 @@ use FileHandle ();
 use File::Basename ();
 use File::Path ();
 use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.51 $, 10;
+$VERSION = substr q$Revision: 1.53 $, 10;
 
 =head1 NAME
 
@@ -204,7 +204,7 @@ software to CPAN bear names that are outside the ASCII range. If your
 terminal supports UTF-8, you say no to the next question, if it
 supports ISO-8859-1 (also known as LATIN1) then you say yes, and if it
 supports neither nor, your answer does not matter, you will not be
-able to read the names of some authors anyway. If you answer no, nmes
+able to read the names of some authors anyway. If you answer no, names
 will be output in UTF-8.
 
 };
@@ -384,6 +384,44 @@ the \$CPAN::Config takes precedence.
        $CPAN::Config->{$_} = prompt("Your $_?",$default);
     }
 
+    if ($CPAN::Config->{ftp_proxy} ||
+        $CPAN::Config->{http_proxy}) {
+        $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER;
+        print qq{
+
+If your proxy is an authenticating proxy, you can store your username
+permanently. If you do not want that, just press RETURN. You will then
+be asked for your username in every future session.
+
+};
+        if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) {
+            print qq{
+
+Your password for the authenticating proxy can also be stored
+permanently on disk. If this violates your security policy, just press
+RETURN. You will then be asked for the password in every future
+session.
+
+};
+
+            if ($CPAN::META->has_inst("Term::ReadKey")) {
+                Term::ReadKey::ReadMode("noecho");
+            } else {
+                print qq{
+
+Warning: Term::ReadKey seems not to be available, your password will
+be echoed to the terminal!
+
+};
+            }
+            $CPAN::Config->{proxy_pass} = prompt("Your proxy password?");
+            if ($CPAN::META->has_inst("Term::ReadKey")) {
+                Term::ReadKey::ReadMode("restore");
+            }
+            $CPAN::Frontend->myprint("\n\n");
+        }
+    }
+
     #
     # MIRRORED.BY
     #
@@ -426,11 +464,11 @@ sub conf_sites {
       my $mtime = localtime((stat _)[9]);
       my $prompt = qq{Found $mby as of $mtime
 
-  I\'d use that as a database of CPAN sites. If that is OK for you,
-  please answer 'y', but if you want me to get a new database now,
-  please answer 'n' to the following question.
+I\'d use that as a database of CPAN sites. If that is OK for you,
+please answer 'y', but if you want me to get a new database now,
+please answer 'n' to the following question.
 
-  Shall I use the local database in $mby?};
+Shall I use the local database in $mby?};
       my $ans = prompt($prompt,"y");
       $overwrite_local = 1 unless $ans =~ /^y/i;
   }
index 933f917..c431019 100644 (file)
@@ -73,11 +73,11 @@ Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1)
 
 =head1 SYNOPSIS
 
-    use Text::Tabs;
+use Text::Tabs;
 
-    $tabstop = 4;
-    @lines_without_tabs = expand(@lines_with_tabs);
-    @lines_with_tabs = unexpand(@lines_without_tabs);
+$tabstop = 4;
+@lines_without_tabs = expand(@lines_with_tabs);
+@lines_with_tabs = unexpand(@lines_without_tabs);
 
 =head1 DESCRIPTION
 
index 04efe19..579e09b 100644 (file)
@@ -6,7 +6,7 @@ require Exporter;
 @EXPORT = qw(wrap fill);
 @EXPORT_OK = qw($columns $break $huge);
 
-$VERSION = 2000.06292219; #GMT
+$VERSION = 2001.0131;
 
 use vars qw($VERSION $columns $debug $break $huge);
 use strict;
@@ -15,7 +15,7 @@ BEGIN {
        $columns = 76;  # <= screen width
        $debug = 0;
        $break = '\s';
-       $huge = 'wrap'; # alternatively: 'die'
+       $huge = 'wrap'; # alternatively: 'die' or 'overflow'
 }
 
 use Text::Tabs qw(expand unexpand);
@@ -25,20 +25,25 @@ sub wrap
        my ($ip, $xp, @t) = @_;
 
        my $r = "";
-       my $t = expand(join(" ",@t));
+       my $tail = pop(@t);
+       my $t = expand(join("", (map { /\s+\Z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
        my $lead = $ip;
        my $ll = $columns - length(expand($ip)) - 1;
        my $nll = $columns - length(expand($xp)) - 1;
        my $nl = "";
        my $remainder = "";
 
-       while ($t !~ /^\s*$/) {
-               if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//x) {
+       pos($t) = 0;
+       while ($t !~ /\G\s*\Z/gc) {
+               if ($t =~ /\G([^\n]{0,$ll})($break|\Z(?!\n))/xmgc) {
                        $r .= unexpand($nl . $lead . $1);
                        $remainder = $2;
-               } elsif ($huge eq 'wrap' && $t =~ s/^([^\n]{$ll})//) {
+               } elsif ($huge eq 'wrap' && $t =~ /\G([^\n]{$ll})/gc) {
                        $r .= unexpand($nl . $lead . $1);
                        $remainder = "\n";
+               } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\Z(?!\n))/xmgc) {
+                       $r .= unexpand($nl . $lead . $1);
+                       $remainder = $2;
                } elsif ($huge eq 'die') {
                        die "couldn't wrap '$t'";
                } else {
@@ -53,11 +58,13 @@ sub wrap
 
        print "-----------$r---------\n" if $debug;
 
-       print "Finish up with '$lead', '$t'\n" if $debug;
+       print "Finish up with '$lead'\n" if $debug;
 
-       $r .= $lead . $t if $t ne "";
+       $r .= $lead . substr($t, pos($t), length($t)-pos($t))
+               if pos($t) ne length($t);
 
        print "-----------$r---------\n" if $debug;;
+
        return $r;
 }
 
@@ -76,7 +83,8 @@ sub fill
        # if paragraph_indent is the same as line_indent, 
        # separate paragraphs with blank lines
 
-       return join ($ip eq $xp ? "\n\n" : "\n", @para);
+       my $ps = ($ip eq $xp) ? "\n\n" : "\n";
+       return join ($ps, @para);
 }
 
 1;
@@ -88,38 +96,73 @@ Text::Wrap - line wrapping to form simple paragraphs
 
 =head1 SYNOPSIS 
 
+B<Example 1>
+
        use Text::Wrap
 
+       $initial_tab = "\t";    # Tab before first line
+       $subsequent_tab = "";   # All other lines flush left
+
        print wrap($initial_tab, $subsequent_tab, @text);
        print fill($initial_tab, $subsequent_tab, @text);
 
+       @lines = wrap($initial_tab, $subsequent_tab, @text);
+
+       @paragraphs = fill($initial_tab, $subsequent_tab, @text);
+
+B<Example 2>
+
        use Text::Wrap qw(wrap $columns $huge);
 
-       $columns = 132;
+       $columns = 132;         # Wrap at 132 characters
        $huge = 'die';
        $huge = 'wrap';
+       $huge = 'overflow';
 
-=head1 DESCRIPTION
+B<Example 3>
+       
+       use Text::Wrap
 
-Text::Wrap::wrap() is a very simple paragraph formatter.  It formats a
-single paragraph at a time by breaking lines at word boundaries.
-Indentation is controlled for the first line ($initial_tab) and
-all subsequent lines ($subsequent_tab) independently.  
+       $Text::Wrap::columns = 72;
+       print wrap('', '', @text);
 
-Lines are wrapped at $Text::Wrap::columns columns.  
-$Text::Wrap::columns should be set to the full width of your output device.
+=head1 DESCRIPTION
 
-When words that are longer than $columns are encountered, they
-are broken up.  Previous versions of wrap() die()ed instead.
-To restore the old (dying) behavior, set $Text::Wrap::huge to
-'die'.
+Text::Wrap::wrap() is a very simple paragraph formatter.  It formats a
+single paragraph at a time by breaking lines at word boundries.
+Indentation is controlled for the first line (C<$initial_tab>) and
+all subsquent lines (C<$subsequent_tab>) independently.  Please note: 
+C<$initial_tab> and C<$subsequent_tab> are the literal strings that will
+be used: it is unlikley you would want to pass in a number.
+
+Lines are wrapped at C<$Text::Wrap::columns> columns.  C<$Text::Wrap::columns>
+should be set to the full width of your output device.  In fact,
+every resulting line will have length of no more than C<$columns - 1>.  
+
+Beginner note: In example 2, above C<$columns> is imported into
+the local namespace, and set locally.  In example 3,
+C<$Text::Wrap::columns> is set in its own namespace without importing it.
+
+When words that are longer than C<$columns> are encountered, they
+are broken up.  C<wrap()> adds a C<"\n"> at column C<$columns>.
+This behavior can be overridden by setting C<$huge> to
+'die' or to 'overflow'.  When set to 'die', large words will cause
+C<die()> to be called.  When set to 'overflow', large words will be
+left intact.  
 
 Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
 each paragraph separately and then joins them together when it's done.  It
-will destroy any whitespace in the original text.  It breaks text into
+will destory any whitespace in the original text.  It breaks text into
 paragraphs by looking for whitespace after a newline.  In other respects
 it acts like wrap().
 
+When called in list context, C<wrap()> will return a list of lines and 
+C<fill()> will return a list of paragraphs.
+
+Historical notes: Older versions of C<wrap()> and C<fill()> always 
+returned strings.  Also, 'die' used to be the default value of
+C<$huge>.  Now, 'wrap' is the default value.
+
 =head1 EXAMPLE
 
        print wrap("\t","","This is a bit of text that forms 
index 2b0b99d..70a5f88 100644 (file)
@@ -967,7 +967,7 @@ would would lead to a memory leak.
 Both these problems can be cured.  Say, if we want to overload hash
 dereference on a reference to an object which is I<implemented> as a
 hash itself, the only problem one has to circumvent is how to access
-this I<actual> hash (as opposed to the I<virtual> exhibited by
+this I<actual> hash (as opposed to the I<virtual> hash exhibited by the
 overloaded dereference operator).  Here is one possible fetching routine:
 
   sub access_hash {
@@ -979,7 +979,7 @@ overloaded dereference operator).  Here is one possible fetching routine:
     $out;
   }
 
-To move creation of the tied hash on each access, one may an extra
+To remove creation of the tied hash on each access, one may an extra
 level of indirection which allows a non-circular structure of references:
 
   package two_refs1;
@@ -1016,10 +1016,10 @@ level of indirection which allows a non-circular structure of references:
     $a->[$key];
   }
 
-Now if $baz is overloaded like this, then C<$bar> is a reference to a
+Now if $baz is overloaded like this, then C<$baz> is a reference to a
 reference to the intermediate array, which keeps a reference to an
 actual array, and the access hash.  The tie()ing object for the access
-hash is also a reference to a reference to the actual array, so
+hash is a reference to a reference to the actual array, so
 
 =over
 
@@ -1106,7 +1106,7 @@ inside such a method it is not necessary to pretty-print the
 I<components> $a and $b of an object.  In the above subroutine
 C<"[$meth $a $b]"> is a catenation of some strings and components $a
 and $b.  If these components use overloading, the catenation operator
-will look for an overloaded operator C<.>, if not present, it will
+will look for an overloaded operator C<.>; if not present, it will
 look for an overloaded operator C<"">.  Thus it is enough to use
 
   use overload nomethod => \&wrap, '""' => \&str;
@@ -1209,7 +1209,7 @@ mutator methods (C<++>, C<-=> and so on), does not do deep copying
 (not required without mutators!), and implements only those arithmetic
 operations which are used in the example.
 
-To implement most arithmetic operations is easy, one should just use
+To implement most arithmetic operations is easy; one should just use
 the tables of operations, and change the code which fills %subr to
 
   my %subr = ( 'n' => sub {$_[0]} );
@@ -1231,7 +1231,7 @@ special to make C<+=> and friends work, except filling C<+=> entry of
 way to know that the implementation of C<'+='> does not mutate
 the argument, compare L<Copy Constructor>).
 
-To implement a copy constructor, add C<'=' => \&cpy> to C<use overload>
+To implement a copy constructor, add C<< '=' => \&cpy >> to C<use overload>
 line, and code (this code assumes that mutators change things one level
 deep only, so recursive copying is not needed):
 
diff --git a/perl.c b/perl.c
index c419857..1741593 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1171,6 +1171,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
            PL_tainting = TRUE;
        else {
            while (s && *s) {
+               char *d;
                while (isSPACE(*s))
                    s++;
                if (*s == '-') {
@@ -1178,11 +1179,18 @@ print \"  \\@INC:\\n    @INC\\n\";");
                    if (isSPACE(*s))
                        continue;
                }
+               d = s;
                if (!*s)
                    break;
                if (!strchr("DIMUdmw", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
-               s = moreswitches(s);
+               while (++s && *s) {
+                   if (isSPACE(*s)) {
+                       *s++ = '\0';
+                       break;
+                   }
+               }
+               moreswitches(d);
            }
        }
     }
index d921e33..507f9d3 100644 (file)
@@ -133,6 +133,7 @@ if (-d "pod") {
     perldebguts         
     perlxstut           
     perlxs              
+    perlclib            
     perlguts            
     perlcall            
     perlutil            
index ac8c94a..d64943e 100644 (file)
@@ -87,6 +87,7 @@ For ease of access, the Perl manual has been split up into several sections:
     perldebguts                Perl debugging guts and tips
     perlxstut          Perl XS tutorial
     perlxs             Perl XS application programming interface
+    perlclib           Internal replacements for standard C library functions
     perlguts           Perl internal functions for those doing extensions
     perlcall           Perl calling conventions from C
     perlutil           utilities packaged with the Perl distribution
diff --git a/pod/perlclib.pod b/pod/perlclib.pod
new file mode 100644 (file)
index 0000000..e2ae529
--- /dev/null
@@ -0,0 +1,197 @@
+=head1 NAME
+
+perlclib - Internal replacements for standard C library functions
+
+=head1 DESCRIPTION
+
+One thing Perl porters should note is that F<perl> doesn't tend to use that
+much of the C standard library internally; you'll see very little use of, 
+for example, the F<ctype.h> functions in there. This is because Perl
+tends to reimplement or abstract standard library functions, so that we
+know exactly how they're going to operate.
+
+This is a reference card for people who are familiar with the C library
+and who want to do things the Perl way; to tells them which functions
+they ought to use instead of the more normal C functions. 
+
+=head2 Conventions
+
+In the following tables:
+
+=over 3
+
+=item C<t>
+
+is a type.
+
+=item C<p>
+
+is a pointer.
+
+=item C<n>
+
+is a number.
+
+=item C<s>
+
+is a string.
+
+=back
+
+C<sv>, C<av>, C<hv>, etc. represent variables of their respective types.
+
+=head2 File Operations
+
+Instead of the F<stdio.h> functions, you should use the Perl abstraction
+layer. Instead of C<FILE*> types, you need to be handling C<PerlIO*>
+types; don't forget that with the new PerlIO layered IO abstraction, 
+C<FILE*> types may not even be available. See also the C<perlapio>
+documentation for more information about the following functions:
+
+    Instead Of:                 Use:
+    
+    stdin                       PerlIO_stdin()
+    stdout                      PerlIO_stdout()
+    stderr                      PerlIO_stderr()
+
+    fopen(fn, mode)             PerlIO_open(fn, mode)
+    freopen(fn, mode, stream)   PerlIO_reopen(fn, mode, perlio) (Deprecated)
+    fflush(stream)              PerlIO_flush(perlio)
+    fclose(stream)              PerlIO_close(perlio)
+
+=head2 File Input and Output
+
+    Instead Of:                 Use:
+
+    fprintf(stream, fmt, ...)   PerlIO_printf(perlio, fmt, ...)
+
+    [f]getc(stream)             PerlIO_getc(perlio)
+    [f]putc(stream, n)          PerlIO_putc(perlio, n)
+    ungetc(n, stream)           PerlIO_ungetc(perlio, n)
+
+Note that the PerlIO equivalents of C<fread> and C<fwrite> are slightly
+different from their C library counterparts:
+
+    fread(p, size, n, stream)   PerlIO_read(perlio, buf, numbytes)
+    fwrite(p, size, n, stream)  PerlIO_write(perlio, buf, numbytes)
+
+    fputs(s, stream)            PerlIO_puts(perlio, s)
+
+There is no equivalent to C<fgets>; one should use C<sv_gets> instead:
+
+    fgets(s, n, stream)         sv_gets(sv, perlio, append)
+
+=head2 File Positioning
+
+    Instead Of:                 Use:
+
+    feof(stream)                PerlIO_eof(perlio)
+    fseek(stream, n, whence)    PerlIO_seek(perlio, n, whence)
+    rewind(stream)              PerlIO_rewind(perlio)
+
+    fgetpos(stream, p)          PerlIO_getpos(perlio, sv)
+    fsetpos(stream, p)          PerlIO_setpos(perlio, sv)
+
+    ferror(stream)              PerlIO_error(perlio)
+    clearerr(stream)            PerlIO_clearerr(perlio)
+
+=head2 Memory Management and String Handling
+
+    Instead Of:                 Use:
+
+    t* p = malloc(n)            New(id, p, n, t)
+    t* p = calloc(n, s)         Newz(id, p, n, t)
+    p = realloc(p, n)           Renew(p, n, t)
+    memcpy(dst, src, n)         Copy(src, dst, n, t)
+    memmove(dst, src, n)        Move(src, dst, n, t)
+    memcpy/*(struct foo *)      StructCopy(src, dst, t)
+    free(p)                     Safefree(p)
+
+    strdup(p)                   savepv(p)
+    strndup(p, n)               savepvn(p, n) (Hey, strndup doesn't exist!)
+
+    strstr(big, little)         instr(big, little)
+    strcmp(s1, s2)              strLE(s1, s2) / strEQ(s1, s2) / strGT(s1,s2)
+    strncmp(s1, s2, n)          strnNE(s1, s2, n) / strnEQ(s1, s2, n)
+
+Notice the different order of arguments to C<Copy> and C<Move> than used
+in C<memcpy> and C<memmove>.
+
+Most of the time, though, you'll want to be dealing with SVs internally
+instead of raw C<char *> strings:
+
+    strlen(s)                   sv_len(sv)
+    strcpy(dt, src)             sv_setpv(sv, s)
+    strncpy(dt, src, n)         sv_setpvn(sv, s, n)
+    strcat(dt, src)             sv_catpv(sv, s)
+    strncat(dt, src)            sv_catpvn(sv, s)
+    sprintf(s, fmt, ...)        sv_setpvf(sv, fmt, ...)
+
+Note also the existence of C<sv_catpvf> and C<sv_catpvfn>, combining
+concatenation with formatting.
+
+=head2 Character Class Tests
+
+There are two types of character class tests that Perl implements: one
+type deals in C<char>s and are thus B<not> Unicode aware (and hence
+deprecated unless you B<know> you should use them) and the other type
+deal in C<UV>s and know about Unicode properties. In the following
+table, C<c> is a C<char>, and C<u> is a Unicode codepoint.
+
+    Instead Of:                 Use:            But better use:
+
+    isalnum(c)                  isALNUM(c)      isALNUM_uni(u)
+    isalpha(c)                  isALPHA(c)      isALPHA_uni(u)
+    iscntrl(c)                  isCNTRL(c)      isCNTRL_uni(u)
+    isdigit(c)                  isDIGIT(c)      isDIGIT_uni(u)
+    isgraph(c)                  isGRAPH(c)      isGRAPH_uni(u)
+    islower(c)                  isLOWER(c)      isLOWER_uni(u)
+    isprint(c)                  isPRINT(c)      isPRINT_uni(u)
+    ispunct(c)                  isPUNCT(c)      isPUNCT_uni(u)
+    isspace(c)                  isSPACE(c)      isSPACE_uni(u)
+    isupper(c)                  isUPPER(c)      isUPPER_uni(u)
+    isxdigit(c)                 isXDIGIT(c)     isXDIGIT_uni(u)
+
+    tolower(c)                  toLOWER(c)      toLOWER_uni(u)
+    toupper(c)                  toUPPER(c)      toUPPER_uni(u)
+
+=head2 F<stdlib.h> functions
+
+    Instead Of:                 Use: 
+
+    atof(s)                     Atof(s)
+    atol(s)                     Atol(s)
+    strtod(s, *p)               Nothing. Just don't use it.
+    strtol(s, *p, n)            Strtol(s, *p, n)
+    strtoul(s, *p, n)           Strtoul(s, *p, n)
+
+Notice also the C<scan_bin>, C<scan_hex>, and C<scan_oct> functions in
+F<util.c> for converting strings representing numbers in the respective
+bases into C<NV>s.
+
+In theory C<Strtol> and C<Strtoul> may not be defined if the machine perl is
+built on doesn't actually have strtol and strtoul. But as those 2
+functions are part of the 1989 ANSI C spec we suspect you'll find them
+everywhere by now.
+
+    int rand()                  double Drand01()
+    srand(n)                    { seedDrand01((Rand_seed_t)n); 
+                                  PL_srand_called = TRUE; }
+    exit(n)                     my_exit(n)
+    system(s)                   Don't. Look at pp_system or use my_popen
+
+    getenv(s)                   PerlEnv_getenv(s)
+    setenv(s, val)              my_putenv(s, val)
+
+=head2 Miscellaneous functions
+
+You should not even B<want> to use F<setjmp.h> functions, but if you
+think you do, use the C<JMPENV> stack in F<scope.h> instead.
+
+For C<signal>/C<sigaction>, use C<rsignal(signo, handler)>.
+
+=head1 SEE ALSO
+
+C<perlapi>, C<perlapio>, C<perlguts>
+
index 5ea1083..11d1a01 100644 (file)
@@ -2869,6 +2869,13 @@ as a list, you need to look into how references work, because Perl will
 not magically convert between scalars and lists for you.  See
 L<perlref>.
 
+=item Scalars leaked: %d
+
+(P) Something went wrong in Perl's internal bookkeeping of scalars:
+not all scalar variables were deallocated by the time Perl exited.
+What this usually indicates is a memory leak, which is of course bad,
+especially if the Perl program is intended to be long-running.
+
 =item Script is not setuid/setgid in suidperl
 
 (F) Oddly, the suidperl program was invoked on a script without a setuid
@@ -3502,8 +3509,7 @@ bad switch on your behalf.)
 
 (W newline) A file operation was attempted on a filename, and that
 operation failed, PROBABLY because the filename contained a newline,
-PROBABLY because you forgot to chop() or chomp() it off.  See
-L<perlfunc/chomp>.
+PROBABLY because you forgot to chomp() it off.  See L<perlfunc/chomp>.
 
 =item Unsupported directory function "%s" called
 
index d806ed6..1df3b6a 100644 (file)
@@ -321,7 +321,7 @@ go bump in the night, finally came up with this:
        # been opened on a pipe...
        system("/bin/stty $stty");
        $_ = <MODEM_IN>;
-       chop;
+       chomp;
        if ( !m/^Connected/ ) {
            print STDERR "$0: cu printed `$_' instead of `Connected'\n";
        }
index 570eb02..35e8edd 100644 (file)
@@ -300,7 +300,7 @@ X<-S>X<-b>X<-c>X<-t>X<-u>X<-g>X<-k>X<-T>X<-B>X<-M>X<-A>X<-C>
 Example:
 
     while (<>) {
-       chop;
+       chomp;
        next unless -f $_;      # ignore specials
        #...
     }
@@ -629,23 +629,11 @@ characters removed is returned.
 =item chop
 
 Chops off the last character of a string and returns the character
-chopped.  It's used primarily to remove the newline from the end of an
-input record, but is much more efficient than C<s/\n//> because it neither
+chopped.  It is much more efficient than C<s/.$//s> because it neither
 scans nor copies the string.  If VARIABLE is omitted, chops C<$_>.
-Example:
-
-    while (<>) {
-       chop;   # avoid \n on last field
-       @array = split(/:/);
-       #...
-    }
-
 If VARIABLE is a hash, it chops the hash's values, but not its keys.
 
-You can actually chop anything that's an lvalue, including an assignment:
-
-    chop($cwd = `pwd`);
-    chop($answer = <STDIN>);
+You can actually chop anything that's an lvalue, including an assignment.
 
 If you chop a list, each element is chopped.  Only the value of the
 last C<chop> is returned.
@@ -4434,13 +4422,12 @@ Example:
 
     open(PASSWD, '/etc/passwd');
     while (<PASSWD>) {
-       ($login, $passwd, $uid, $gid,
+        chomp;
+        ($login, $passwd, $uid, $gid,
          $gcos, $home, $shell) = split(/:/);
        #...
     }
 
-(Note that $shell above will still have a newline on it.  See L</chop>,
-L</chomp>, and L</join>.)
 
 =item sprintf FORMAT, LIST
 
index 8ff4a84..54d0715 100644 (file)
@@ -1354,31 +1354,6 @@ destination starting points.  Perl will move, copy, or zero out C<number>
 instances of the size of the C<type> data structure (using the C<sizeof>
 function).
 
-Here is a handy table of equivalents between ordinary C and Perl's
-memory abstraction layer:
-
-    Instead Of:                 Use:
-
-    t* p = malloc(n)            New(id, p, n, t)
-    t* p = calloc(n, s)         Newz(id, p, n, t)
-    p = realloc(p, n)           Renew(p, n, t)
-    memcpy(dst, src, n)         Copy(src, dst, n, t)
-    memmove(dst, src, n)        Move(src, dst, n, t)
-    free(p)                     Safefree(p)
-    strdup(p)                   savepv(p)
-    strndup(p, n)               savepvn(p, n) (Hey, strndup doesn't exist!)
-    memcpy/*(struct foo *)      StructCopy(src, dst, t)
-
-    t   type
-    p   pointer
-    ck  cookie for the memory region (now unused)
-    n   number of elements
-    src source pointer
-    dst destination pointer
-
-Notice the different order of arguments to C<Copy> and C<Move> than used
-in C<memcpy> and C<memmove>.
-
 =head2 PerlIO
 
 The most recent development releases of Perl has been experimenting with
index c78c52f..a16d66a 100644 (file)
@@ -1734,7 +1734,7 @@ is roughly equivalent to:
 
     open(FOO, "echo *.c | tr -s ' \t\r\f' '\\012\\012\\012\\012'|");
     while (<FOO>) {
-       chop;
+       chomp;
        chmod 0644, $_;
     }
 
index 2059637..15c0f33 100644 (file)
@@ -94,6 +94,26 @@ from) C<\015\012>, depending on whether you're reading or writing.
 Unix does the same thing on ttys in canonical mode.  C<\015\012>
 is commonly referred to as CRLF.
 
+A common cause of unportable programs is the misuse of chop() to trim
+newlines:
+
+    # XXX UNPORTABLE!
+    while(<FILE>) {
+        chop;
+        @array = split(/:/);
+        #...
+    }
+
+You can get away with this on Unix and MacOS (they have a single
+character end-of-line), but the same program will break under DOSish
+perls because you're only chop()ing half the end-of-line.  Instead,
+chomp() should be used to trim newlines.  The Dunce::Files module can
+help audit your code for misuses of chop().
+
+When dealing with binary files (or text files in binary mode) be sure
+to explicitly set $/ to the appropriate value for your file format
+before using chomp().
+
 Because of the "text" mode translation, DOSish perls have limitations
 in using C<seek> and C<tell> on a file accessed in "text" mode.
 Stick to C<seek>-ing to locations you got from C<tell> (and no
index b97af5e..c9a5813 100644 (file)
@@ -236,8 +236,8 @@ unary &, unary *, (TYPE)
 =item Regexp Quote-Like Operators
 
 ?PATTERN?, m/PATTERN/cgimosx, /PATTERN/cgimosx, q/STRING/, C<'STRING'>,
-qq/STRING/, "STRING", qr/STRING/imosx, qx/STRING/, `STRING`, qw/STRING/,
-s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cds,
+qq/STRING/, "STRING", qr/STRING/imosx, qw/STRING/, qu/STRING/, qx/STRING/,
+`STRING`, s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cds,
 y/SEARCHLIST/REPLACEMENTLIST/cds
 
 =item Gory details of parsing quoted constructs
@@ -357,16 +357,16 @@ import, index STR,SUBSTR,POSITION, index STR,SUBSTR, int EXPR, int, ioctl
 FILEHANDLE,FUNCTION,SCALAR, join EXPR,LIST, keys HASH, kill SIGNAL, LIST,
 last LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length,
 link OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR,
-lock, log EXPR, log, lstat FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK
-LIST, map EXPR,LIST, mkdir FILENAME,MASK, mkdir FILENAME, msgctl
-ID,CMD,ARG, msgget KEY,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, msgsnd
-ID,MSG,FLAGS, my EXPR, my EXPR : ATTRIBUTES, next LABEL, next, no Module
-LIST, oct EXPR, oct, open FILEHANDLE,MODE,LIST, open FILEHANDLE,EXPR, open
-FILEHANDLE, opendir DIRHANDLE,EXPR, ord EXPR, ord, our EXPR, pack
-TEMPLATE,LIST, package NAMESPACE, package, pipe READHANDLE,WRITEHANDLE, pop
-ARRAY, pop, pos SCALAR, pos, print FILEHANDLE LIST, print LIST, print,
-printf FILEHANDLE FORMAT, LIST, printf FORMAT, LIST, prototype FUNCTION,
-push ARRAY,LIST, q/STRING/, qq/STRING/, qr/STRING/, qx/STRING/, qw/STRING/,
+lock, log EXPR, log, lstat EXPR, lstat, m//, map BLOCK LIST, map EXPR,LIST,
+mkdir FILENAME,MASK, mkdir FILENAME, msgctl ID,CMD,ARG, msgget KEY,FLAGS,
+msgrcv ID,VAR,SIZE,TYPE,FLAGS, msgsnd ID,MSG,FLAGS, my EXPR, my EXPR :
+ATTRIBUTES, next LABEL, next, no Module LIST, oct EXPR, oct, open
+FILEHANDLE,MODE,LIST, open FILEHANDLE,EXPR, open FILEHANDLE, opendir
+DIRHANDLE,EXPR, ord EXPR, ord, our EXPR, pack TEMPLATE,LIST, package
+NAMESPACE, package, pipe READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos
+SCALAR, pos, print FILEHANDLE LIST, print LIST, print, printf FILEHANDLE
+FORMAT, LIST, printf FORMAT, LIST, prototype FUNCTION, push ARRAY,LIST,
+q/STRING/, qq/STRING/, qr/STRING/, qu/STRING/, qw/STRING/, qx/STRING/,
 quotemeta EXPR, quotemeta, rand EXPR, rand, read
 FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir
 DIRHANDLE, readline EXPR, readlink EXPR, readlink, readpipe EXPR, recv
@@ -1343,6 +1343,8 @@ C<(?(condition)yes-pattern|no-pattern)>
 
 =item DESCRIPTION
 
+=item Class Data in a Can
+
 =item Class Data as Package Variables
 
 =over 4
@@ -1866,12 +1868,12 @@ wait, waitpid PID,FLAGS
 
 =item CHANGES
 
-v1.48, 02 February 2001, v1.47, 22 March 2000, v1.46, 12 February 2000,
-v1.45, 20 December 1999, v1.44, 19 July 1999, v1.43, 24 May 1999, v1.42, 22
-May 1999, v1.41, 19 May 1999, v1.40, 11 April 1999, v1.39, 11 February
-1999, v1.38, 31 December 1998, v1.37, 19 December 1998, v1.36, 9 September
-1998, v1.35, 13 August 1998, v1.33, 06 August 1998, v1.32, 05 August 1998,
-v1.30, 03 August 1998, v1.23, 10 July 1998
+v1.47, 22 March 2000, v1.46, 12 February 2000, v1.45, 20 December 1999,
+v1.44, 19 July 1999, v1.43, 24 May 1999, v1.42, 22 May 1999, v1.41, 19 May
+1999, v1.40, 11 April 1999, v1.39, 11 February 1999, v1.38, 31 December
+1998, v1.37, 19 December 1998, v1.36, 9 September 1998, v1.35, 13 August
+1998, v1.33, 06 August 1998, v1.32, 05 August 1998, v1.30, 03 August 1998,
+v1.23, 10 July 1998
 
 =item Supported Platforms
 
@@ -2181,42 +2183,40 @@ chcp, dataset access, OS/390 iconv, locales
 =item Pragmatic Modules
 
 attributes, attrs, autouse, base, blib, bytes, charnames, constant,
-diagnostics, fields, filetest, integer, less, lib, locale, open, ops,
-overload, re, sigtrap, strict, subs, utf8, vars, warnings,
-warnings::register
+diagnostics, fields, filetest, integer, less, locale, open, ops, overload,
+perlio, re, sigtrap, strict, subs, utf8, vars, warnings, warnings::register
 
 =item Standard Modules
 
 AnyDBM_File, AutoLoader, AutoSplit, B, B::Asmdata, B::Assembler, B::Bblock,
-B::Bytecode, B::C, B::CC, B::Concise, B::Debug, B::Deparse,
-B::Disassembler, B::Lint, B::Showlex, B::Stackobj, B::Stash, B::Terse,
-B::Xref, Benchmark, ByteLoader, CGI, CGI::Apache, CGI::Carp, CGI::Cookie,
-CGI::Fast, CGI::Pretty, CGI::Push, CGI::Switch, CPAN, CPAN::FirstTime,
-CPAN::Nox, Carp, Carp::Heavy, Class::Struct, Cwd, DB, DB_File,
-Devel::SelfStubber, DirHandle, Dumpvalue, English, Env, Exporter,
-Exporter::Heavy, ExtUtils::Command, ExtUtils::Embed, ExtUtils::Install,
-ExtUtils::Installed, ExtUtils::Liblist, ExtUtils::MM_Cygwin,
-ExtUtils::MM_OS2, ExtUtils::MM_Unix, ExtUtils::MM_VMS, ExtUtils::MM_Win32,
+B::Bytecode, B::C, B::CC, B::Debug, B::Deparse, B::Disassembler, B::Lint,
+B::Showlex, B::Stackobj, B::Stash, B::Terse, B::Xref, Benchmark,
+ByteLoader, CGI, CGI::Apache, CGI::Carp, CGI::Cookie, CGI::Fast,
+CGI::Pretty, CGI::Push, CGI::Switch, CPAN, CPAN::FirstTime, CPAN::Nox,
+Carp, Class::Struct, Cwd, DB, DB_File, Devel::SelfStubber, DirHandle,
+Dumpvalue, Encode, English, Env, Exporter, Exporter::Heavy,
+ExtUtils::Command, ExtUtils::Embed, ExtUtils::Install, ExtUtils::Installed,
+ExtUtils::Liblist, ExtUtils::MM_Cygwin, ExtUtils::MM_OS2,
+ExtUtils::MM_Unix, ExtUtils::MM_VMS, ExtUtils::MM_Win32,
 ExtUtils::MakeMaker, ExtUtils::Manifest, ExtUtils::Mkbootstrap,
 ExtUtils::Mksymlists, ExtUtils::Packlist, ExtUtils::testlib, Fatal, Fcntl,
 File::Basename, File::CheckTree, File::Compare, File::Copy, File::DosGlob,
 File::Find, File::Path, File::Spec, File::Spec::Epoc,
 File::Spec::Functions, File::Spec::Mac, File::Spec::OS2, File::Spec::Unix,
 File::Spec::VMS, File::Spec::Win32, File::Temp, File::stat, FileCache,
-FileHandle, FindBin, GDBM_File, Getopt::Long, Getopt::Std, I18N::Collate,
-IO, IPC::Open2, IPC::Open3, Math::BigFloat, Math::BigInt, Math::Complex,
-Math::Trig, Net::Ping, Net::hostent, Net::netent, Net::protoent,
-Net::servent, O, Opcode, Pod::Checker, Pod::Find, Pod::Html,
-Pod::InputObjects, Pod::LaTeX, Pod::Man, Pod::ParseUtils, Pod::Parser,
-Pod::Plainer, Pod::Select, Pod::Text, Pod::Text::Color,
-Pod::Text::Overstrike, Pod::Text::Termcap, Pod::Usage, SDBM_File, Safe,
-Search::Dict, SelectSaver, SelfLoader, Shell, Socket, Symbol,
-Term::ANSIColor, Term::Cap, Term::Complete, Term::ReadLine, Test,
-Test::Harness, Text::Abbrev, Text::ParseWords, Text::Soundex, Text::Wrap,
-Thread, Thread::Queue, Thread::Semaphore, Thread::Signal, Thread::Specific,
-Tie::Array, Tie::Handle, Tie::Hash, Tie::RefHash, Tie::Scalar,
-Tie::SubstrHash, Time::Local, Time::gmtime, Time::localtime, Time::tm,
-UNIVERSAL, User::grent, User::pwent
+FileHandle, Filter::Simple, FindBin, Getopt::Long, Getopt::Std,
+I18N::Collate, IO, IPC::Open2, IPC::Open3, Math::BigFloat, Math::BigInt,
+Math::Complex, Math::Trig, NDBM_File, Net::Ping, Net::hostent, Net::netent,
+Net::protoent, Net::servent, O, ODBM_File, Opcode, Pod::Checker, Pod::Find,
+Pod::Html, Pod::InputObjects, Pod::LaTeX, Pod::Man, Pod::ParseUtils,
+Pod::Parser, Pod::Plainer, Pod::Select, Pod::Text, Pod::Text::Color,
+Pod::Text::Termcap, Pod::Usage, SDBM_File, Safe, Search::Dict, SelectSaver,
+SelfLoader, Shell, Socket, Storable, Symbol, Term::ANSIColor, Term::Cap,
+Term::Complete, Term::ReadLine, Test, Test::Harness, Text::Abbrev,
+Text::ParseWords, Text::Soundex, Text::Wrap, Tie::Array, Tie::Handle,
+Tie::Hash, Tie::RefHash, Tie::Scalar, Tie::SubstrHash, Time::Local,
+Time::gmtime, Time::localtime, Time::tm, UNIVERSAL, User::grent,
+User::pwent
 
 =item Extension Modules
 
@@ -3481,6 +3481,38 @@ C<!!!>, C<!!>, C<!>
 
 =back
 
+=head2 perlclib - Internal replacements for standard C library functions
+
+=over 4
+
+=item DESCRIPTION
+
+=over 4
+
+=item Conventions
+
+C<t>, C<p>, C<n>, C<s>
+
+=item File Operations
+
+=item File Input and Output
+
+=item File Positioning
+
+=item Memory Management and String Handling
+
+=item Character Class Tests
+
+=item F<stdlib.h> functions
+
+=item Miscellaneous functions
+
+=back
+
+=item SEE ALSO
+
+=back
+
 =head2 perlguts - Introduction to the Perl API
 
 =over 4
@@ -3817,53 +3849,53 @@ B<filter_fetch_value>
 AvFILL, av_clear, av_delete, av_exists, av_extend, av_fetch, av_fill,
 av_len, av_make, av_pop, av_push, av_shift, av_store, av_undef, av_unshift,
 bytes_from_utf8, bytes_to_utf8, call_argv, call_method, call_pv, call_sv,
-CLASS, Copy, croak, CvSTASH, dMARK, dORIGMARK, dSP, dXSARGS, dXSI32, ENTER,
-eval_pv, eval_sv, EXTEND, fbm_compile, fbm_instr, FREETMPS, get_av, get_cv,
-get_hv, get_sv, GIMME, GIMME_V, GvSV, gv_fetchmeth, gv_fetchmethod,
-gv_fetchmethod_autoload, gv_stashpv, gv_stashsv, G_ARRAY, G_DISCARD,
-G_EVAL, G_NOARGS, G_SCALAR, G_VOID, HEf_SVKEY, HeHASH, HeKEY, HeKLEN, HePV,
-HeSVKEY, HeSVKEY_force, HeSVKEY_set, HeVAL, HvNAME, hv_clear, hv_delete,
-hv_delete_ent, hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent,
+CLASS, Copy, croak, CvSTASH, cv_const_sv, dMARK, dORIGMARK, dSP, dXSARGS,
+dXSI32, ENTER, eval_pv, eval_sv, EXTEND, fbm_compile, fbm_instr, FREETMPS,
+get_av, get_cv, get_hv, get_sv, GIMME, GIMME_V, GvSV, gv_fetchmeth,
+gv_fetchmethod, gv_fetchmethod_autoload, gv_stashpv, gv_stashsv, G_ARRAY,
+G_DISCARD, G_EVAL, G_NOARGS, G_SCALAR, G_VOID, HEf_SVKEY, HeHASH, HeKEY,
+HeKLEN, HePV, HeSVKEY, HeSVKEY_force, HeSVKEY_set, HeVAL, HvNAME, hv_clear,
+hv_delete, hv_delete_ent, hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent,
 hv_iterinit, hv_iterkey, hv_iterkeysv, hv_iternext, hv_iternextsv,
 hv_iterval, hv_magic, hv_store, hv_store_ent, hv_undef, isALNUM, isALPHA,
 isDIGIT, isLOWER, isSPACE, isUPPER, is_utf8_char, is_utf8_string, items,
 ix, LEAVE, looks_like_number, MARK, mg_clear, mg_copy, mg_find, mg_free,
 mg_get, mg_length, mg_magical, mg_set, Move, New, newAV, Newc, newCONSTSUB,
 newHV, newRV_inc, newRV_noinc, NEWSV, newSViv, newSVnv, newSVpv, newSVpvf,
-newSVpvn, newSVrv, newSVsv, newSVuv, newXS, newXSproto, Newz, Nullav,
-Nullch, Nullcv, Nullhv, Nullsv, ORIGMARK, perl_alloc, perl_construct,
-perl_destruct, perl_free, perl_parse, perl_run, PL_modglobal, PL_na,
-PL_sv_no, PL_sv_undef, PL_sv_yes, POPi, POPl, POPn, POPp, POPs, PUSHi,
-PUSHMARK, PUSHn, PUSHp, PUSHs, PUSHu, PUTBACK, Renew, Renewc, require_pv,
-RETVAL, Safefree, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ, strGE,
-strGT, strLE, strLT, strNE, strnEQ, strnNE, StructCopy, SvCUR, SvCUR_set,
-SvEND, SvGETMAGIC, SvGROW, SvIOK, SvIOKp, SvIOK_notUV, SvIOK_off, SvIOK_on,
-SvIOK_only, SvIOK_only_UV, SvIOK_UV, SvIV, SvIVX, SvLEN, SvNIOK, SvNIOKp,
-SvNIOK_off, SvNOK, SvNOKp, SvNOK_off, SvNOK_on, SvNOK_only, SvNV, SvNVX,
-SvOK, SvOOK, SvPOK, SvPOKp, SvPOK_off, SvPOK_on, SvPOK_only,
-SvPOK_only_UTF8, SvPV, SvPVX, SvPV_force, SvPV_nolen, SvREFCNT,
-SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV, SvSETMAGIC,
-SvSetSV, SvSetSV_nosteal, SvSTASH, SvTAINT, SvTAINTED, SvTAINTED_off,
-SvTAINTED_on, SvTRUE, svtype, SvTYPE, SVt_IV, SVt_NV, SVt_PV, SVt_PVAV,
-SVt_PVCV, SVt_PVHV, SVt_PVMG, SvUPGRADE, SvUTF8, SvUTF8_off, SvUTF8_on,
-SvUV, SvUVX, sv_2mortal, sv_bless, sv_catpv, sv_catpvf, sv_catpvf_mg,
-sv_catpvn, sv_catpvn_mg, sv_catpv_mg, sv_catsv, sv_catsv_mg, sv_chop,
-sv_clear, sv_cmp, sv_cmp_locale, sv_dec, sv_derived_from, sv_eq, sv_free,
-sv_gets, sv_grow, sv_inc, sv_insert, sv_isa, sv_isobject, sv_len,
-sv_len_utf8, sv_magic, sv_mortalcopy, sv_newmortal, sv_pvn_force,
-sv_pvutf8n_force, sv_reftype, sv_replace, sv_rvweaken, sv_setiv,
-sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv, sv_setpvf, sv_setpvf_mg,
-sv_setpviv, sv_setpviv_mg, sv_setpvn, sv_setpvn_mg, sv_setpv_mg,
-sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn, sv_setsv,
-sv_setsv_mg, sv_setuv, sv_setuv_mg, sv_true, sv_unmagic, sv_unref,
-sv_upgrade, sv_usepvn, sv_usepvn_mg, sv_utf8_downgrade, sv_utf8_encode,
-sv_utf8_upgrade, sv_vcatpvfn, sv_vsetpvfn, THIS, toLOWER, toUPPER,
-utf8_distance, utf8_hop, utf8_length, utf8_to_bytes, utf8_to_uv,
-utf8_to_uv_simple, uv_to_utf8, warn, XPUSHi, XPUSHn, XPUSHp, XPUSHs,
-XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO,
-XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNO,
-XST_mNV, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK,
-Zero
+newSVpvn, newSVpvn_share, newSVrv, newSVsv, newSVuv, newXS, newXSproto,
+Newz, Nullav, Nullch, Nullcv, Nullhv, Nullsv, ORIGMARK, perl_alloc,
+perl_construct, perl_destruct, perl_free, perl_parse, perl_run,
+PL_modglobal, PL_na, PL_sv_no, PL_sv_undef, PL_sv_yes, POPi, POPl, POPn,
+POPp, POPs, PUSHi, PUSHMARK, PUSHn, PUSHp, PUSHs, PUSHu, PUTBACK, Renew,
+Renewc, require_pv, RETVAL, Safefree, savepv, savepvn, SAVETMPS, SP,
+SPAGAIN, ST, strEQ, strGE, strGT, strLE, strLT, strNE, strnEQ, strnNE,
+StructCopy, SvCUR, SvCUR_set, SvEND, SvGETMAGIC, SvGROW, SvIOK, SvIOKp,
+SvIOK_notUV, SvIOK_off, SvIOK_on, SvIOK_only, SvIOK_only_UV, SvIOK_UV,
+SvIV, SvIVX, SvLEN, SvNIOK, SvNIOKp, SvNIOK_off, SvNOK, SvNOKp, SvNOK_off,
+SvNOK_on, SvNOK_only, SvNV, SvNVX, SvOK, SvOOK, SvPOK, SvPOKp, SvPOK_off,
+SvPOK_on, SvPOK_only, SvPOK_only_UTF8, SvPV, SvPVX, SvPV_force, SvPV_nolen,
+SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV,
+SvSETMAGIC, SvSetSV, SvSetSV_nosteal, SvSTASH, SvTAINT, SvTAINTED,
+SvTAINTED_off, SvTAINTED_on, SvTRUE, svtype, SvTYPE, SVt_IV, SVt_NV,
+SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SvUOK, SvUPGRADE, SvUTF8,
+SvUTF8_off, SvUTF8_on, SvUV, SvUVX, sv_2mortal, sv_bless, sv_catpv,
+sv_catpvf, sv_catpvf_mg, sv_catpvn, sv_catpvn_mg, sv_catpv_mg, sv_catsv,
+sv_catsv_mg, sv_chop, sv_clear, sv_cmp, sv_cmp_locale, sv_dec,
+sv_derived_from, sv_eq, sv_free, sv_gets, sv_grow, sv_inc, sv_insert,
+sv_isa, sv_isobject, sv_len, sv_len_utf8, sv_magic, sv_mortalcopy,
+sv_newmortal, sv_pvn_force, sv_pvutf8n_force, sv_reftype, sv_replace,
+sv_rvweaken, sv_setiv, sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv,
+sv_setpvf, sv_setpvf_mg, sv_setpviv, sv_setpviv_mg, sv_setpvn,
+sv_setpvn_mg, sv_setpv_mg, sv_setref_iv, sv_setref_nv, sv_setref_pv,
+sv_setref_pvn, sv_setsv, sv_setsv_mg, sv_setuv, sv_setuv_mg, sv_true,
+sv_unmagic, sv_unref, sv_unref_flags, sv_upgrade, sv_usepvn, sv_usepvn_mg,
+sv_utf8_downgrade, sv_utf8_encode, sv_utf8_upgrade, sv_vcatpvfn,
+sv_vsetpvfn, THIS, toLOWER, toUPPER, utf8_distance, utf8_hop, utf8_length,
+utf8_to_bytes, utf8_to_uv, utf8_to_uv_simple, uv_to_utf8, warn, XPUSHi,
+XPUSHn, XPUSHp, XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV,
+XSRETURN_NO, XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES,
+XST_mIV, XST_mNO, XST_mNV, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION,
+XS_VERSION_BOOTCHECK, Zero
 
 =item AUTHORS
 
@@ -3871,15 +3903,15 @@ Zero
 
 =back
 
-=head2 perlintern - autogenerated documentation of purely B<internal> 
+=head2 perlintern - autogenerated documentation of purely B<internal>
                 Perl functions
 
 =over 4
 
 =item DESCRIPTION
 
-is_gv_magical, LVRET, PL_DBsingle, PL_DBsub, PL_DBtrace, PL_dowarn,
-PL_last_in_gv, PL_ofs_sv, PL_rs
+djSP, is_gv_magical, LVRET, PL_DBsingle, PL_DBsub, PL_DBtrace, PL_dowarn,
+PL_last_in_gv, PL_ofs_sv, PL_rs, start_glob
 
 =item AUTHORS
 
@@ -3887,6 +3919,74 @@ PL_last_in_gv, PL_ofs_sv, PL_rs
 
 =back
 
+=head2 perliol - C API for Perl's implementation of IO in Layers.
+
+=over 4
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=over 4
+
+=item History and Background
+
+=item Layers vs Disciplines
+
+=item Data Structures
+
+1. The functions and attributes of the "layer class", 2. The per-instance
+data for a particular handle
+
+=item Functions and Attributes
+
+1. Opening and setup functions, 2. Basic IO operations, 3. Stdio class
+buffering options, 4. Functions to support Perl's traditional "fast" access
+to the buffer
+
+=item Per-instance Data
+
+=item Layers in action.
+
+=item Per-instance flag bits
+
+PERLIO_F_EOF, PERLIO_F_CANWRITE,  PERLIO_F_CANREAD, PERLIO_F_ERROR,
+PERLIO_F_TRUNCATE, PERLIO_F_APPEND, PERLIO_F_CRLF, PERLIO_F_UTF8,
+PERLIO_F_UNBUF, PERLIO_F_WRBUF, PERLIO_F_RDBUF, PERLIO_F_LINEBUF,
+PERLIO_F_TEMP, PERLIO_F_OPEN, PERLIO_F_FASTGETS
+
+=item Methods in Detail
+
+IV     (*Fileno)(PerlIO *f);,  PerlIO *        (*Fdopen)(PerlIO_funcs
+*tab, int fd, const char *mode);,  PerlIO *     (*Open)(PerlIO_funcs *tab,
+const char *path, const char *mode);,  int          (*Reopen)(const char
+*path, const char *mode, PerlIO *f);,  IV         (*Pushed)(PerlIO
+*f,const char *mode,const char *arg,STRLEN len);,  IV        
+(*Popped)(PerlIO *f);, SSize_t (*Read)(PerlIO *f, void *vbuf, Size_t
+count);,  SSize_t (*Unread)(PerlIO *f, const void *vbuf, Size_t count);, 
+SSize_t (*Write)(PerlIO *f, const void *vbuf, Size_t count);,  IV         
+    (*Seek)(PerlIO *f, Off_t offset, int whence);,  Off_t         
+(*Tell)(PerlIO *f);,  IV               (*Close)(PerlIO *f);,  IV          
+    (*Flush)(PerlIO *f);,  IV              (*Fill)(PerlIO *f);,  IV       
+       (*Eof)(PerlIO *f);,  IV         (*Error)(PerlIO *f);,  void        
+    (*Clearerr)(PerlIO *f);,  void         (*Setlinebuf)(PerlIO *f);, 
+STDCHAR *   (*Get_base)(PerlIO *f);,  Size_t              
+(*Get_bufsiz)(PerlIO *f);,  STDCHAR *  (*Get_ptr)(PerlIO *f);,  SSize_t   
+    (*Get_cnt)(PerlIO *f);,  void          (*Set_ptrcnt)(PerlIO *f,STDCHAR
+*ptr,SSize_t cnt);
+
+=item Core Layers
+
+"unix", "perlio", "stdio", "crlf", "mmap", "pending", "raw", "utf8"
+
+=item Extension Layers
+
+"encoding"
+
+=back
+
+=back
+
 =head2 perlapio - perl's IO abstraction interface.
 
 =over 4
@@ -3895,27 +3995,36 @@ PL_last_in_gv, PL_ofs_sv, PL_rs
 
 =item DESCRIPTION
 
-B<PerlIO *>, B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()>,
-B<PerlIO_open(path, mode)>, B<PerlIO_fdopen(fd,mode)>,
+1. USE_STDIO, 2. USE_SFIO, 3. USE_PERLIO, B<PerlIO_stdin()>,
+B<PerlIO_stdout()>, B<PerlIO_stderr()>, B<PerlIO_open(path, mode)>,
+B<PerlIO_fdopen(fd,mode)>, B<PerlIO_reopen(path,mode,f)>,
 B<PerlIO_printf(f,fmt,...)>, B<PerlIO_vprintf(f,fmt,a)>,
 B<PerlIO_stdoutf(fmt,...)>, B<PerlIO_read(f,buf,count)>,
 B<PerlIO_write(f,buf,count)>, B<PerlIO_close(f)>, B<PerlIO_puts(f,s)>,
 B<PerlIO_putc(f,c)>, B<PerlIO_ungetc(f,c)>, B<PerlIO_getc(f)>,
 B<PerlIO_eof(f)>, B<PerlIO_error(f)>, B<PerlIO_fileno(f)>,
-B<PerlIO_clearerr(f)>, B<PerlIO_flush(f)>, B<PerlIO_tell(f)>,
-B<PerlIO_seek(f,o,w)>, B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)>,
-B<PerlIO_rewind(f)>, B<PerlIO_tmpfile()>
+B<PerlIO_clearerr(f)>, B<PerlIO_flush(f)>, B<PerlIO_seek(f,offset,whence)>,
+B<PerlIO_tell(f)>, B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)>,
+B<PerlIO_rewind(f)>, B<PerlIO_tmpfile()>, B<PerlIO_setlinebuf(f)>
 
 =over 4
 
 =item Co-existence with stdio
 
 B<PerlIO_importFILE(f,flags)>, B<PerlIO_exportFILE(f,flags)>,
-B<PerlIO_findFILE(f)>, B<PerlIO_releaseFILE(p,f)>, B<PerlIO_setlinebuf(f)>,
-B<PerlIO_has_cntptr(f)>, B<PerlIO_get_ptr(f)>, B<PerlIO_get_cnt(f)>,
-B<PerlIO_canset_cnt(f)>, B<PerlIO_fast_gets(f)>,
-B<PerlIO_set_ptrcnt(f,p,c)>, B<PerlIO_set_cnt(f,c)>, B<PerlIO_has_base(f)>,
-B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)>
+B<PerlIO_findFILE(f)>, B<PerlIO_releaseFILE(p,f)>
+
+=item "Fast gets" Functions
+
+B<PerlIO_fast_gets(f)>, B<PerlIO_has_cntptr(f)>, B<PerlIO_get_cnt(f)>,
+B<PerlIO_get_ptr(f)>, B<PerlIO_set_ptrcnt(f,p,c)>, B<PerlIO_canset_cnt(f)>,
+B<PerlIO_set_cnt(f,c)>, B<PerlIO_has_base(f)>, B<PerlIO_get_base(f)>,
+B<PerlIO_get_bufsiz(f)>
+
+=item Other Functions
+
+PerlIO_apply_layers(f,mode,layers), PerlIO_binmode(f,ptype,imode,layers),
+'E<lt>' read, 'E<gt>' write, '+' read/write, PerlIO_debug(fmt,...)
 
 =back
 
@@ -4246,16 +4355,9 @@ work?, Patches speak louder than words
 =item Keeping in sync
 
 rsync'ing the source tree, Using rsync over the LAN, Using pushing over the
-NFS, rsync'ing the patches
-
-=item Why rsync the source tree
-
-It's easier, It's more recent, It's more reliable
-
-=item Why rsync the patches
-
-It's easier, It's a good reference, Finding a start point, Finding how to
-fix a bug, Finding the source of misbehaviour
+NFS, rsync'ing the patches, It's easier, It's more recent, It's more
+reliable, It's easier, It's a good reference, Finding a start point,
+Finding how to fix a bug, Finding the source of misbehaviour
 
 =item Submitting patches
 
@@ -4347,7 +4449,91 @@ I<The Road goes ever on and on, down from the door where it began.>
 
 =back
 
-=head2 perldelta - what's new for perl v5.6.0
+=head2 perldelta - what's new for perl v5.7.0
+
+=over 4
+
+=item DESCRIPTION
+
+=item Security Vulnerability Closed
+
+=item Incompatible Changes
+
+=item Core Enhancements
+
+=item Modules and Pragmata
+
+=over 4
+
+=item New Modules
+
+=item Updated And Improved Modules and Pragmata
+
+=back
+
+=item Utility Changes
+
+=item New Documentation
+
+=item Performance Enhancements
+
+=item Installation and Configuration Improvements
+
+=over 4
+
+=item Generic Improvements
+
+=back
+
+=item Selected Bug Fixes
+
+=over 4
+
+=item Platform Specific Changes and Fixes
+
+=back
+
+=item New or Changed Diagnostics
+
+=item Changed Internals
+
+=item Known Problems
+
+=over 4
+
+=item Unicode Support Still Far From Perfect
+
+=item EBCDIC Still A Lost Platform
+
+=item Building Extensions Can Fail Because Of Largefiles
+
+=item ftmp-security tests warn 'system possibly insecure'
+
+=item Test lib/posix Subtest 9 Fails In LP64-Configured HP-UX
+
+=item Long Doubles Still Don't Work In Solaris
+
+=item Linux With Sfio Fails op/misc Test 48
+
+=item sprintf tests 129 and 130
+
+=item Storable tests fail in some platforms
+
+=item Threads Are Still Experimental
+
+=item The Compiler Suite Is Still Experimental
+
+=back
+
+=item Reporting Bugs
+
+=item SEE ALSO
+
+=item HISTORY
+
+=back
+
+=head2 perl56delta, perldelta - what's new for perl v5.6.0
 
 =over 4
 
@@ -4551,8 +4737,6 @@ perlreftut.pod, perltootc.pod, perltodo.pod, perlunicode.pod
 
 =item Enhanced Installation Directories
 
-=item gcc automatically tried if 'cc' does not seem to be working
-
 =back
 
 =item Platform specific changes
@@ -5335,50 +5519,6 @@ Source, Compiled Module Source, Perl Modules/Scripts
 
 =back
 
-=head2 perldos - Perl under DOS, W31, W95.
-
-=over 4
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=over 4
-
-=item Prerequisites
-
-DJGPP, Pthreads
-
-=item Shortcomings of Perl under DOS
-
-=item Building
-
-=item Testing
-
-=item Installation
-
-=back
-
-=item BUILDING AND INSTALLING MODULES
-
-=over 4
-
-=item Prerequisites
-
-=item Unpacking CPAN Modules
-
-=item Building Non-XS Modules
-
-=item Building XS Modules
-
-=back
-
-=item AUTHOR
-
-=item SEE ALSO
-
-=back
-
 =head2 perlepoc, README.epoc - Perl for EPOC
 
 =over 4
@@ -6028,48 +6168,6 @@ LIST, waitpid PID,FLAGS
 
 =back
 
-=head2 perlwin32 - Perl under Win32
-
-=over 4
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=over 4
-
-=item Setting Up
-
-Make, Command Shell, Borland C++, Microsoft Visual C++, Mingw32 with GCC
-
-=item Building
-
-=item Testing
-
-=item Installation
-
-=item Usage Hints
-
-Environment Variables, File Globbing, Using perl from the command line,
-Building Extensions, Command-line Wildcard Expansion, Win32 Specific
-Extensions, Running Perl Scripts, Miscellaneous Things
-
-=back
-
-=item BUGS AND CAVEATS
-
-=item AUTHORS
-
-Gary Ng E<lt>71564.1743@CompuServe.COME<gt>, Gurusamy Sarathy
-E<lt>gsar@activestate.comE<gt>, Nick Ing-Simmons
-E<lt>nick@ni-s.u-net.comE<gt>
-
-=item SEE ALSO
-
-=item HISTORY
-
-=back
-
 =head1 PRAGMA DOCUMENTATION
 
 =head2 attrs - set/get attributes of a subroutine (deprecated)
@@ -6480,6 +6578,26 @@ type, `%s' is not a code reference
 
 =back
 
+=head2 perlio - perl pragma to configure C level IO
+
+=over 4
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+unix, stdio, perlio
+
+=over 4
+
+=item Defaults and how to override them
+
+=back
+
+=item AUTHOR
+
+=back
+
 =head2 re - Perl pragma to alter regular expression behaviour
 
 =over 4
@@ -6542,6 +6660,19 @@ C<strict refs>, C<strict vars>, C<strict subs>
 
 =back
 
+=head2 unicode::distinct - Perl pragma to strictly distinguish UTF8 data
+and non-UTF data.
+
+=over 4
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item SEE ALSO
+
+=back
+
 =head2 utf8 - Perl pragma to enable/disable UTF-8 in source code
 
 =over 4
@@ -6721,7 +6852,7 @@ FILL, MAX, OFF, ARRAY, AvFLAGS
 =item B::CV METHODS
 
 STASH, START, ROOT, GV, FILE, DEPTH, PADLIST, OUTSIDE, XSUB, XSUBANY,
-CvFLAGS
+CvFLAGS, const_sv
 
 =item B::HV METHODS
 
@@ -7618,7 +7749,7 @@ B<name()>, B<value()>, B<domain()>, B<path()>, B<expires()>
 
 Searching for authors, bundles, distribution files and modules, make, test,
 install, clean modules or distributions, get, readme, look module or
-distribution, Signals
+distribution, ls author, Signals
 
 =item CPAN::Shell
 
@@ -7716,6 +7847,8 @@ http firewall, ftp firewall, One way visibility, SOCKS, IP Masquerade
 
 =item AUTHOR
 
+=item TRANSLATIONS
+
 =item SEE ALSO
 
 =back
@@ -7761,15 +7894,7 @@ module
 
 =back
 
-=head2 Carp::Heavy - Carp guts
-
-=over 4
-
-=item SYNOPIS
-
-=item DESCRIPTION
-
-=back
+=head2 Carp::Heavy, Carp heavy machinery - no user serviceable parts inside
 
 =head2 Class::Struct - declare struct-like datatypes as Perl classes
 
@@ -7902,23 +8027,23 @@ C<d_setproctitle>, C<d_setpwent>, C<d_setregid>, C<d_setresgid>,
 C<d_setresuid>, C<d_setreuid>, C<d_setrgid>, C<d_setruid>, C<d_setsent>,
 C<d_setsid>, C<d_setvbuf>, C<d_sfio>, C<d_shm>, C<d_shmat>,
 C<d_shmatprototype>, C<d_shmctl>, C<d_shmdt>, C<d_shmget>, C<d_sigaction>,
-C<d_sigsetjmp>, C<d_socket>, C<d_socklen_t>, C<d_sockpair>,
-C<d_socks5_init>, C<d_sqrtl>, C<d_statblks>, C<d_statfs_f_flags>,
-C<d_statfs_s>, C<d_statvfs>, C<d_stdio_cnt_lval>, C<d_stdio_ptr_lval>,
-C<d_stdio_ptr_lval_nochange_cnt>, C<d_stdio_ptr_lval_sets_cnt>,
-C<d_stdio_stream_array>, C<d_stdiobase>, C<d_stdstdio>, C<d_strchr>,
-C<d_strcoll>, C<d_strctcpy>, C<d_strerrm>, C<d_strerror>, C<d_strtod>,
-C<d_strtol>, C<d_strtold>, C<d_strtoll>, C<d_strtoul>, C<d_strtoull>,
-C<d_strtouq>, C<d_strxfrm>, C<d_suidsafe>, C<d_symlink>, C<d_syscall>,
-C<d_sysconf>, C<d_sysernlst>, C<d_syserrlst>, C<d_system>, C<d_tcgetpgrp>,
-C<d_tcsetpgrp>, C<d_telldir>, C<d_telldirproto>, C<d_time>, C<d_times>,
-C<d_truncate>, C<d_tzname>, C<d_umask>, C<d_uname>, C<d_union_semun>,
-C<d_ustat>, C<d_vendorarch>, C<d_vendorbin>, C<d_vendorlib>, C<d_vfork>,
-C<d_void_closedir>, C<d_voidsig>, C<d_voidtty>, C<d_volatile>,
-C<d_vprintf>, C<d_wait4>, C<d_waitpid>, C<d_wcstombs>, C<d_wctomb>,
-C<d_xenix>, C<date>, C<db_hashtype>, C<db_prefixtype>, C<defvoidused>,
-C<direntrytype>, C<dlext>, C<dlsrc>, C<doublesize>, C<drand01>,
-C<dynamic_ext>
+C<d_sigprocmask>, C<d_sigsetjmp>, C<d_socket>, C<d_socklen_t>,
+C<d_sockpair>, C<d_socks5_init>, C<d_sqrtl>, C<d_statblks>,
+C<d_statfs_f_flags>, C<d_statfs_s>, C<d_statvfs>, C<d_stdio_cnt_lval>,
+C<d_stdio_ptr_lval>, C<d_stdio_ptr_lval_nochange_cnt>,
+C<d_stdio_ptr_lval_sets_cnt>, C<d_stdio_stream_array>, C<d_stdiobase>,
+C<d_stdstdio>, C<d_strchr>, C<d_strcoll>, C<d_strctcpy>, C<d_strerrm>,
+C<d_strerror>, C<d_strtod>, C<d_strtol>, C<d_strtold>, C<d_strtoll>,
+C<d_strtoq>, C<d_strtoul>, C<d_strtoull>, C<d_strtouq>, C<d_strxfrm>,
+C<d_suidsafe>, C<d_symlink>, C<d_syscall>, C<d_sysconf>, C<d_sysernlst>,
+C<d_syserrlst>, C<d_system>, C<d_tcgetpgrp>, C<d_tcsetpgrp>, C<d_telldir>,
+C<d_telldirproto>, C<d_time>, C<d_times>, C<d_truncate>, C<d_tzname>,
+C<d_umask>, C<d_uname>, C<d_union_semun>, C<d_ustat>, C<d_vendorarch>,
+C<d_vendorbin>, C<d_vendorlib>, C<d_vfork>, C<d_void_closedir>,
+C<d_voidsig>, C<d_voidtty>, C<d_volatile>, C<d_vprintf>, C<d_wait4>,
+C<d_waitpid>, C<d_wcstombs>, C<d_wctomb>, C<d_xenix>, C<date>,
+C<db_hashtype>, C<db_prefixtype>, C<defvoidused>, C<direntrytype>,
+C<dlext>, C<dlsrc>, C<doublesize>, C<drand01>, C<dynamic_ext>
 
 =item e
 
@@ -7963,7 +8088,8 @@ C<installarchlib>, C<installbin>, C<installman1dir>, C<installman3dir>,
 C<installprefix>, C<installprefixexp>, C<installprivlib>, C<installscript>,
 C<installsitearch>, C<installsitebin>, C<installsitelib>, C<installstyle>,
 C<installusrbinperl>, C<installvendorarch>, C<installvendorbin>,
-C<installvendorlib>, C<intsize>, C<ivdformat>, C<ivsize>, C<ivtype>
+C<installvendorlib>, C<intsize>, C<issymlink>, C<ivdformat>, C<ivsize>,
+C<ivtype>
 
 =item k
 
@@ -7991,10 +8117,10 @@ C<multiarch>, C<mv>, C<myarchname>, C<mydomain>, C<myhostname>, C<myuname>
 
 =item n
 
-C<n>, C<netdb_hlen_type>, C<netdb_host_type>, C<netdb_name_type>,
-C<netdb_net_type>, C<nm>, C<nm_opt>, C<nm_so_opt>, C<nonxs_ext>, C<nroff>,
-C<nveformat>, C<nvEUformat>, C<nvfformat>, C<nvFUformat>, C<nvgformat>,
-C<nvGUformat>, C<nvsize>, C<nvtype>
+C<n>, C<need_va_copy>, C<netdb_hlen_type>, C<netdb_host_type>,
+C<netdb_name_type>, C<netdb_net_type>, C<nm>, C<nm_opt>, C<nm_so_opt>,
+C<nonxs_ext>, C<nroff>, C<nveformat>, C<nvEUformat>, C<nvfformat>,
+C<nvFUformat>, C<nvgformat>, C<nvGUformat>, C<nvsize>, C<nvtype>
 
 =item o
 
@@ -8027,17 +8153,17 @@ C<revision>, C<rm>, C<rmail>, C<runnm>
 C<sched_yield>, C<scriptdir>, C<scriptdirexp>, C<sed>, C<seedfunc>,
 C<selectminbits>, C<selecttype>, C<sendmail>, C<sh>, C<shar>, C<sharpbang>,
 C<shmattype>, C<shortsize>, C<shrpenv>, C<shsharp>, C<sig_count>,
-C<sig_name>, C<sig_name_init>, C<sig_num>, C<sig_num_init>, C<signal_t>,
-C<sitearch>, C<sitearchexp>, C<sitebin>, C<sitebinexp>, C<sitelib>,
-C<sitelib_stem>, C<sitelibexp>, C<siteprefix>, C<siteprefixexp>,
-C<sizesize>, C<sizetype>, C<sleep>, C<smail>, C<so>, C<sockethdr>,
-C<socketlib>, C<socksizetype>, C<sort>, C<spackage>, C<spitshell>,
-C<sPRId64>, C<sPRIeldbl>, C<sPRIEUldbl>, C<sPRIfldbl>, C<sPRIFUldbl>,
-C<sPRIgldbl>, C<sPRIGUldbl>, C<sPRIi64>, C<sPRIo64>, C<sPRIu64>,
-C<sPRIx64>, C<sPRIXU64>, C<src>, C<sSCNfldbl>, C<ssizetype>, C<startperl>,
-C<startsh>, C<static_ext>, C<stdchar>, C<stdio_base>, C<stdio_bufsiz>,
-C<stdio_cnt>, C<stdio_filbuf>, C<stdio_ptr>, C<stdio_stream_array>,
-C<strings>, C<submit>, C<subversion>, C<sysman>
+C<sig_name>, C<sig_name_init>, C<sig_num>, C<sig_num_init>, C<sig_size>,
+C<signal_t>, C<sitearch>, C<sitearchexp>, C<sitebin>, C<sitebinexp>,
+C<sitelib>, C<sitelib_stem>, C<sitelibexp>, C<siteprefix>,
+C<siteprefixexp>, C<sizesize>, C<sizetype>, C<sleep>, C<smail>, C<so>,
+C<sockethdr>, C<socketlib>, C<socksizetype>, C<sort>, C<spackage>,
+C<spitshell>, C<sPRId64>, C<sPRIeldbl>, C<sPRIEUldbl>, C<sPRIfldbl>,
+C<sPRIFUldbl>, C<sPRIgldbl>, C<sPRIGUldbl>, C<sPRIi64>, C<sPRIo64>,
+C<sPRIu64>, C<sPRIx64>, C<sPRIXU64>, C<src>, C<sSCNfldbl>, C<ssizetype>,
+C<startperl>, C<startsh>, C<static_ext>, C<stdchar>, C<stdio_base>,
+C<stdio_bufsiz>, C<stdio_cnt>, C<stdio_filbuf>, C<stdio_ptr>,
+C<stdio_stream_array>, C<strings>, C<submit>, C<subversion>, C<sysman>
 
 =item t
 
@@ -8458,6 +8584,57 @@ Perl code
 
 =back
 
+=head2 Encode - character encodings
+
+=over 4
+
+=item TERMINOLOGY
+
+=item bytes
+
+=item chars
+
+=item chars With Encoding
+
+=item Testing For UTF-8
+
+=item Toggling UTF-8-ness
+
+=item UTF-16 and UTF-32 Encodings
+
+=item Handling Malformed Data
+
+=back
+
+=head2 Encode::EncodeFormat, EncodeFormat - the format of encoding tables
+of the Encode extension
+
+=over 4
+
+=item DESCRIPTION
+
+[1]   B<S>, [2]   B<D>, [3]   B<M>, [4]   B<E>
+
+=item KEYWORDS
+
+=item COPYRIGHT
+
+=back
+
+=head2 EncodeFormat - the format of encoding tables of the Encode extension
+
+=over 4
+
+=item DESCRIPTION
+
+[1]   B<S>, [2]   B<D>, [3]   B<M>, [4]   B<E>
+
+=item KEYWORDS
+
+=item COPYRIGHT
+
+=back
+
 =head2 English - use nice English (or awk) names for ugly punctuation
 variables
 
@@ -8467,7 +8644,7 @@ variables
 
 =item DESCRIPTION
 
-=item BUGS
+=item PERFORMANCE
 
 =back
 
@@ -9157,6 +9334,10 @@ PERL_MM_OPT
 C<Not in MANIFEST:> I<file>, C<No such file:> I<file>, C<MANIFEST:> I<$!>,
 C<Added to MANIFEST:> I<file>
 
+=item ENVIRONMENT
+
+B<PERL_MM_MANIFEST_DEBUG>
+
 =item SEE ALSO
 
 =item AUTHOR
@@ -9785,6 +9966,72 @@ $fh->print, $fh->printf, $fh->getline, $fh->getlines
 
 =back
 
+=head2 Filter::Simple - Simplified source filtering
+
+=over 4
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=over 4
+
+=item The Problem
+
+=item A Solution
+
+=item How it works
+
+=back
+
+=item AUTHOR
+
+=item COPYRIGHT
+
+=back
+
+=head2 Filter::Util::Call - Perl Source Filter Utility Module
+
+=over 4
+
+=item SYNOPSIS
+
+    use Filter::Util::Call ;
+
+=item DESCRIPTION
+
+=over 4
+
+=item B<use Filter::Util::Call>
+
+=item B<import()>
+
+=item B<filter() and anonymous sub>
+
+B<$_>, B<$status>, B<filter_read> and B<filter_read_exact>, B<filter_del>
+
+=back
+
+=item EXAMPLES
+
+=over 4
+
+=item Example 1: A simple filter.
+
+=item Example 2: Using the context
+
+=item Example 3: Using the context within the filter
+
+=item Example 4: Using filter_del
+
+=back
+
+=item AUTHOR
+
+=item DATE
+
+=back
+
 =head2 FindBin - Locate directory of original perl script
 
 =over 4
@@ -12281,6 +12528,60 @@ pack_sockaddr_un PATH, unpack_sockaddr_un SOCKADDR_UN
 
 =back
 
+=head2 Storable - persistency for perl data structures
+
+=over 4
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item MEMORY STORE
+
+=item ADVISORY LOCKING
+
+=item SPEED
+
+=item CANONICAL REPRESENTATION
+
+=item ERROR REPORTING
+
+=item WIZARDS ONLY
+
+=over 4
+
+=item Hooks
+
+C<STORABLE_freeze> I<obj>, I<cloning>, C<STORABLE_thaw> I<obj>, I<cloning>,
+I<serialized>, ..
+
+=item Predicates
+
+C<Storable::last_op_in_netorder>, C<Storable::is_storing>,
+C<Storable::is_retrieving>
+
+=item Recursion
+
+=item Deep Cloning
+
+=back
+
+=item EXAMPLES
+
+=item WARNING
+
+=item BUGS
+
+=item CREDITS
+
+=item TRANSLATIONS
+
+=item AUTHOR
+
+=item SEE ALSO
+
+=back
+
 =head2 Symbol - manipulate Perl symbols and their names
 
 =over 4
@@ -12455,6 +12756,10 @@ NORMAL TESTS, SKIPPED TESTS, TODO TESTS
 
 =item The test script output
 
+B<1..M>, B<'ok', 'not ok'.  Ok?>, B<test numbers>,
+B<$Test::Harness::verbose>, B<$Test::Harness::switches>, B<Skipping tests>,
+B<Bail out!>, B<Comments>
+
 =back
 
 =item EXPORT
@@ -12464,7 +12769,7 @@ NORMAL TESTS, SKIPPED TESTS, TODO TESTS
 C<All tests successful.\nFiles=%d,  Tests=%d, %s>, C<FAILED tests
 %s\n\tFailed %d/%d tests, %.2f%% okay.>, C<Test returned status %d (wstat
 %d)>, C<Failed 1 test, %.2f%% okay. %s>, C<Failed %d/%d tests, %.2f%% okay.
-%s>
+%s>, C<FAILED--Further testing stopped%s>
 
 =item ENVIRONMENT
 
@@ -12566,7 +12871,7 @@ cond_broadcast VARIABLE, yield
 
 =item METHODS
 
-join, eval, detach, equal, tid
+join, eval, detach, equal, tid, flags, done
 
 =item LIMITATIONS
 
index 7b56a17..be7a345 100644 (file)
@@ -97,7 +97,7 @@ Similarly, F<s2p> converts F<sed> scripts to Perl programs. F<s2p> run
 on C<s/foo/bar> will produce a Perl program based around this:
 
     while (<>) {
-        chop;
+        chomp;
         s/foo/bar/g;
         print if $printit;
     }
diff --git a/t/TEST b/t/TEST
index ef3d312..d48f370 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -24,7 +24,7 @@ $ENV{EMXSHELL} = 'sh';        # For OS/2
 
 if ($#ARGV == -1) {
     @ARGV = split(/[ \n]/,
-      `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`);
+      `echo base/*.t comp/*.t cmd/*.t run/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`);
 }
 
 %infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); 
diff --git a/t/lib/cgi-esc.t b/t/lib/cgi-esc.t
new file mode 100644 (file)
index 0000000..f0471cf
--- /dev/null
@@ -0,0 +1,56 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to escape() and unescape() punctuation characters
+# except for qw(- . _).
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..59\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI::Util qw(escape unescape);
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# ASCII order, ASCII codepoints, ASCII repertoire
+
+my %punct = (
+    ' ' => '20',  '!' => '21',  '"' => '22',  '#' =>  '23', 
+    '$' => '24',  '%' => '25',  '&' => '26',  '\'' => '27', 
+    '(' => '28',  ')' => '29',  '*' => '2A',  '+' =>  '2B', 
+    ',' => '2C',                              '/' =>  '2F',  # '-' => '2D',  '.' => '2E' 
+    ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D', 
+    '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C', 
+    ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
+    '{' => '7B',  '|' => '7C',  '}' => '7D',  '~' =>  '7E', 
+         );
+
+# The sort order may not be ASCII on EBCDIC machines:
+
+my $i = 1;
+
+foreach(sort(keys(%punct))) { 
+    $i++;
+    my $escape = "AbC\%$punct{$_}dEF";
+    my $cgi_escape = escape("AbC$_" . "dEF");
+    test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
+    $i++;
+    my $unescape = "AbC$_" . "dEF";
+    my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
+    test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
+}
+
index ea9012c..aa5380d 100755 (executable)
-#!./perl
+#!./perl -w
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
 
-print "1..3\n";
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST 1 u
+                x
+END
+               x
+END
+TEST 2 e
+               x
+END
+                x
+END
+TEST 3 e
+       x
+               y
+                       z
+END
+        x
+                y
+                        z
+END
+TEST 4 u
+        x
+                y
+                        z
+END
+       x
+               y
+                       z
+END
+TEST 5 u
+This    Is      a       test    of      a       line with many embedded tabs
+END
+This   Is      a       test    of      a       line with many embedded tabs
+END
+TEST 6 e
+This   Is      a       test    of      a       line with many embedded tabs
+END
+This    Is      a       test    of      a       line with many embedded tabs
+END
+TEST 7 u
+            x
+END
+           x
+END
+TEST 8 e
+       
+               
+       
 
-use Text::Tabs;
+           
+END
+        
+                
+        
+
+           
+END
+TEST 9 u
+           
+END
+          
+END
+TEST 10 u
+       
+               
+       
+
+           
+END
+       
+               
+       
+
+          
+END
+TEST 11 u
+foobar                  IN     A               140.174.82.12
+
+END
+foobar                 IN      A               140.174.82.12
 
-$tabstop = 4;
+END
+DONE
 
-$s1 = "foo\tbar\tb\tb";
-$s2 = expand $s1;
-$s3 = unexpand $s2;
+$| = 1;
 
-print "not " unless $s2 eq "foo bar b   b";
-print "ok 1\n";
+print "1..";
+print @tests/2;
+print "\n";
 
-print "not " unless $s3 eq "foo bar b\tb";
-print "ok 2\n";
+use Text::Tabs;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+while (@tests) {
+       my $in = shift(@tests);
+       my $out = shift(@tests);
 
+       $in =~ s/^TEST\s*(\d+)?\s*(\S+)?\n//;
 
-$tabstop = 8;
+       if ($2 eq 'e') {
+               $f = \&expand;
+               $fn = 'expand';
+       } else {
+               $f = \&unexpand;
+               $fn = 'unexpand';
+       }
 
-print "not " unless unexpand("                    foo") eq "\t\t    foo";
-print "ok 3\n";
+       my $back = &$f($in);
+
+       if ($back eq $out) {
+               print "ok $tn\n";
+       } elsif ($rerun) {
+               my $oi = $in;
+               foreach ($in, $back, $out) {
+                       s/\t/^I\t/gs;
+                       s/\n/\$\n/gs;
+               }
+               print "------------ input ------------\n";
+               print $in;
+               print "\$\n------------ $fn -----------\n";
+               print $back;
+               print "\$\n------------ expected ---------\n";
+               print $out;
+               print "\$\n-------------------------------\n";
+               $Text::Tabs::debug = 1;
+               my $back = &$f($in);
+               exit(1);
+       } else {
+               print "not ok $tn\n";
+       }
+       $tn++;
+}
index af24036..fee6ce0 100755 (executable)
@@ -4,7 +4,6 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
-use Text::Wrap qw(&wrap);
 
 @tests = (split(/\nEND\n/s, <<DONE));
 TEST1
@@ -84,21 +83,57 @@ END
  a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
  4567
 END
+TEST10
+my mother once said
+"never eat paste my darling"
+would that I heeded
+END
+   my mother once said
+ "never eat paste my darling"
+ would that I heeded
+END
+TEST11
+This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn
+END
+   This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_pr
+ ogram_does_not_crash_and_burn
+END
+TEST12
+This
+
+Has
+
+Blank
+
+Lines
+
+END
+   This
+ Has
+ Blank
+ Lines
+
+END
 DONE
 
 
 $| = 1;
 
-print "1..", @tests/2, "\n";
+print "1..", 1 +@tests, "\n";
 
 use Text::Wrap;
 
 $rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
 
 $tn = 1;
-while (@tests) {
-       my $in = shift(@tests);
-       my $out = shift(@tests);
+
+@st = @tests;
+while (@st) {
+       my $in = shift(@st);
+       my $out = shift(@st);
 
        $in =~ s/^TEST(\d+)?\n//;
 
@@ -126,4 +161,49 @@ while (@tests) {
                print "not ok $tn\n";
        }
        $tn++;
+
+}
+
+@st = @tests;
+while(@st) {
+       my $in = shift(@st);
+       my $out = shift(@st);
+
+       $in =~ s/^TEST(\d+)?\n//;
+
+       my @in = split("\n", $in, -1);
+       @in = ((map { "$_\n" } @in[0..$#in-1]), $in[-1]);
+       
+       my $back = wrap('   ', ' ', @in);
+
+       if ($back eq $out) {
+               print "ok $tn\n";
+       } elsif ($rerun) {
+               my $oi = $in;
+               foreach ($in, $back, $out) {
+                       s/\t/^I\t/gs;
+                       s/\n/\$\n/gs;
+               }
+               print "------------ input2 ------------\n";
+               print $in;
+               print "\n------------ output2 -----------\n";
+               print $back;
+               print "\n------------ expected2 ---------\n";
+               print $out;
+               print "\n-------------------------------\n";
+               $Text::Wrap::debug = 1;
+               wrap('   ', ' ', $oi);
+               exit(1);
+       } else {
+               print "not ok $tn\n";
+       }
+       $tn++;
 }
+
+$Text::Wrap::huge = 'overflow';
+
+my $tw = 'This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn';
+my $w = wrap('zzz','yyy',$tw);
+print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn");
+$tn++;
+
diff --git a/t/run/runenv.t b/t/run/runenv.t
new file mode 100644 (file)
index 0000000..736e48f
--- /dev/null
@@ -0,0 +1,137 @@
+#!./perl
+#
+# Tests for Perl run-time environment variable settings
+#
+# $PERL5OPT, $PERL5LIB, etc.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my $STDOUT = './results-0';
+my $STDERR = './results-1';
+my $PERL = './perl';
+my $FAILURE_CODE = 119;
+
+print "1..9\n";
+
+# Run perl with specified environment and arguments returns a list.
+# First element is true iff Perl's stdout and stderr match the
+# supplied $stdout and $stderr argument strings exactly.
+# second element is an explanation of the failure
+sub runperl {
+  local *F;
+  my ($env, $args, $stdout, $stderr) = @_;
+
+  unshift @$args, '-I../lib';
+
+  $stdout = '' unless defined $stdout;
+  $stderr = '' unless defined $stderr;
+  my $pid = fork;
+  return (0, "Couldn't fork: $!") unless defined $pid;   # failure
+  if ($pid) {                   # parent
+    my ($actual_stdout, $actual_stderr);
+    wait;
+    return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
+
+    open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
+    { local $/; $actual_stdout = <F> }
+    open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
+    { local $/; $actual_stderr = <F> }
+
+    if ($actual_stdout ne $stdout) {
+      return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
+    } elsif ($actual_stderr ne $stderr) {
+      return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
+    } else {
+      return 1;                 # success
+    }
+  } else {                      # child
+    for my $k (keys %$env) {
+      $ENV{$k} = $env->{$k};
+    }
+    open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
+    open STDERR, "> $STDERR" or it_didnt_work();
+    { exec $PERL, @$args }
+    it_didnt_work();
+  }
+}
+
+
+sub it_didnt_work {
+    print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
+    exit $FAILURE_CODE;
+}
+
+sub try {
+  my $testno = shift;
+  my ($success, $reason) = runperl(@_);
+  if ($success) {
+    print "ok $testno\n";
+  } else {
+    $reason =~ s/\n/\\n/g;
+    print "not ok $testno # $reason\n";    
+  }
+}
+
+#  PERL5OPT    Command-line options (switches).  Switches in
+#                    this variable are taken as if they were on
+#                    every Perl command line.  Only the -[DIMUdmw]
+#                    switches are allowed.  When running taint
+#                    checks (because the program was running setuid
+#                    or setgid, or the -T switch was used), this
+#                    variable is ignored.  If PERL5OPT begins with
+#                    -T, tainting will be enabled, and any
+#                    subsequent options ignored.
+
+my  $T = 1;
+try($T++, {PERL5OPT => '-w'}, ['-e', 'print $::x'],
+    "", 
+    qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n});
+
+try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
+    "", "");
+
+try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
+    "", 
+    qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
+    "", 
+    qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
+    "", 
+    <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value in print at -e line 1.
+ERROR
+    );
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
+    "", 
+    <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value in print at -e line 1.
+ERROR
+    );
+
+try($T++, {PERL5OPT => '-MExporter'}, ['-e0'],
+    "", 
+    "");
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
+    "", 
+    "");
+
+try($T++, {PERL5OPT => '-Mstrict -Mwarnings'}, 
+    ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
+    "ok",
+    "");
+
+print "# ", $T-1, " tests total.\n";
diff --git a/toke.c b/toke.c
index 9cd9b4a..b64b394 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3006,10 +3006,6 @@ Perl_yylex(pTHX)
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
-                       if (PL_lex_stuff) {
-                           SvREFCNT_dec(PL_lex_stuff);
-                           PL_lex_stuff = Nullsv;
-                       }
                        /* MUST advance bufptr here to avoid bogus
                           "at end of line" context messages from yyerror().
                         */
@@ -4704,9 +4700,10 @@ Perl_yylex(pTHX)
                    force_next(THING);
                }
            }
-           if (PL_lex_stuff)
+           if (PL_lex_stuff) {
                SvREFCNT_dec(PL_lex_stuff);
-           PL_lex_stuff = Nullsv;
+               PL_lex_stuff = Nullsv;
+           }
            PL_expect = XTERM;
            TOKEN('(');
 
@@ -4974,12 +4971,8 @@ Perl_yylex(pTHX)
                    char *p;
 
                    s = scan_str(s,FALSE,FALSE);
-                   if (!s) {
-                       if (PL_lex_stuff)
-                           SvREFCNT_dec(PL_lex_stuff);
-                       PL_lex_stuff = Nullsv;
+                   if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
-                   }
                    /* strip spaces */
                    d = SvPVX(PL_lex_stuff);
                    tmp = 0;
@@ -6162,12 +6155,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
     char *s;
 
     s = scan_str(start,FALSE,FALSE);
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Search pattern not terminated");
-    }
 
     pm = (PMOP*)newPMOP(type, 0);
     if (PL_multi_open == '?')
@@ -6199,12 +6188,8 @@ S_scan_subst(pTHX_ char *start)
 
     s = scan_str(start,FALSE,FALSE);
 
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Substitution pattern not terminated");
-    }
 
     if (s[-1] == PL_multi_open)
        s--;
@@ -6212,12 +6197,10 @@ S_scan_subst(pTHX_ char *start)
     first_start = PL_multi_start;
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
-       if (PL_lex_stuff)
+       if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
-       if (PL_lex_repl)
-           SvREFCNT_dec(PL_lex_repl);
-       PL_lex_repl = Nullsv;
+           PL_lex_stuff = Nullsv;
+       }
        Perl_croak(aTHX_ "Substitution replacement not terminated");
     }
     PL_multi_start = first_start;      /* so whole substitution is taken together */
@@ -6272,23 +6255,17 @@ S_scan_trans(pTHX_ char *start)
     yylval.ival = OP_NULL;
 
     s = scan_str(start,FALSE,FALSE);
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Transliteration pattern not terminated");
-    }
     if (s[-1] == PL_multi_open)
        s--;
 
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
-       if (PL_lex_stuff)
+       if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
-       if (PL_lex_repl)
-           SvREFCNT_dec(PL_lex_repl);
-       PL_lex_repl = Nullsv;
+           PL_lex_stuff = Nullsv;
+       }
        Perl_croak(aTHX_ "Transliteration replacement not terminated");
     }
 
@@ -6662,11 +6639,11 @@ S_scan_inputsymbol(pTHX_ char *start)
    delimiter.  It allows quoting of delimiters, and if the string has
    balanced delimiters ([{<>}]) it allows nesting.
 
-   The lexer always reads these strings into lex_stuff, except in the
-   case of the operators which take *two* arguments (s/// and tr///)
-   when it checks to see if lex_stuff is full (presumably with the 1st
-   arg to s or tr) and if so puts the string into lex_repl.
-
+   On success, the SV with the resulting string is put into lex_stuff or,
+   if that is already non-NULL, into lex_repl. The second case occurs only
+   when parsing the RHS of the special constructs s/// and tr/// (y///).
+   For convenience, the terminating delimiter character is stuffed into
+   SvIVX of the SV.
 */
 
 STATIC char *
diff --git a/utf8.h b/utf8.h
index c8dbabc..453ca27 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -64,6 +64,22 @@ END_EXTERN_C
 
 #define UTF8_QUAD_MAX  UINT64_C(0x1000000000)
 
+/*
+ The following table is from Unicode 3.1.
+
+ Code Points           1st Byte  2nd Byte  3rd Byte  4th Byte
+
+   U+0000..U+007F      00..7F   
+   U+0080..U+07FF      C2..DF    80..BF   
+   U+0800..U+0FFF      E0        A0..BF    80..BF  
+   U+1000..U+FFFF      E1..EF    80..BF    80..BF  
+  U+10000..U+3FFFF     F0        90..BF    80..BF    80..BF
+  U+40000..U+FFFFF     F1..F3    80..BF    80..BF    80..BF
+ U+100000..U+10FFFF    F4        80..8F    80..BF    80..BF
+
+ */
+
 #define UTF8_IS_ASCII(c)               (((U8)c) <  0x80)
 #define UTF8_IS_START(c)               (((U8)c) >= 0xc0 && (((U8)c) <= 0xfd))
 #define UTF8_IS_CONTINUATION(c)                (((U8)c) >= 0x80 && (((U8)c) <= 0xbf))
index 014a74e..7915679 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -293,7 +293,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
     static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
     char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv;
     unsigned long int idx = 0;
-    int trnsuccess;
+    int trnsuccess, success, secure, saverr, savvmserr;
     SV *tmpsv;
 
     if (PL_curinterp) {  /* Perl interpreter running -- may be threaded */
@@ -317,16 +317,25 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
         lnm = uplnm;
       }
       /* Impose security constraints only if tainting */
-      if (sys) sys = PL_curinterp ? PL_tainting : will_taint;
-      if (vmstrnenv(lnm,eqv,idx,
-                    sys ? fildev : NULL,
+      if (sys) {
+        /* Impose security constraints only if tainting */
+        secure = PL_curinterp ? PL_tainting : will_taint;
+        saverr = errno;  savvmserr = vaxc$errno;
+      }
+      else secure = 0;
+      success = vmstrnenv(lnm,eqv,idx,
+                          secure ? fildev : NULL,
 #ifdef SECURE_INTERNAL_GETENV
-                    sys ? PERL__TRNENV_SECURE : 0
+                          secure ? PERL__TRNENV_SECURE : 0
 #else
-                                                0
+                         0
 #endif
-                                                 )) return eqv;
-      else return Nullch;
+                                                            );
+      /* Discard NOLOGNAM on internal calls since we're often looking
+       * for an optional name, and this "error" often shows up as the
+       * (bogus) exit status for a die() call later on.  */
+      if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
+      return success ? eqv : Nullch;
     }
 
 }  /* end of my_getenv() */
@@ -341,6 +350,7 @@ my_getenv_len(const char *lnm, unsigned long *len, bool sys)
     char *buf, *cp1, *cp2;
     unsigned long idx = 0;
     static char __my_getenv_len_eqv[LNM$C_NAMLENGTH+1];
+    int secure, saverr, savvmserr;
     SV *tmpsv;
     
     if (PL_curinterp) {  /* Perl interpreter running -- may be threaded */
@@ -364,19 +374,25 @@ my_getenv_len(const char *lnm, unsigned long *len, bool sys)
         idx = strtoul(cp2+1,NULL,0);
         lnm = buf;
       }
-      /* Impose security constraints only if tainting */
-      if (sys) sys = PL_curinterp ? PL_tainting : will_taint;
-      if ((*len = vmstrnenv(lnm,buf,idx,
-                           sys ? fildev : NULL,
+      if (sys) {
+        /* Impose security constraints only if tainting */
+        secure = PL_curinterp ? PL_tainting : will_taint;
+        saverr = errno;  savvmserr = vaxc$errno;
+      }
+      else secure = 0;
+      *len = vmstrnenv(lnm,buf,idx,
+                       secure ? fildev : NULL,
 #ifdef SECURE_INTERNAL_GETENV
-                           sys ? PERL__TRNENV_SECURE : 0
+                       secure ? PERL__TRNENV_SECURE : 0
 #else
-                                                       0
+                                                      0
 #endif
-                                                         )))
-         return buf;
-      else
-         return Nullch;
+                                                      );
+      /* Discard NOLOGNAM on internal calls since we're often looking
+       * for an optional name, and this "error" often shows up as the
+       * (bogus) exit status for a die() call later on.  */
+      if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
+      return *len ? buf : Nullch;
     }
 
 }  /* end of my_getenv_len() */
@@ -707,25 +723,25 @@ vmssetenv(char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
 void
 Perl_my_setenv(pTHX_ char *lnm,char *eqv)
 {
-  if (lnm && *lnm) {
-    int len = strlen(lnm);
-    if  (len == 7) {
-    char uplnm[8];
-    int i;
-    for (i = 0; lnm[i]; i++) uplnm[i] = _toupper(lnm[i]);
-    if (!strcmp(uplnm,"DEFAULT")) {
-      if (eqv && *eqv) chdir(eqv);
-      return;
-    }
-  }
-#ifndef RTL_USES_UTC
-    if (len == 6 || len == 2) {
-        char uplnm[7];
+    if (lnm && *lnm) {
+      int len = strlen(lnm);
+      if  (len == 7) {
+        char uplnm[8];
         int i;
         for (i = 0; lnm[i]; i++) uplnm[i] = _toupper(lnm[i]);
-        uplnm[len] = '\0';
-        if (!strcmp(uplnm,"UCX$TZ")) tz_updated = 1;
-        if (!strcmp(uplnm,"TZ")) tz_updated = 1;
+        if (!strcmp(uplnm,"DEFAULT")) {
+          if (eqv && *eqv) chdir(eqv);
+          return;
+        }
+    } 
+#ifndef RTL_USES_UTC
+    if (len == 6 || len == 2) {
+      char uplnm[7];
+      int i;
+      for (i = 0; lnm[i]; i++) uplnm[i] = _toupper(lnm[i]);
+      uplnm[len] = '\0';
+      if (!strcmp(uplnm,"UCX$TZ")) tz_updated = 1;
+      if (!strcmp(uplnm,"TZ")) tz_updated = 1;
     }
 #endif
   }
@@ -4746,6 +4762,57 @@ do_spawn(char *cmd)
 }  /* end of do_spawn() */
 /*}}}*/
 
+
+static unsigned int *sockflags, sockflagsize;
+
+/*
+ * Shim fdopen to identify sockets for my_fwrite later, since the stdio
+ * routines found in some versions of the CRTL can't deal with sockets.
+ * We don't shim the other file open routines since a socket isn't
+ * likely to be opened by a name.
+ */
+/*{{{ FILE *my_fdopen(int fd, char *mode)*/
+FILE *my_fdopen(int fd, char *mode)
+{
+  FILE *fp = fdopen(fd,mode);
+
+  if (fp) {
+    unsigned int fdoff = fd / sizeof(unsigned int);
+    struct stat sbuf; /* native stat; we don't need flex_stat */
+    if (!sockflagsize || fdoff > sockflagsize) {
+      if (sockflags) Renew(     sockflags,fdoff+2,unsigned int);
+      else           New  (1324,sockflags,fdoff+2,unsigned int);
+      memset(sockflags+sockflagsize,0,fdoff + 2 - sockflagsize);
+      sockflagsize = fdoff + 2;
+    }
+    if (fstat(fd,&sbuf) == 0 && S_ISSOCK(sbuf.st_mode))
+      sockflags[fdoff] |= 1 << (fd % sizeof(unsigned int));
+  }
+  return fp;
+
+}
+/*}}}*/
+
+
+/*
+ * Clear the corresponding bit when the (possibly) socket stream is closed.
+ * There still a small hole: we miss an implicit close which might occur
+ * via freopen().  >> Todo
+ */
+/*{{{ int my_fclose(FILE *fp)*/
+int my_fclose(FILE *fp) {
+  if (fp) {
+    unsigned int fd = fileno(fp);
+    unsigned int fdoff = fd / sizeof(unsigned int);
+
+    if (sockflagsize && fdoff <= sockflagsize)
+      sockflags[fdoff] &= ~(1 << fd % sizeof(unsigned int));
+  }
+  return fclose(fp);
+}
+/*}}}*/
+
+
 /* 
  * A simple fwrite replacement which outputs itmsz*nitm chars without
  * introducing record boundaries every itmsz chars.
@@ -4759,10 +4826,18 @@ int
 my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)
 {
   register char *cp, *end, *cpd, *data;
+  register unsigned int fd = fileno(dest);
+  register unsigned int fdoff = fd / sizeof(unsigned int);
   int retval;
-  int bufsize = itmsz*nitm+1;
+  int bufsize = itmsz * nitm + 1;
+
+  if (fdoff < sockflagsize &&
+      (sockflags[fdoff] | 1 << (fd % sizeof(unsigned int)))) {
+    if (write(fd, src, itmsz * nitm) == EOF) return EOF;
+    return nitm;
+  }
 
-  _ckvmssts_noperl(lib$get_vm( &bufsize, &data ));
+  _ckvmssts_noperl(lib$get_vm(&bufsize, &data));
   memcpy( data, src, itmsz*nitm );
   data[itmsz*nitm] = '\0';
 
@@ -4778,7 +4853,7 @@ my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)
     cpd = cp + 1;
   }
 
-  if (data) _ckvmssts_noperl(lib$free_vm( &bufsize, &data ));
+  if (data) _ckvmssts_noperl(lib$free_vm(&bufsize, &data));
   return retval;
 
 }  /* end of my_fwrite() */
index 17c5a00..15cda49 100644 (file)
  * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
  *                            (e.g. pointer fields of descriptors)
  */
-#ifdef __DECC
-#  pragma message disable (ADDRCONSTEXT,NEEDCONSTEXT)
-#endif
-#ifdef __DECCXX 
+#if defined(__DECC) || defined(__DECCXX)
 #  pragma message disable (ADDRCONSTEXT,NEEDCONSTEXT)
 #endif
 
 #include <unixio.h>
 #include <unixlib.h>
 #include <file.h>  /* it's not <sys/file.h>, so don't use I_SYS_FILE */
-#if defined(__DECC) && defined(__DECC_VER) && __DECC_VER > 20000000
-#  include <unistd.h> /* DECC has this; VAXC and gcc don't */
-#endif
-#ifdef __DECCXX 
-#  include <unistd.h> /* DECC has this; VAXC and gcc don't */
-#endif
-
-/* VAXC doesn't have a unary plus operator, so we need to get there indirectly */
-#if defined(VAXC) && !defined(__DECC)
-#  define NO_UNARY_PLUS
+#if (defined(__DECC) && defined(__DECC_VER) && __DECC_VER > 20000000) || defined(__DECCXX)
+#  include <unistd.h> /* DECC has this; gcc doesn't */
 #endif
 
 #ifdef NO_PERL_TYPEDEFS /* a2p; we don't want Perl's special routines */
 #define vms_do_exec            Perl_vms_do_exec
 #define do_aspawn              Perl_do_aspawn
 #define do_spawn               Perl_do_spawn
+#define my_fdopen               Perl_my_fdopen
+#define my_fclose               Perl_my_fclose
 #define my_fwrite              Perl_my_fwrite
 #define my_flush               Perl_my_flush
 #define my_getpwnam            Perl_my_getpwnam
  */
 #define fwrite1 my_fwrite
 
+
+#ifndef DONT_MASK_RTL_CALLS
+#  define fdopen my_fdopen
+#  define fclose my_fclose
+#endif
+
+
 /* By default, flush data all the way to disk, not just to RMS buffers */
 #define Fflush(fp) my_flush(fp)
 
 /* Assorted fiddling with sigs . . . */
 # include <signal.h>
 #define ABORT() abort()
-    /* VAXC's signal.h doesn't #define SIG_ERR, but provides BADSIG instead. */
-#if !defined(SIG_ERR) && defined(BADSIG)
-#  define SIG_ERR BADSIG
-#endif
-
 
 /* Used with our my_utime() routine in vms.c */
 struct utimbuf {
@@ -482,7 +475,7 @@ struct utimbuf {
 /* Thin jacket around cuserid() to match Unix' calling sequence */
 #define getlogin my_getlogin
 
-/* Ditto for sys$hash_passwrod() . . . */
+/* Ditto for sys$hash_password() . . . */
 #define crypt  my_crypt
 
 /* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */
@@ -743,6 +736,8 @@ bool        vms_do_aexec (SV *, SV **, SV **);
 bool   vms_do_exec (char *);
 unsigned long int      do_aspawn (void *, void **, void **);
 unsigned long int      do_spawn (char *);
+FILE *  my_fdopen (int, char *);
+int     my_fclose (FILE *);
 int    my_fwrite (void *, size_t, size_t, FILE *);
 int    my_flush (FILE *);
 struct passwd *        my_getpwnam (char *name);