diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1998-05-14 23:11:05 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-05-14 23:11:05 +0000 |
commit | 7b8d334a971230040a212bc5038097b3f600a094 (patch) | |
tree | e0fd6231e06e9b8f7e54aae4cec4ead51585219a | |
parent | 6ee623d521a149edc6574c512fa951a192cd086a (diff) | |
download | perl-7b8d334a971230040a212bc5038097b3f600a094.tar.gz |
[win32] merge change#897 from maintbranch
p4raw-link: @897 on //depot/maint-5.004/perl: f06f9b6fc5a686f0169ee2a91b32d5e7125a44ae
p4raw-id: //depot/win32/perl@974
47 files changed, 572 insertions, 271 deletions
@@ -21,6 +21,7 @@ Would be nice to have reference to compiled regexp lexically scoped functions: my sub foo { ... } lvalue functions + regression/sanity tests for suidperl Full 64 bit support (i.e. "long long") Possible pragmas @@ -55,5 +56,4 @@ Vague possibilities structured types autocroak? Modifiable $1 et al - substr EXPR,OFFSET,LENGTH,STRING @@ -171,8 +171,11 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe if (strNE(name,"-")) TAINT_ENV(); TAINT_PROPER("piped open"); - if (dowarn && name[strlen(name)-1] == '|') - warn("Can't do bidirectional pipe"); + if (name[strlen(name)-1] == '|') { + name[strlen(name)-1] = '\0' ; + if (dowarn) + warn("Can't do bidirectional pipe"); + } fp = PerlProc_popen(name,"w"); writing = 1; } diff --git a/ext/IO/IO.pm b/ext/IO/IO.pm index 1ba05ca916..4d4c81ce40 100644 --- a/ext/IO/IO.pm +++ b/ext/IO/IO.pm @@ -12,7 +12,7 @@ IO - load various IO modules =head1 DESCRIPTION -C<IO> provides a simple mechanism to load all of the IO modules at one go. +C<IO> provides a simple mechanism to load some of the IO modules at one go. Currently this includes: IO::Handle diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index b71e8b43cf..717b97ff84 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -152,7 +152,7 @@ like gv2cv, i_ncmp and ftsvtx. =item an operator tag name (optag) Operator tags can be used to refer to groups (or sets) of operators. -Tag names always being with a colon. The Opcode module defines several +Tag names always begin with a colon. The Opcode module defines several optags and the user can define others using the define_optag function. =item a negated opname or optag @@ -569,7 +569,7 @@ Originally designed and implemented by Malcolm Beattie, mbeattie@sable.ox.ac.uk as part of Safe version 1. Split out from Safe module version 1, named opcode tags and other -changes added by Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>. +changes added by Tim Bunce. =cut diff --git a/lib/Carp.pm b/lib/Carp.pm index 685a7933d0..6397d1b999 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -47,6 +47,15 @@ environment variable. # This package is heavily used. Be small. Be fast. Be good. +# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an +# _almost_ complete understanding of the package. Corrections and +# comments are welcome. + +# The $CarpLevel variable can be set to "strip off" extra caller levels for +# those times when Carp calls are buried inside other functions. The +# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval +# text and function arguments should be formatted when printed. + $CarpLevel = 0; # How many extra package levels to skip on carp. $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. $MaxArgLen = 64; # How much of each argument to print. 0 = all. @@ -58,30 +67,62 @@ require Exporter; @EXPORT_OK = qw(cluck verbose); @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode + +# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl") +# then the following method will be called by the Exporter which knows +# to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the word +# 'verbose'. + sub export_fail { shift; if ($_[0] eq 'verbose') { - local $^W = 0; - *shortmess = \&longmess; - shift; + local $^W = 0; # avoid "sub-routine redefined..." warning + *shortmess = \&longmess; # set shortmess() as an alias to longmess() + shift; # remove 'verbose' from the args to keep Exporter happy } return @_; } +# longmess() crawls all the way up the stack reporting on all the function +# calls made. The error string, $error, is originally constructed from the +# arguments passed into longmess() via confess(), cluck() or shortmess(). +# This gets appended with the stack trace messages which are generated for +# each function call on the stack. + sub longmess { my $error = join '', @_; my $mess = ""; my $i = 1 + $CarpLevel; my ($pack,$file,$line,$sub,$hargs,$eval,$require); my (@a); + # + # crawl up the stack.... + # while (do { { package DB; @a = caller($i++) } } ) { - ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a; + # get copies of the variables returned from caller() + ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a; + # + # if the $error error string is newline terminated then it + # is copied into $mess. Otherwise, $mess gets set (at the end of + # the 'else {' section below) to one of two things. The first time + # through, it is set to the "$error at $file line $line" message. + # $error is then set to 'called' which triggers subsequent loop + # iterations to append $sub to $mess before appending the "$error + # at $file line $line" which now actually reads "called at $file line + # $line". Thus, the stack trace message is constructed: + # + # first time: $mess = $error at $file line $line + # subsequent times: $mess .= $sub $error at $file line $line + # ^^^^^^ + # "called" if ($error =~ m/\n$/) { $mess .= $error; } else { + # Build a string, $sub, which names the sub-routine called. + # This may also be "require ...", "eval '...' or "eval {...}" if (defined $eval) { - if ($require) { + if ($require) { $sub = "require $eval"; } else { $eval =~ s/([\\\'])/\\$1/g; @@ -93,32 +134,48 @@ sub longmess { } elsif ($sub eq '(eval)') { $sub = 'eval {...}'; } + # if there are any arguments in the sub-routine call, format + # them according to the format variables defined earlier in + # this file and join them onto the $sub sub-routine string if ($hargs) { - @a = @DB::args; # must get local copy of args - if ($MaxArgNums and @a > $MaxArgNums) { - $#a = $MaxArgNums; - $a[$#a] = "..."; - } - for (@a) { - $_ = "undef", next unless defined $_; - if (ref $_) { - $_ .= ''; - s/'/\\'/g; + # we may trash some of the args so we take a copy + @a = @DB::args; # must get local copy of args + # don't print any more than $MaxArgNums + if ($MaxArgNums and @a > $MaxArgNums) { + # cap the length of $#a and set the last element to '...' + $#a = $MaxArgNums; + $a[$#a] = "..."; } - else { - s/'/\\'/g; - substr($_,$MaxArgLen) = '...' - if $MaxArgLen and $MaxArgLen < length; + for (@a) { + # set args to the string "undef" if undefined + $_ = "undef", next unless defined $_; + if (ref $_) { + # dunno what this is for... + $_ .= ''; + s/'/\\'/g; + } + else { + s/'/\\'/g; + # terminate the string early with '...' if too long + substr($_,$MaxArgLen) = '...' + if $MaxArgLen and $MaxArgLen < length; + } + # 'quote' arg unless it looks like a number + $_ = "'$_'" unless /^-?[\d.]+$/; + # print high-end chars as 'M-<char>' or '^<char>' + s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; + s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; } - $_ = "'$_'" unless /^-?[\d.]+$/; - s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; - s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; - } - $sub .= '(' . join(', ', @a) . ')'; + # append ('all', 'the', 'arguments') to the $sub string + $sub .= '(' . join(', ', @a) . ')'; } + # here's where the error message, $mess, gets constructed $mess .= "\t$sub " if $error eq "called"; $mess .= "$error at $file line $line\n"; } + # we don't need to print the actual error message again so we can + # change this to "called" so that the string "$error at $file line + # $line" makes sense as "called at $file line $line". $error = "called"; } # this kludge circumvents die's incorrect handling of NUL @@ -127,36 +184,70 @@ sub longmess { $$msg; } + +# shortmess() is called by carp() and croak() to skip all the way up to +# the top-level caller's package and report the error from there. confess() +# and cluck() generate a full stack trace so they call longmess() to +# generate that. In verbose mode shortmess() is aliased to longmess() so +# you always get a stack trace + sub shortmess { # Short-circuit &longmess if called via multiple packages my $error = join '', @_; my ($prevpack) = caller(1); my $extra = $CarpLevel; my $i = 2; my ($pack,$file,$line); + # when reporting an error, we want to report it from the context of the + # calling package. So what is the calling package? Within a module, + # there may be many calls between methods and perhaps between sub-classes + # and super-classes, but the user isn't interested in what happens + # inside the package. We start by building a hash array which keeps + # track of all the packages to which the calling package belongs. We + # do this by examining its @ISA variable. Any call from a base class + # method (one of our caller's @ISA packages) can be ignored my %isa = ($prevpack,1); + # merge all the caller's @ISA packages into %isa. @isa{@{"${prevpack}::ISA"}} = () if(defined @{"${prevpack}::ISA"}); + # now we crawl up the calling stack and look at all the packages in + # there. For each package, we look to see if it has an @ISA and then + # we see if our caller features in that list. That would imply that + # our caller is a derived class of that package and its calls can also + # be ignored while (($pack,$file,$line) = caller($i++)) { if(defined @{$pack . "::ISA"}) { my @i = @{$pack . "::ISA"}; my %i; @i{@i} = (); + # merge any relevant packages into %isa @isa{@i,$pack} = () if(exists $i{$prevpack} || exists $isa{$pack}); } + # and here's where we do the ignoring... if the package in + # question is one of our caller's base or derived packages then + # we can ignore it (skip it) and go onto the next (but note that + # the continue { } block below gets called every time) next if(exists $isa{$pack}); + # Hey! We've found a package that isn't one of our caller's + # clan....but wait, $extra refers to the number of 'extra' levels + # we should skip up. If $extra > 0 then this is a false alarm. + # We must merge the package into the %isa hash (so we can ignore it + # if it pops up again), decrement $extra, and continue. if ($extra-- > 0) { %isa = ($pack,1); @isa{@{$pack . "::ISA"}} = () if(defined @{$pack . "::ISA"}); } else { - # this kludge circumvents die's incorrect handling of NUL + # OK! We've got a candidate package. Time to construct the + # relevant error message and return it. die() doesn't like + # to be given NUL characters (which $msg may contain) so we + # remove them first. (my $msg = "$error at $file line $line\n") =~ tr/\0//d; return $msg; } @@ -165,12 +256,23 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages $prevpack = $pack; } + # uh-oh! It looks like we crawled all the way up the stack and + # never found a candidate package. Oh well, let's call longmess + # to generate a full stack trace. We use the magical form of 'goto' + # so that this shortmess() function doesn't appear on the stack + # to further confuse longmess() about it's calling package. goto &longmess; } -sub confess { die longmess @_; } -sub croak { die shortmess @_; } -sub carp { warn shortmess @_; } -sub cluck { warn longmess @_; } + +# the following four functions call longmess() or shortmess() depending on +# whether they should generate a full stack trace (confess() and cluck()) +# or simply report the caller's package (croak() and carp()), respectively. +# confess() and croak() die, carp() and cluck() warn. + +sub croak { die shortmess @_ } +sub confess { die longmess @_ } +sub carp { warn shortmess @_ } +sub cluck { warn longmess @_ } 1; diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 4f861dfe2a..99ca0bd1fb 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -1953,7 +1953,7 @@ pure_site_install :: }.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{ doc_perl_install :: - }.$self->{NOECHO}.q{$(DOC_INSTALL) \ + -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLPRIVLIB)" \ LINKTYPE "$(LINKTYPE)" \ @@ -1962,7 +1962,7 @@ doc_perl_install :: >> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{ doc_site_install :: - }.$self->{NOECHO}.q{$(DOC_INSTALL) \ + -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLSITELIB)" \ LINKTYPE "$(LINKTYPE)" \ @@ -2327,7 +2327,7 @@ $tmp/perlmain.c: $makefilename}, q{ push @m, q{ doc_inst_perl: }.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod - }.$self->{NOECHO}.q{$(DOC_INSTALL) \ + -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ "Perl binary" "$(MAP_TARGET)" \ MAP_STATIC "$(MAP_STATIC)" \ MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \ diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index 8ff3e8964b..dafa27d781 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -3,6 +3,8 @@ package Pod::Html; use Pod::Functions; use Getopt::Long; # package for handling command-line parameters require Exporter; +use vars qw($VERSION); +$VERSION = 1.01; @ISA = Exporter; @EXPORT = qw(pod2html htmlify); use Cwd; @@ -11,13 +13,15 @@ use Carp; use strict; +use Config; + =head1 NAME -Pod::HTML - module to convert pod files to HTML +Pod::Html - module to convert pod files to HTML =head1 SYNOPSIS - use Pod::HTML; + use Pod::Html; pod2html([options]); =head1 DESCRIPTION @@ -302,7 +306,7 @@ sub pod2html { for (my $i = 0; $i < @poddata; $i++) { if ($poddata[$i] =~ /^=head1\s*NAME\b/m) { for my $para ( @poddata[$i, $i+1] ) { - last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s; + last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+.*\S)/s; } } @@ -316,19 +320,22 @@ sub pod2html { warn "adopted '$title' as title for $podfile\n" if $verbose and $title; } - unless ($title) { + if ($title) { + $title =~ s/\s*\(.*\)//; + } else { warn "$0: no title for $podfile"; $podfile =~ /^(.*)(\.[^.\/]+)?$/; $title = ($podfile eq "-" ? 'No Title' : $1); warn "using $title" if $verbose; } print HTML <<END_OF_HEAD; - <HTML> - <HEAD> - <TITLE>$title</TITLE> - </HEAD> +<HTML> +<HEAD> +<TITLE>$title</TITLE> +<LINK REV="made" HREF="mailto:$Config{perladmin}"> +</HEAD> - <BODY> +<BODY> END_OF_HEAD @@ -368,9 +375,9 @@ END_OF_HEAD } else { next if @begin_stack && $begin_stack[-1] ne 'html'; - if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading + if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading process_head($1, $2); - } elsif (/^=item\s*(.*)/sm) { # =item text + } elsif (/^=item\s*(.*\S)/sm) { # =item text process_item($1); } elsif (/^=over\s*(.*)/) { # =over N process_over(); @@ -391,16 +398,16 @@ END_OF_HEAD next if @begin_stack && $begin_stack[-1] ne 'html'; my $text = $_; process_text(\$text, 1); - print HTML "$text\n<P>\n\n"; + print HTML "<P>\n$text"; } } # finish off any pending directives finish_list(); print HTML <<END_OF_TAIL; - </BODY> +</BODY> - </HTML> +</HTML> END_OF_TAIL # close the html file @@ -782,7 +789,7 @@ sub scan_headings { $index .= "\n" . ("\t" x $listdepth) . "<LI>" . "<A HREF=\"#" . htmlify(0,$title) . "\">" . - process_text(\$title, 0) . "</A>"; + html_escape(process_text(\$title, 0)) . "</A>"; } } @@ -823,8 +830,8 @@ sub scan_items { if ($1 eq "*") { # bullet list /\A=item\s+\*\s*(.*?)\s*\Z/s; $item = $1; - } elsif ($1 =~ /^[0-9]+/) { # numbered list - /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s; + } elsif ($1 =~ /^\d+/) { # numbered list + /\A=item\s+\d+\.?(.*?)\s*\Z/s; $item = $1; } else { # /\A=item\s+(.*?)\s*\Z/s; @@ -856,6 +863,7 @@ sub process_head { print HTML "<H$level>"; # unless $listlevel; #print HTML "<H$level>" unless $listlevel; my $convert = $heading; process_text(\$convert, 0); + $convert = html_escape($convert); print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>"; print HTML "</H$level>"; # unless $listlevel; print HTML "\n"; @@ -898,30 +906,36 @@ sub process_item { print HTML "<UL>\n"; } - print HTML "<LI><STRONG>"; - $text =~ /\A\*\s*(.*)\Z/s; - print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++; - $quote = 1; - #print HTML process_puretext($1, \$quote); - print HTML $1; - print HTML "</A>" if $1; - print HTML "</STRONG>"; + print HTML '<LI>'; + if ($text =~ /\A\*\s*(.+)\Z/s) { + print HTML '<STRONG>'; + if ($items_named{$1}++) { + print HTML html_escape($1); + } else { + my $name = 'item_' . htmlify(1,$1); + print HTML qq(<A NAME="$name">), html_escape($1), '</A>'; + } + print HTML '</STRONG>'; + } - } elsif ($text =~ /\A[0-9#]+/) { # numbered list + } elsif ($text =~ /\A[\d#]+/) { # numbered list if ($need_preamble) { push(@listend, "</OL>"); print HTML "<OL>\n"; } - print HTML "<LI><STRONG>"; - $text =~ /\A[0-9]+\.?(.*)\Z/s; - print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1; - $quote = 1; - #print HTML process_puretext($1, \$quote); - print HTML $1 if $1; - print HTML "</A>" if $1; - print HTML "</STRONG>"; + print HTML '<LI>'; + if ($text =~ /\A\d+\.?\s*(.+)\Z/s) { + print HTML '<STRONG>'; + if ($items_named{$1}++) { + print HTML html_escape($1); + } else { + my $name = 'item_' . htmlify(0,$1); + print HTML qq(<A NAME="$name">), html_escape($1), '</A>'; + } + print HTML '</STRONG>'; + } } else { # all others @@ -930,18 +944,17 @@ sub process_item { print HTML "<DL>\n"; } - print HTML "<DT><STRONG>"; - print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">" - if $text && !$items_named{($text =~ /(\S+)/)[0]}++; - # preceding craziness so that the duplicate leading bits in - # perlfunc work to find just the first one. otherwise - # open etc would have many names - $quote = 1; - #print HTML process_puretext($text, \$quote); - print HTML $text; - print HTML "</A>" if $text; - print HTML "</STRONG>"; - + print HTML '<DT>'; + if ($text =~ /(\S+)/) { + print HTML '<STRONG>'; + if ($items_named{$1}++) { + print HTML html_escape($text); + } else { + my $name = 'item_' . htmlify(1,$text); + print HTML qq(<A NAME="$name">), html_escape($text), '</A>'; + } + print HTML '</STRONG>'; + } print HTML '<DD>'; } @@ -1276,12 +1289,15 @@ sub process_puretext { $word = qq(<A HREF="$word">$word</A>); } elsif ($word =~ /[\w.-]+\@\w+\.\w/) { # looks like an e-mail address - $word = qq(<A HREF="MAILTO:$word">$word</A>); + my ($w1, $w2, $w3) = ("", $word, ""); + ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/; + ($w1, $w2, $w3) = ("<", $1, ">$2") if $word =~ /^<(.*?)>(,?)/; + $word = qq($w1<A HREF="mailto:$w2">$w2</A>$w3); } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase? - $word = html_escape($word) if $word =~ /[&<>]/; + $word = html_escape($word) if $word =~ /["&<>]/; $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape; } else { - $word = html_escape($word) if $word =~ /[&<>]/; + $word = html_escape($word) if $word =~ /["&<>]/; } } @@ -1443,6 +1459,7 @@ sub process_C { $s1 =~ s/\([^()]*\)//g; # delete parentheses $s2 = $s1; $s1 =~ s/\W//g; # delete bogus characters + $str = html_escape($str); # if there was a pod file that we found earlier with an appropriate # =item directive, then create a link to that page. @@ -1512,7 +1529,7 @@ sub process_X { # after the entire pod file has been read and converted. # sub finish_list { - while ($listlevel >= 0) { + while ($listlevel > 0) { print HTML "</DL>\n"; $listlevel--; } @@ -1546,4 +1563,3 @@ BEGIN { } 1; - diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index 2183c8d235..83ba375742 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -310,7 +310,7 @@ sub ornaments { return $rl_term_set unless @_; $rl_term_set = shift; $rl_term_set ||= ',,,'; - $rl_term_set = 'us,ue,md,me' if $rl_term_set == 1; + $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1'; my @ts = split /,/, $rl_term_set, 4; eval { LoadTermCap }; unless (defined $terminal) { @@ -362,7 +362,7 @@ abs abs ck_fun fstu% S? # String stuff. length length ck_lengthconst istu% S? -substr substr ck_fun st@ S S S? +substr substr ck_fun st@ S S S? S? vec vec ck_fun ist@ S S S index index ck_index ist@ S S S? @@ -668,6 +668,7 @@ setuid perl scripts securely.\n"); s = argv[0]+1; reswitch: switch (*s) { + case ' ': case '0': case 'F': case 'a': @@ -1562,8 +1563,11 @@ moreswitches(char *s) inplace = savepv(s+1); /*SUPPRESS 530*/ for (s = inplace; *s && !isSPACE(*s); s++) ; - if (*s) + if (*s) { *s++ = '\0'; + if (*s == '-') /* Additional switches on #! line. */ + s++; + } return s; case 'I': /* -I handled both here and in parse_perl() */ forbid_setid("-I"); diff --git a/pod/perlapio.pod b/pod/perlapio.pod index c963d232f6..f69e79502c 100644 --- a/pod/perlapio.pod +++ b/pod/perlapio.pod @@ -67,7 +67,7 @@ has been "tidied up a little". =item B<PerlIO *> -This takes the place of FILE *. Unlike FILE * it should be treated as +This takes the place of FILE *. Like FILE * it should be treated as opaque (it is probably safe to assume it is a pointer to something). =item B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()> @@ -84,7 +84,7 @@ These correspond to fopen()/fdopen() arguments are the same. =item B<PerlIO_printf(f,fmt,...)>, B<PerlIO_vprintf(f,fmt,a)> -These are is fprintf()/vfprintf equivalents. +These are fprintf()/vfprintf() equivalents. =item B<PerlIO_stdoutf(fmt,...)> @@ -201,8 +201,8 @@ behaviour. =item B<PerlIO_setlinebuf(f)> This corresponds to setlinebuf(). Use is deprecated pending -further discussion. (Perl core uses it I<only> when "dumping" -is has nothing to do with $| auto-flush.) +further discussion. (Perl core uses it I<only> when "dumping"; +it has nothing to do with $| auto-flush.) =back diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 865d3bf88d..37916ae6d8 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -1918,7 +1918,7 @@ refers to the last. =head2 Creating and calling an anonymous subroutine in C -As we've already shown, L<perl_call_sv> can be used to invoke an +As we've already shown, C<perl_call_sv> can be used to invoke an anonymous subroutine. However, our example showed how Perl script invoking an XSUB to preform this operation. Let's see how it can be done inside our C code: @@ -1931,8 +1931,9 @@ done inside our C code: perl_call_sv(cvrv, G_VOID|G_NOARGS); -L<perlguts/perl_eval_pv> is used to compile the anonymous subroutine, which -will be the return value as well. Once this code reference is in hand, it +C<perl_eval_pv> is used to compile the anonymous subroutine, which +will be the return value as well (read more about C<perl_eval_pv> in +L<perlguts/perl_eval_pv>). Once this code reference is in hand, it can be mixed in with all the previous examples we've shown. =head1 SEE ALSO diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 8937c7e989..8f49541b40 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -63,7 +63,7 @@ it prints out the description for just that command. The special argument of C<h h> produces a more compact help listing, designed to fit together on one screen. -If the output the C<h> command (or any command, for that matter) scrolls +If the output of the C<h> command (or any command, for that matter) scrolls past your screen, either precede the command with a leading pipe symbol so it's run through your pager, as in @@ -281,7 +281,7 @@ The sequence of steps taken by the debugger is 4. prompt user if at a breakpoint or in single-step 5. evaluate line -For example, this will print out C<$foo> every time line +For example, this will print out $foo every time line 53 is passed: a 53 print "DB FOUND $foo\n" @@ -667,8 +667,8 @@ C<main::pests> was called in a scalar context, also from I<camel_flea>, but from line 4. Note that if you execute C<T> command from inside an active C<use> -statement, the backtrace will contain both C<L<perlfunc/require>> -frame and an C<L<perlfunc/eval EXPR>>) frame. +statement, the backtrace will contain both C<require> +frame and an C<eval>) frame. =item Listing @@ -868,7 +868,7 @@ compile subname> for the same purpose. =head2 Debugger Customization -Most probably you not want to modify the debugger, it contains enough +Most probably you do not want to modify the debugger, it contains enough hooks to satisfy most needs. You may change the behaviour of debugger from the debugger itself, using C<O>ptions, from the command line via C<PERLDB_OPTS> environment variable, and from I<customization files>. @@ -966,14 +966,14 @@ application. =item * -The array C<@{"_<$filename"}> is the line-by-line contents of +The array C<@{"_E<lt>$filename"}> is the line-by-line contents of $filename for all the compiled files. Same for C<eval>ed strings which contain subroutines, or which are currently executed. The C<$filename> for C<eval>ed strings looks like C<(eval 34)>. =item * -The hash C<%{"_<$filename"}> contains breakpoints and action (it is +The hash C<%{"_E<lt>$filename"}> contains breakpoints and action (it is keyed by line number), and individual entries are settable (as opposed to the whole hash). Only true/false is important to Perl, though the values used by F<perl5db.pl> have the form @@ -981,22 +981,22 @@ C<"$break_condition\0$action">. Values are magical in numeric context: they are zeros if the line is not breakable. Same for evaluated strings which contain subroutines, or which are -currently executed. The C<$filename> for C<eval>ed strings looks like +currently executed. The $filename for C<eval>ed strings looks like C<(eval 34)>. =item * -The scalar C<${"_<$filename"}> contains C<"_<$filename">. Same for +The scalar C<${"_E<lt>$filename"}> contains C<"_E<lt>$filename">. Same for evaluated strings which contain subroutines, or which are currently -executed. The C<$filename> for C<eval>ed strings looks like C<(eval +executed. The $filename for C<eval>ed strings looks like C<(eval 34)>. =item * After each C<require>d file is compiled, but before it is executed, -C<DB::postponed(*{"_<$filename"})> is called (if subroutine +C<DB::postponed(*{"_E<lt>$filename"})> is called (if subroutine C<DB::postponed> exists). Here the $filename is the expanded name of -the C<require>d file (as found in values of C<%INC>). +the C<require>d file (as found in values of %INC). =item * diff --git a/pod/perldelta4.pod b/pod/perldelta4.pod index 9443f386d9..f1b6c8f096 100644 --- a/pod/perldelta4.pod +++ b/pod/perldelta4.pod @@ -753,26 +753,27 @@ in Windows NT). This port includes support for perl extension building tools like L<MakeMaker> and L<h2xs>, so that many extensions available on the Comprehensive Perl Archive Network (CPAN) can now be readily built under Windows NT. See http://www.perl.com/ for more -information on CPAN, and L<README.win32> for more details on how to -get started with building this port. +information on CPAN and F<README.win32> in the perl distribution for more +details on how to get started with building this port. There is also support for building perl under the Cygwin32 environment. Cygwin32 is a set of GNU tools that make it possible to compile and run many UNIX programs under Windows NT by providing a mostly UNIX-like -interface for compilation and execution. See L<README.cygwin32> for -more details on this port, and how to obtain the Cygwin32 toolkit. +interface for compilation and execution. See F<README.cygwin32> in the +perl distribution for more details on this port and how to obtain the +Cygwin32 toolkit. =head2 Plan 9 -See L<README.plan9>. +See F<README.plan9> in the perl distribution. =head2 QNX -See L<README.qnx>. +See F<README.qnx> in the perl distribution. =head2 AmigaOS -See L<README.amigaos>. +See F<README.amigaos> in the perl distribution. =head1 Pragmata @@ -1379,8 +1380,7 @@ a possibility to shut down by trapping this error is granted. (W) qw() lists contain items separated by whitespace; as with literal strings, comment characters are not ignored, but are instead treated as literal data. (You may have used different delimiters than the -exclamation marks parentheses shown here; braces are also frequently -used.) +parentheses shown here; braces are also frequently used.) You probably wrote something like this: diff --git a/pod/perldiag.pod b/pod/perldiag.pod index dedde649a6..4808563782 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1094,6 +1094,13 @@ a goto, or a loop control statement. (W) You are exiting a substitution by unconventional means, such as a return, a goto, or a loop control statement. +=item Explicit blessing to '' (assuming package main) + +(W) You are blessing a reference to a zero length string. This has +the effect of blessing the reference into the package main. This is +usually not what you want. Consider providing a default target +package, e.g. bless($ref, $p or 'MyPackage'); + =item Fatal VMS error at %s, line %d (P) An error peculiar to VMS. Something untoward happened in a VMS system @@ -1919,7 +1926,7 @@ was string. (P) The lexer got into a bad state while processing a case modifier. -=item Pareneses missing around "%s" list +=item Parentheses missing around "%s" list (W) You said something like @@ -1957,8 +1964,7 @@ the BSD version, which takes a pid. (W) qw() lists contain items separated by whitespace; as with literal strings, comment characters are not ignored, but are instead treated as literal data. (You may have used different delimiters than the -exclamation marks parentheses shown here; braces are also frequently -used.) +parentheses shown here; braces are also frequently used.) You probably wrote something like this: @@ -2075,6 +2081,18 @@ to use parens. In any case, a hash requires key/value B<pairs>. %hash = ( one => 1, two => 2, ); # right %hash = qw( one 1 two 2 ); # also fine +=item Reference found where even-sized list expected + +(W) You gave a single reference where Perl was expecting a list with +an even number of elements (for assignment to a hash). This +usually means that you used the anon hash constructor when you meant +to use parens. In any case, a hash requires key/value B<pairs>. + + %hash = { one => 1, two => 2, }; # WRONG + %hash = [ qw/ an anon array / ]; # WRONG + %hash = ( one => 1, two => 2, ); # right + %hash = qw( one 1 two 2 ); # also fine + =item Reference miscount in sv_replace() (W) The internal sv_replace() function was handed a new SV with a @@ -2183,6 +2201,7 @@ or possibly some other missing operator, such as a comma. Check your logic flow. =item Sequence (? incomplete + (F) A regular expression ended with an incomplete extension (?. See L<perlre>. @@ -2641,7 +2660,7 @@ the name you call Perl by to C<perl_>, C<perl__>, and so on. =item Unsupported function %s -(F) This machines doesn't implement the indicated function, apparently. +(F) This machine doesn't implement the indicated function, apparently. At least, Configure doesn't think so. =item Unsupported socket function "%s" called @@ -2701,7 +2720,7 @@ a split() explicitly to an array (or list). (D) As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked up as methods (using the C<@ISA> hierarchy) even when the subroutines to be autoloaded were called as plain functions (e.g. C<Foo::bar()>), not -as methods (e.g. C<Foo->bar()> or C<$obj->bar()>). +as methods (e.g. C<Foo-E<gt>bar()> or C<$obj-E<gt>bar()>). This bug will be rectified in Perl 5.005, which will use method lookup only for methods' C<AUTOLOAD>s. However, there is a significant base @@ -2716,7 +2735,7 @@ C<BaseClass>, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during startup. In code that currently says C<use AutoLoader; @ISA = qw(AutoLoader);> you should remove AutoLoader from @ISA and change C<use AutoLoader;> to -C<C<use AutoLoader 'AUTOLOAD';>. +C<use AutoLoader 'AUTOLOAD';>. =item Use of %s is deprecated diff --git a/pod/perlembed.pod b/pod/perlembed.pod index 32096789ec..7876da5ae8 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -20,8 +20,7 @@ Read about back-quotes and about C<system> and C<exec> in L<perlfunc>. =item B<Use Perl from Perl?> -Read about L<perlfunc/do> and L<perlfunc/eval> and L<perlfunc/require> -and L<perlfunc/use>. +Read about do(), eval(), require(), and use() in L<perlfunc>. =item B<Use C from C?> @@ -35,27 +34,49 @@ Read on... =head2 ROADMAP -L<Compiling your C program> +Compiling your C program There's one example in each of the nine sections: -L<Adding a Perl interpreter to your C program> +=over 4 -L<Calling a Perl subroutine from your C program> +=item * -L<Evaluating a Perl statement from your C program> +Adding a Perl interpreter to your C program -L<Performing Perl pattern matches and substitutions from your C program> +=item * -L<Fiddling with the Perl stack from your C program> +Calling a Perl subroutine from your C program -L<Maintaining a persistent interpreter> +=item * -L<Maintaining multiple interpreter instances> +Evaluating a Perl statement from your C program -L<Using Perl modules, which themselves use C libraries, from your C program> +=item * -L<Embedding Perl under Win32> +Performing Perl pattern matches and substitutions from your C program + +=item * + +Fiddling with the Perl stack from your C program + +=item * + +Maintaining a persistent interpreter + +=item * + +Maintaining multiple interpreter instances + +=item * + +Using Perl modules, which themselves use C libraries, from your C program + +=item * + +Embedding Perl under Win32 + +=back =head2 Compiling your C program @@ -96,7 +117,7 @@ Execute this statement for a hint about where to find CORE: perl -MConfig -e 'print $Config{archlib}' Here's how you'd compile the example in the next section, -L<Adding a Perl interpreter to your C program>, on my Linux box: +Adding a Perl interpreter to your C program, on my Linux box: % gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include -I/usr/local/lib/perl5/i586-linux/5.003/CORE @@ -199,8 +220,8 @@ calling I<perl_run()>. =head2 Calling a Perl subroutine from your C program To call individual Perl subroutines, you can use any of the B<perl_call_*> -functions documented in the L<perlcall> manpage. -In this example we'll use I<perl_call_argv>. +functions documented in L<perlcall>. +In this example we'll use perl_call_argv(). That's shown below, in a program I'll call I<showtime.c>. @@ -257,21 +278,20 @@ If you want to pass arguments to the Perl subroutine, you can add strings to the C<NULL>-terminated C<args> list passed to I<perl_call_argv>. For other data types, or to examine return values, you'll need to manipulate the Perl stack. That's demonstrated in the -last section of this document: L<Fiddling with the Perl stack from -your C program>. +last section of this document: Fiddling with the Perl stack from +your C program. =head2 Evaluating a Perl statement from your C program Perl provides two API functions to evaluate pieces of Perl code. -These are L<perlguts/perl_eval_sv()> and L<perlguts/perl_eval_pv()>. +These are perl_eval_sv() and perl_eval_pv(). Arguably, these are the only routines you'll ever need to execute snippets of Perl code from within your C program. Your code can be as long as you wish; it can contain multiple statements; it can employ -L<perlfunc/use>, L<perlfunc/require> and L<perlfunc/do> to include -external Perl files. +use(), require(), and do() to include external Perl files. -I<perl_eval_pv()> lets us evaluate individual Perl strings, and then +perl_eval_pv() lets us evaluate individual Perl strings, and then extract variables for coercion into C types. The following program, I<string.c>, executes three Perl strings, extracting an C<int> from the first, a C<float> from the second, and a C<char *> from the third. @@ -320,7 +340,7 @@ I<SvPV()> to create a string: In the example above, we've created a global variable to temporarily store the computed value of our eval'd expression. It is also possible and in most cases a better strategy to fetch the return value -from L<perl_eval_pv> instead. Example: +from perl_eval_pv() instead. Example: ... SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE); @@ -626,10 +646,10 @@ troubles. One way to avoid namespace collisions in this scenario is to translate the filename into a guaranteed-unique package name, and then compile -the code into that package using L<perlfunc/eval>. In the example +the code into that package using eval(). In the example below, each file will only be compiled once. Or, the application might choose to clean out the symbol table associated with the file -after it's no longer needed. Using L<perlcall/perl_call_argv>, We'll +after it's no longer needed. Using perl_call_argv(), We'll call the subroutine C<Embed::Persistent::eval_file> which lives in the file C<persistent.pl> and pass the filename and boolean cleanup/cache flag as arguments. @@ -640,7 +660,7 @@ conditions that cause Perl's symbol table to grow. You might want to add some logic that keeps track of the process size, or restarts itself after a certain number of requests, to ensure that memory consumption is minimized. You'll also want to scope your variables -with L<perlfunc/my> whenever possible. +with my() whenever possible. package Embed::Persistent; diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index bbc361a5ba..0f73eea978 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -169,7 +169,7 @@ include alt.sources; see their FAQ for details. =head2 Perl Books -A number books on Perl and/or CGI programming are available. A few of +A number of books on Perl and/or CGI programming are available. A few of these are good, some are ok, but many aren't worth your money. Tom Christiansen maintains a list of these books, some with extensive reviews, at http://www.perl.com/perl/critiques/index.html. @@ -314,7 +314,7 @@ to join or leave this list. =item Perl-Packrats Discussion related to archiving of perl materials, particularly the -Comprehensive PerlArchive Network (CPAN). Subscribe by emailing +Comprehensive Perl Archive Network (CPAN). Subscribe by emailing majordomo@cis.ufl.edu: subscribe perl-packrats diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod index 65ebafdea5..7a307594da 100644 --- a/pod/perlfaq3.pod +++ b/pod/perlfaq3.pod @@ -85,7 +85,7 @@ perl-mode for emacs can provide a remarkable amount of help with most (but not all) code, and even less programmable editors can provide significant assistance. -If you are using to using vgrind program for printing out nice code to +If you are used to using vgrind program for printing out nice code to a laser printer, you can take a stab at this using http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the results are not particularly satisfying for sophisticated code. @@ -260,7 +260,7 @@ module written in C can. With the FCGI module (from CPAN), a Perl executable compiled with sfio (see the F<INSTALL> file in the distribution) and the mod_fastcgi module (available from http://www.fastcgi.com/) each of your perl scripts becomes a permanent -CGI daemon processes. +CGI daemon process. Both of these solutions can have far-reaching effects on your system and on the way you write your CGI scripts, so investigate them with diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index a5b505c4a7..4c38d906ba 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -559,7 +559,7 @@ quite a lot of space by using bit strings instead: @articles = ( 1..10, 150..2000, 2017 ); undef $read; - grep (vec($read,$_,1) = 1, @articles); + for (@articles) { vec($read,$_,1) = 1 } Now check whether C<vec($read,$n,1)> is true for some C<$n>. diff --git a/pod/perlfaq5.pod b/pod/perlfaq5.pod index 03d5e6a797..5d71f648de 100644 --- a/pod/perlfaq5.pod +++ b/pod/perlfaq5.pod @@ -802,7 +802,7 @@ files. =head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl? This is elaborately and painstakingly described in the "Far More Than -You Every Wanted To Know" in +You Ever Wanted To Know" in http://www.perl.com/CPAN/doc/FMTEYEWTK/file-dir-perms . The executive summary: learn how your filesystem works. The diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod index 283aa2bb34..d62ee36621 100644 --- a/pod/perlfaq7.pod +++ b/pod/perlfaq7.pod @@ -669,7 +669,7 @@ before Perl has seen that such a package exists. It's wisest to make sure your packages are all defined before you start using them, which will be taken care of if you use the C<use> statement instead of C<require>. If not, make sure to use arrow notation (eg, -C<Guru->find("Samy")>) instead. Object notation is explained in +C<Guru-E<gt>find("Samy")>) instead. Object notation is explained in L<perlobj>. =head2 How can I find out my current package? diff --git a/pod/perlfaq8.pod b/pod/perlfaq8.pod index f4d3c12f6f..dbc1bcd10e 100644 --- a/pod/perlfaq8.pod +++ b/pod/perlfaq8.pod @@ -269,7 +269,7 @@ http://www.perl.com/CPAN/doc/misc/ancient/tutorial/eg/itimers.pl . In general, you may not be able to. The Time::HiRes module (available from CPAN) provides this functionality for some systems. -In general, you may not be able to. But if you system supports both the +In general, you may not be able to. But if your system supports both the syscall() function in Perl as well as a system call like gettimeofday(2), then you may be able to do something like this: @@ -758,8 +758,9 @@ If your version of perl is compiled without dynamic loading, then you just need to replace step 3 (B<make>) with B<make perl> and you will get a new F<perl> binary with your extension linked in. -See L<ExtUtils::MakeMaker> for more details on building extensions, -the question "How do I keep my own module/library directory?" +See L<ExtUtils::MakeMaker> for more details on building extensions +and an answer to the question "How do I keep my own module/library +directory?" =head2 How do I keep my own module/library directory? @@ -778,7 +779,7 @@ See Perl's L<lib> for more information. =head2 How do I add the directory my program lives in to the module/library search path? use FindBin; - use lib "$FindBin:Bin"; + use lib "$FindBin::Bin"; use your_own_modules; =head2 How do I add a directory to my include path at runtime? diff --git a/pod/perlform.pod b/pod/perlform.pod index 7e540b8ff6..0b2a68c3d4 100644 --- a/pod/perlform.pod +++ b/pod/perlform.pod @@ -20,8 +20,8 @@ apart from all the other "types" in Perl. This means that if you have a function named "Foo", it is not the same thing as having a format named "Foo". However, the default name for the format associated with a given filehandle is the same as the name of the filehandle. Thus, the default -format for STDOUT is name "STDOUT", and the default format for filehandle -TEMP is name "TEMP". They just look the same. They aren't. +format for STDOUT is named "STDOUT", and the default format for filehandle +TEMP is named "TEMP". They just look the same. They aren't. Output record formats are declared as follows: diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 1a5e0e6846..6a0f9c2e7d 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -657,7 +657,7 @@ Breaks the binding between a DBM file and a hash. [This function has been superseded by the tie() function.] -This binds a dbm(3), ndbm(3), sdbm(3), gdbm(), or Berkeley DB file to a +This binds a dbm(3), ndbm(3), sdbm(3), gdbm(3), or Berkeley DB file to a hash. HASH is the name of the hash. (Unlike normal open, the first argument is I<NOT> a filehandle, even though it looks like one). DBNAME is the name of the database (without the F<.dir> or F<.pag> extension if @@ -1279,7 +1279,7 @@ you're done. You should reopen those to /dev/null if it's any issue. =item format -Declare a picture format with use by the write() function. For +Declare a picture format for use by the write() function. For example: format Something = @@ -1600,7 +1600,7 @@ Note that, because $_ is a reference into the list value, it can be used to modify the elements of the array. While this is useful and supported, it can cause bizarre results if the LIST is not a named array. Similarly, grep returns aliases into the original list, -much like the way that L<Foreach Loops>'s index variable aliases the list +much like the way that a for loops's index variable aliases the list elements. That is, modifying an element of a list returned by grep (for example, in a C<foreach>, C<map> or another C<grep>) actually modifies the element in the original list. @@ -1812,8 +1812,8 @@ subroutine, C<eval{}>, or C<do>. If more than one value is listed, the list must be placed in parentheses. See L<perlsub/"Temporary Values via local()"> for details, including issues with tied arrays and hashes. -But you really probably want to be using my() instead, because local() isn't -what most people think of as "local"). See L<perlsub/"Private Variables +You really probably want to be using my() instead, because local() isn't +what most people think of as "local". See L<perlsub/"Private Variables via my()"> for details. =item localtime EXPR @@ -2981,7 +2981,7 @@ always sleep the full amount. For delays of finer granularity than one second, you may use Perl's syscall() interface to access setitimer(2) if your system supports it, -or else see L</select()> below. +or else see L</select()> above. See also the POSIX module's sigpause() function. @@ -3175,9 +3175,9 @@ splits on whitespace (after skipping any leading whitespace). Anything matching PATTERN is taken to be a delimiter separating the fields. (Note that the delimiter may be longer than one character.) -If LIMIT is specified and is not negative, splits into no more than -that many fields (though it may split into fewer). If LIMIT is -unspecified, trailing null fields are stripped (which potential users +If LIMIT is specified and is positive, splits into no more than that +many fields (though it may split into fewer). If LIMIT is unspecified +or zero, trailing null fields are stripped (which potential users of pop() would do well to remember). If LIMIT is negative, it is treated as if an arbitrarily large LIMIT had been specified. @@ -3326,7 +3326,7 @@ omitted, uses a semi-random value based on the current time and process ID, among other things. In versions of Perl prior to 5.004 the default seed was just the current time(). This isn't a particularly good seed, so many old programs supply their own seed value (often C<time ^ $$> or -C<time ^ ($$ + ($$ << 15))>), but that isn't necessary any more. +C<time ^ ($$ + ($$ E<lt>E<lt> 15))>), but that isn't necessary any more. In fact, it's usually not necessary to call srand() at all, because if it is not called explicitly, it is called implicitly at the first use of @@ -3476,6 +3476,8 @@ a NAME, it's an anonymous function declaration, and does actually return a value: the CODE ref of the closure you just created. See L<perlsub> and L<perlref> for details. +=item substr EXPR,OFFSET,LEN,REPLACEMENT + =item substr EXPR,OFFSET,LEN =item substr EXPR,OFFSET @@ -3498,6 +3500,12 @@ something longer than LEN, the string will grow to accommodate it. To keep the string the same length you may need to pad or chop your value using sprintf(). +An alternative to using substr() as an lvalue is to specify the +replacement string as the 4th argument. This allows you to replace +parts of the EXPR and return what was there before in one operation. +In this case LEN can be C<undef> if you want to affect everything to +the end of the string. + =item symlink OLDFILE,NEWFILE Creates a new filename symbolically linked to the old filename. @@ -3534,7 +3542,7 @@ Syscall returns whatever value returned by the system call it calls. If the system call fails, syscall returns -1 and sets C<$!> (errno). Note that some system calls can legitimately return -1. The proper way to handle such calls is to assign C<$!=0;> before the call and -check the value of <$!> if syscall returns -1. +check the value of C<$!> if syscall returns -1. There's a problem with C<syscall(&SYS_pipe)>: it returns the file number of the read end of the pipe it creates. There is no way @@ -3628,13 +3636,18 @@ Here's a more elaborate example of analysing the return value from system() on a Unix system to check for all possibilities, including for signals and core dumps. - $rc = 0xffff & system @args; + $! = 0; + $rc = system @args; printf "system(%s) returned %#04x: ", "@args", $rc; if ($rc == 0) { print "ran with normal exit\n"; } elsif ($rc == 0xff00) { - print "command failed: $!\n"; + # Note that $! can be an empty string if the command that + # system() tried to execute was not found, not executable, etc. + # These errors occur in the child process after system() has + # forked, so the errno value is not visible in the parent. + printf "command failed: %s\n", ($! || "Unknown system() error"); } elsif ($rc > 0x80) { $rc >>= 8; @@ -3802,7 +3815,8 @@ If EXPR is omitted, uses $_. =item umask Sets the umask for the process to EXPR and returns the previous value. -If EXPR is omitted, merely returns the current umask. Remember that a +If EXPR is omitted, merely returns the current umask. If umask(2) is +not implemented on your system, returns C<undef>. Remember that a umask is a number, usually given in octal; it is I<not> a string of octal digits. See also L</oct>, if all you have is a string. diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 6edb8b80e1..c27883ffcc 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1326,7 +1326,7 @@ This is converted to a tree similar to this one: / \ $b $c -(but slightly more complicated). This tree reflect the way Perl +(but slightly more complicated). This tree reflects the way Perl parsed your code, but has nothing to do with the execution order. There is an additional "thread" going through the nodes of the tree which shows the order of execution of the nodes. In our simplified @@ -1399,7 +1399,7 @@ and corresponding check routines is described in F<opcode.pl> (do not forget to run C<make regen_headers> if you modify this file). A check routine is called when the node is fully constructed except -for the execution-order thread. Since at this time there is no +for the execution-order thread. Since at this time there are no back-links to the currently constructed node, one can do most any operation to the top-level node, including freeing it and/or creating new nodes above/below it. @@ -1442,7 +1442,7 @@ of free()ing (i.e. their type is changed to OP_NULL). After the compile tree for a subroutine (or for an C<eval> or a file) is created, an additional pass over the code is performed. This pass is neither top-down or bottom-up, but in the execution order (with -additional compilications for conditionals). These optimizations are +additional complications for conditionals). These optimizations are done in the subroutine peep(). Optimizations performed at this stage are subject to the same restrictions as in the pass 2. @@ -1701,7 +1701,7 @@ Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and L<perlcall>. Returns the glob with the given C<name> and a defined subroutine or C<NULL>. The glob lives in the given C<stash>, or in the stashes -accessable via @ISA and @<UNIVERSAL>. +accessable via @ISA and @UNIVERSAL. The argument C<level> should be either 0 or -1. If C<level==0>, as a side-effect creates a glob with the given C<name> in the given diff --git a/pod/perlhist.pod b/pod/perlhist.pod index cbbe0b9cac..60f0a8de26 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -6,7 +6,7 @@ perlhist - the Perl history records =for RCS # -# $Id: perlhist.pod,v 1.31 1998/03/10 16:39:28 jhi Exp $ +# $Id: perlhist.pod,v 1.32 1998/04/04 12:20:50 jhi Exp $ # =end RCS @@ -30,8 +30,8 @@ Perl history in brief, by Larry Wall: =head1 THE KEEPERS OF THE PUMPKIN -Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, -Nick Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie. +Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, Nick +Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie. =head2 PUMPKIN? @@ -272,6 +272,8 @@ the pumpking or the pumpkineer. 5.004_60 1998-Feb-20 5.004_61 1998-Feb-27 5.004_62 1998-Mar-06 + 5.004_63 1998-Mar-17 + 5.004_64 1998-Apr-03 =head2 SELECTED RELEASE SIZES @@ -440,7 +442,7 @@ context diff output format. p54rc1 1997-May-12 8 1 11 p54rc2 1997-May-14 6 0 40 - 5.004 1997-May-15 4 0 4 + 5.004 1997-May-15 4 0 4 Tim 5.004_01 1997-Jun-13 222 14 57 5.004_02 1997-Aug-07 112 16 119 @@ -452,8 +454,9 @@ context diff output format. Jarkko Hietaniemi <F<jhi@iki.fi>>. Thanks to the collective memory of the Perlfolk. In addition to the -Keepers of the Pumpkin also Alan Champion, Andreas König, John +Keepers of the Pumpkin also Alan Champion, Andreas Knig, John Macdonald, Matthias Neeracher, Michael Peppler, Randal Schwartz, and Paul D. Smith sent corrections and additions. =cut + diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 030463c7a0..65818961d8 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -981,9 +981,6 @@ The C<kill> function in the parent's C<if> block is there to send a signal to our child process (current running in the C<else> block) as soon as the remote server has closed its end of the connection. -The C<kill> at the end of the parent's block is there to eliminate the -child process as soon as the server we connect to closes its end. - If the remote server sends data a byte at time, and you need that data immediately without waiting for a newline (which might not happen), you may wish to replace the C<while> loop in the parent with the @@ -1054,7 +1051,7 @@ you'll have to use the C<sysread> variant of the interactive client above. This server accepts one of five different commands, sending output back to the client. Note that unlike most network servers, this one only handles one incoming client at a time. Multithreaded servers are -covered in Chapter 6 of the Camel or in the perlipc(1) manpage. +covered in Chapter 6 of the Camel as well as later in this manpage. Here's the code. We'll diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 70a32e4fe9..2a08835fe8 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -494,7 +494,7 @@ setting, characters like 'E<aelig>', 'E<eth>', 'E<szlig>', and The C<LC_CTYPE> locale also provides the map used in transliterating characters between lower and uppercase. This affects the case-mapping functions - lc(), lcfirst, uc() and ucfirst(); case-mapping -interpolation with C<\l>, C<\L>, C<\u> or <\U> in double-quoted strings +interpolation with C<\l>, C<\L>, C<\u> or C<\U> in double-quoted strings and in C<s///> substitutions; and case-independent regular expression pattern matching using the C<i> modifier. @@ -652,7 +652,7 @@ the locale: Scalar true/false (or less/equal/greater) result is never tainted. -=item B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or <\U>) +=item B<Case-mapping interpolation> (with C<\l>, C<\L>, C<\u> or C<\U>) Result string containing interpolated material is tainted if C<use locale> is in effect. @@ -676,7 +676,7 @@ Has the same behavior as the match operator. Also, the left operand of C<=~> becomes tainted when C<use locale> in effect, if it is modified as a result of a substitution based on a regular expression match involving C<\w>, C<\W>, C<\s>, or C<\S>; or of -case-mapping with C<\l>, C<\L>,C<\u> or <\U>. +case-mapping with C<\l>, C<\L>,C<\u> or C<\U>. =item B<In-memory formatting function> (sprintf()): @@ -754,7 +754,7 @@ of a match involving C<\w> when C<use locale> is in effect. A string that can suppress Perl's warning about failed locale settings at startup. Failure can occur if the locale support in the operating -system is lacking (broken) is some way - or if you mistyped the name of +system is lacking (broken) in some way - or if you mistyped the name of a locale when you set up your environment. If this environment variable is absent, or has a value which does not evaluate to integer zero - that is "0" or "" - Perl will complain about locale setting failures. @@ -906,11 +906,36 @@ operating system upgrade. =head1 SEE ALSO -L<POSIX (3)/isalnum>, L<POSIX (3)/isalpha>, L<POSIX (3)/isdigit>, -L<POSIX (3)/isgraph>, L<POSIX (3)/islower>, L<POSIX (3)/isprint>, -L<POSIX (3)/ispunct>, L<POSIX (3)/isspace>, L<POSIX (3)/isupper>, -L<POSIX (3)/isxdigit>, L<POSIX (3)/localeconv>, L<POSIX (3)/setlocale>, -L<POSIX (3)/strcoll>, L<POSIX (3)/strftime>, L<POSIX (3)/strtod>, +L<POSIX (3)/isalnum> + +L<POSIX (3)/isalpha> + +L<POSIX (3)/isdigit> + +L<POSIX (3)/isgraph> + +L<POSIX (3)/islower> + +L<POSIX (3)/isprint>, + +L<POSIX (3)/ispunct> + +L<POSIX (3)/isspace> + +L<POSIX (3)/isupper>, + +L<POSIX (3)/isxdigit> + +L<POSIX (3)/localeconv> + +L<POSIX (3)/setlocale>, + +L<POSIX (3)/strcoll> + +L<POSIX (3)/strftime> + +L<POSIX (3)/strtod>, + L<POSIX (3)/strxfrm> =head1 HISTORY diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod index 14bb7ebfa4..6e4da5e307 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -998,8 +998,8 @@ Please remember to send me an updated entry for the Module list! =item Take care when changing a released module. -Always strive to remain compatible with previous released versions -(see 2.2 above) Otherwise try to add a mechanism to revert to the +Always strive to remain compatible with previous released versions. +Otherwise try to add a mechanism to revert to the old behaviour if people rely on it. Document incompatible changes. =back diff --git a/pod/perlop.pod b/pod/perlop.pod index 4781b7fbbe..69e4fcb0d9 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -599,7 +599,7 @@ a transliteration, the first ten of these sequences may be used. \Q quote regexp metacharacters till \E If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u> -and <\U> is taken from the current locale. See L<perllocale>. +and C<\U> is taken from the current locale. See L<perllocale>. Patterns are subject to an additional level of interpretation as a regular expression. This is done as a second pass, after variables are @@ -897,7 +897,7 @@ text is not evaluated as a command. If the PATTERN is delimited by bracketing quotes, the REPLACEMENT has its own pair of quotes, which may or may not be bracketing quotes, e.g., C<s(foo)(bar)> or C<sE<lt>fooE<gt>/bar/>. A C</e> will cause the -replacement portion to be interpreter as a full-fledged Perl expression +replacement portion to be interpreted as a full-fledged Perl expression and eval()ed right then and there. It is, however, syntax checked at compile-time. @@ -1031,7 +1031,7 @@ an eval(): =head2 I/O Operators There are several I/O operators you should know about. -A string is enclosed by backticks (grave accents) first undergoes +A string enclosed by backticks (grave accents) first undergoes variable substitution just like a double quoted string. It is then interpreted as a command, and the output of that command is the value of the pseudo-literal, like in a shell. In a scalar context, a single @@ -1054,17 +1054,35 @@ Ordinarily you must assign that value to a variable, but there is one situation where an automatic assignment happens. I<If and ONLY if> the input symbol is the only thing inside the conditional of a C<while> or C<for(;;)> loop, the value is automatically assigned to the variable -C<$_>. The assigned value is then tested to see if it is defined. -(This may seem like an odd thing to you, but you'll use the construct -in almost every Perl script you write.) Anyway, the following lines -are equivalent to each other: +C<$_>. In these loop constructs, the assigned value (whether assignment +is automatic or explcit) is then tested to see if it is defined. +The defined test avoids problems where line has a string value +that would be treated as false by perl e.g. "" or "0" with no trailing +newline. (This may seem like an odd thing to you, but you'll use the +construct in almost every Perl script you write.) Anyway, the following +lines are equivalent to each other: while (defined($_ = <STDIN>)) { print; } + while ($_ = <STDIN>) { print; } while (<STDIN>) { print; } for (;<STDIN>;) { print; } print while defined($_ = <STDIN>); + print while ($_ = <STDIN>); print while <STDIN>; +and this also behaves similarly, but avoids the use of $_ : + + while (my $line = <STDIN>) { print $line } + +If you really mean such values to terminate the loop they should be +tested for explcitly: + + while (($_ = <STDIN>) ne '0') { ... } + while (<STDIN>) { last unless $_; ... } + +In other boolean contexts C<E<lt>I<filehandle>E<gt>> without explcit C<defined> +test or comparison will solicit a warning if C<-w> is in effect. + The filehandles STDIN, STDOUT, and STDERR are predefined. (The filehandles C<stdin>, C<stdout>, and C<stderr> will also work except in packages, where they would be interpreted as local identifiers rather @@ -1124,9 +1142,9 @@ Getopts modules or put a loop on the front like this: ... # code for each line } -The E<lt>E<gt> symbol will return FALSE only once. If you call it again after -this it will assume you are processing another @ARGV list, and if you -haven't set @ARGV, will input from STDIN. +The E<lt>E<gt> symbol will return C<undef> for end-of-file only once. +If you call it again after this it will assume you are processing another +@ARGV list, and if you haven't set @ARGV, will input from STDIN. If the string inside the angle brackets is a reference to a scalar variable (e.g., E<lt>$fooE<gt>), then that variable contains the name of the @@ -1174,9 +1192,12 @@ A glob evaluates its (embedded) argument only when it is starting a new list. All values must be read before it will start over. In a list context this isn't important, because you automatically get them all anyway. In a scalar context, however, the operator returns the next value -each time it is called, or a FALSE value if you've just run out. Again, -FALSE is returned only once. So if you're expecting a single value from -a glob, it is much better to say +each time it is called, or a C<undef> value if you've just run out. As +for filehandles an automatic C<defined> is generated when the glob +occurs in the test part of a C<while> or C<for> - because legal glob returns +(e.g. a file called F<0>) would otherwise terminate the loop. +Again, C<undef> is returned only once. So if you're expecting a single value +from a glob, it is much better to say ($file) = <blurch*>; diff --git a/pod/perlre.pod b/pod/perlre.pod index 95da75d95f..f029cbecc1 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -34,6 +34,13 @@ line anywhere within the string, Treat string as single line. That is, change "." to match any character whatsoever, even a newline, which it normally would not match. +The /s and /m modifiers both override the C<$*> setting. That is, no matter +what C<$*> contains, /s (without /m) will force "^" to match only at the +beginning of the string and "$" to match only at the end (or just before a +newline at the end) of the string. Together, as /ms, they let the "." match +any character whatsoever, while yet allowing "^" and "$" to match, +respectively, just after and just before newlines within the string. + =item x Extend your pattern's legibility by permitting whitespace and comments. @@ -139,7 +146,7 @@ also work: \Q quote (disable) regexp metacharacters till \E If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u> -and <\U> is taken from the current locale. See L<perllocale>. +and C<\U> is taken from the current locale. See L<perllocale>. In addition, Perl defines the following: @@ -238,7 +245,7 @@ non-alphanumeric characters: $pattern =~ s/(\W)/\\$1/g; Now it is much more common to see either the quotemeta() function or -the \Q escape sequence used to disable the metacharacters special +the C<\Q> escape sequence used to disable all metacharacters' special meanings like this: /$unquoted\Q$quoted\E$unquoted/ @@ -278,14 +285,15 @@ matches a word followed by a tab, without including the tab in C<$&>. A zero-width negative lookahead assertion. For example C</foo(?!bar)/> matches any occurrence of "foo" that isn't followed by "bar". Note however that lookahead and lookbehind are NOT the same thing. You cannot -use this for lookbehind. If you are looking for a "bar" which isn't preceeded -"foo", C</(?!foo)bar/> will not do what you want. That's because -the C<(?!foo)> is just saying that the next thing cannot be "foo"--and -it's not, it's a "bar", so "foobar" will match. You would have to do -something like C</(?!foo)...bar/> for that. We say "like" because there's -the case of your "bar" not having three characters before it. You could -cover that this way: C</(?:(?!foo)...|^.{0,2})bar/>. Sometimes it's still -easier just to say: +use this for lookbehind. + +If you are looking for a "bar" which isn't preceded by a "foo", C</(?!foo)bar/> +will not do what you want. That's because the C<(?!foo)> is just saying that +the next thing cannot be "foo"--and it's not, it's a "bar", so "foobar" will +match. You would have to do something like C</(?!foo)...bar/> for that. We +say "like" because there's the case of your "bar" not having three characters +before it. You could cover that this way: C</(?:(?!foo)...|^.{0,2})bar/>. +Sometimes it's still easier just to say: if (/bar/ && $` !~ /foo$/) diff --git a/pod/perlref.pod b/pod/perlref.pod index 6aa086088d..51807e2b8d 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -15,9 +15,9 @@ hashes, hashes of arrays, arrays of hashes of functions, and so on. Hard references are smart--they keep track of reference counts for you, automatically freeing the thing referred to when its reference count goes -to zero. (Note: The reference counts for values in self-referential or +to zero. (Note: the reference counts for values in self-referential or cyclic data structures may not go to zero without a little help; see -L<perlobj/"Two-Phased Garbage Collection"> for a detailed explanation. +L<perlobj/"Two-Phased Garbage Collection"> for a detailed explanation.) If that thing happens to be an object, the object is destructed. See L<perlobj> for more about objects. (In a sense, everything in Perl is an object, but we usually reserve the word for references to objects that diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 4bb55bceeb..84ce270e3e 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -332,7 +332,7 @@ know when the filename has changed. It does, however, use ARGVOUT for the selected filehandle. Note that STDOUT is restored as the default output filehandle after the loop. -You can use C<eof> without parenthesis to locate the end of each input file, +You can use C<eof> without parentheses to locate the end of each input file, in case you want to append to each file, or reset line numbering (see example in L<perlfunc/eof>). diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod index 5ad73cfafe..cf280ce1da 100644 --- a/pod/perlstyle.pod +++ b/pod/perlstyle.pod @@ -242,7 +242,7 @@ to fit on one line anyway. Always check the return codes of system calls. Good error messages should go to STDERR, include which program caused the problem, what the failed -system call and arguments were, and VERY IMPORTANT) should contain the +system call and arguments were, and (VERY IMPORTANT) should contain the standard system error message for what went wrong. Here's a simple but sufficient example: diff --git a/pod/perlsub.pod b/pod/perlsub.pod index c66bcb6e97..7212bb5907 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -159,7 +159,7 @@ Do not, however, be tempted to do this: Because like its flat incoming parameter list, the return list is also flat. So all you have managed to do here is stored everything in @a and -made @b an empty list. See L</"Pass by Reference"> for alternatives. +made @b an empty list. See L<Pass by Reference> for alternatives. A subroutine may be called using the "&" prefix. The "&" is optional in modern Perls, and so are the parentheses if the subroutine has been diff --git a/pod/perltoot.pod b/pod/perltoot.pod index 3a35c05b90..90ef81ae26 100644 --- a/pod/perltoot.pod +++ b/pod/perltoot.pod @@ -315,7 +315,7 @@ be made through methods. Perl doesn't impose restrictions on who gets to use which methods. The public-versus-private distinction is by convention, not syntax. (Well, unless you use the Alias module described below in -L</"Data Members as Variables">.) Occasionally you'll see method names beginning or ending +L<Data Members as Variables>.) Occasionally you'll see method names beginning or ending with an underscore or two. This marking is a convention indicating that the methods are private to that class alone and sometimes to its closest acquaintances, its immediate subclasses. But this distinction diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 36b4ec47b6..2cb95afe05 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -413,6 +413,9 @@ C<$? & 255> gives which signal, if any, the process died from, and whether there was a core dump. (Mnemonic: similar to B<sh> and B<ksh>.) +Additionally, if the C<h_errno> variable is supported in C, its value +is returned via $? if any of the C<gethost*()> functions fail. + Note that if you have installed a signal handler for C<SIGCHLD>, the value of C<$?> will usually be wrong outside that handler. @@ -821,7 +824,7 @@ The C<__DIE__> handler is explicitly disabled during the call, so that you can die from a C<__DIE__> handler. Similarly for C<__WARN__>. Note that the C<$SIG{__DIE__}> hook is called even inside eval()ed -blocks/strings. See L<perlfunc/die>, L<perlvar/$^S> for how to +blocks/strings. See L<perlfunc/die> and L<perlvar/$^S> for how to circumvent this. Note that C<__DIE__>/C<__WARN__> handlers are very special in one diff --git a/pod/perlxs.pod b/pod/perlxs.pod index d065b94425..2f4be67a1e 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -25,6 +25,11 @@ linked. See L<perlxstut> for a tutorial on the whole extension creation process. +Note: For many extensions, Dave Beazley's SWIG system provides a +significantly more convenient mechanism for creating the XS glue +code. See L<http://www.cs.utah.edu/~beazley/SWIG> for more +information. + =head2 On The Road Many of the examples which follow will concentrate on creating an interface @@ -598,7 +603,7 @@ of $timep will either be undef or it will be a valid time. $timep = rpcb_gettime( "localhost" ); -The following XSUB uses the C<SV *> return type as a mneumonic only, +The following XSUB uses the C<SV *> return type as a mnemonic only, and uses a CODE: block to indicate to the compiler that the programmer has supplied all the necessary code. The sv_newmortal() call will initialize the return value to undef, making that diff --git a/pod/pod2man.PL b/pod/pod2man.PL index a91d3e585e..42ad9f917c 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -736,7 +736,7 @@ while (<>) { # first hide the escapes in case we need to # intuit something and get it wrong due to fmting - s/([A-Z]<[^<>]*>)/noremap($1)/ge; + 1 while s/([A-Z]<[^<>]*>)/noremap($1)/ge; # func() is a reference to a perl function s{ diff --git a/pod/roffitall b/pod/roffitall index cbd19af4fe..244048af2d 100644 --- a/pod/roffitall +++ b/pod/roffitall @@ -199,3 +199,4 @@ eval $run $toroff rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" + @@ -507,8 +507,14 @@ PP(pp_bless) if (MAXARG == 1) stash = curcop->cop_stash; - else - stash = gv_stashsv(POPs, TRUE); + else { + SV *ssv = POPs; + STRLEN len; + char *ptr = SvPV(ssv,len); + if (dowarn && len == 0) + warn("Explicit blessing to '' (assuming package main)"); + stash = gv_stashpvn(ptr, len, TRUE); + } (void)sv_bless(TOPs, stash); RETURN; @@ -1783,6 +1789,7 @@ PP(pp_substr) djSP; dTARGET; SV *sv; I32 len; + I32 len_ok = 0; STRLEN curlen; I32 pos; I32 rem; @@ -1790,10 +1797,25 @@ PP(pp_substr) I32 lvalue = op->op_flags & OPf_MOD; char *tmps; I32 arybase = curcop->cop_arybase; + char *repl = 0; + STRLEN repl_len; SvTAINTED_off(TARG); /* decontaminate */ - if (MAXARG > 2) + if (MAXARG > 3) { + /* pop off replacement string */ + sv = POPs; + repl = SvPV(sv, repl_len); + /* pop off length */ + sv = POPs; + if (SvOK(sv)) { + len = SvIV(sv); + len_ok++; + } + } else if (MAXARG == 3) { len = POPi; + len_ok++; + } + pos = POPi; sv = POPs; PUTBACK; @@ -1802,7 +1824,7 @@ PP(pp_substr) pos -= arybase; rem = curlen-pos; fail = rem; - if (MAXARG > 2) { + if (len_ok) { if (len < 0) { rem += len; if (rem < 0) @@ -1814,7 +1836,7 @@ PP(pp_substr) } else { pos += curlen; - if (MAXARG < 3) + if (!len_ok) rem = curlen; else if (len >= 0) { rem = pos+len; @@ -1832,7 +1854,7 @@ PP(pp_substr) rem -= pos; } if (fail < 0) { - if (dowarn || lvalue) + if (dowarn || lvalue || repl) warn("substr outside of string"); RETPUSHUNDEF; } @@ -1862,6 +1884,8 @@ PP(pp_substr) LvTARGOFF(TARG) = pos; LvTARGLEN(TARG) = rem; } + else if (repl) + sv_insert(sv, pos, rem, repl, repl_len); } SPAGAIN; PUSHs(TARG); /* avoid SvSETMAGIC here */ @@ -464,7 +464,7 @@ PP(pp_umask) TAINT_PROPER("umask"); XPUSHi(anum); #else - DIE(no_func, "Unsupported function umask"); + XPUSHs(&sv_undef) #endif RETURN; } @@ -17,6 +17,7 @@ chdir 't' if -f 't/TEST'; die "You need to run \"make test\" first to set things up.\n" unless -e 'perl' or -e 'perl.exe'; +#$ENV{PERL_DESTRUCT_LEVEL} = '2'; $ENV{EMXSHELL} = 'sh'; # For OS/2 if ($#ARGV == -1) { @@ -4,7 +4,7 @@ # various typeglob tests # -print "1..18\n"; +print "1..16\n"; # type coersion on assignment $foo = 'foo'; @@ -71,7 +71,7 @@ $foo = 'stuff'; @foo = qw(more stuff); %foo = qw(even more random stuff); undef *foo; -print +($foo || @foo || %foo) ? "not ok" : "ok", " 16\n"; +print +($foo || @foo || %foo) ? "not ok" : "ok", " 14\n"; # test warnings from assignment of undef to glob { @@ -79,7 +79,7 @@ print +($foo || @foo || %foo) ? "not ok" : "ok", " 16\n"; local $SIG{__WARN__} = sub { $msg = $_[0] }; local $^W = 1; *foo = 'bar'; - print $msg ? "not ok" : "ok", " 17\n"; + print $msg ? "not ok" : "ok", " 15\n"; *foo = undef; - print $msg ? "ok" : "not ok", " 18\n"; + print $msg ? "ok" : "not ok", " 16\n"; } diff --git a/t/op/substr.t b/t/op/substr.t index bb655f5209..967016a8d0 100755 --- a/t/op/substr.t +++ b/t/op/substr.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: substr.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:31 $ - -print "1..97\n"; +print "1..100\n"; #P = start of string Q = start of substr R = end of substr S = end of string @@ -178,3 +176,13 @@ for (0,1) { # check no spurious warnings print $w ? "not ok 97\n" : "ok 97\n"; + +# check new replacement syntax +$a = "abcxyz"; +print "not " unless substr($a, 0, 3, "") eq "abc" && $a eq "xyz"; +print "ok 98\n"; +print "not " unless substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz"; +print "ok 99\n"; +print "not " unless substr($a, 3, undef, "") eq "xyz" && $a eq "abc"; +print "ok 100\n"; + @@ -196,7 +196,7 @@ prime_env_iter(void) # define CLI$M_TRUSTED 0x40 /* Missing from VAXC headers */ #endif unsigned long int flags = CLI$M_NOWAIT | CLI$M_NOCLISYM | CLI$M_NOKEYPAD | CLI$M_TRUSTED; - unsigned long int retsts, substs = 0, wakect = 0; + unsigned long int i, retsts, substs = 0, wakect = 0; STRLEN eqvlen; SV *oldrs, *linesv, *eqvsv; $DESCRIPTOR(cmddsc,"Show Logical *"); $DESCRIPTOR(nldsc,"_NLA0:"); @@ -212,12 +212,18 @@ prime_env_iter(void) /* Perform a dummy fetch as an lval to insure that the hash table is * set up. Otherwise, the hv_store() will turn into a nullop. */ (void) hv_fetch(envhv,"DEFAULT",7,TRUE); - /* Also, set up the four "special" keys that the CRTL defines, - * whether or not underlying logical names exist. */ - (void) hv_fetch(envhv,"HOME",4,TRUE); - (void) hv_fetch(envhv,"TERM",4,TRUE); - (void) hv_fetch(envhv,"PATH",4,TRUE); - (void) hv_fetch(envhv,"USER",4,TRUE); + /* Also, set up any "special" keys that the CRTL defines, + * either by itself or becasue we were called from a C program + * using exec[lv]e() */ + for (i = 0; environ[i]; i++) { + if (!(start = strchr(environ[i],'='))) { + warn("Ill-formed CRTL environ value \"%s\"\n",environ[i]); + } + else { + start++; + (void) hv_store(envhv,environ[i],start - environ[i] - 1,newSVpv(start,0),0); + } + } /* Now, go get the logical names */ create_mbx(&chan,&mbxdsc); diff --git a/x2p/find2perl.PL b/x2p/find2perl.PL index c23fc923a8..ea13c710f9 100644 --- a/x2p/find2perl.PL +++ b/x2p/find2perl.PL @@ -26,7 +26,7 @@ print "Extracting $file (with variable substitutions)\n"; print OUT <<"!GROK!THIS!"; $Config{startperl} eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' - if \$running_under_some_shell; + if \$running_under_some_shell; \$startperl = "$Config{startperl}"; \$perlpath = "$Config{perlpath}"; !GROK!THIS! @@ -34,10 +34,16 @@ $Config{startperl} # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; + # # Modified September 26, 1993 to provide proper handling of years after 1999 # Tom Link <tml+@pitt.edu> # University of Pittsburgh +# +# Modified April 7, 1998 with nasty hacks to implement the troublesome -follow +# Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au> +# University of Adelaide, Adelaide, South Australia +# while ($ARGV[0] =~ /^[^-!(]/) { push(@roots, shift); @@ -47,6 +53,8 @@ for (@roots) { $_ = "e($_); } $roots = join(',', @roots); $indent = 1; +$stat = 'lstat'; +$decl = ''; while (@ARGV) { $_ = shift; @@ -60,6 +68,12 @@ while (@ARGV) { $indent--; $out .= &tab . ")"; } + elsif ($_ eq 'follow') { + $stat = 'stat'; + $decl = '%already_seen = ();'; + $out .= &tab . '(not $already_seen{"$dev,$ino"}) &&'; + $out .= "\n" . &tab . '(($already_seen{"$dev,$ino"} = !(-d _)) || 1)'; + } elsif ($_ eq '!') { $out .= &tab . "!"; next; @@ -178,7 +192,7 @@ while (@ARGV) { $file = shift; $newername = 'AGE_OF' . $file; $newername =~ s/[^\w]/_/g; - $newername = '$' . $newername; + $newername = "\$$newername"; $out .= "(-M _ < $newername)"; $initnewer .= "$newername = -M " . "e($file) . ";\n"; } @@ -278,10 +292,10 @@ require "$find.pl"; # Traverse desired filesystems +$decl &$find($roots); $flushall exit; - sub wanted { $out; } @@ -312,10 +326,11 @@ END } if ($initls) { - print <<'END'; + print <<"INTERP", <<'END'; sub ls { - ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm, - $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_); + (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$sizemm, + \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\); +INTERP $pname = $name; @@ -380,7 +395,7 @@ END } if ($initcpio) { -print <<'END'; +print <<'START', <<"INTERP", <<'END'; sub cpio { local($nc,$fh) = @_; local($text); @@ -390,8 +405,10 @@ sub cpio { $size = 0; } else { - ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_); +START + (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size, + \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\); +INTERP if (-f _) { open(IN, "./$_\0") || do { warn "Couldn't open $name: $!\n"; @@ -465,14 +482,16 @@ END } if ($inittar) { -print <<'END'; +print <<'START', <<"INTERP", <<'END'; sub tar { local($fh) = @_; local($linkname,$header,$l,$slop); local($linkflag) = "\0"; - ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_); +START + (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size, + \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\); +INTERP $nm = $name; if ($nlink > 1) { if ($linkname = $linkseen{$fh,$dev,$ino}) { @@ -561,13 +580,13 @@ sub tab { } else { if ($saw_or) { - $tabstring .= <<'ENDOFSTAT' . $tabstring; -($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && + $tabstring .= <<"ENDOFSTAT" . $tabstring; +(\$nlink || ((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\))) && ENDOFSTAT } else { - $tabstring .= <<'ENDOFSTAT' . $tabstring; -(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && + $tabstring .= <<"ENDOFSTAT" . $tabstring; +((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\)) && ENDOFSTAT } $statdone = 1; |