----------------
+Version 5.003_92
+----------------
+
+This release will be the public beta of 5.004, or my name isn't
+Larson T. Pettifogger.
+
+ CORE LANGUAGE CHANGES
+
+ Title: "Strictly follow lexical context of C<eval ''> and nested subs"
+ From: Chip Salzenberg
+ Files: op.c
+
+ Title: "Make ::SUPER and UNIVERSAL work together"
+ From: Chip Salzenberg
+ Files: gv.c pod/perlguts.pod
+
+ CORE PORTABILITY
+
+ Title: "HP-UX hint update"
+ From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com>
+ Msg-ID: <1479.857653838@lyon.grenoble.hp.com>
+ Date: Thu, 06 Mar 97 14:10:38 +0100
+ Files: hints/hpux.sh
+
+ Title: "Re: The continuing MachTen saga"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.95q.970305091611.3572E-100000@kelly.teleport.com>
+ Date: Wed, 5 Mar 1997 09:47:22 -0800 (PST)
+ Files: hints/machten_2.sh
+
+ Title: "OS/2 patches"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199703060308.WAA22211@monk.mps.ohio-state.edu>
+ Date: Wed, 5 Mar 1997 22:08:43 -0500 (EST)
+ Files: hints/os2.sh lib/ExtUtils/MakeMaker.pm t/op/taint.t
+
+ Title: "VMS patches"
+ From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
+ Msg-ID: <01IG5SQE4A6U00661G@hmivax.humgen.upenn.edu>
+ Date: Wed, 05 Mar 1997 23:10:24 -0500 (EST)
+ Files: lib/ExtUtils/MM_VMS.pm lib/ExtUtils/Manifest.pm perlsdio.h
+ t/op/runlevel.t t/op/taint.t vms/descrip.mms vms/perly_c.vms
+ vms/sockadapt.c vms/sockadapt.h vms/vms_yfix.pl
+
+ OTHER CORE CHANGES
+
+ Title: "Make sure $^X is tainted when ARG_ZERO_IS_SCRIPT"
+ From: Chip Salzenberg
+ Files: toke.c
+
+ Title: "Clarify '-T too late' error"
+ From: Chip Salzenberg
+ Files: perl.c pod/perldiag.pod
+
+ Title: "Warn when redefining or undefining a constant sub"
+ From: Chip Salzenberg
+ Files: pod/perldiag.pod pp.c sv.c
+
+ Title: "Don't generate spurious 'not imported' warning"
+ From: Chip Salzenberg
+ Files: gv.c t/pragma/strict-vars pod/perldiag.pod
+
+ Title: "Clarify message re: @host in string"
+ From: Chip Salzenberg
+ Files: pod/perldiag.pod pod/perltrap.pod toke.c
+
+ Title: "Disconnect refs that are targets of pp_readline"
+ From: Chip Salzenberg
+ Files: pp_hot.c
+
+ Title: "Fix typo in test of HvFILL()"
+ From: Chip Salzenberg
+ Files: op.c
+
+ Title: "Allow for pad name array to be shorter than pad array"
+ From: Chip Salzenberg
+ Files: op.c
+
+ Title: "Eliminate format-string type warnings"
+ From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
+ Msg-ID: <199703030915.KAA11634@bombur2.uio.no>
+ Date: Mon, 3 Mar 1997 10:15:11 +0100 (MET)
+ Files: doio.c ext/POSIX/POSIX.xs gv.c hints/dec_osf.sh pp.c pp_ctl.c
+ pp_hot.c run.c sv.c x2p/a2py.c
+
+ Title: "Update copyright dates"
+ From: Chip Salzenberg
+ Files: *.[hc] x2p/*.[hc] win32/EXTERN.h vms/vmsish.h vms/vms.c
+
+ BUILD PROCESS
+
+ Title: "near-harmless bug in _91's Configure"
+ From: Roderick Schertler <roderick@argon.org>
+ Msg-ID: <pzg1yfuiza.fsf@eeyore.ibcinc.com>
+ Date: 01 Mar 1997 21:26:49 -0500
+ Files: Configure
+
+ Title: "Change 'continuing anyway' to 'probably harmless'"
+ From: Chip Salzenberg
+ Files: INSTALL lib/ExtUtils/Liblist.pm
+
+ LIBRARY AND EXTENSIONS
+
+ Title: "Newer ReadLine"
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID: <199703040634.BAA19919@monk.mps.ohio-state.edu>
+ Date: Tue, 4 Mar 1997 01:34:28 -0500 (EST)
+ Files: lib/Term/ReadLine.pm lib/perl5db.pl
+
+ Title: "Refresh Getopt::Long to 2.9"
+ From: Johan Vromans <jvromans@squirrel.nl>
+ Files: lib/Getopt/Long.pm
+
+ Title: "Benchmark: using code refs"
+ From: Hugo van der Sanden <hv@iii.co.uk>
+ Msg-ID: <199703041132.LAA07613@tyree.iii.co.uk>
+ Date: Tue, 04 Mar 1997 11:32:11 +0000
+ Files: lib/Benchmark.pm
+
+ Title: "Fix quotewords"
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID: <199703060755.HAA15060@crypt.compulink.co.uk>
+ Date: Thu, 06 Mar 1997 07:55:25 +0000
+ Files: lib/Text/ParseWords.pm
+
+ Title: "Use IV instead of double for tms structure members"
+ From: Chip Salzenberg
+ Files: ext/POSIX/POSIX.xs
+
+ Title: "Document IO::File::new_tmpfile"
+ From: Chip Salzenberg
+ Files: ext/IO/lib/IO/File.pm
+
+ TESTS
+
+ Title: "Make op/TEST silent under -w"
+ From: d-lewart@uiuc.edu (Daniel S. Lewart)
+ Msg-ID: <199703011821.NAA13037@sinistar.idle.com>
+ Date: Sat, 1 Mar 97 12:04:09 CST
+ Files: t/TEST
+
+ Title: "Smarter t/op/taint.t"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.95q.970303103047.24000A-100000@kelly.teleport.com
+ Date: Mon, 3 Mar 1997 10:31:54 -0800 (PST)
+ Files: t/op/taint.t
+
+ Title: "Fix taint test for systems without csh"
+ From: Chip Salzenberg
+ Files: t/op/taint.t
+
+ Title: "Don't test locales if there is no setlocale()"
+ From: Chip Salzenberg
+ Files: t/pragma/locale.t
+
+ UTILITIES
+
+ Title: "Update pod2html"
+ From: wmiddlet@Adobe.COM (William Middleton)
+ Msg-ID: <199703030025.QAA08106@ducks>
+ Date: Sun, 2 Mar 1997 16:25:03 -0800 (PST)
+ Files: pod/pod2html.PL
+
+ Title: "Support 'long long' in h2ph"
+ From: (name lost)
+ Files: utils/h2ph.PL
+
+ DOCUMENTATION
+
+ Title: "Add taint checks and srand to perldelta"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.95q.970302115355.23058D-100000@kelly.teleport.com
+ Date: Sun, 2 Mar 1997 11:56:08 -0800 (PST)
+ Files: pod/perldelta.pod
+
+ Title: "Don't call FileHandle 'deprecated'"
+ From: Chip Salzenberg
+ Files: pod/perldelta.pod
+
+ Title: "Improve sample module header"
+ From: Tom Christiansen <tchrist@jhereg.perl.com>,
+ Graham Barr <gbarr@ti.com>
+ Msg-ID: <199703011732.KAA14693@jhereg.perl.com>
+ Date: Sat, 01 Mar 1997 10:32:31 -0700
+ Files: pod/perlmod.pod
+
+ Title: "Clarify C<crypt> documentation"
+ From: Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID: <Pine.GSO.3.95q.970228131112.12357D-100000@kelly.teleport.com
+ Date: Fri, 28 Feb 1997 13:18:25 -0800 (PST)
+ Files: pod/perlfunc.pod
+
+ Title: "Update list of CPAN sites"
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID: <199703021454.QAA07446@alpha.hut.fi>
+ Date: Sun, 2 Mar 1997 16:54:22 +0200 (EET)
+ Files: pod/perlmod.pod
+
+ Title: "Enhance description of 'server error'"
+ From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Msg-ID: <199702041903.VAA16070@alpha.hut.fi>
+ Date: Tue, 4 Feb 1997 21:03:23 +0200 (EET)
+ Files: pod/perldiag.pod
+
+ Title: "Regularize format of E-Mail addresses in *.pod"
+ From: Chip Salzenberg
+ Files: pod/*.pod
+
+
+----------------
Version 5.003_91
----------------
/* EXTERN.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* INTERN.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* av.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* av.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* cop.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* cv.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* deb.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* doio.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
{
a = SvPV(astr, len);
if (len != infosize)
- croak("Bad arg length for %s, is %d, should be %ld",
- op_desc[optype], len, (long)infosize);
+ croak("Bad arg length for %s, is %lu, should be %ld",
+ op_desc[optype], (unsigned long)len, (long)infosize);
}
}
else
/* doop.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* dump.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
clock_t realtime;
realtime = times( &tms );
EXTEND(sp,5);
- PUSHs( sv_2mortal( newSVnv( realtime ) ) );
- PUSHs( sv_2mortal( newSVnv( tms.tms_utime ) ) );
- PUSHs( sv_2mortal( newSVnv( tms.tms_stime ) ) );
- PUSHs( sv_2mortal( newSVnv( tms.tms_cutime ) ) );
- PUSHs( sv_2mortal( newSVnv( tms.tms_cstime ) ) );
+ PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
+ PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
+ PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
+ PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
+ PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
double
difftime(time1, time2)
/* form.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* gv.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
GV* topgv;
GV* gv;
GV** gvp;
- HV* lastchance;
CV* cv;
if (!stash)
}
}
- gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
- if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+ gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
+ av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav;
+
+ /* create @.*::SUPER::ISA on demand */
+ if (!av) {
+ char* packname = HvNAME(stash);
+ STRLEN packlen = strlen(packname);
+
+ if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
+ HV* basestash;
+
+ packlen -= 7;
+ basestash = gv_stashpvn(packname, packlen, TRUE);
+ gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
+ if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+ gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
+ if (!gvp || !(gv = *gvp))
+ croak("Cannot create %s::ISA", HvNAME(stash));
+ if (SvTYPE(gv) != SVt_PVGV)
+ gv_init(gv, stash, "ISA", 3, TRUE);
+ SvREFCNT_dec(GvAV(gv));
+ GvAV(gv) = (AV*)SvREFCNT_inc(av);
+ }
+ }
+ }
+
+ if (av) {
SV** svp = AvARRAY(av);
I32 items = AvFILL(av) + 1;
while (items--) {
}
}
+ /* if at top level, try UNIVERSAL */
+
if (level == 0 || level == -1) {
+ HV* lastchance;
+
if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
if (gv = gv_fetchmeth(lastchance, name, len,
(level >= 0) ? level + 1 : level - 1)) {
GV* gv;
for (nend = name; *nend; nend++) {
- if (*nend == ':' || *nend == '\'')
+ if (*nend == '\'')
nsplit = nend;
+ else if (*nend == ':' && *(nend + 1) == ':')
+ nsplit = ++nend;
}
if (nsplit) {
- char ch;
char *origname = name;
name = nsplit + 1;
- ch = *nsplit;
if (*nsplit == ':')
--nsplit;
- *nsplit = '\0';
- if (strEQ(origname,"SUPER")) {
- /* Degenerate case ->SUPER::method should really lookup in original stash */
- SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0));
+ if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
+ /* ->SUPER::method should really be looked up in original stash */
+ SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash), 0));
sv_catpvn(tmpstr, "::SUPER", 7);
- stash = gv_stashpvn(SvPVX(tmpstr),SvCUR(tmpstr),TRUE);
- *nsplit = ch;
- DEBUG_o( deb("Treating %s as %s::%s\n",origname,HvNAME(stash),name) );
- } else {
- stash = gv_stashpvn(origname, nsplit - origname, TRUE);
- *nsplit = ch;
+ stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
+ DEBUG_o( deb("Treating %s as %s::%s\n",
+ origname, HvNAME(stash), name) );
}
- }
- gv = gv_fetchmeth(stash, name, nend - name, 0);
-
- if (!gv) {
- /* Failed obvious case - look for SUPER as last element of stash's name */
- char *packname = HvNAME(stash);
- STRLEN len = strlen(packname);
- if (len >= 7 && strEQ(packname+len-7,"::SUPER")) {
- /* Now look for @.*::SUPER::ISA */
- GV** gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
- len -= 7;
- if (!gvp || (gv = *gvp) == (GV*)&sv_undef || !GvAV(gv)) {
- /* No @ISA in package ending in ::SUPER - drop suffix
- and see if there is an @ISA there
- */
- HV *basestash;
- char ch = packname[len];
- AV *av;
- packname[len] = '\0';
- basestash = gv_stashpvn(packname, len, TRUE);
- packname[len] = ch;
- gvp = (GV**)hv_fetch(basestash,"ISA",3,FALSE);
- if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
- /* Okay found @ISA after dropping the SUPER, alias it */
- SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
- sv_catpvn(tmpstr, "::ISA", 5);
- gv = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV);
- if (gv) {
- GvAV(gv) = (AV*)SvREFCNT_inc(av);
- /* ... and re-try lookup */
- gv = gv_fetchmeth(stash, name, nend - name, 0);
- } else {
- croak("Cannot create %s::ISA",HvNAME(stash));
- }
- }
- }
- }
+ else
+ stash = gv_stashpvn(origname, nsplit - origname, TRUE);
}
+ gv = gv_fetchmeth(stash, name, nend - name, 0);
if (!gv) {
if (strEQ(name,"import"))
gv = (GV*)&sv_yes;
I32 len;
register char *namend;
HV *stash = 0;
- bool global = FALSE;
+ U32 add_gvflags = 0;
char *tmpbuf;
if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
if (!stash) {
if (isIDFIRST(*name)) {
+ bool global = FALSE;
+
if (isUPPER(*name)) {
if (*name > 'I') {
if (*name == 'S' && (
}
else if (*name == '_' && !name[1])
global = TRUE;
+
if (global)
stash = defstash;
else if ((COP*)curcop == &compiling) {
warn("Global symbol \"%s\" requires explicit package name", name);
++error_count;
stash = curstash ? curstash : defstash; /* avoid core dumps */
+ add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
+ : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
+ : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
+ : 0);
}
else
return Nullgv;
warn("Had to create %s unexpectedly", nambeg);
gv_init(gv, stash, name, len, add & 2);
gv_init_sv(gv, sv_type);
+ GvFLAGS(gv) |= add_gvflags;
/* set up magic where warranted */
switch (*name) {
{
int filled = 0;
int i;
- char *cp;
+ const char *cp;
SV* sv = NULL;
SV** svp;
/* Work with "fallback" key, which we assume to be first in AMG_names */
- if ( cp = (char *)AMG_names[0] ) {
+ if ( cp = AMG_names[0] ) {
/* Try to find via inheritance. */
gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */
if (gv) sv = GvSV(gv);
for (i = 1; i < NofAMmeth; i++) {
cv = 0;
- cp = (char *)AMG_names[i];
+ cp = AMG_names[i];
*buf = '('; /* A cookie: "(". */
strcpy(buf + 1, cp);
/* gv.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* handy.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
# be nauseatingly ANSI
case "$cc" in
-gcc) ccflags="$ccflags -ansi"
+*gcc*) ccflags="$ccflags -ansi"
;;
*) ccflags="$ccflags -std"
;;
if test "$libemx" = "X"; then echo "Cannot find C library!"; fi
-libpth="$libemx/mt $libemx"
+# Acute backslashitis:
+libpth="`echo \"$LIBRARY_PATH\" | tr ';\\\' ' /'`"
+libpth="$libpth $libemx/mt $libemx"
set `emxrev -f emxlibcm`
emxcrtrev=$5
/* hv.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* hv.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
# Author: Charles Bailey bailey@genetics.upenn.edu
package ExtUtils::MM_VMS;
-$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.39 (31-Jan-1997)';
-unshift @MM::ISA, 'ExtUtils::MM_VMS';
use Carp qw( &carp );
use Config;
use VMS::Filespec;
use File::Basename;
+use vars qw($Revision);
+$Revision = '5.3901 (6-Mar-1997)';
+
+unshift @MM::ISA, 'ExtUtils::MM_VMS';
+
Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
=head1 NAME
foreach $lib (split ' ', $self->{LDLOADLIBS}) {
$lib =~ s%\$%\\\$%g; # Escape '$' in VMS filespecs
if (length($line) + length($lib) > 160) {
- push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n";
+ push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
$line = $lib . '\n';
}
else { $line .= $lib . '\n'; }
}
- push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n" if $line;
+ push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
}
join('',@m);
push(@m,'
If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
- $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;"
+ $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
');
push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
join('',@m);
subdirs ::
olddef = F$Environment("Default")
Set Default ',$subdir,'
- - $(MMS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
+ - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
Set Default \'olddef\'
';
join('',@m);
foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
my($vmsdir) = $self->fixpath($dir,1);
push( @m, ' If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
- '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) clean`;"',"\n");
+ '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
}
push @m, ' $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
';
foreach(@{$self->{DIR}}){
my($vmsdir) = $self->fixpath($_,1);
push(@m, ' If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
- '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) realclean`;"',"\n");
+ '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
}
push @m,' $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
';
startdir = F$Environment("Default")
Set Default [.$(DISTVNAME)]
$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
- $(MMS)
- $(MMS) test
+ $(MMS)$(MMSQUALIFIERS)
+ $(MMS)$(MMSQUALIFIERS) test
Set Default 'startdir'
};
}
$(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
$(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
- $(MV) $(MAKEFILE) $(MAKEFILE)_old
- - $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean
+ - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
$(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
$(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
foreach(@{$self->{DIR}}){
my($vmsdir) = $self->fixpath($_,1);
push(@m, ' If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
- '; print `$(MMS) $(PASTHRU2) test`'."\n");
+ '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
}
push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
unless $tests or -f "test.pl" or @{$self->{DIR}};
MAKEAPERL=1 NORECURS=1
$(MAP_TARGET) :: $(MAKE_APERL_FILE)
- $(MMS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
+ $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
};
push @m, map( " \\\n\t\t$_", @ARGV );
push @m, "\n";
$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
$(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
- $(NOECHO) $(SAY) " $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
+ $(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
$(NOECHO) $(SAY) "To remove the intermediate files, say
- $(NOECHO) $(SAY) " $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
+ $(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
';
push @m,'
',"${tmp}perlmain.c",' : $(MAKEFILE)
package ExtUtils::MakeMaker;
-$Version = $VERSION = "5.4001";
+$Version = $VERSION = "5.4002";
$Version_OK = "5.17"; # Makefiles older than $Version_OK will die
# (Will be checked from MakeMaker version 4.13 onwards)
($Revision = substr(q$Revision: 1.211 $, 10)) =~ s/\s+$//;
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
tool_autosplit
- installpm
+ IMPORTS
+ installpm
/;
+ # IMPORTS is used under OS/2
+
# ^^^ installpm is deprecated, will go about Summer 96
# @Overridable is close to @MM_Sections but not identical. The
use Carp;
use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION $Debug $Verbose $Is_VMS $Quiet $MANIFEST $found);
+use vars qw($VERSION @ISA @EXPORT_OK
+ $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
+$VERSION = '1.2801';
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
'skipcheck', 'maniread', 'manicopy');
-$Debug = 0;
-$Verbose = 1;
$Is_VMS = $^O eq 'VMS';
+if ($Is_VMS) { require File::Basename }
-$VERSION = "1.28";
-
+$Debug = 0;
+$Verbose = 1;
$Quiet = 0;
-
$MANIFEST = 'MANIFEST';
# Really cool fix from Ilya :)
}
while (<M>){
chomp;
- if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
- else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+ if ($Is_VMS) {
+ my($file)= /^(\S+)/;
+ next unless $file;
+ my($base,$dir) = File::Basename::fileparse($file);
+ # Resolve illegal file specifications in the same way as tar
+ $dir =~ tr/./_/;
+ my(@pieces) = split(/\./,$base);
+ if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
+ my $okfile = "$dir$base";
+ warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
+ $read->{"\L$okfile"}=$_;
+ }
+ else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
}
close M;
$read;
$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
}
- if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
- else { cp_if_diff($file, "$target/$file", $how); }
+ cp_if_diff($file, "$target/$file", $how);
}
}
}
}
-# Do the comparisons here rather than spawning off another process
-sub vms_cp_if_diff {
- my($from,$to) = @_;
- my($diff) = 0;
- local(*F,*T);
- open(F,$from) or croak "Can't read $from: $!\n";
- if (open(T,$to)) {
- while (<F>) { $diff++,last if $_ ne <T>; }
- $diff++ unless eof(T);
- close T;
- }
- else { $diff++; }
- close F;
- if ($diff) {
- system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1
- or confess "Copy failed: $!";
- }
-}
-
sub cp {
my ($srcFile, $dstFile) = @_;
my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
copy($srcFile,$dstFile);
- utime $access, $mod, $dstFile;
+ utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
# chmod a+rX-w,go-w
chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile );
}
sub ln {
my ($srcFile, $dstFile) = @_;
+ return &cp if $Is_VMS;
link($srcFile, $dstFile);
local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
my $mode= 0444 | (stat)[2] & 0700;
/* mg.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* mg.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* op.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
for (off = AvFILL(curname); off > 0; off--) {
if ((sv = svp[off]) &&
sv != &sv_undef &&
- !SvFAKE(sv) &&
seq <= SvIVX(sv) &&
seq > I_32(SvNVX(sv)) &&
strEQ(SvPVX(sv), name))
depth = CvDEPTH(cv);
if (!depth) {
- if (newoff)
+ if (newoff) {
+ if (SvFAKE(sv))
+ continue;
return 0; /* don't clone from inactive stack frame */
+ }
depth = 1;
}
oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
oldsv = *av_fetch(oldpad, off, TRUE);
if (!newoff) { /* Not a mere clone operation. */
- SV *sv = NEWSV(1103,0);
+ SV *namesv = NEWSV(1103,0);
newoff = pad_alloc(OP_PADSV, SVs_PADMY);
- sv_upgrade(sv, SVt_PVNV);
- sv_setpv(sv, name);
- av_store(comppad_name, newoff, sv);
- SvNVX(sv) = (double)curcop->cop_seq;
- SvIVX(sv) = 999999999; /* A ref, intro immediately */
- SvFAKE_on(sv); /* A ref, not a real var */
+ sv_upgrade(namesv, SVt_PVNV);
+ sv_setpv(namesv, name);
+ av_store(comppad_name, newoff, namesv);
+ SvNVX(namesv) = (double)curcop->cop_seq;
+ SvIVX(namesv) = 999999999; /* A ref, intro immediately */
+ SvFAKE_on(namesv); /* A ref, not a real var */
if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) {
/* "It's closures all the way down." */
CvCLONE_on(compcv);
}
}
else if (!CvUNIQUE(compcv)) {
- if (dowarn && !CvUNIQUE(cv))
+ if (dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
warn("Variable \"%s\" will not stay shared", name);
}
}
pname = AvARRAY(pad_name);
ppad = AvARRAY(pad);
- for (ix = 1; ix <= AvFILL(pad); ix++) {
+ for (ix = 1; ix <= AvFILL(pad_name); ix++) {
if (SvPOK(pname[ix]))
PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (%s\"%s\" %ld-%ld)\n",
ix, ppad[ix],
AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
SV** pname = AvARRAY(protopad_name);
SV** ppad = AvARRAY(protopad);
+ I32 fname = AvFILL(protopad_name);
+ I32 fpad = AvFILL(protopad);
AV* comppadlist;
CV* cv;
av_store(comppad, 0, (SV*)av);
AvFLAGS(av) = AVf_REIFY;
- for (ix = AvFILL(protopad); ix > 0; ix--) {
- SV* namesv = pname[ix];
+ for (ix = fpad; ix > 0; ix--) {
+ SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
if (namesv && namesv != &sv_undef) {
char *name = SvPVX(namesv); /* XXX */
if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
/* Now that vars are all in place, clone nested closures. */
- for (ix = AvFILL(protopad); ix > 0; ix--) {
- SV* namesv = pname[ix];
+ for (ix = fpad; ix > 0; ix--) {
+ SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
if (namesv
&& namesv != &sv_undef
&& !(SvFLAGS(namesv) & SVf_FAKE)
db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
}
hv = GvHVn(db_postponed);
- if (HvFILL(hv) >= 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
- && (cv = GvCV(db_postponed))) {
+ if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
+ && (cv = GvCV(db_postponed))) {
dSP;
PUSHMARK(sp);
XPUSHs(tmpstr);
/* op.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#define PATCHLEVEL 3
-#define SUBVERSION 91
+#define SUBVERSION 92
/*
local_patches -- list of locally applied less-than-subversion patches.
/* perl.c
*
- * Copyright (c) 1987-1996 Larry Wall
+ * Copyright (c) 1987-1997 Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
return s;
case 'T':
if (!tainting)
- croak("Too late for \"-T\" option (try putting it first)");
+ croak("Too late for \"-T\" option");
s++;
return s;
case 'u':
#endif
#ifdef OS2
printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
- "Version 5 port Copyright (c) 1994-1996, Andreas Kaiser, Ilya Zakharevich\n");
+ "Version 5 port Copyright (c) 1994-1997, Andreas Kaiser, Ilya Zakharevich\n");
#endif
#ifdef atarist
printf("atariST series port, ++jrb bammi@cadence.com\n");
/* perl.h
*
- * Copyright (c) 1987-1994, Larry Wall
+ * Copyright (c) 1987-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#define PerlIO_printf fprintf
#define PerlIO_stdoutf printf
#define PerlIO_vprintf(f,fmt,a) vfprintf(f,fmt,a)
-#define PerlIO_read(f,buf,count) fread(buf,1,count,f)
#define PerlIO_write(f,buf,count) fwrite1(buf,1,count,f)
#define PerlIO_open fopen
#define PerlIO_fdopen fdopen
#define PerlIO_close(f) fclose(f)
#define PerlIO_puts(f,s) fputs(s,f)
#define PerlIO_putc(f,c) fputc(c,f)
-#if defined(VMS) && defined(__DECC)
- /* Unusual definition of ungetc() here to accomodate fast_sv_gets()'
- * belief that it can mix getc/ungetc with reads from stdio buffer */
- int decc$ungetc(int __c, FILE *__stream);
-# define PerlIO_ungetc(f,c) ((c) == EOF ? EOF : \
- ((*(f) && !((*(f))->_flag & _IONBF) && \
- ((*(f))->_ptr > (*(f))->_base)) ? \
- ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f)))
- /* Work around bug in DECCRTL/AXP (DECC v5.x) which causes read
- * from a pipe after EOF has been returned once to hang.
+#if defined(VMS)
+# if defined(__DECC)
+ /* Unusual definition of ungetc() here to accomodate fast_sv_gets()'
+ * belief that it can mix getc/ungetc with reads from stdio buffer */
+ int decc$ungetc(int __c, FILE *__stream);
+# define PerlIO_ungetc(f,c) ((c) == EOF ? EOF : \
+ ((*(f) && !((*(f))->_flag & _IONBF) && \
+ ((*(f))->_ptr > (*(f))->_base)) ? \
+ ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f)))
+# else
+# define PerlIO_ungetc(f,c) ungetc(c,f)
+# endif
+ /* Work around bug in DECCRTL/AXP (DECC v5.x) and some versions of old
+ * VAXCRTL which causes read from a pipe after EOF has been returned
+ * once to hang.
*/
# define PerlIO_getc(f) (feof(f) ? EOF : getc(f))
+# define PerlIO_read(f,buf,count) (feof(f) ? 0 : fread(buf,1,count,f))
#else
# define PerlIO_ungetc(f,c) ungetc(c,f)
# define PerlIO_getc(f) getc(f)
+# define PerlIO_read(f,buf,count) fread(buf,1,count,f)
#endif
#define PerlIO_eof(f) feof(f)
#define PerlIO_getname(f,b) fgetname(f,b)
/* perly.y
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
-p9pvers = 5.003_91
+p9pvers = 5.003_92
=head1 AUTHOR
-Larry Wall E<lt>F<larry@wall.org>E<gt>, with the help of oodles of other folks.
+Larry Wall <F<larry@wall.org>>, with the help of oodles of other folks.
=head1 FILES
You may mail your bug reports (be sure to include full configuration
information as output by the myconfig program in the perl source tree,
-or by C<perl -V>) to F<perlbug@perl.com>.
+or by C<perl -V>) to <F<perlbug@perl.com>>.
If you've succeeded in compiling perl, the perlbug script in the utils/
subdirectory can be used to help mail in a bug report.
=head1 AUTHOR
-Paul Marquess E<lt>F<pmarquess@bfsec.bt.co.uk>E<gt>
+Paul Marquess <F<pmarquess@bfsec.bt.co.uk>>
Special thanks to the following people who assisted in the creation of
the document.
C<$$."0">, but rather to C<${$0}>. To get the old behavior, change
"$$" followed by a digit to "${$}".
-=head2 Internal Change: FileHandle Deprecated
+=head2 Changes to Tainting Checks
-Filehandles are now stored internally as type IO::Handle.
-Although C<use FileHandle> and C<*STDOUT{FILEHANDLE}>
-are still supported for backwards compatibility,
-C<use IO::Handle> (or C<IO::Seekable> or C<IO::File>) and
-C<*STDOUT{IO}> are the way of the future.
+A bug in previous versions may have failed to detect some insecure
+conditions when taint checks are turned on. (Taint checks are used
+in setuid or setgid scripts, or when explicitly turned on with the
+C<-T> invocation option.) Although it's unlikely, this may cause a
+previously-working script to now fail -- which should be construed
+as a blessing, since that indicates a potentially-serious security
+hole was just plugged.
+
+=head2 Internal Change: FileHandle Class Based on IO::* Classes
+
+File handles are now stored internally as type IO::Handle. The
+FileHandle module is still supported for backwards compatibility, but
+it is now merely a front end to the IO::* modules -- specifically,
+IO::Handle, IO::Seekable, and IO::File. We suggest, but do not
+require, that you use the IO::* modules in new code.
+
+In harmony with this change, C<*GLOB{FILEHANDLE}> is now a
+backward-compatible synonym for C<*STDOUT{IO}>.
=head2 Internal Change: PerlIO internal IO abstraction interface
function whose prototype you want to retrieve.
(Not actually new; just never documented before.)
+=item srand
+
+The default seed for C<srand>, which used to be C<time>, has been changed.
+Now it's a heady mix of difficult-to-predict system-dependent values,
+which should be sufficient for most everyday purposes.
+
+Previous to version 5.004, calling C<rand> without first calling C<srand>
+would yield the same sequence of random numbers on most or all machines.
+Now, when perl sees that you're calling C<rand> and haven't yet called
+C<srand>, it calls C<srand> with the default seed. You should still call
+C<srand> manually if your code might ever be run on a pre-5.004 system,
+of course, or if you want a seed other than the default.
+
=item $_ as Default
Functions documented in the Camel to default to $_ now in
Home Page.
If you believe you have an unreported bug, please run the B<perlbug>
-program included with your release. Make sure you trim your bug
-down to a tiny but sufficient test case. Your bug report, along
-with the output of C<perl -V>, will be sent off to F<perlbug@perl.com>
-to be analysed by the Perl porting team.
+program included with your release. Make sure you trim your bug down
+to a tiny but sufficient test case. Your bug report, along with the
+output of C<perl -V>, will be sent off to <F<perlbug@perl.com>> to be
+analysed by the Perl porting team.
=head1 SEE ALSO
inlining. See L<perlsub/"Constant Functions"> for commentary and
workarounds.
+=item Constant subroutine %s undefined
+
+(S) You undefined a subroutine which had previously been eligible for
+inlining. See L<perlsub/"Constant Functions"> for commentary and
+workarounds.
+
=item Copy method did not return a reference
(F) The method which overloads "=" is buggy. See L<overload/Copy Constructor>.
(W) You may have tried to use an 8 or 9 in a octal number. Interpretation
of the octal number stopped before the 8 or 9.
+=item In string, @%s now must be written as \@%s
+
+(F) It used to be that Perl would try to guess whether you wanted an
+array interpolated or a literal @. It did this when the string was first
+used at runtime. Now strings are parsed at compile time, and ambiguous
+instances of @ must be disambiguated, either by prepending a backslash to
+indicate a literal, or by declaring (or using) the array within the
+program before the string (lexically). (Someday it will simply assume
+that an unbackslashed @ interpolates an array.)
+
=item Insecure dependency in %s
(F) You tried to do something that the tainting mechanism didn't like.
(W) You tried to do a listen on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/listen>.
-=item Literal @%s now requires backslash
-
-(F) It used to be that Perl would try to guess whether you wanted an
-array interpolated or a literal @. It did this when the string was
-first used at runtime. Now strings are parsed at compile time, and
-ambiguous instances of @ must be disambiguated, either by putting a
-backslash to indicate a literal, or by declaring (or using) the array
-within the program before the string (lexically). (Someday it will simply
-assume that an unbackslashed @ interpolates an array.)
-
=item Method for operation %s not found in package %s during blessing
(F) An attempt was made to specify an entry in an overloading table that
=item Server error
-Also known as "500 Server error". This is a CGI error, not a Perl
-error. You need to make sure your script is executable, is accessible
-by the user CGI is running the script under (which is probably not
-the user account you tested it under), does not rely on any environment
-variables (like PATH) from the user it isn't running under, and isn't
-in a location where the CGI server can't find it, basically, more or less.
+Also known as "500 Server error".
+
+B<This is a CGI error, not a Perl error>.
+
+You need to make sure your script is executable, is accessible by the user
+CGI is running the script under (which is probably not the user account you
+tested it under), does not rely on any environment variables (like PATH)
+from the user it isn't running under, and isn't in a location where the CGI
+server can't find it, basically, more or less. Please see the following
+for more information:
+
+ http://www.perl.com/perl/faq/idiots-guide.html
+ http://www.perl.com/perl/faq/perl-cgi-faq.html
+ ftp://rtfm.mit.edu/pub/usenet/news.answers/www/cgi-faq
+ http://hoohoo.ncsa.uiuc.edu/cgi/interface.html
+ http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
=item setegid() not implemented
(F) There has to be at least one argument to syscall() to specify the
system call to call, silly dilly.
-=item Too late for "B<-T>" option (try putting it first)
+=item Too late for "B<-T>" option
+
+(X) The #! line (or local equivalent) in a Perl script contains the
+B<-T> option, but Perl was not invoked with B<-T> in its argument
+list. This is an error because, by the time Perl discovers a B<-T> in
+a script, it's too late to properly taint everything from the
+environment. So Perl gives up.
-(X) The #! line in a Perl script contains the B<-T> option, but Perl
-was not invoked with B<-T> in its argument list. Due to the way Perl
-handles tainting, by the time Perl discovers a B<-T> in a script, it's
-too late to properly taint everything from the environment. So Perl
-gives up.
+If the Perl script is being executed as a command using the #!
+mechanism (or its local equivalent), this error can usually be fixed
+by editing the #! line so that the B<-T> option is a part of Perl's
+first argument: e.g. change C<perl -n -T> to C<perl -T -n>.
-This error can usually be fixed by editing the #! line so that the
-B<-T> option is in the Perl program's first argument. (Many operating
-systems that implement the #! feature only pick up one argument from
-it, so Perl has to get the rest on its own.)
+If the Perl script is being executed as C<perl scriptname>, then the
+B<-T> option must appear on the command line: C<perl -T scriptname>.
=item Too many ('s
is probably not what you intended. When using these constructs in
conditional expressions, test their values with the C<defined> operator.
-=item Variable "%s" is not exported
+=item Variable "%s" is not imported%s
(F) While "use strict" in effect, you referred to a global variable
that you apparently thought was imported from another module, because
=head1 AUTHOR
-Tom Christiansen E<lt>F<tchrist@perl.com>E<gt>
+Tom Christiansen <F<tchrist@perl.com>>
Last update:
Wed Oct 23 04:57:50 MET DST 1996
L<Using Perl modules, which themselves use C libraries, from your C program>
This documentation is Unix specific; if you have information about how
-to embed Perl on other platforms, please send e-mail to
-orwant@tpj.com.
+to embed Perl on other platforms, please send e-mail to <F<orwant@tpj.com>>.
=head2 Compiling your C program
=head1 AUTHOR
-Jon Orwant and F<E<lt>orwant@media.mit.eduE<gt>> and Doug MacEachern
-F<E<lt>dougm@osf.orgE<gt>>, with small contributions from Tim Bunce,
-Tom Christiansen, Hallvard Furuseth, Dov Grobgeld, and Ilya Zakharevich.
+Jon Orwant and <F<orwant@tpj.com>> and Doug MacEachern <F<dougm@osf.org>>,
+with small contributions from Tim Bunce, Tom Christiansen, Hallvard Furuseth,
+Dov Grobgeld, and Ilya Zakharevich.
Check out Doug's article on embedding in Volume 1, Issue 4 of The Perl
Journal. Info about TPJ is available from http://tpj.com.
=item gv_fetchmeth
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>.
+C<NULL>. The glob lives in the given C<stash>, or in the stashes
+accessable via @ISA and @<UNIVERSAL>.
-The argument C<level> should be either 0 or -1. If C<level==0>, as a
+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
C<stash> which in the case of success contains an alias for the
subroutine, and sets up caching info for this glob. Similarly for all
the searched stashes.
+This function grants C<"SUPER"> token as a postfix of the stash name.
+
The GV returned from C<gv_fetchmeth> may be a method cache entry,
which is not visible to Perl code. So when calling C<perl_call_sv>,
you should not use the GV directly; instead, you should use the
may load a different subroutine due to $AUTOLOAD changing its value.
Use the glob created via a side effect to do this.
-This function grants C<"SUPER"> token as prefix of name or postfix of
-the stash name.
+This function grants C<"SUPER"> token as a prefix of the method name.
Has the same side-effects and as C<gv_fetchmeth> with C<level==0>.
C<name> should be writable if contains C<':'> or C<'\''>.
=head1 EDITOR
-Jeff Okamoto <okamoto@corp.hp.com>
+Jeff Okamoto <F<okamoto@corp.hp.com>>
With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
Bowers, Matthew Green, Tim Bunce, Spider Boardman, and Ulrich Pfeifer.
-API Listing by Dean Roehrich <roehrich@cray.com>.
+API Listing by Dean Roehrich <F<roehrich@cray.com>>.
=head1 DATE
-Version 31.1: 1997/2/25
+Version 31.2: 1997/3/5
$rendezvous = shift || '/tmp/catsock';
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
- connect(SOCK, sockaddr_un($remote)) || die "connect: $!";
+ connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
while ($line = <SOCK>) {
print $line;
}
is broken and cannot be fixed or used by Perl. Such deficiencies can
and will result in mysterious hangs and/or Perl core dumps when the
C<use locale> is in effect. When confronted with such a system,
-please report in excruciating detail to F<perlbug@perl.com>, and
+please report in excruciating detail to <F<perlbug@perl.com>>, and
complain to your vendor: maybe some bug fixes exist for these problems
in your operating system. Sometimes such bug fixes are called an
operating system upgrade.
=head1 AUTHOR
-Tom Christiansen E<lt>F<tchrist@perl.com>E<gt>
+Tom Christiansen <F<tchrist@perl.com>>
Last udpate: Sat Oct 7 19:35:26 MDT 1995
calls on the class and its objects, without explicit exportation of any
symbols. Or it can do a little of both.
-For example, to start a normal module called Fred, create
-a file called Fred.pm and put this at the start of it:
-
- package Fred;
- use strict;
- use Exporter ();
- use vars qw(@ISA @EXPORT @EXPORT_OK);
- @ISA = qw(Exporter);
- @EXPORT = qw(&func1 &func2);
- @EXPORT_OK = qw($sally @listabob %harry &func3);
- use vars qw($sally @listabob %harry);
+For example, to start a normal module called Some::Module, create
+a file called Some/Module.pm and start with this template:
+
+ package Some::Module; # assumes Some/Module.pm
+
+ use strict;
+
+ BEGIN {
+ use Exporter ();
+ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+ # set the version for version checking
+ $VERSION = 1.00;
+ # if using RCS/CVS, this may be preferred
+ $VERSION = do { my @r = (q$Revision: 2.21 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
+
+ @ISA = qw(Exporter);
+ @EXPORT = qw(&func1 &func2 &func4);
+ %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
+
+ # your exported package globals go here,
+ # as well as any optionally exported functions
+ @EXPORT_OK = qw($Var1 %Hashit &func3);
+ }
+ use vars @EXPORT_OK;
+
+ # non-exported package globals go here
+ use vars qw(@more $stuff);
+
+ # initalize package globals, first exported ones
+ $Var1 = '';
+ %Hashit = ();
+
+ # then the others (which are still accessible as $Some::Module::stuff)
+ $stuff = '';
+ @more = ();
+
+ # all file-scoped lexicals must be created before
+ # the functions below that use them.
+
+ # file-private lexicals go here
+ my $priv_var = '';
+ my %secret_hash = ();
+
+ # here's a file-private function as a closure,
+ # callable as &$priv_func; it cannot be prototyped.
+ my $priv_func = sub {
+ # stuff goes here.
+ };
+
+ # make all your functions, whether exported or not;
+ # remember to put something interesting in the {} stubs
+ sub func1 {} # no prototype
+ sub func2() {} # proto'd void
+ sub func3($$) {} # proto'd to 2 scalars
+
+ # this one isn't exported, but could be called!
+ sub func4(\%) {} # proto'd to 1 hash ref
+
+ END { } # module clean-up code here (global destructor)
Then go on to declare and use your variables in functions
without any qualifications.
=over
=item *
-ftp://ftp.sterling.com/programming/languages/perl/
-
-=item *
-ftp://ftp.sedl.org/pub/mirrors/CPAN/
-
-=item *
-ftp://ftp.uoknor.edu/mirrors/CPAN/
-
-=item *
-ftp://ftp.delphi.com/pub/mirrors/packages/perl/CPAN/
+Africa
-=item *
-ftp://uiarchive.cso.uiuc.edu/pub/lang/perl/CPAN/
-
-=item *
-ftp://ftp.cis.ufl.edu/pub/perl/CPAN/
-
-=item *
-ftp://ftp.switch.ch/mirror/CPAN/
-
-=item *
-ftp://ftp.sunet.se/pub/lang/perl/CPAN/
-
-=item *
-ftp://ftp.ci.uminho.pt/pub/lang/perl/
-
-=item *
-ftp://ftp.cs.ruu.nl/pub/PERL/CPAN/
+ South Africa ftp://ftp.is.co.za/programming/perl/CPAN/
=item *
-ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
+Asia
-=item *
-ftp://ftp.rz.ruhr-uni-bochum.de/pub/programming/languages/perl/CPAN/
-
-=item *
-ftp://ftp.leo.org/pub/comp/programming/languages/perl/CPAN/
+ Hong Kong ftp://ftp.hkstar.com/pub/CPAN/
+ Japan ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/
+ ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
+ South Korea ftp://ftp.nuri.net/pub/CPAN/
+ Taiwan ftp://dongpo.math.ncu.edu.tw/perl/CPAN/
+ ftp://ftp.wownet.net/pub2/PERL/
=item *
-ftp://ftp.pasteur.fr/pub/computing/unix/perl/CPAN/
+Australasia
-=item *
-ftp://ftp.ibp.fr/pub/perl/CPAN/
-
-=item *
-ftp://ftp.funet.fi/pub/languages/perl/CPAN/
+ Australia ftp://ftp.netinfo.com.au/pub/perl/CPAN/
+ New Zealand ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/
=item *
-ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/
+Europe
+
+ Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/
+ Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/
+ Czech Republic ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/
+ Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/
+ Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/
+ France ftp://ftp.ibp.fr/pub/perl/CPAN/
+ ftp://ftp.pasteur.fr/pub/computing/unix/perl/CPAN/
+ Germany ftp://ftp.gmd.de/packages/CPAN/
+ ftp://ftp.leo.org/pub/comp/programming/languages/perl/CPAN/
+ ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/
+ ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/
+ ftp://ftp.uni-erlangen.de/pub/source/Perl/CPAN/
+ ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/
+ Greece ftp://ftp.ntua.gr/pub/lang/perl/
+ Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/
+ Italy ftp://cis.utovrm.it/CPAN/
+ the Netherlands ftp://ftp.cs.ruu.nl/pub/PERL/CPAN/
+ ftp://ftp.EU.net/packages/cpan/
+ Norway ftp://ftp.uit.no/pub/languages/perl/cpan/
+ Poland ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/
+ ftp://sunsite.icm.edu.pl/pub/CPAN/
+ Portugal ftp://ftp.ci.uminho.pt/pub/lang/perl/
+ ftp://ftp.telepac.pt/pub/CPAN/
+ Russia ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/
+ Slovenia ftp://ftp.arnes.si/software/perl/CPAN/
+ Spain ftp://ftp.etse.urv.es/pub/mirror/perl/
+ ftp://ftp.rediris.es/mirror/CPAN/
+ Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/
+ Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/
+ UK ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
+ ftp://sunsite.doc.ic.ac.uk/packages/CPAN/
+ ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/
=item *
-ftp://ftp.mame.mu.oz.au/pub/perl/CPAN/
+North America
+
+ Ontario ftp://ftp.utilis.com/public/CPAN/
+ ftp://enterprise.ic.gc.ca/pub/perl/CPAN/
+ Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/
+ California ftp://ftp.digital.com/pub/plan/perl/CPAN/
+ ftp://ftp.cdrom.com/pub/perl/
+ Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
+ Florida ftp://ftp.cis.ufl.edu/pub/perl/CPAN/
+ Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/
+ Massachusetts ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/
+ New York ftp://ftp.rge.com/pub/languages/perl/
+ North Carolina ftp://ftp.duke.edu/pub/perl/
+ Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/
+ Oregon ftp://ftp.orst.edu/pub/packages/CPAN/
+ Pennsylvania ftp://ftp.epix.net/pub/languages/perl/
+ Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/
+ ftp://ftp.metronet.com/pub/perl/
+ Washington ftp://ftp.spu.edu/pub/CPAN/
=item *
-ftp://coombs.anu.edu.au/pub/perl/
+South America
-=item *
-ftp://dongpo.math.ncu.edu.tw/perl/CPAN/
-
-=item *
-ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
-
-=item *
-ftp://ftp.is.co.za/programming/perl/CPAN/
+ Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/
=back
ftp://franz.ww.tu-berlin.de/incoming
ftp://ftp.cis.ufl.edu/incoming
-and notify upload@franz.ww.tu-berlin.de.
+and notify <F<upload@franz.ww.tu-berlin.de>>.
By using the WWW interface you can ask the Upload Server to mirror
your modules from your ftp or WWW site into your own directory on
system priority is retrieved and returned. If those variables are set,
then the process's priority is changed!
-We'll use Jarkko Hietaniemi F<E<lt>Jarkko.Hietaniemi@hut.fiE<gt>>'s
+We'll use Jarkko Hietaniemi <F<Jarkko.Hietaniemi@hut.fi>>'s
BSD::Resource class (not included) to access the PRIO_PROCESS, PRIO_MIN,
and PRIO_MAX constants from your system, as well as the getpriority() and
setpriority() system calls. Here's the preamble of the class.
Tom Christiansen
-TIEHANDLE by Sven Verdoolaege E<lt>F<skimo@dns.ufsia.ac.be>E<gt>
+TIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>>
=item Fixed Parsing of $$<digit>, &$<digit>, etc.
-=item Internal Change: FileHandle Deprecated
+=item Changes to Tainting Checks
+
+=item Internal Change: FileHandle Class Based on IO::* Classes
=item Internal Change: PerlIO internal IO abstraction interface
delete on slices, flock, printf and sprintf, keys as an lvalue, my() in
Control Structures, unpack() and pack(), use VERSION, use Module VERSION
-LIST, prototype(FUNCTION), $_ as Default, C<m//g> does not trigger a pos()
-reset on failure, nested C<sub{}> closures work now, formats work right on
-changing lexicals
+LIST, prototype(FUNCTION), srand, $_ as Default, C<m//g> does not trigger a
+pos() reset on failure, nested C<sub{}> closures work now, formats work
+right on changing lexicals
=item New Built-in Methods
Archiving and Compression, Images, Pixmap and Bitmap Manipulation, Drawing,
and Graphing, Mail and Usenet News, Control Flow Utilities (callbacks and
exceptions etc), File Handle and Input/Output Stream Utilities,
-Miscellaneous Modules
+Miscellaneous Modules, Africa, Asia, Australasia, Europe, North America,
+South America
=item Modules: Creation, Use, and Abuse
=item EXAMPLES
-=item CONFIGURATION VARIABLES
+=item CONFIGURATION OPTIONS
+
+default, auto_abbrev, getopt_compat, require_order, permute, bundling
+(default: reset), bundling_override (default: reset), ignore_case
+(default: set), ignore_case_always (default: reset), pass_through (default:
+reset), debug (default: reset)
+
+=item OTHER USEFUL VARIABLES
-$Getopt::Long::autoabbrev, $Getopt::Long::getopt_compat,
-$Getopt::Long::order, $Getopt::Long::bundling, $Getopt::Long::ignorecase,
-$Getopt::Long::passthrough, $Getopt::Long::VERSION, $Getopt::Long::error,
-$Getopt::Long::debug
+$Getopt::Long::VERSION, $Getopt::Long::error
=head2 Getopt::Std, getopt - Process single-character switches with switch
clustering
=item CONSTRUCTOR
-new ([ ARGS ] )
+new ([ ARGS ] ), new_tmpfile
=item METHODS
=item CONSTRUCTOR
-new ([ ARGS ] )
+new ([ ARGS ] ), new_tmpfile
=item METHODS
=item Minimal set of supported functions
C<ReadLine>, C<new>, C<readline>, C<addhistory>, C<IN>, $C<OUT>,
-C<MinLine>, C<findConsole>, C<Features>
+C<MinLine>, C<findConsole>, Attribs, C<Features>
+
+=item Additional supported functions
=item EXPORTS
+=item ENVIRONMENT
+
=head2 Test::Harness - run perl standard test scripts with statistics
=item SYNOPSIS
=back
If you find an example of a conversion trap that is not listed here,
-please submit it to Bill Middleton F<wjm@best.com> for inclusion.
-Also note that at least some of these can be caught with C<-w>.
+please submit it to Bill Middleton <F<wjm@best.com>> for inclusion.
+Also note that at least some of these can be caught with B<-w>.
=head2 Discontinuance, Deprecation, and BugFix traps
=item * BugFix
-Perl 4 would ignore any text which was attached to an C<-e> switch,
+Perl 4 would ignore any text which was attached to an B<-e> switch,
always taking the code snippet from the following arg. Additionally, it
-would silently accept an C<-e> switch without a following arg. Both of
+would silently accept an B<-e> switch without a following arg. Both of
these behaviors have been fixed.
perl -e'print "attached to -e"' 'print "separate arg"'
print "@fred"; # should print "1, 2, 4"
# perl4 prints: 1 2 4
- # perl5 prints: Literal @fred now requires backslash
+ # perl5 prints: In string, @fred now must be written as \@fred
=item * (Scalar String)
print "To: someone@somewhere.com\n";
# perl4 prints: To:someone@somewhere.com
- # perl5 errors : Literal @somewhere now requires backslash
+ # perl5 errors : In string, @somewhere now must be written as \@somewhere
=item * Interpolation
=head1 AUTHOR
-Dean Roehrich F<E<lt>roehrich@cray.comE<gt>>
+Dean Roehrich <F<roehrich@cray.com>>
Jul 8, 1996
=head2 Author
-Jeff Okamoto E<lt>F<okamoto@corp.hp.com>E<gt>
+Jeff Okamoto <F<okamoto@corp.hp.com>>
Reviewed and assisted by Dean Roehrich, Ilya Zakharevich, Andreas Koenig,
and Tim Bunce.
/* pp.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
else {
SV* sv = sv_newmortal();
if (HvFILL((HV*)TARG)) {
- sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
+ sprintf(buf, "%ld/%ld",
+ (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG)+1);
sv_setpv(sv, buf);
}
else
hv_undef((HV*)sv);
break;
case SVt_PVCV:
+ if (!CvANON((CV*)sv) && cv_const_sv((CV*)sv))
+ warn("Constant subroutine %s undefined",
+ GvENAME(CvGV((CV*)sv)));
+ /* FALL THROUGH */
+ case SVt_PVFM:
cv_undef((CV*)sv);
break;
case SVt_PVGV:
char decn[sizeof(UV) * 3 + 1];
char *t;
- (void) sprintf(decn, "%0*ld", sizeof(decn) - 1, auv);
+ (void) sprintf(decn, "%0*ld",
+ (int)sizeof(decn) - 1, auv);
sv = newSVpv(decn, 0);
while (s < strend) {
sv = mul128(sv, *s & 0x7f);
/* pp.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* pp_ctl.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
const void *a;
const void *b;
{
- SV **str1 = (SV **) a;
- SV **str2 = (SV **) b;
+ SV * const *str1 = (SV * const *)a;
+ SV * const *str2 = (SV * const *)b;
I32 oldsaveix = savestack_ix;
I32 oldscopeix = scopestack_ix;
I32 result;
const void *a;
const void *b;
{
- return sv_cmp(*(SV **)a, *(SV **)b);
+ return sv_cmp(*(SV * const *)a, *(SV * const *)b);
}
static int
const void *a;
const void *b;
{
- return sv_cmp_locale(*(SV **)a, *(SV **)b);
+ return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b);
}
PP(pp_reset)
/* pp_hot.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
else {
dTARGET;
if (HvFILL(hv)) {
- sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
+ sprintf(buf, "%ld/%ld", (long)HvFILL(hv), (long)HvMAX(hv)+1);
sv_setpv(TARG, buf);
}
else
}
else {
sv = TARG;
+ if (SvROK(sv))
+ sv_unref(sv);
(void)SvUPGRADE(sv, SVt_PV);
tmplen = SvLEN(sv); /* remember if already alloced */
if (!tmplen)
/* pp_sys.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
**** Alterations to Henry's code are...
****
- **** Copyright (c) 1991-1994, Larry Wall
+ **** Copyright (c) 1991-1997, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
*
**** Alterations to Henry's code are...
****
- **** Copyright (c) 1991-1994, Larry Wall
+ **** Copyright (c) 1991-1997, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
/* run.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
void
debprofdump()
{
- U32 i;
+ unsigned i;
if (!profiledata)
return;
for (i = 0; i < MAXO; i++) {
if (profiledata[i])
- PerlIO_printf(Perl_debug_log, "%d\t%lu\n", i, profiledata[i]);
+ PerlIO_printf(Perl_debug_log,
+ "%u\t%lu\n", i, (unsigned long)profiledata[i]);
}
}
/* scope.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* sv.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
CV* cv = GvCV(dstr);
if (cv) {
dref = (SV*)cv;
- if (dowarn && sref != dref &&
- !GvCVGEN((GV*)dstr) &&
- (CvROOT(cv) || CvXSUB(cv)) )
- warn("Subroutine %s redefined",
- GvENAME((GV*)dstr));
+ if (sref != dref &&
+ !GvCVGEN((GV*)dstr) &&
+ (CvROOT(cv) || CvXSUB(cv)) ) {
+ if (cv_const_sv(cv))
+ warn("Constant subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ else if (dowarn)
+ warn("Subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ }
}
}
if (GvCV(dstr) != (CV*)sref) {
SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */
DEBUG_P(PerlIO_printf(Perl_debug_log,
"Screamer: done, len=%d, string=|%.*s|\n",
- SvCUR(sv),SvCUR(sv),SvPVX(sv)));
+ SvCUR(sv),(int)SvCUR(sv),SvPVX(sv)));
}
else
{
/* sv.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
chdir 't' if -d 't';
@INC = "../lib";
-$ENV{PERL5LIB} = "../lib";
+$Is_VMS = $^O eq 'VMS';
+$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
$|=1;
$tmpfile = "runltmp000";
1 while -f ++$tmpfile;
-END { unlink $tmpfile if $tmpfile; }
+END { if ($tmpfile) { 1 while unlink $tmpfile; } }
for (@prgs){
my $switch;
- if (s/^\s*-\w+//){
- $switch = $&;
+ if (s/^\s*(-\w+)//){
+ $switch = $1;
}
my($prog,$expected) = split(/\nEXPECT\n/, $_);
- open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
- print TEST $prog, "\n";
+ open TEST, ">$tmpfile";
+ print TEST "$prog\n";
close TEST;
- $status = $?;
- $results = `cat $tmpfile`;
+ my $results = $Is_VMS ?
+ `MCR $^X "-I[-.lib]" $switch $tmpfile` :
+ `sh -c './perl $switch $tmpfile' 2>&1`;
+ my $status = $?;
$results =~ s/\n+$//;
+ # allow expected output to be written as if $prog is on STDIN
+ $results =~ s/runltmp\d+/-/g;
+ $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
$expected =~ s/\n+$//;
- if ( $results ne $expected){
+ if ($results ne $expected) {
print STDERR "PROG: $switch\n$prog\n";
print STDERR "EXPECTED:\n$expected\n";
print STDERR "GOT:\n$results\n";
# Taint tests by Tom Phoenix <rootbeer@teleport.com>.
#
# I don't claim to know all about tainting. If anyone sees
-# tests that I've missed here, please add them. But this is
+# tests that I've missed here, please add them. But this is
# better than having no tests at all, right?
#
for (split m/^/m, $diag) {
print "# $_";
}
- print "\n" unless
+ print "\n" unless
$diag eq ''
or substr($diag, -1) eq "\n";
}
close PROG;
my $echo = "$Invoke_Perl $ECHO";
-print "1..96\n";
+print "1..98\n";
# First, let's make sure that Perl is checking the dangerous
# environment variables. Maybe they aren't set yet, so we'll
$ENV{'DCL$PATH'} = '' if $Is_VMS;
$ENV{PATH} = $TAINT;
- $ENV{IFS} = '';
+ $ENV{IFS} = " \t\n";
test 1, eval { `$echo 1` } eq '';
test 2, $@ =~ /^Insecure \$ENV{PATH}/, $@;
test 3, eval { `$echo 1` } eq '';
test 4, $@ =~ /^Insecure \$ENV{IFS}/, $@;
- my ($tmp) = grep { (stat)[2] & 2 } '/tmp', '/var/tmp', '/usr/tmp';
+ my $tmp;
+ if ($^O eq 'os2' || $^O eq 'amigaos') {
+ print "# all directories are writeable\n";
+ }
+ else {
+ $tmp = (grep { defined and -d and (stat _)[2] & 2 }
+ qw(/tmp /var/tmp /usr/tmp /sys$scratch),
+ @ENV{qw(TMP TEMP)})[0]
+ or print "# can't find world-writeable directory to test PATH\n";
+ }
+
if ($tmp) {
$ENV{PATH} = $tmp;
+ $ENV{IFS} = " \t\n";
test 5, eval { `$echo 1` } eq '';
test 6, $@ =~ /^Insecure directory in \$ENV{PATH}/, $@;
}
else {
- print "# can't find writeable directory to test PATH tainting\n";
for (5..6) { print "ok $_\n" }
}
$ENV{PATH} = '';
- $ENV{IFS} = '';
+ $ENV{IFS} = " \t\n";
test 7, eval { `$echo 1` } eq "1\n";
test 8, $@ eq '', $@;
$ENV{'DCL$PATH'} = $TAINT;
test 9, eval { `$echo 1` } eq '';
test 10, $@ =~ /^Insecure \$ENV{DCL\$PATH}/, $@;
+ if ($tmp) {
+ $ENV{'DCL$PATH'} = $tmp;
+ test 11, eval { `$echo 1` } eq '';
+ test 12, $@ =~ /^Insecure directory in \$ENV{DCL\$PATH}/, $@;
+ }
+ else {
+ print "# can't find world-writeable directory to test DCL\$PATH\n";
+ for (11..12) { print "ok $_\n" }
+ }
$ENV{'DCL$PATH'} = '';
}
else {
print "# This is not VMS\n";
- for (9..10) { print "ok $_\n"; }
+ for (9..12) { print "ok $_\n"; }
}
}
# Let's see that we can taint and untaint as needed.
{
my $foo = $TAINT;
- test 11, tainted $foo;
+ test 13, tainted $foo;
+
+ # That was a sanity check. If it failed, stop the insanity!
+ die "Taint checks don't seem to be enabled" unless tainted $foo;
$foo = "foo";
- test 12, not tainted $foo;
+ test 14, not tainted $foo;
taint_these($foo);
- test 13, tainted $foo;
+ test 15, tainted $foo;
my @list = 1..10;
- test 14, not any_tainted @list;
+ test 16, not any_tainted @list;
taint_these @list[1,3,5,7,9];
- test 15, any_tainted @list;
- test 16, all_tainted @list[1,3,5,7,9];
- test 17, not any_tainted @list[0,2,4,6,8];
+ test 17, any_tainted @list;
+ test 18, all_tainted @list[1,3,5,7,9];
+ test 19, not any_tainted @list[0,2,4,6,8];
($foo) = $foo =~ /(.+)/;
- test 18, not tainted $foo;
+ test 20, not tainted $foo;
$foo = $1 if ('bar' . $TAINT) =~ /(.+)/;
- test 19, not tainted $foo;
- test 20, $foo eq 'bar';
+ test 21, not tainted $foo;
+ test 22, $foo eq 'bar';
my $pi = 4 * atan2(1,1) + $TAINT0;
- test 21, tainted $pi;
+ test 23, tainted $pi;
($pi) = $pi =~ /(\d+\.\d+)/;
- test 22, not tainted $pi;
- test 23, sprintf("%.5f", $pi) eq '3.14159';
+ test 24, not tainted $pi;
+ test 25, sprintf("%.5f", $pi) eq '3.14159';
}
# How about command-line arguments? The problem is that we don't
};
close PROG;
print `$Invoke_Perl "-T" $arg and some suspect arguments`;
- test 24, !$?, "Exited with status $?";
+ test 26, !$?, "Exited with status $?";
unlink $arg;
}
# Reading from a file should be tainted
{
- my $file = './perl' . $Config{exe_ext};
- test 25, open(FILE, $file), "Couldn't open '$file': $!";
+ my $file = './TEST';
+ test 27, open(FILE, $file), "Couldn't open '$file': $!";
my $block;
sysread(FILE, $block, 100);
- my $line = <FILE>; # Should "work"
+ my $line = <FILE>;
close FILE;
- test 26, tainted $block;
- test 27, tainted $line;
+ test 28, tainted $block;
+ test 29, tainted $line;
}
-# Globs should be tainted.
+# Globs should be tainted.
{
+ # Some glob implementations need to spawn system programs.
+ local $ENV{PATH} = '';
+ $ENV{PATH} = (-l '/bin' ? '' : '/bin:') . '/usr/bin' unless $Is_VMS;
+
my @globs = <*>;
- test 28, all_tainted @globs;
+ test 30, all_tainted @globs;
@globs = glob '*';
- test 29, all_tainted @globs;
+ test 31, all_tainted @globs;
}
# Output of commands should be tainted
{
my $foo = `$echo abc`;
- test 30, tainted $foo;
+ test 32, tainted $foo;
}
# Certain system variables should be tainted
{
- test 31, all_tainted $^X, $0;
+ test 33, all_tainted $^X, $0;
}
# Results of matching should all be untainted
{
my $foo = "abcdefghi" . $TAINT;
- test 32, tainted $foo;
+ test 34, tainted $foo;
$foo =~ /def/;
- test 33, not any_tainted $`, $&, $';
+ test 35, not any_tainted $`, $&, $';
$foo =~ /(...)(...)(...)/;
- test 34, not any_tainted $1, $2, $3, $+;
+ test 36, not any_tainted $1, $2, $3, $+;
my @bar = $foo =~ /(...)(...)(...)/;
- test 35, not any_tainted @bar;
+ test 37, not any_tainted @bar;
- test 36, tainted $foo; # $foo should still be tainted!
- test 37, $foo eq "abcdefghi";
+ test 38, tainted $foo; # $foo should still be tainted!
+ test 39, $foo eq "abcdefghi";
}
# Operations which affect files can't use tainted data.
{
- test 38, eval { chmod 0, $TAINT } eq '', 'chmod';
- test 39, $@ =~ /^Insecure dependency/, $@;
-
- test 40, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
+ test 40, eval { chmod 0, $TAINT } eq '', 'chmod';
test 41, $@ =~ /^Insecure dependency/, $@;
- test 42, eval { rename '', $TAINT } eq '', 'rename';
- test 43, $@ =~ /^Insecure dependency/, $@;
+ # There is no feature test in $Config{} for truncate,
+ # so we allow for the possibility that it's missing.
+ test 42, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
+ test 43, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;
- test 44, eval { unlink $TAINT } eq '', 'unlink';
+ test 44, eval { rename '', $TAINT } eq '', 'rename';
test 45, $@ =~ /^Insecure dependency/, $@;
- test 46, eval { utime $TAINT } eq '', 'utime';
+ test 46, eval { unlink $TAINT } eq '', 'unlink';
test 47, $@ =~ /^Insecure dependency/, $@;
+ test 48, eval { utime $TAINT } eq '', 'utime';
+ test 49, $@ =~ /^Insecure dependency/, $@;
+
if ($Config{d_chown}) {
- test 48, eval { chown -1, -1, $TAINT } eq '', 'chown';
- test 49, $@ =~ /^Insecure dependency/, $@;
+ test 50, eval { chown -1, -1, $TAINT } eq '', 'chown';
+ test 51, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# chown() is not available\n";
- for (48..49) { print "ok $_\n" }
+ for (50..51) { print "ok $_\n" }
}
if ($Config{d_link}) {
- test 50, eval { link $TAINT, '' } eq '', 'link';
- test 51, $@ =~ /^Insecure dependency/, $@;
+ test 52, eval { link $TAINT, '' } eq '', 'link';
+ test 53, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# link() is not available\n";
- for (50..51) { print "ok $_\n" }
+ for (52..53) { print "ok $_\n" }
}
if ($Config{d_symlink}) {
- test 52, eval { symlink $TAINT, '' } eq '', 'symlink';
- test 53, $@ =~ /^Insecure dependency/, $@;
+ test 54, eval { symlink $TAINT, '' } eq '', 'symlink';
+ test 55, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# symlink() is not available\n";
- for (52..53) { print "ok $_\n" }
+ for (54..55) { print "ok $_\n" }
}
}
# Operations which affect directories can't use tainted data.
{
- test 54, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
- test 55, $@ =~ /^Insecure dependency/, $@;
-
- test 56, eval { rmdir $TAINT } eq '', 'rmdir';
+ test 56, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
test 57, $@ =~ /^Insecure dependency/, $@;
- test 58, eval { chdir $TAINT } eq '', 'chdir';
+ test 58, eval { rmdir $TAINT } eq '', 'rmdir';
test 59, $@ =~ /^Insecure dependency/, $@;
+ test 60, eval { chdir $TAINT } eq '', 'chdir';
+ test 61, $@ =~ /^Insecure dependency/, $@;
+
if ($Config{d_chroot}) {
- test 60, eval { chroot $TAINT } eq '', 'chroot';
- test 61, $@ =~ /^Insecure dependency/, $@;
+ test 62, eval { chroot $TAINT } eq '', 'chroot';
+ test 63, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# chroot() is not available\n";
- for (60..61) { print "ok $_\n" }
+ for (62..63) { print "ok $_\n" }
}
}
# Some operations using files can't use tainted data.
{
my $foo = "imaginary library" . $TAINT;
- test 62, eval { require $foo } eq '', 'require';
- test 63, $@ =~ /^Insecure dependency/, $@;
+ test 64, eval { require $foo } eq '', 'require';
+ test 65, $@ =~ /^Insecure dependency/, $@;
my $filename = "./taintB$$"; # NB: $filename isn't tainted!
END { unlink $filename if defined $filename }
$foo = $filename . $TAINT;
unlink $filename; # in any case
- test 64, eval { open FOO, $foo } eq '', 'open for read';
- test 65, $@ eq '', $@; # NB: This should be allowed
- test 66, $! == 2; # File not found
+ test 66, eval { open FOO, $foo } eq '', 'open for read';
+ test 67, $@ eq '', $@; # NB: This should be allowed
+ test 68, $! == 2; # File not found
- test 67, eval { open FOO, "> $foo" } eq '', 'open for write';
- test 68, $@ =~ /^Insecure dependency/, $@;
+ test 69, eval { open FOO, "> $foo" } eq '', 'open for write';
+ test 70, $@ =~ /^Insecure dependency/, $@;
}
# Commands to the system can't use tainted data
if ($^O eq 'amigaos') {
print "# open(\"|\") is not available\n";
- for (69..72) { print "ok $_\n" }
+ for (71..74) { print "ok $_\n" }
}
else {
- test 69, eval { open FOO, "| $foo" } eq '', 'popen to';
- test 70, $@ =~ /^Insecure dependency/, $@;
-
- test 71, eval { open FOO, "$foo |" } eq '', 'popen from';
+ test 71, eval { open FOO, "| $foo" } eq '', 'popen to';
test 72, $@ =~ /^Insecure dependency/, $@;
- }
- test 73, eval { exec $TAINT } eq '', 'exec';
- test 74, $@ =~ /^Insecure dependency/, $@;
+ test 73, eval { open FOO, "$foo |" } eq '', 'popen from';
+ test 74, $@ =~ /^Insecure dependency/, $@;
+ }
- test 75, eval { system $TAINT } eq '', 'system';
+ test 75, eval { exec $TAINT } eq '', 'exec';
test 76, $@ =~ /^Insecure dependency/, $@;
+ test 77, eval { system $TAINT } eq '', 'system';
+ test 78, $@ =~ /^Insecure dependency/, $@;
+
$foo = "*";
taint_these $foo;
- test 77, eval { `$echo 1$foo` } eq '', 'backticks';
- test 78, $@ =~ /^Insecure dependency/, $@;
+ test 79, eval { `$echo 1$foo` } eq '', 'backticks';
+ test 80, $@ =~ /^Insecure dependency/, $@;
if ($Is_VMS) { # wildcard expansion doesn't invoke shell, so is safe
- test 79, join('', eval { glob $foo } ) ne '', 'globbing';
- test 80, $@ eq '', $@;
+ test 81, join('', eval { glob $foo } ) ne '', 'globbing';
+ test 82, $@ eq '', $@;
}
else {
- test 79, join('', eval { glob $foo } ) eq '', 'globbing';
- test 80, $@ =~ /^Insecure dependency/, $@;
+ test 81, join('', eval { glob $foo } ) eq '', 'globbing';
+ test 82, $@ =~ /^Insecure dependency/, $@;
}
}
# Operations which affect processes can't use tainted data.
{
- test 81, eval { kill 0, $TAINT } eq '', 'kill';
- test 82, $@ =~ /^Insecure dependency/, $@;
+ test 83, eval { kill 0, $TAINT } eq '', 'kill';
+ test 84, $@ =~ /^Insecure dependency/, $@;
if ($Config{d_setpgrp}) {
- test 83, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
- test 84, $@ =~ /^Insecure dependency/, $@;
+ test 85, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
+ test 86, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# setpgrp() is not available\n";
- for (83..84) { print "ok $_\n" }
+ for (85..86) { print "ok $_\n" }
}
if ($Config{d_setprior}) {
- test 85, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
- test 86, $@ =~ /^Insecure dependency/, $@;
+ test 87, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
+ test 88, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# setpriority() is not available\n";
- for (85..86) { print "ok $_\n" }
+ for (87..88) { print "ok $_\n" }
}
}
# Some miscellaneous operations can't use tainted data.
{
if ($Config{d_syscall}) {
- test 87, eval { syscall $TAINT } eq '', 'syscall';
- test 88, $@ =~ /^Insecure dependency/, $@;
+ test 89, eval { syscall $TAINT } eq '', 'syscall';
+ test 90, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# syscall() is not available\n";
- for (87..88) { print "ok $_\n" }
+ for (89..90) { print "ok $_\n" }
}
{
local *FOO;
my $temp = "./taintC$$";
END { unlink $temp }
- test 89, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
+ test 91, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
- test 90, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
- test 91, $@ =~ /^Insecure dependency/, $@;
+ test 92, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
+ test 93, $@ =~ /^Insecure dependency/, $@;
if ($Config{d_fcntl}) {
- test 92, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
- test 93, $@ =~ /^Insecure dependency/, $@;
+ test 94, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
+ test 95, $@ =~ /^Insecure dependency/, $@;
}
else {
print "# fcntl() is not available\n";
- for (92..93) { print "ok $_\n" }
+ for (94..95) { print "ok $_\n" }
}
close FOO;
}
}
-# Some tests involving references
+# Some tests involving references
{
my $foo = 'abc' . $TAINT;
my $fooref = \$foo;
- test 94, not tainted $fooref;
- test 95, tainted $$fooref;
- test 96, tainted $foo;
+ test 96, not tainted $fooref;
+ test 97, tainted $$fooref;
+ test 98, tainted $foo;
}
$joe = 1 ;
EXPECT
Global symbol "joe" requires explicit package name at - line 5.
-Variable "$joe" is not imported at - line 8.
-Global symbol "joe" requires explicit package name at - line 8.
Execution of - aborted due to compilation errors.
########
/* toke.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
GV *gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV);
if (!gv || ((tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) {
char tmpbuf[1024];
- sprintf(tmpbuf, "Literal %s now requires backslash", tokenbuf);
+ sprintf(tmpbuf, "In string, %s now must be written as \\%s",
+ tokenbuf, tokenbuf);
yyerror(tmpbuf);
}
}
*/
SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
assert(SvPOK(x) || SvGMAGICAL(x));
- if (sv_eq(x, GvSV(curcop->cop_filegv)))
+ if (sv_eq(x, GvSV(curcop->cop_filegv))) {
sv_setpvn(x, ipath, ipathend - ipath);
+ SvSETMAGIC(x);
+ }
TAINT_NOT; /* $^X is always tainted, but that's OK */
}
#endif /* ARG_ZERO_IS_SCRIPT */
/* util.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* util.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
* when Perl is built. Please do not change it by hand; make
* any changes to FndVers.Com instead.
*/
-#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00391" /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00392" /**/
#define ARCHLIB ARCHLIB_EXP /*config-skip*/
/* ARCHNAME:
.endif
# Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00391#
+PERL_VERSION = 5_00392#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
archify : all
@ Write Sys$Output "Moving files to architecture-specific locations for $(ARCH)"
archroot = "$(ARCHAUTO)" - "]" + "...]"
- Backup/Log/Verify [.lib.auto...]*.*;/Exclude=(*.al,*.ix) 'archroot'
- Delete/Log/NoConfirm [.lib.auto...]*.*;*/exclude=(*.al,*.ix)
+ Backup/Log/Verify [.lib.auto...]*.*;/Exclude=(*.al,*.ix) 'archroot'/New_Version
+ Delete/Log/NoConfirm [.lib.auto...]*.*;*/exclude=(*.al,*.ix,*.dir)
Delete/Log/NoConfirm [.lib]Config.pm;*
Copy/Log/NoConfirm *$(E);,[.x2p]a2p$(E); $(ARCHDIR)
Delete/Log/NoConfirm Perl*$(E);*,[.x2p]a2p$(E);*
int retval = 0;
#if YYDEBUG
register char *yys;
+# ifndef getenv
extern char *getenv();
+# endif
#endif
struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
/* sockadapt.c
*
* Author: Charles Bailey bailey@genetics.upenn.edu
- * Last Revised: 29-Jan-1996
+ * Last Revised: 4-Mar-1997
*
* This file should contain stubs for any of the TCP/IP functions perl5
* requires which are not supported by your TCP/IP stack. These stubs
* can attempt to emulate the routine in question, or can just return
* an error status or cause perl to die.
*
- * This version is set up for perl5 with socketshr 0.9D TCP/IP support.
+ * This version is set up for perl5 with UCX (or emulation) via
+ * the DECCRTL or SOCKETSHR 0.9D.
*/
#include "EXTERN.h"
#include "perl.h"
+
#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000)
+# define __sockadapt_my_hostent_t __struct_hostent_ptr32
# define __sockadapt_my_netent_t __struct_netent_ptr32
+# define __sockadapt_my_servent_t __struct_servent_ptr32
# define __sockadapt_my_addr_t __in_addr_t
# define __sockadapt_my_name_t const char *
#else
+# define __sockadapt_my_hostent_t struct hostent *
# define __sockadapt_my_netent_t struct netent *
+# define __sockadapt_my_servent_t struct servent *
# define __sockadapt_my_addr_t long
# define __sockadapt_my_name_t char *
#endif
+void setnetent(int stayopen) {
+ croak("Function \"setnetent\" not implemented in this version of perl");
+}
+void endnetent() {
+ croak("Function \"endnetent\" not implemented in this version of perl");
+}
+
+#if defined(DECCRTL_SOCKETS)
+ /* Use builtin socket interface in DECCRTL and
+ * UCX emulation in whatever TCP/IP stack is present.
+ */
+
+ void sethostent(int stayopen) {
+ croak("Function \"sethostent\" not implemented in this version of perl");
+ }
+ void endhostent() {
+ croak("Function \"endhostent\" not implemented in this version of perl");
+ }
+ void setprotoent(int stayopen) {
+ croak("Function \"setprotoent\" not implemented in this version of perl");
+ }
+ void endprotoent() {
+ croak("Function \"endprotoent\" not implemented in this version of perl");
+ }
+ void setservent(int stayopen) {
+ croak("Function \"setservent\" not implemented in this version of perl");
+ }
+ void endservent() {
+ croak("Function \"endservent\" not implemented in this version of perl");
+ }
+ __sockadapt_my_hostent_t gethostent() {
+ croak("Function \"gethostent\" not implemented in this version of perl");
+ return (__sockadapt_my_hostent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
+ }
+ __sockadapt_my_servent_t getservent() {
+ croak("Function \"getservent\" not implemented in this version of perl");
+ return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
+ }
+
+#else
+ /* Work around things missing/broken in SOCKETSHR. */
+
__sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) {
croak("Function \"getnetbyaddr\" not implemented in this version of perl");
return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
}
__sockadapt_my_netent_t getnetent() {
croak("Function \"getnetent\" not implemented in this version of perl");
- return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
-}
-void setnetent() {
- croak("Function \"setnetent\" not implemented in this version of perl");
-}
-void endnetent() {
- croak("Function \"endnetent\" not implemented in this version of perl");
+ return (__sockadapt_my_netent_t )NULL; /* Avoid MISSINGRETURN warning, not reached */
}
/* Some TCP/IP implementations seem to return success, when getpeername()
}
return rslt;
}
+#endif /* SOCKETSHR stuff */
*
* Authors: Charles Bailey bailey@genetics.upenn.edu
* David Denholm denholm@conmat.phys.soton.ac.uk
- * Last Revised: 17-Mar-1995
+ * Last Revised: 4-Mar-1997
*
* This file should include any other header files and procide any
* declarations, typedefs, and prototypes needed by perl for TCP/IP
* This version is set up for perl5 with socketshr 0.9D TCP/IP support.
*/
-/* SocketShr doesn't support these routines, but the DECC RTL contains
- * stubs with these names, designed to be used with the UCX socket
- * library. We avoid linker collisions by substituting new names.
- */
-#define getnetbyaddr no_getnetbyaddr
-#define getnetbyname no_getnetbyname
-#define getnetent no_getnetent
-#define setnetent no_setnetent
-#define endnetent no_endnetent
+#ifndef __SOCKADAPT_INCLUDED
+#define __SOCKADAPT_INCLUDED 1
+
+#if defined(DECCRTL_SOCKETS)
+ /* Use builtin socket interface in DECCRTL and
+ * UCX emulation in whatever TCP/IP stack is present.
+ * Provide prototypes for missing routines; stubs are
+ * in sockadapt.c.
+ */
+# include <socket.h>
+# include <inet.h>
+# include <in.h>
+# include <netdb.h>
+ void sethostent(int);
+ void endhostent(void);
+ void setnetent(int);
+ void endnetent(void);
+ void setprotoent(int);
+ void endprotoent(void);
+ void setservent(int);
+ void endservent(void);
+
+#else
+ /* Pull in SOCKETSHR's header, and set up structures for
+ * gcc, whose basic header file set doesn't include the
+ * TCP/IP stuff.
+ */
#ifdef __GNU_CC__
struct netent *getnetbyaddr( long net, int type);
struct netent *getnetbyname( char *name);
struct netent *getnetent();
-void setnetent();
+void setnetent(int);
void endnetent();
#else /* !__GNU_CC__ */
#include <inet.h>
#include <netdb.h>
/* However, we don't have these two in the system headers. */
-void setnetent();
+void setnetent(int);
void endnetent();
+/* SocketShr doesn't support these routines, but the DECC RTL contains
+ * stubs with these names, designed to be used with the UCX socket
+ * library. We avoid linker collisions by substituting new names.
+ */
+#define getnetbyaddr no_getnetbyaddr
+#define getnetbyname no_getnetbyname
+#define getnetent no_getnetent
+#define setnetent no_setnetent
+#define endnetent no_endnetent
#endif
#include <socketshr.h>
-/* socketshr.h from SocketShr 0.9D doesn't alias fileno; it's comments say
+/* socketshr.h from SocketShr 0.9D doesn't alias fileno; its comments say
* that the CRTL version works OK. This isn't the case, at least with
* VAXC, so we use the SocketShr version.
* N.B. This means that sockadapt.h must be included *after* stdio.h.
#endif
#define getpeername my_getpeername
int my_getpeername _((int, struct sockaddr *, int *));
+
+#endif /* SOCKETSHR stuff */
+#endif /* include guard */
/*
* VMS readdir() routines.
* Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
- * This code has no copyright.
*
* 21-Jul-1994 Charles Bailey bailey@genetics.upenn.edu
* Minor modifications to original routines.
# "y.tab.c" is illegal as a VMS filename; DECC 5.2/VAX preprocessor
# doesn't like this.
if ( s/^#line\s+(\d+)\s+"y.tab.c"/#line $1 "y_tab.c"/ ) { 1; }
+ elsif (/char \*getenv/) {
+ # accomodate old VAXC's macro susbstitution pecularities
+ $_ = "# ifndef getenv\n$_# endif\n";
+ }
else {
# add the dEXT tag to definitions of global vars, so we'll insert
# a globaldef when perly.c is compiled
* opendir(), closedir(), readdir(), seekdir(), telldir(), and
* vmsreaddirversions(), and preprocessor stuff on which these depend:
* Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
- * This code has no copyright.
*/
/* Data structure returned by READDIR(). */
struct dirent {
/* EXTERN.h
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: EXTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:05 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: INTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:06 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#line 2 "a2p.y"
/* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: a2p.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:09 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
%{
/* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
STR *walk();
#ifdef OS2
+static void
usage()
{
printf("\nThis is the AWK to PERL translator, version 5.0, patchlevel %d\n", PATCHLEVEL);
exit(1);
}
#endif
+
+int
main(argc,argv,env)
register int argc;
register char **argv;
/* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:20 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: hash.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:21 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* proto.h
*
- * Copyright (c) 1991-1996, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: str.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:26 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: str.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:27 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: util.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:29 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: util.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:30 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* $RCSfile: walk.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:31 $
*
- * Copyright (c) 1991, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
https://perl5.git.perl.org / perl5.git / commitdiff