diff options
| author | Tim Bunce <TimBunce@ig.ac.uk> | 1998-04-22 23:49:24 +0000 |
|---|---|---|
| committer | Tim Bunce <TimBunce@ig.ac.uk> | 1998-04-22 23:49:24 +0000 |
| commit | 4cb32042c1172b6aa007e88ab04c91f21bb59518 (patch) | |
| tree | 0b5c91aa42e9072c256a3ee191104ab19e96a2c7 | |
| parent | 414645906186700eee37c3af6cbb7d1018ca6582 (diff) | |
| download | perl-4cb32042c1172b6aa007e88ab04c91f21bb59518.tar.gz | |
[difference between patch application from Change 896 and Change 897]
------ CORE LANGUAGE ------
Title: "fix for "Unbalanced string table refcount""
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Msg-ID: <199804042251.RAA25527@aatma.engin.umich.edu>
Files: sv.c
(applied based on p5p message as 45b0f2da05a0069bf1df601ff96ee525f651b435)
Title: "Add fourth arg to substr: substr EXPR,OFFSET,LEN,REPLACEMENT"
From: Gisle Aas <gisle@aas.no>
Msg-ID: <m3g1jglqtm.fsf@furu.g.aas.no>
Files: pod/perlfunc.pod Todo opcode.pl pp.c t/op/substr.t
Title: "Odd number of elements in hash list."
From: Tom Phoenix <rootbeer@teleport.com>
Msg-ID: <Pine.GSO.3.96.980328151929.29336D-100000@user2.teleport.com>
Files: MANIFEST pod/perldiag.pod pp.c pp_hot.c t/op/hashwarn.t
(applied based on p5p message as 4e6dd09136b96d3e6f8fc8cf5af2dc3e32c65eec)
Title: "bidirectional pipe warning blues"
From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
Msg-ID: <9804082151.AA20399@claudius.bfsec.bt.co.uk>
Files: doio.c
(applied based on p5p message as 610d1f920220f1a98002175088e769d3d561e68a)
Title: "warning for: bless $foo, """
From: Joshua.Pritikin@NewYork2.dmg.deuba.com
Msg-ID: <H00000e5000378a0@MHS>
Files: pod/perldiag.pod pp.c
------ DOCUMENTATION ------
Title: "long list of man page nitpicks"
From: Greg Bacon <gbacon@mickey.cs.uah.edu>, Tom Christiansen
<tchrist@jhereg.perl.com>
Msg-ID: <199804221844.NAA08338@pluto.cs.uah.edu>,
<199804222204.QAA20805@jhereg.perl.com>
Files: pod/perlapio.pod pod/perlcall.pod pod/perldebug.pod pod/perldelta.pod
pod/perldiag.pod pod/perlembed.pod pod/perlfaq2.pod
pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
pod/perlfaq7.pod pod/perlfaq8.pod pod/perlform.pod
pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod
pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod
pod/perlre.pod pod/perlref.pod pod/perlrun.pod
pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod
pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod
pod/pod2man.PL
[one change was applied as
d340c03c5edfa005a10d99f0986879c79286ca07]
Title: "document that system() does not set $! when it fails"
From: "Mark R. Levinson" <mrl@isc.upenn.edu>
Msg-ID: <199803011946.OAA31942@anaximander.dccs.upenn.edu>
Files: pod/perlfunc.pod
Title: "Fix pod/roffitall execute permission"
From: lvirden@cas.org
Msg-ID: <1997Nov17.132031.2589892@cor.newman>
Files: pod/roffitall
Title: "document when split ignores trailing empty fields"
From: Hugo van der Sanden <hv@crypt0.demon.co.uk>
Msg-ID: <l03130300b14fac832b77@[194.222.64.89]>
Files: pod/perlfunc.pod
------ EXTENSIONS ------
Title: "Buglet in Opcode.pm documentation"
From: Horst von Brand <vonbrand@sleipnir.valparaiso.cl>
Msg-ID: <199804170349.XAA32445@sleipnir.valparaiso.cl>
Files: ext/Opcode/Opcode.pm
(applied based on p5p message as eff8350db965b7b9ea400107c5d354b9651e0a46)
Title: "Failure to append to perllocal.pod should not be fatal"
From: koenig@kulturbox.de (Andreas J. Koenig)
Msg-ID: <sfciuogy67x.fsf@dubravka.in-berlin.de>
Files: lib/ExtUtils/MM_Unix.pm
------ PORTABILITY - GENERAL ------
Title: "Add Social Contract (2nd Draft) as Porting/Contract"
From: Russ Allbery <rra@stanford.edu>
Msg-ID: <m3btw66n8i.fsf@windlord.Stanford.EDU>
Files: Porting/Contract
Title: "VMS patches to 5.004_03"
From: Charles Bailey <BAILEY@newman.upenn.edu>
Msg-ID: <01IVYJS0L8D200209B@cor.newman.upenn.edu>
Files: vms/vms.c
Title: "hints/netbsd.sh - enable vfork"
From: Andy Dougherty <doughera@lafcol.lafayette.edu>
Msg-ID: <Pine.SUN.3.96.980417110749.19327B-100000@newton.phys>
Files: hints/netbsd.sh
p4raw-link: @896 on //depot/maint-5.004/perl: 0562b9ae2b0eff79632fc0164c13c34c06a019e2
p4raw-id: //depot/maint-5.004/perl@897
44 files changed, 580 insertions, 264 deletions
@@ -723,6 +723,7 @@ t/op/glob.t See if <*> works t/op/goto.t See if goto works t/op/groups.t See if $( works t/op/gv.t See if typeglobs work +t/op/hashwarn.t See if hash warnings work t/op/inc.t See if inc/dec of integers near 32 bit limit work t/op/index.t See if index works t/op/int.t See if int works diff --git a/Porting/Contract b/Porting/Contract new file mode 100644 index 0000000000..cc91af26bc --- /dev/null +++ b/Porting/Contract @@ -0,0 +1,108 @@ + + Contributed Modules in Perl Core + A Social Contract about Artistic Control + +What follows is a statement about artistic control, defined as the ability +of authors of packages to guide the future of their code and maintain +control over their work. It is a recognition that authors should have +control over their work, and that it is a responsibility of the rest of +the Perl community to ensure that they retain this control. It is an +attempt to document the standards to which we, as Perl developers, intend +to hold ourselves. It is an attempt to write down rough guidelines about +the respect we owe each other as Perl developers. + +This statement is not a legal contract. This statement is not a legal +document in any way, shape, or form. Perl is distributed under the GNU +Public License and under the Artistic License; those are the precise legal +terms. This statement isn't about the law or licenses. It's about +community, mutual respect, trust, and good-faith cooperation. + +We recognize that the Perl core, defined as the software distributed with +the heart of Perl itself, is a joint project on the part of all of us. +>From time to time, a script, module, or set of modules (hereafter referred +to simply as a "module") will prove so widely useful and/or so integral to +the correct functioning of Perl itself that it should be distributed with +Perl core. This should never be done without the author's explicit +consent, and a clear recognition on all parts that this means the module +is being distributed under the same terms as Perl itself. A module author +should realize that inclusion of a module into the Perl core will +necessarily mean some loss of control over it, since changes may +occasionally have to be made on short notice or for consistency with the +rest of Perl. + +Once a module has been included in the Perl core, however, everyone +involved in maintaining Perl should be aware that the module is still the +property of the original author unless the original author explicitly +gives up their ownership of it. In particular: + + 1) The version of the module in the core should still be considered the + work of the original author. All patches, bug reports, and so forth + should be fed back to them. Their development directions should be + respected whenever possible. + + 2) Patches may be applied by the pumpkin holder without the explicit + cooperation of the module author if and only if they are very minor, + time-critical in some fashion (such as urgent security fixes), or if + the module author cannot be reached. Those patches must still be + given back to the author when possible, and if the author decides on + an alternate fix in their version, that fix should be strongly + preferred unless there is a serious problem with it. Any changes not + endorsed by the author should be marked as such, and the contributor + of the change acknowledged. + + 3) The version of the module distributed with Perl should, whenever + possible, be the latest version of the module as distributed by the + author (the latest non-beta version in the case of public Perl + releases), although the pumpkin holder may hold off on upgrading the + version of the module distributed with Perl to the latest version + until the latest version has had sufficient testing. + +In other words, the author of a module should be considered to have final +say on modifications to their module whenever possible (bearing in mind +that it's expected that everyone involved will work together and arrive at +reasonable compromises when there are disagreements). + +As a last resort, however: + + 4) If the author's vision of the future of their module is sufficiently + different from the vision of the pumpkin holder and perl5-porters as a + whole so as to cause serious problems for Perl, the pumpkin holder may + choose to formally fork the version of the module in the core from the + one maintained by the author. This should not be done lightly and + should *always* if at all possible be done only after direct input + from Larry. If this is done, it must then be made explicit in the + module as distributed with Perl core that it is a forked version and + that while it is based on the original author's work, it is no longer + maintained by them. This must be noted in both the documentation and + in the comments in the source of the module. + +Again, this should be a last resort only. Ideally, this should never +happen, and every possible effort at cooperation and compromise should be +made before doing this. If it does prove necessary to fork a module for +the overall health of Perl, proper credit must be given to the original +author in perpetuity and the decision should be constantly re-evaluated to +see if a remerging of the two branches is possible down the road. + +In all dealings with contributed modules, everyone maintaining Perl should +keep in mind that the code belongs to the original author, that they may +not be on perl5-porters at any given time, and that a patch is not +official unless it has been integrated into the author's copy of the +module. To aid with this, and with points #1, #2, and #3 above, contact +information for the authors of all contributed modules should be kept with +the Perl distribution. + +Finally, the Perl community as a whole recognizes that respect for +ownership of code, respect for artistic control, proper credit, and active +effort to prevent unintentional code skew or communication gaps is vital +to the health of the community and Perl itself. Members of a community +should not normally have to resort to rules and laws to deal with each +other, and this document, although it contains rules so as to be clear, is +about an attitude and general approach. The first step in any dispute +should be open communication, respect for opposing views, and an attempt +at a compromise. In nearly every circumstance nothing more will be +necessary, and certainly no more drastic measure should be used until +every avenue of communication and discussion has failed. + +-- +Version 1.2. By Russ Allbery (rra@stanford.edu) and the perl5-porters. + @@ -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 Possible pragmas debugger @@ -54,5 +55,4 @@ Vague possibilities structured types autocroak? Modifiable $1 et al - substr EXPR,OFFSET,LENGTH,STRING @@ -179,7 +179,7 @@ PerlIO *supplied_fp; TAINT_PROPER("piped open"); if (name[strlen(name)-1] == '|') { name[strlen(name)-1] = '\0' ; - if (dowarn) + if (dowarn) warn("Can't do bidirectional pipe"); } fp = my_popen(name,"w"); @@ -146,6 +146,7 @@ #define div_amg Perl_div_amg #define div_ass_amg Perl_div_ass_amg #define do_aexec Perl_do_aexec +#define do_binmode Perl_do_binmode #define do_chomp Perl_do_chomp #define do_chop Perl_do_chop #define do_close Perl_do_close @@ -203,6 +204,7 @@ #define filter_add Perl_filter_add #define filter_del Perl_filter_del #define filter_read Perl_filter_read +#define find_script Perl_find_script #define fold Perl_fold #define fold_constants Perl_fold_constants #define fold_locale Perl_fold_locale diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 6f37780b35..82bf71e80f 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -563,7 +563,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/hints/netbsd.sh b/hints/netbsd.sh index 974a5c16ee..1782f88030 100644 --- a/hints/netbsd.sh +++ b/hints/netbsd.sh @@ -65,6 +65,10 @@ case "$osvers" in ;; esac +# vfork is ok on NetBSD. +case "$usevfork" in +'') usevfork=true ;; +esac # Avoid telldir prototype conflict in pp_sys.c (NetBSD uses const DIR *) # Configure should test for this. Volunteers? pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' @@ -848,7 +848,6 @@ register HE *entry; if (HeVAL(entry) && isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv)) sub_generation++; /* may be deletion of method from stash */ SvREFCNT_dec(HeVAL(entry)); - if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); Safefree(HeKEY_hek(entry)); diff --git a/lib/Carp.pm b/lib/Carp.pm index 93945c1c6e..6397d1b999 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -47,21 +47,14 @@ 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. @@ -74,36 +67,28 @@ 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 function will be called by the Exporter which knows +# 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 { - # get rid of the package name passed implicitly shift; if ($_[0] eq 'verbose') { - # disable warnings to avoid "sub-routine redefined..." warning - local $^W = 0; - # set shortmess() as an alias to longmess() - *shortmess = \&longmess; - # remove 'verbose' from the args to keep Exporter happy - 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 '', @_; @@ -111,15 +96,12 @@ sub longmess { 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++) } } ) { - # 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 @@ -134,11 +116,9 @@ sub longmess { # 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) { @@ -154,15 +134,12 @@ 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) { # 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 '...' @@ -172,7 +149,6 @@ sub longmess { for (@a) { # set args to the string "undef" if undefined $_ = "undef", next unless defined $_; - if (ref $_) { # dunno what this is for... $_ .= ''; @@ -184,10 +160,8 @@ sub longmess { 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; @@ -195,7 +169,6 @@ sub longmess { # 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"; @@ -212,14 +185,11 @@ sub longmess { } - -# # 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 '', @_; @@ -227,7 +197,6 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages 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 @@ -264,7 +233,6 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages 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. @@ -297,17 +265,14 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages } - -# # 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 confess { die longmess @_; } -sub croak { die shortmess @_; } -sub carp { warn shortmess @_; } -sub cluck { warn longmess @_; } +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 524c53de39..cc70182698 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -1948,7 +1948,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)" \ @@ -1957,7 +1957,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)" \ @@ -2319,7 +2319,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 6ceac847d3..d7c063a420 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -136,7 +136,7 @@ Display progress messages. =head1 EXAMPLE pod2html("pod2html", - "--podpath=lib:ext:pod:vms", + "--podpath=lib:ext:pod:vms", "--podroot=/usr/src/perl", "--htmlroot=/perl/nmanual", "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop", @@ -167,8 +167,8 @@ my $itemcache = "pod2html-itemcache"; my @begin_stack = (); # begin/end stack -my @libpods = (); # files to search for links from C<> directives -my $htmlroot = "/"; # http-server base directory from which all +my @libpods = (); # files to search for links from C<> directives +my $htmlroot = "/"; # http-server base directory from which all # relative paths in $podpath stem. my $htmlfile = ""; # write to stdout by default my $podfile = ""; # read from stdin by default @@ -177,7 +177,7 @@ my $podroot = "."; # filesystem base directory from which all # relative paths in $podpath stem. my $recurse = 1; # recurse on subdirectories in $podpath. my $verbose = 0; # not verbose by default -my $doindex = 1; # non-zero if we should generate an index +my $doindex = 1; # non-zero if we should generate an index my $listlevel = 0; # current list depth my @listitem = (); # stack of HTML commands to use when a =item is # encountered. the top of the stack is the @@ -209,8 +209,8 @@ $itemcache = "pod2html-itemcache"; @begin_stack = (); # begin/end stack -@libpods = (); # files to search for links from C<> directives -$htmlroot = "/"; # http-server base directory from which all +@libpods = (); # files to search for links from C<> directives +$htmlroot = "/"; # http-server base directory from which all # relative paths in $podpath stem. $htmlfile = ""; # write to stdout by default $podfile = ""; # read from stdin by default @@ -219,7 +219,7 @@ $podroot = "."; # filesystem base directory from which all # relative paths in $podpath stem. $recurse = 1; # recurse on subdirectories in $podpath. $verbose = 0; # not verbose by default -$doindex = 1; # non-zero if we should generate an index +$doindex = 1; # non-zero if we should generate an index $listlevel = 0; # current list depth @listitem = (); # stack of HTML commands to use when a =item is # encountered. the top of the stack is the @@ -267,14 +267,14 @@ sub pod2html { # set some variables to their default values if necessary local *POD; - unless (@ARGV && $ARGV[0]) { + unless (@ARGV && $ARGV[0]) { $podfile = "-" unless $podfile; # stdin open(POD, "<$podfile") || die "$0: cannot open $podfile file for input: $!\n"; } else { $podfile = $ARGV[0]; # XXX: might be more filenames *POD = *ARGV; - } + } $htmlfile = "-" unless $htmlfile; # stdout $htmlroot = "" if $htmlroot eq "/"; # so we don't get a // @@ -299,23 +299,23 @@ sub pod2html { # put a title in the HTML file $title = ''; TITLE_SEARCH: { - for (my $i = 0; $i < @poddata; $i++) { + for (my $i = 0; $i < @poddata; $i++) { if ($poddata[$i] =~ /^=head1\s*NAME\b/m) { - for my $para ( @poddata[$i, $i+1] ) { + for my $para ( @poddata[$i, $i+1] ) { last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+.*\S)/s; } - } + } - } - } + } + } if (!$title and $podfile =~ /\.pod$/) { # probably a split pod so take first =head[12] as title - for (my $i = 0; $i < @poddata; $i++) { + for (my $i = 0; $i < @poddata; $i++) { last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/; - } + } warn "adopted '$title' as title for $podfile\n" if $verbose and $title; - } + } if ($title) { $title =~ s/\s*\(.*\)//; } else { @@ -728,12 +728,12 @@ sub scan_dir { $pages{$_} = "" unless defined $pages{$_}; $pages{$_} .= "$dir/$_:"; push(@subdirs, $_); - } elsif (/\.pod$/) { # .pod + } elsif (/\.pod$/) { # .pod s/\.pod$//; $pages{$_} = "" unless defined $pages{$_}; $pages{$_} .= "$dir/$_.pod:"; push(@pods, "$dir/$_.pod"); - } elsif (/\.pm$/) { # .pm + } elsif (/\.pm$/) { # .pm s/\.pm$//; $pages{$_} = "" unless defined $pages{$_}; $pages{$_} .= "$dir/$_.pm:"; @@ -951,7 +951,7 @@ sub process_item { } print HTML '</STRONG>'; } - print HTML '<DD>'; + print HTML '<DD>'; } print HTML "\n"; @@ -1012,7 +1012,7 @@ sub process_for { my($whom, $text) = @_; if ( $whom =~ /^(pod2)?html$/i) { print HTML $text; - } + } } # @@ -1038,7 +1038,7 @@ sub process_end { $whom = lc($whom); if ($begin_stack[-1] ne $whom ) { die "Unmatched begin/end at chunk $paragraph\n" - } + } pop @begin_stack; } @@ -1054,7 +1054,7 @@ sub process_text { return if $ignore; - $quote = 0; # status of double-quote conversion + $quote = 0; # status of double-quote conversion $result = ""; $rest = $$text; @@ -1093,9 +1093,9 @@ sub process_text { file wais ftp - } ) + } ) . ')'; - + my $ltrs = '\w'; my $gunk = '/#~:.?+=&%@!\-'; my $punc = '.:?\-'; @@ -1191,7 +1191,7 @@ WARN $s1 = $params; if (!$tag || $tag eq " ") { # <> : no tag $s1 = "<$params>"; - } elsif ($tag eq "L") { # L<> : link + } elsif ($tag eq "L") { # L<> : link $s1 = process_L($params); } elsif ($tag eq "I" || # I<> : italicize text $tag eq "B" || # B<> : bold text @@ -1230,7 +1230,7 @@ sub html_escape { $rest =~ s/>/>/g; $rest =~ s/"/"/g; return $rest; -} +} # # process_puretext - process pure text (without pod-escapes) converting @@ -1290,7 +1290,7 @@ sub process_puretext { } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase? $word = html_escape($word) if $word =~ /["&<>]/; $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape; - } else { + } else { $word = html_escape($word) if $word =~ /["&<>]/; } } @@ -1446,7 +1446,7 @@ sub process_C { $s1 = ($items{$s1} ? "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) . "\">$str</A>" : "<A HREF=\"#item_" . htmlify(0,$s2) . "\">$str</A>"); - $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; + $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/; } else { $s1 = "<CODE>$str</CODE>"; @@ -1495,7 +1495,7 @@ sub process_S { } # -# process_X - this is supposed to make an index entry. we'll just +# process_X - this is supposed to make an index entry. we'll just # ignore it. # sub process_X { @@ -1524,7 +1524,7 @@ sub htmlify { if ($compact) { $heading =~ /^(\w+)/; $heading = $1; - } + } # $heading = lc($heading); $heading =~ s/[^\w\s]/_/g; @@ -2248,7 +2248,7 @@ EXT U32 opargs[] = { 0x0000098e, /* oct */ 0x0000098e, /* abs */ 0x0000099c, /* length */ - 0x0009110c, /* substr */ + 0x0099110c, /* substr */ 0x0001111c, /* vec */ 0x0009111c, /* index */ 0x0009111c, /* rindex */ @@ -336,7 +336,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? 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 244e11654c..833aaa26b4 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -1919,7 +1919,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: @@ -1932,8 +1932,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 a02fd5c710..994c8fbebc 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" @@ -655,8 +655,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 @@ -856,7 +856,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>. @@ -954,14 +954,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 @@ -969,22 +969,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/perldelta.pod b/pod/perldelta.pod index 9443f386d9..f1b6c8f096 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.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 d15a8acca1..9f70813c4c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1058,6 +1058,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 @@ -1883,7 +1890,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 @@ -1921,8 +1928,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: @@ -2147,6 +2153,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>. @@ -2605,7 +2612,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 @@ -2665,7 +2672,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 @@ -2680,7 +2687,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 972a5870e7..b72e70ba3a 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/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 d1356a6657..ad56ae12a7 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 @@ -1277,7 +1277,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 = @@ -1582,7 +1582,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. @@ -1794,8 +1794,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 @@ -2954,7 +2954,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. @@ -3148,9 +3148,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. @@ -3299,7 +3299,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 @@ -3449,6 +3449,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 @@ -3471,6 +3473,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. @@ -3507,7 +3515,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 @@ -3601,13 +3609,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; diff --git a/pod/perlguts.pod b/pod/perlguts.pod index a9a08b5632..1e44885831 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. @@ -1687,7 +1687,7 @@ Used to indicate void context. See C<GIMME_V> 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 cfb281dcc7..9c8d9ff83a 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -994,8 +994,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 5b950ed69b..3f163dbc9b 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/ 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 06cc235a8a..30023b7446 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -328,7 +328,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 16babd2092..4bda9fdbac 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 ee343dd4b1..0011abff75 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 b00e4fbd41..2f4be67a1e 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -603,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 54053e700c..a90d9af987 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 100755 --- 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" + @@ -433,8 +433,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; @@ -1699,6 +1705,7 @@ PP(pp_substr) dSP; dTARGET; SV *sv; I32 len; + I32 len_ok = 0; STRLEN curlen; I32 pos; I32 rem; @@ -1706,10 +1713,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; @@ -1718,7 +1740,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) @@ -1730,7 +1752,7 @@ PP(pp_substr) } else { pos += curlen; - if (MAXARG < 3) + if (!len_ok) rem = curlen; else if (len >= 0) { rem = pos+len; @@ -1748,7 +1770,7 @@ PP(pp_substr) rem -= pos; } if (fail < 0) { - if (dowarn || lvalue) + if (dowarn || lvalue || repl) warn("substr outside of string"); RETPUSHUNDEF; } @@ -1778,6 +1800,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 */ @@ -380,6 +380,10 @@ sv_free_arenas() Safefree((void *)sva); } + if (nice_chunk) + Safefree(nice_chunk); + nice_chunk = Nullch; + nice_chunk_size = 0; sv_arenaroot = 0; sv_root = 0; } @@ -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/hashwarn.t b/t/op/hashwarn.t index 741982622b..d3e43e1ee7 100644..100755 --- a/t/op/hashwarn.t +++ b/t/op/hashwarn.t @@ -1,12 +1,12 @@ #!./perl -use strict; - BEGIN { chdir 't' if -d 't'; + @INC = '../lib'; } use vars qw{ @warnings }; +use strict; BEGIN { $^W |= 1; # Insist upon warnings 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"; + @@ -2,8 +2,8 @@ * * VMS-specific routines for perl5 * - * Last revised: 23-Sep-1997 by Charles Bailey bailey@newman.upenn.edu - * Version: 5.4.4 + * Last revised: 16-Apr-1998 by Charles Bailey bailey@newman.upenn.edu + * Version: 5.4.5 */ #include <acedef.h> @@ -184,7 +184,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:"); @@ -195,12 +195,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); @@ -853,12 +859,14 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) retsts = sys$parse(&myfab,0,0); if (!(retsts & 1)) { + mynam.nam$b_nop |= NAM$M_SYNCHK; if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV || retsts == RMS$_DEV) { - mynam.nam$b_nop |= NAM$M_SYNCHK; retsts = sys$parse(&myfab,0,0); if (retsts & 1) goto expanded; } + mynam.nam$l_rlf = NULL; myfab.fab$b_dns = 0; + (void) sys$parse(&myfab,0,0); /* Free search context */ if (out) Safefree(out); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); @@ -869,6 +877,8 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) } retsts = sys$search(&myfab,0,0); if (!(retsts & 1) && retsts != RMS$_FNF) { + mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL; + myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0); /* Free search context */ if (out) Safefree(out); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); @@ -886,6 +896,10 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) if (!(mynam.nam$l_fnb & NAM$M_EXP_VER) && (!defspec || !*defspec || !strchr(myfab.fab$l_dna,';'))) speclen = mynam.nam$l_ver - out; + if (!(mynam.nam$l_fnb & NAM$M_EXP_TYPE) && + (!defspec || !*defspec || defspec[myfab.fab$b_dns-1] != '.' || + defspec[myfab.fab$b_dns-2] == '.')) + speclen = mynam.nam$l_type - out; /* If we just had a directory spec on input, $PARSE "helpfully" * adds an empty name and type for us */ if (mynam.nam$l_name == mynam.nam$l_type && @@ -907,6 +921,9 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) if (do_tounixspec(outbuf,tmpfspec,0) == NULL) return NULL; strcpy(outbuf,tmpfspec); } + mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL; + mynam.nam$l_rsa = NULL; mynam.nam$b_rss = 0; + myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0); /* Free search context */ return outbuf; } /*}}}*/ @@ -1044,6 +1061,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } cp1++; } while ((cp1 = strstr(cp1,"/.")) != NULL); + lastdir = strrchr(dir,'/'); } else if (!strcmp(&dir[dirlen-7],"/000000")) { /* Ditto for specs that end in an MFD -- let the VMS code @@ -2432,7 +2450,7 @@ trim_unixpath(char *fspec, char *wildspec, int opts) for (front = end ; front >= base; front--) if (*front == '/' && !dirs--) { front++; break; } } - for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcend + sizeof lcend; + for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + sizeof lcres; cp1++,cp2++) *cp2 = _tolower(*cp1); /* Make lc copy for match */ if (cp1 != '\0') return 0; /* Path too long. */ lcend = cp2; @@ -2521,13 +2539,22 @@ opendir(char *name) { DIR *dd; char dir[NAM$C_MAXRSS+1]; - - /* Get memory for the handle, and the pattern. */ - New(1306,dd,1,DIR); + struct mystat sb; + if (do_tovmspath(name,dir,0) == NULL) { - Safefree((char *)dd); - return(NULL); + return NULL; + } + if (flex_stat(dir,&sb) == -1) return NULL; + if (!S_ISDIR(sb.st_mode)) { + set_errno(ENOTDIR); set_vaxc_errno(RMS$_DIR); + return NULL; + } + if (!cando_by_name(S_IRUSR,0,dir)) { + set_errno(EACCES); set_vaxc_errno(RMS$_PRV); + return NULL; } + /* Get memory for the handle, and the pattern. */ + New(1306,dd,1,DIR); New(1307,dd->pattern,strlen(dir)+sizeof "*.*" + 1,char); /* Fill in the fields; mainly playing with the descriptor. */ @@ -2865,6 +2892,7 @@ setup_cmddsc(char *cmd, int check_img) s = resspec; while (*s && !isspace(*s)) s++; *s = '\0'; + if (!cando_by_name(S_IXUSR,0,resspec)) return RMS$_PRV; New(402,VMScmd.dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char); strcpy(VMScmd.dsc$a_pointer,"$ MCR "); strcat(VMScmd.dsc$a_pointer,resspec); @@ -2922,7 +2950,22 @@ vms_do_exec(char *cmd) if ((retsts = setup_cmddsc(cmd,1)) & 1) retsts = lib$do_command(&VMScmd); - set_errno(EVMSERR); + switch (retsts) { + case RMS$_FNF: + set_errno(ENOENT); break; + case RMS$_DNF: case RMS$_DIR: case RMS$_DEV: + set_errno(ENOTDIR); break; + case RMS$_PRV: + set_errno(EACCES); break; + case RMS$_SYN: + set_errno(EINVAL); break; + case CLI$_BUFOVF: + set_errno(E2BIG); break; + case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */ + _ckvmssts(retsts); /* fall through */ + default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */ + set_errno(EVMSERR); + } set_vaxc_errno(retsts); if (dowarn) warn("Can't exec \"%s\": %s", VMScmd.dsc$a_pointer, Strerror(errno)); @@ -2950,27 +2993,43 @@ do_aspawn(SV *really,SV **mark,SV **sp) unsigned long int do_spawn(char *cmd) { - unsigned long int substs, hadcmd = 1; + unsigned long int sts, substs, hadcmd = 1; TAINT_ENV(); TAINT_PROPER("spawn"); if (!cmd || !*cmd) { hadcmd = 0; - _ckvmssts(lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0)); + sts = lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0); } - else if ((substs = setup_cmddsc(cmd,0)) & 1) { - _ckvmssts(lib$spawn(&VMScmd,0,0,0,0,0,&substs,0,0,0,0,0,0)); + else if ((sts = setup_cmddsc(cmd,0)) & 1) { + sts = lib$spawn(&VMScmd,0,0,0,0,0,&substs,0,0,0,0,0,0); } - if (!(substs&1)) { - set_errno(EVMSERR); - set_vaxc_errno(substs); + set_vaxc_errno(sts); + if (!(sts & 1)) { + switch (sts) { + case RMS$_FNF: + set_errno(ENOENT); break; + case RMS$_DNF: case RMS$_DIR: case RMS$_DEV: + set_errno(ENOTDIR); break; + case RMS$_PRV: + set_errno(EACCES); break; + case RMS$_SYN: + set_errno(EINVAL); break; + case CLI$_BUFOVF: + set_errno(E2BIG); break; + case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */ + _ckvmssts(sts); /* fall through */ + default: /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */ + set_errno(EVMSERR); + } if (dowarn) warn("Can't spawn \"%s\": %s", hadcmd ? VMScmd.dsc$a_pointer : "", Strerror(errno)); } + else set_errno(0); vms_execfree(); - return substs; + return (sts & 1) ? substs : sts; } /* end of do_spawn() */ /*}}}*/ @@ -3269,7 +3328,6 @@ void my_endpwent() } /*}}}*/ -#if __VMS_VER < 70000000 || __DECC_VER < 50200000 /* Used for UTC calculation in my_gmtime(), my_localtime(), my_time(), * my_utime(), and flex_stat(), all of which operate on UTC unless * VMSISH_TIMES is true. @@ -3289,6 +3347,10 @@ static long int utc_offset_secs; #undef localtime #undef time +#if defined(__VMS_VER) && __VMS_VER >= 70000000 && __DECC_VER >= 50200000 +# define RTL_USES_UTC 1 +#endif + static time_t toutc_dst(time_t loc) { struct tm *rsltmp; @@ -3363,8 +3425,12 @@ time_t my_time(time_t *timep) when = time(NULL); # ifdef VMSISH_TIME +# ifdef RTL_USES_UTC + if (VMSISH_TIME) when = _toloc(when); +# else if (!VMSISH_TIME) when = _toutc(when); # endif +# endif if (timep != NULL) *timep = when; return when; @@ -3390,10 +3456,14 @@ my_gmtime(const time_t *timep) # ifdef VMSISH_TIME if (VMSISH_TIME) when = _toutc(when); /* Input was local time */ # endif +# ifdef RTL_USES_UTC /* this implies that the CRTL has a working gmtime() */ + return gmtime(&when); +# else /* CRTL localtime() wants local time as input, so does no tz correction */ rsltmp = localtime(&when); if (rsltmp) rsltmp->tm_isdst = 0; /* We already took DST into account */ return rsltmp; +#endif } /* end of my_gmtime() */ /*}}}*/ @@ -3413,9 +3483,17 @@ my_localtime(const time_t *timep) if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */ when = *timep; +# ifdef RTL_USES_UTC +# ifdef VMSISH_TIME + if (VMSISH_TIME) when = _toutc(when); +# endif + /* CRTL localtime() wants UTC as input, does tz correction itself */ + return localtime(&when); +# else # ifdef VMSISH_TIME if (!VMSISH_TIME) when = _toloc(when); /* Input was UTC */ # endif +# endif /* CRTL localtime() wants local time as input, so does no tz correction */ rsltmp = localtime(&when); if (rsltmp && gmtime_emulation_type != 1) rsltmp->tm_isdst = -1; @@ -3429,8 +3507,6 @@ my_localtime(const time_t *timep) #define localtime(t) my_localtime(t) #define time(t) my_time(t) -#endif /* VMS VER < 7.0 || Dec C < 5.2 - /* my_utime - update modification time of a file * calling sequence is identical to POSIX utime(), but under * VMS only the modification time is changed; ODS-2 does not @@ -3493,7 +3569,7 @@ int my_utime(char *file, struct utimbuf *utimes) */ lowbit = (utimes->modtime & 1) ? secscale : 0; unixtime = (long int) utimes->modtime; -#if defined(VMSISH_TIME) && (__VMS_VER < 70000000 || __DECC_VER < 50200000) +# ifdef VMSISH_TIME /* If input was UTC; convert to local for sys svc */ if (!VMSISH_TIME) unixtime = _toloc(unixtime); # endif @@ -3800,7 +3876,7 @@ cando_by_name(I32 bit, I32 effective, char *fname) retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst); if (retsts == SS$_NOPRIV || retsts == SS$_NOSUCHOBJECT || - retsts == SS$_INVFILFOROP || retsts == RMS$_FNF || + retsts == SS$_INVFILFOROP || retsts == RMS$_FNF || retsts == RMS$_SYN || retsts == RMS$_DIR || retsts == RMS$_DEV) { set_vaxc_errno(retsts); if (retsts == SS$_NOPRIV) set_errno(EACCES); @@ -3836,17 +3912,25 @@ flex_fstat(int fd, struct mystat *statbufp) if (!fstat(fd,(stat_t *) statbufp)) { if (statbufp == (struct mystat *) &statcache) *namecache == '\0'; statbufp->st_dev = encode_dev(statbufp->st_devnam); +# ifdef RTL_USES_UTC +# ifdef VMSISH_TIME + if (VMSISH_TIME) { + statbufp->st_mtime = _toloc(statbufp->st_mtime); + statbufp->st_atime = _toloc(statbufp->st_atime); + statbufp->st_ctime = _toloc(statbufp->st_ctime); + } +# endif +# else # ifdef VMSISH_TIME if (!VMSISH_TIME) { /* Return UTC instead of local time */ # else if (1) { # endif -#if __VMS_VER < 70000000 || __DECC_VER < 50200000 statbufp->st_mtime = _toutc(statbufp->st_mtime); statbufp->st_atime = _toutc(statbufp->st_atime); statbufp->st_ctime = _toutc(statbufp->st_ctime); -#endif } +# endif return 0; } return -1; @@ -3890,18 +3974,25 @@ flex_stat(char *fspec, struct mystat *statbufp) if (retval) retval = stat(fspec,(stat_t *) statbufp); if (!retval) { statbufp->st_dev = encode_dev(statbufp->st_devnam); +# ifdef RTL_USES_UTC +# ifdef VMSISH_TIME + if (VMSISH_TIME) { + statbufp->st_mtime = _toloc(statbufp->st_mtime); + statbufp->st_atime = _toloc(statbufp->st_atime); + statbufp->st_ctime = _toloc(statbufp->st_ctime); + } +# endif +# else # ifdef VMSISH_TIME if (!VMSISH_TIME) { /* Return UTC instead of local time */ # else if (1) { # endif -#if __VMS_VER < 70000000 || __DECC_VER < 50200000 - if (!gmtime_emulation_type) (void)time(NULL); - statbufp->st_mtime -= utc_offset_secs; - statbufp->st_atime -= utc_offset_secs; - statbufp->st_ctime -= utc_offset_secs; -#endif + statbufp->st_mtime = _toutc(statbufp->st_mtime); + statbufp->st_atime = _toutc(statbufp->st_atime); + statbufp->st_ctime = _toutc(statbufp->st_ctime); } +# endif } return retval; @@ -3913,25 +4004,36 @@ flex_stat(char *fspec, struct mystat *statbufp) FILE * my_binmode(FILE *fp, char iotype) { - char filespec[NAM$C_MAXRSS], *acmode; + char filespec[NAM$C_MAXRSS], *acmode, *s, *colon, *dirend = Nullch; + int ret = 0, saverrno = errno, savevmserrno = vaxc$errno; fpos_t pos; if (!fgetname(fp,filespec)) return NULL; - if (iotype != '-' && fgetpos(fp,&pos) == -1) return NULL; + for (s = filespec; *s; s++) { + if (*s == ':') colon = s; + else if (*s == ']' || *s == '>') dirend = s; + } + /* Looks like a tmpfile, which will go away if reopened */ + if (s == dirend + 3) return fp; + /* If we've got a non-file-structured device, clip off the trailing + * junk, and don't lose sleep if we can't get a stream position. */ + if (dirend == Nullch) *(colon+1) = '\0'; + if (iotype != '-'&& (ret = fgetpos(fp, &pos)) == -1 && dirend) return NULL; switch (iotype) { case '<': case 'r': acmode = "rb"; break; - case '>': case 'w': + case '>': case 'w': case '|': /* use 'a' instead of 'w' to avoid creating new file; fsetpos below will take care of restoring file position */ case 'a': acmode = "ab"; break; - case '+': case '|': case 's': acmode = "rb+"; break; + case '+': case 's': acmode = "rb+"; break; case '-': acmode = fileno(fp) ? "ab" : "rb"; break; default: warn("Unrecognized iotype %c in my_binmode",iotype); acmode = "rb+"; } if (freopen(filespec,acmode,fp) == NULL) return NULL; - if (iotype != '-' && fsetpos(fp,&pos) == -1) return NULL; + if (iotype != '-' && ret != -1 && fsetpos(fp,&pos) == -1) return NULL; + if (ret == -1) { set_errno(saverrno); set_vaxc_errno(savevmserrno); } return fp; } /* end of my_binmode() */ /*}}}*/ |