# This is a patch for perl5.004_01 to bring it up to perl5.004_01_02. # To apply this patch, chdir to you perl5.004_01 source directory and enter # # /bin/sh # patch -p1 -N < touch win32/bin/runperl.bat exit Index: perl5.004_01_02/patchlevel.h *** perl5.004_01/patchlevel.h Wed Jun 11 03:06:10 1997 --- perl5.004_01_02/patchlevel.h Thu Jul 31 22:55:52 1997 *************** *** 38,43 **** --- 38,44 ---- */ static char *local_patches[] = { NULL + ,"MAINT_TRIAL_2 - Maintenance release trial 2" ,NULL }; Index: perl5.004_01_02/Configure Prereq: 3.0.1.8 *** perl5.004_01/Configure Wed Jun 11 00:28:03 1997 --- perl5.004_01_02/Configure Fri Aug 1 00:20:50 1997 *************** *** 739,745 **** loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" : general looking path for locating libraries ! glibpth="/shlib /usr/shlib /lib/pa1.1 /usr/lib/large" glibpth="$glibpth /lib /usr/lib $xlibpth" glibpth="$glibpth /lib/large /usr/lib/small /lib/small" glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib" --- 739,745 ---- loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" : general looking path for locating libraries ! glibpth="/shlib /usr/shlib /usr/lib/pa1.1 /usr/lib/large" glibpth="$glibpth /lib /usr/lib $xlibpth" glibpth="$glibpth /lib/large /usr/lib/small /lib/small" glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib" *************** *** 1780,1785 **** --- 1780,1789 ---- bsd386) osname=bsd386 osvers=`$uname -r` ;; + powerux | power_ux | powermax_os | powermaxos | \ + powerunix | power_unix) osname=powerux + osvers="$3" + ;; next*) osname=next ;; solaris) osname=solaris case "$3" in *************** *** 6377,6383 **** EOCP : check sys/file.h first to get FREAD on Sun if $test `./findhdr sys/file.h` && \ ! $cc $cppflags "-DI_SYS_FILE" open3.c -o open3 >/dev/null 2>&1 ; then h_sysfile=true; echo " defines the O_* constants..." >&4 if ./open3; then --- 6381,6387 ---- EOCP : check sys/file.h first to get FREAD on Sun if $test `./findhdr sys/file.h` && \ ! $cc $ccflags "-DI_SYS_FILE" -o open3 $ldflags open3.c $libs ; then h_sysfile=true; echo " defines the O_* constants..." >&4 if ./open3; then *************** *** 6388,6394 **** val="$undef" fi elif $test `./findhdr fcntl.h` && \ ! $cc "-DI_FCNTL" open3.c -o open3 >/dev/null 2>&1 ; then h_fcntl=true; echo " defines the O_* constants..." >&4 if ./open3; then --- 6392,6398 ---- val="$undef" fi elif $test `./findhdr fcntl.h` && \ ! $cc $ccflags "-DI_FCNTL" -o open3 $ldflags open3.c $libs ; then h_fcntl=true; echo " defines the O_* constants..." >&4 if ./open3; then Index: perl5.004_01_02/INSTALL Prereq: 1.18 *** perl5.004_01/INSTALL Wed Jun 11 02:09:17 1997 --- perl5.004_01_02/INSTALL Thu Jul 31 23:43:20 1997 *************** *** 123,128 **** --- 123,132 ---- then Configure will suggest /opt/perl/lib instead of /opt/perl/lib/perl5/. + NOTE: You must not specify an installation directory that is below + your perl source directory. If you do, installperl will attempt + infinite recursion. + By default, Configure will compile perl to use dynamic loading if your system supports it. If you want to force perl to be compiled statically, you can either choose this when Configure prompts you or *************** *** 661,680 **** =over 4 ! =item -DDEBUGGING_MSTATS ! ! If DEBUGGING_MSTATS is defined, you can extract malloc ! statistics from the Perl interpreter. The overhead this imposes is not ! large (perl just twiddles integers at malloc/free/sbrk time). When you ! run perl with the environment variable PERL_DEBUG_MSTATS set to ! either 1 or 2, the interpreter will dump statistics to stderr at exit ! time and (with a value of 2) after compilation. If you install the ! Devel::Peek module you can get the statistics whenever you like by ! invoking its mstat() function. ! ! =item -DEMERGENCY_SBRK ! If EMERGENCY_SBRK is defined, running out of memory need not be a fatal error: a memory pool can allocated by assigning to the special variable $^M. See perlvar(1) for more details. --- 665,673 ---- =over 4 ! =item -DPERL_EMERGENCY_SBRK ! If PERL_EMERGENCY_SBRK is defined, running out of memory need not be a fatal error: a memory pool can allocated by assigning to the special variable $^M. See perlvar(1) for more details. *************** *** 1145,1154 **** =head1 make test ! This will run the regression tests on the perl you just made. If it ! doesn't say "All tests successful" then something went wrong. See the ! file t/README in the t subdirectory. Note that you can't run the ! tests in background if this disables opening of /dev/tty. If make test bombs out, just cd to the t directory and run ./TEST by hand to see if it makes any difference. If individual tests --- 1138,1151 ---- =head1 make test ! This will run the regression tests on the perl you just made (you ! should run plain 'make' before 'make test' otherwise you won't have a ! complete build). If 'make test' doesn't say "All tests successful" ! then something went wrong. See the file t/README in the t subdirectory. ! ! If you want to run make test in the background you should ! Note that you can't run the tests in background if this disables ! opening of /dev/tty. If make test bombs out, just cd to the t directory and run ./TEST by hand to see if it makes any difference. If individual tests *************** *** 1410,1413 **** =head1 LAST MODIFIED ! $Id: INSTALL,v 1.18 1997/05/29 18:24:10 doughera Exp $ --- 1407,1410 ---- =head1 LAST MODIFIED ! $Id: INSTALL,v 1.21.1.1 1997/07/31 21:48:38 timbo Released $ Index: perl5.004_01_02/MANIFEST *** perl5.004_01/MANIFEST Thu Jun 12 21:32:45 1997 --- perl5.004_01_02/MANIFEST Tue Jul 29 01:01:17 1997 *************** *** 819,825 **** win32/TEST Win32 port win32/autosplit.pl Win32 port win32/bin/network.pl Win32 port ! win32/bin/pl2bat.bat Win32 port win32/bin/search.bat Win32 port win32/bin/test.bat Win32 port win32/bin/webget.bat Win32 port --- 819,826 ---- win32/TEST Win32 port win32/autosplit.pl Win32 port win32/bin/network.pl Win32 port ! win32/bin/pl2bat.bat wrap perl scripts into batch files ! win32/bin/runperl.bat run perl script via batch file namesake win32/bin/search.bat Win32 port win32/bin/test.bat Win32 port win32/bin/webget.bat Win32 port Index: perl5.004_01_02/Makefile.SH *** perl5.004_01/Makefile.SH Thu Jun 12 23:27:56 1997 --- perl5.004_01_02/Makefile.SH Thu Jul 31 23:11:41 1997 *************** *** 359,367 **** install.man: all installman ./perl installman ! # Not implemented yet. ! #install.html: all installhtml ! # ./perl installhtml # I now supply perly.c with the kits, so the following section is # used only if you force byacc to run by saying --- 359,376 ---- install.man: all installman ./perl installman ! # XXX Experimental. Hardwired values, but useful for testing. ! # Eventually Configure could ask for some of these values. ! install.html: all installhtml ! ./installhtml \ ! --podroot=. --podpath=. --recurse \ ! --htmldir=$(privlib)/html \ ! --htmlroot=$(privlib)/html \ ! --splithead=pod/perlipc \ ! --splititem=pod/perlfunc \ ! --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ ! --verbose ! # I now supply perly.c with the kits, so the following section is # used only if you force byacc to run by saying Index: perl5.004_01_02/Porting/patchls Prereq: 1.3 *** perl5.004_01/Porting/patchls Wed Jun 11 21:18:59 1997 --- perl5.004_01_02/Porting/patchls Thu Jul 31 19:48:43 1997 *************** *** 18,25 **** use strict; sub usage { ! die qq{ ! patchls [options] patchfile [ ... ] -i Invert: for each patched file list which patch files patch it --- 18,24 ---- use strict; sub usage { ! die q{ patchls [options] patchfile [ ... ] -i Invert: for each patched file list which patch files patch it *************** *** 29,35 **** -m print formatted Meta-information (Subject,From,Msg-ID etc) -p N strip N levels of directory Prefix (like patch), else automatic -v more verbose (-d for noisy debugging) ! } } --- 28,35 ---- -m print formatted Meta-information (Subject,From,Msg-ID etc) -p N strip N levels of directory Prefix (like patch), else automatic -v more verbose (-d for noisy debugging) ! -f F only list patches which patch files matching regexp F ! (F has $ appended unless it contains a /). } } *************** *** 43,52 **** $::opt_h = 0; $::opt_l = 0; $::opt_c = 0; usage unless @ARGV; ! getopts("mihlvcp:") or usage; my %cat_title = ( 'TEST' => 'TESTS', --- 43,53 ---- $::opt_h = 0; $::opt_l = 0; $::opt_c = 0; + $::opt_f = ''; usage unless @ARGV; ! getopts("mihlvcp:f:") or usage; my %cat_title = ( 'TEST' => 'TESTS', *************** *** 141,146 **** --- 142,160 ---- $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in} } values %ls; + if ($::opt_f) { + my $out; + $::opt_f .= '$' unless $::opt_f =~ m:/:; + @ls = grep { + my @out = keys %{$_->{out}}; + my $match = 0; + for $out (@out) { + ++$match if $out =~ m/$::opt_f/o; + } + $match; + } @ls; + } + unless ($::opt_c and $::opt_m) { foreach $ls (@ls) { next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; *************** *** 194,199 **** --- 208,215 ---- sub trim_name { # reduce/tidy file paths from diff lines my $name = shift; $name = "$name ($in)" if $name eq "/dev/null"; + $name =~ s:\\:/:g; # adjust windows paths + $name =~ s://:/:g; # simplify (and make win \\share into absolute path) if (defined $::opt_p) { # strip on -p levels of directory prefix my $dc = $::opt_p; *************** *** 202,208 **** else { # try to strip off leading path to perl directory # if absolute path, strip down to any *perl* directory first $name =~ s:^/.*?perl.*?/::i; ! $name =~ s:.*perl[-_]?5\.[-_a-z0-9.]+/::i; $name =~ s:^\./::; } return $name; --- 218,224 ---- else { # try to strip off leading path to perl directory # if absolute path, strip down to any *perl* directory first $name =~ s:^/.*?perl.*?/::i; ! $name =~ s:.*perl[-_]?5?[._]?[-_a-z0-9.+]*/::i; $name =~ s:^\./::; } return $name; *************** *** 239,245 **** sub my_wrap { ! return expand(wrap(@_)); } --- 255,263 ---- sub my_wrap { ! my $txt = eval { expand(wrap(@_)) }; # die's on long lines! ! return $txt unless $@; ! return expand("@_"); } Index: perl5.004_01_02/README.os2 *** perl5.004_01/README.os2 Thu May 8 18:31:34 1997 --- perl5.004_01_02/README.os2 Tue Jul 29 01:44:50 1997 *************** *** 1082,1089 **** =item ! Since L is present in EMX, but is not functional, the same is ! true for perl. Here is the list of things which may be "broken" on EMX (from EMX docs): =over --- 1082,1094 ---- =item ! Since L is present in EMX, but is not functional, it is ! emulated by perl. To disable the emulations, set environment variable ! C. ! ! =item ! ! Here is the list of things which may be "broken" on EMX (from EMX docs): =over *************** *** 1099,1105 **** =item * ! L is not yet implemented (dummy function). =item * --- 1104,1110 ---- =item * ! L is not yet implemented (dummy function). (Perl has a workaround.) =item * *************** *** 1155,1160 **** --- 1160,1171 ---- C special-cases F and F. + =item C + + Since L is present in EMX, but is not functional, it is + emulated by perl. To disable the emulations, set environment variable + C. + =back =head1 Perl flavors *************** *** 1333,1338 **** --- 1344,1355 ---- Specific for EMX port. Gives the directory part of the location for F. + + =head2 C + + Specific for EMX port. Since L is present in EMX, but is not + functional, it is emulated by perl. To disable the emulations, set + environment variable C. =head2 C or C Index: perl5.004_01_02/README.win32 *** perl5.004_01/README.win32 Wed Jun 11 23:15:58 1997 --- perl5.004_01_02/README.win32 Tue Jul 29 01:02:36 1997 *************** *** 24,30 **** was extracted. Make sure you read and understand the terms under which this software is being distributed. ! Also make sure you read the L section below for the known limitations of this port. The INSTALL file in the perl top-level has much information that is --- 24,30 ---- was extracted. Make sure you read and understand the terms under which this software is being distributed. ! Also make sure you read L below for the known limitations of this port. The INSTALL file in the perl top-level has much information that is *************** *** 142,147 **** --- 142,151 ---- extension dll's under the lib\auto directory. If the build fails for any reason, make sure you have done the previous steps correctly. + The build process may produce "harmless" compiler warnings (more or + less copiously, depending on how picky your compiler gets). The + maintainers are aware of these warnings, thankyouverymuch. :) + When building using Visual C++, a perl95.exe will also get built. This executable is only needed on Windows95, and should be used instead of perl.exe, and then only if you want sockets to work properly on Windows95. *************** *** 290,296 **** perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less ! Discovering the usage of the "command.com" shell on Windows95 is left as an exercise to the reader :) =item Building Extensions --- 294,300 ---- perl -e "print 'foo'; print STDERR 'bar'" 2> blurch | less ! Discovering the usefulness of the "command.com" shell on Windows95 is left as an exercise to the reader :) =item Building Extensions *************** *** 337,343 **** CPAN in source form, along with many added bugfixes, and with MakeMaker support. This bundle is available at: ! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.06.tar.gz See the README in that distribution for building and installation instructions. Look for later versions that may be available at the --- 341,347 ---- CPAN in source form, along with many added bugfixes, and with MakeMaker support. This bundle is available at: ! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.08.tar.gz See the README in that distribution for building and installation instructions. Look for later versions that may be available at the *************** *** 348,353 **** --- 352,427 ---- the 5.004 release of perl, at which point the need for a dedicated bundle such as the above should diminish. + =item Running Perl Scripts + + Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to + indicate to the OS that it should execute the file using perl. + Win32 has no comparable means to indicate arbitrary files are + executables. + + Instead, all available methods to execute plain text files on + Win32 rely on the file "extension". There are three methods + to use this to execute perl scripts: + + =over 8 + + =item 1 + + There is a facility called "file extension associations" that will + work in Windows NT 4.0. This can be manipulated via the two + commands "assoc" and "ftype" that come standard with Windows NT + 4.0. Type "ftype /?" for a complete example of how to set this + up for perl scripts (Say what? You thought Windows NT wasn't + perl-ready? :). + + =item 2 + + Since file associations don't work everywhere, and there are + reportedly bugs with file associations where it does work, the + old method of wrapping the perl script to make it look like a + regular batch file to the OS, may be used. The install process + makes available the "pl2bat.bat" script which can be used to wrap + perl scripts into batch files. For example: + + pl2bat foo.pl + + will create the file "FOO.BAT". Note "pl2bat" strips any + .pl suffix and adds a .bat suffix to the generated file. + + If you use the 4DOS/NT or similar command shell, note that + "pl2bat" uses the "%*" variable in the generated batch file to + refer to all the command line arguments, so you may need to make + sure that construct works in batch files. As of this writing, + 4DOS/NT users will need a "ParameterChar = *" statement in their + 4NT.INI file, or will need to execute "setdos /p*" in the 4DOS/NT + startup file to enable this to work. + + =item 3 + + Using "pl2bat" has a few problems: the file name gets changed, + so scripts that rely on C<$0> to find what they must do may not + run properly; running "pl2bat" replicates the contents of the + original script, and so this process can be maintenance intensive + if the originals get updated often. A different approach that + avoids both problems is possible. + + A script called "runperl.bat" is available that can be copied + to any filename (along with the .bat suffix). For example, + if you call it "foo.bat", it will run the file "foo" when it is + executed. Since you can run batch files on Win32 platforms simply + by typing the name (without the extension), this effectively + runs the file "foo", when you type either "foo" or "foo.bat". + With this method, "foo.bat" can even be in a different location + than the file "foo", as long as "foo" is available somewhere on + the PATH. If your scripts are on a filesystem that allows symbolic + links, you can even avoid copying "runperl.bat". + + Here's a diversion: copy "runperl.bat" to "runperl", and type + "runperl". Explain the observed behavior, or lack thereof. :) + Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH + + =back + =item Miscellaneous Things A full set of HTML documentation is installed, so you should be *************** *** 374,391 **** changes in any of these areas: build process, installation structure, supported utilities/modules, and supported perl functionality. In particular, functionality specific to the Win32 environment may ! ultimately be supported as either core modules or extensions. This ! means that you should be prepared to recompile extensions when binary ! incompatibilites arise due to changes in the internal structure of ! the code. ! ! The DLLs produced by the two supported compilers are incompatible ! with each other due to the conventions they use to export symbols, ! and due to differences in the Runtime libraries that they provide. ! This means that extension binaries built under either compiler will ! only work with the perl binaries built under the same compiler. ! If you know of a robust, freely available C Runtime that can ! be used under win32, let us know. If you have had prior exposure to Perl on Unix platforms, you will notice this port exhibits behavior different from what is documented. Most of the --- 448,467 ---- changes in any of these areas: build process, installation structure, supported utilities/modules, and supported perl functionality. In particular, functionality specific to the Win32 environment may ! ultimately be supported as either core modules or extensions. The ! beta status implies, among other things, that you should be prepared ! to recompile extensions when binary incompatibilites arise due to ! changes in the internal structure of the code. ! ! An effort has been made to ensure that the DLLs produced by the two ! supported compilers are compatible with each other (despite the ! best efforts of the compiler vendors). Extension binaries produced ! by one compiler should also coexist with a perl binary built by ! a different compiler. In order to accomplish this, PERL.DLL provides ! a layer of runtime code that uses the C Runtime that perl was compiled ! with. Extensions which include "perl.h" will transparently access ! the functions in this layer, thereby ensuring that both perl and ! extensions use the same runtime functions. If you have had prior exposure to Perl on Unix platforms, you will notice this port exhibits behavior different from what is documented. Most of the *************** *** 404,416 **** =item * ! The following functions are currently unavailable: C, C, C, C, C, C, C, C, C, C, C, C, C. This list is possibly very incomplete. =item * Various C related calls are supported, but they may not behave as on Unix platforms. --- 480,498 ---- =item * ! The following functions are currently unavailable: C, C, C, C, C, C, C, C, C, C, C, C. This list is possibly very incomplete. =item * + crypt() is not available due to silly export restrictions. It may + become available when the laws change. Meanwhile, look in CPAN for + extensions that provide it. + + =item * + Various C related calls are supported, but they may not behave as on Unix platforms. *************** *** 440,446 **** =item * Signal handling may not behave as on Unix platforms (where it ! doesn't exactly "behave", either :). =item * --- 522,533 ---- =item * Signal handling may not behave as on Unix platforms (where it ! doesn't exactly "behave", either :). For instance, calling C ! or C from signal handlers will cause an exception, since most ! implementations of C on Win32 are severely crippled. ! Thus, signals may work only for simple things like setting a flag ! variable in the handler. Using signals under this port should ! currently be considered unsupported. =item * *************** *** 473,478 **** --- 560,567 ---- =back + This document is maintained by Gurusamy Sarathy. + =head1 SEE ALSO L *************** *** 488,494 **** Borland support was added in 5.004_01 (Gurusamy Sarathy). ! Last updated: 11 June 1997 =cut --- 577,583 ---- Borland support was added in 5.004_01 (Gurusamy Sarathy). ! Last updated: 25 July 1997 =cut Index: perl5.004_01_02/Todo *** perl5.004_01/Todo Wed Feb 12 19:45:24 1997 --- perl5.004_01_02/Todo Thu Jul 31 21:43:18 1997 *************** *** 47,53 **** ref function in list context data prettyprint function? (or is it, as I suspect, a lib routine?) make tr/// return histogram in list context? - undef wantarray in void context Loop control on do{} et al Explicit switch statements built-in globbing --- 47,52 ---- Index: perl5.004_01_02/XSUB.h *** perl5.004_01/XSUB.h Mon Apr 28 19:52:56 1997 --- perl5.004_01_02/XSUB.h Tue Jul 29 01:37:31 1997 *************** *** 44,56 **** Sv = ST(1); \ else { \ /* XXX GV_ADDWARN */ \ ! Sv = perl_get_sv(vn = form("%s::XS_VERSION", module), FALSE); \ if (!Sv || !SvOK(Sv)) \ ! Sv = perl_get_sv(vn = form("%s::VERSION", module), FALSE); \ } \ if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv, na)))) \ ! croak("%s object version %s does not match $%s %_", \ ! module, XS_VERSION, vn, Sv); \ } STMT_END #else # define XS_VERSION_BOOTCHECK --- 44,58 ---- Sv = ST(1); \ else { \ /* XXX GV_ADDWARN */ \ ! Sv = perl_get_sv(form("%s::%s", module, \ ! vn = "XS_VERSION"), FALSE); \ if (!Sv || !SvOK(Sv)) \ ! Sv = perl_get_sv(form("%s::%s", module, \ ! vn = "VERSION"), FALSE); \ } \ if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv, na)))) \ ! croak("%s object version %s does not match $%s::%s %_", \ ! module, XS_VERSION, module, vn, Sv); \ } STMT_END #else # define XS_VERSION_BOOTCHECK Index: perl5.004_01_02/av.c *** perl5.004_01/av.c Fri Mar 7 06:10:31 1997 --- perl5.004_01_02/av.c Mon Jul 28 23:55:36 1997 *************** *** 253,269 **** av = (AV*)NEWSV(8,0); sv_upgrade((SV *) av,SVt_PVAV); - New(4,ary,size+1,SV*); - AvALLOC(av) = ary; AvFLAGS(av) = AVf_REAL; ! SvPVX(av) = (char*)ary; ! AvFILL(av) = size - 1; ! AvMAX(av) = size - 1; ! for (i = 0; i < size; i++) { ! assert (*strp); ! ary[i] = NEWSV(7,0); ! sv_setsv(ary[i], *strp); ! strp++; } return av; } --- 253,271 ---- av = (AV*)NEWSV(8,0); sv_upgrade((SV *) av,SVt_PVAV); AvFLAGS(av) = AVf_REAL; ! if (size) { /* `defined' was returning undef for size==0 anyway. */ ! New(4,ary,size,SV*); ! AvALLOC(av) = ary; ! SvPVX(av) = (char*)ary; ! AvFILL(av) = size - 1; ! AvMAX(av) = size - 1; ! for (i = 0; i < size; i++) { ! assert (*strp); ! ary[i] = NEWSV(7,0); ! sv_setsv(ary[i], *strp); ! strp++; ! } } return av; } Index: perl5.004_01_02/configpm *** perl5.004_01/configpm Sat Mar 29 23:36:23 1997 --- perl5.004_01_02/configpm Thu Jul 31 20:50:34 1997 *************** *** 79,85 **** sub myconfig { return $summary if $summary_expanded; ! $summary =~ s/\$(\w+)/$Config{$1}/ge; $summary_expanded = 1; $summary; } --- 79,86 ---- sub myconfig { return $summary if $summary_expanded; ! $summary =~ s{\$(\w+)} ! { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge; $summary_expanded = 1; $summary; } Index: perl5.004_01_02/doio.c *** perl5.004_01/doio.c Wed Jun 11 04:50:24 1997 --- perl5.004_01_02/doio.c Tue Jul 29 02:08:11 1997 *************** *** 942,948 **** } } ! #ifndef OS2 bool do_exec(cmd) --- 942,948 ---- } } ! #if !defined(OS2) && !defined(WIN32) bool do_exec(cmd) *************** *** 1033,1039 **** return FALSE; } ! #endif /* OS2 */ I32 apply(type,mark,sp) --- 1033,1039 ---- return FALSE; } ! #endif /* OS2 || WIN32 */ I32 apply(type,mark,sp) *************** *** 1364,1392 **** infosize = sizeof(struct semid_ds); else if (cmd == GETALL || cmd == SETALL) { #ifdef __linux__ /* XXX Need metaconfig test */ ! /* linux uses : ! int semctl (int semid, int semnun, int cmd, union semun arg) ! union semun { int val; struct semid_ds *buf; ushort *array; }; */ ! union semun semds; ! if (semctl(id, 0, IPC_STAT, semds) == -1) #else - struct semid_ds semds; if (semctl(id, 0, IPC_STAT, &semds) == -1) #endif return -1; getinfo = (cmd == GETALL); - #ifdef __linux__ /* XXX Need metaconfig test */ - infosize = semds.buf->sem_nsems * sizeof(short); - #else infosize = semds.sem_nsems * sizeof(short); - #endif /* "short" is technically wrong but much more portable than guessing about u_?short(_t)? */ } --- 1364,1388 ---- infosize = sizeof(struct semid_ds); else if (cmd == GETALL || cmd == SETALL) { + struct semid_ds semds; #ifdef __linux__ /* XXX Need metaconfig test */ ! /* linux (and Solaris2?) uses : ! int semctl (int semid, int semnum, int cmd, union semun arg) union semun { int val; struct semid_ds *buf; ushort *array; }; */ ! union semun semun; ! semun.buf = &semds; ! if (semctl(id, 0, IPC_STAT, semun) == -1) #else if (semctl(id, 0, IPC_STAT, &semds) == -1) #endif return -1; getinfo = (cmd == GETALL); infosize = semds.sem_nsems * sizeof(short); /* "short" is technically wrong but much more portable than guessing about u_?short(_t)? */ } Index: perl5.004_01_02/dosish.h *** perl5.004_01/dosish.h Mon Apr 14 03:23:55 1997 --- perl5.004_01_02/dosish.h Thu Jul 31 18:38:06 1997 *************** *** 11,20 **** # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ Perl_DJGPP_init(); } STMT_END #else /* DJGPP */ - # define PERL_SYS_INIT(c,v) # ifdef WIN32 # define BIT_BUCKET "nul" # else # define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */ # endif #endif /* DJGPP */ --- 11,21 ---- # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ Perl_DJGPP_init(); } STMT_END #else /* DJGPP */ # ifdef WIN32 + # define PERL_SYS_INIT(c,v) Perl_win32_init(c,v) # define BIT_BUCKET "nul" # else + # define PERL_SYS_INIT(c,v) # define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */ # endif #endif /* DJGPP */ Index: perl5.004_01_02/embed.h *** perl5.004_01/embed.h Tue Jun 10 01:48:57 1997 --- perl5.004_01_02/embed.h Tue Jul 29 01:33:25 1997 *************** *** 307,314 **** #define lshift_amg Perl_lshift_amg #define lshift_ass_amg Perl_lshift_ass_amg #define lt_amg Perl_lt_amg - #define magic_clearenv Perl_magic_clearenv #define magic_clear_all_env Perl_magic_clear_all_env #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack --- 307,314 ---- #define lshift_amg Perl_lshift_amg #define lshift_ass_amg Perl_lshift_ass_amg #define lt_amg Perl_lt_amg #define magic_clear_all_env Perl_magic_clear_all_env + #define magic_clearenv Perl_magic_clearenv #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack *************** *** 1046,1051 **** --- 1046,1052 ---- #define sv_setptrobj Perl_sv_setptrobj #define sv_setpv Perl_sv_setpv #define sv_setpvf Perl_sv_setpvf + #define sv_setpviv Perl_sv_setpviv #define sv_setpvn Perl_sv_setpvn #define sv_setref_iv Perl_sv_setref_iv #define sv_setref_nv Perl_sv_setref_nv Index: perl5.004_01_02/ext/DB_File/DB_File.pm *** perl5.004_01/ext/DB_File/DB_File.pm Thu May 1 02:24:48 1997 --- perl5.004_01_02/ext/DB_File/DB_File.pm Thu Jul 31 20:54:11 1997 *************** *** 1,8 **** # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) ! # last modified 30th Apr 1997 ! # version 1.14 # # Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or --- 1,8 ---- # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) ! # last modified 29th Jun 1997 ! # version 1.15 # # Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or *************** *** 98,104 **** croak ref($self) . " does not define the method ${method}" ; } - sub DESTROY { undef %{$_[0]} } sub FIRSTKEY { my $self = shift ; $self->NotHere("FIRSTKEY") } sub NEXTKEY { my $self = shift ; $self->NotHere("NEXTKEY") } sub CLEAR { my $self = shift ; $self->NotHere("CLEAR") } --- 98,103 ---- *************** *** 146,152 **** use Carp; ! $VERSION = "1.14" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; --- 145,151 ---- use Carp; ! $VERSION = "1.15" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; *************** *** 212,228 **** } ! # import borrowed from IO::File ! # exports Fcntl constants if available. ! sub import { ! my $pkg = shift; ! my $callpkg = caller; ! Exporter::export $pkg, $callpkg, @_; ! eval { ! require Fcntl; ! Exporter::export 'Fcntl', $callpkg, '/^O_/'; ! }; ! } bootstrap DB_File $VERSION; --- 211,223 ---- } ! eval { ! # Make all Fcntl O_XXX constants available for importing ! require Fcntl; ! my @O = grep /^O_/, @Fcntl::EXPORT; ! Fcntl->import(@O); # first we import what we want to export ! push(@EXPORT, @O); ! }; bootstrap DB_File $VERSION; *************** *** 1665,1670 **** --- 1660,1680 ---- Made it illegal to tie an associative array to a RECNO database and an ordinary array to a HASH or BTREE database. + + =item 1.15 + + Patch from Gisle Aas to suppress "use of undefined + value" warning with db_get and db_seq. + + Patch from Gisle Aas to make DB_File export only the O_* + constants from Fcntl. + + Removed the DESTROY method from the DB_File::HASHINFO module. + + Previously DB_File hard-wired the class name of any object that it + created to "DB_File". This makes sub-classing difficult. Now DB_File + creats objects in the namespace of the package it has been inherited + into. =back Index: perl5.004_01_02/ext/DB_File/DB_File.xs *** perl5.004_01/ext/DB_File/DB_File.xs Thu May 1 02:24:48 1997 --- perl5.004_01_02/ext/DB_File/DB_File.xs Thu Jul 31 20:53:33 1997 *************** *** 3,10 **** DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) ! last modified 30th Apr 1997 ! version 1.14 All comments/suggestions/problems are welcome --- 3,10 ---- DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) ! last modified 29th Jun 1997 ! version 1.15 All comments/suggestions/problems are welcome *************** *** 42,47 **** --- 42,50 ---- 1.13 - Tidied up a few casts. 1.14 - Made it illegal to tie an associative array to a RECNO database and an ordinary array to a HASH or BTREE database. + 1.15 - Patch from Gisle Aas to suppress "use of + undefined value" warning with db_get and db_seq. + */ *************** *** 50,55 **** --- 53,61 ---- #include "XSUB.h" #include + /* #ifdef DB_VERSION_MAJOR */ + /* #include */ + /* #endif */ #include *************** *** 87,93 **** typedef DBT DBTKEY ; ! /* #define TRACE */ #define db_DESTROY(db) ((db->dbp)->close)(db->dbp) #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags) --- 93,99 ---- typedef DBT DBTKEY ; ! /* #define TRACE */ #define db_DESTROY(db) ((db->dbp)->close)(db->dbp) #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags) *************** *** 1062,1068 **** db_get(db, key, value, flags=0) DB_File db DBTKEY key ! DBT value u_int flags INIT: CurrentDB = db ; --- 1068,1074 ---- db_get(db, key, value, flags=0) DB_File db DBTKEY key ! DBT value = NO_INIT u_int flags INIT: CurrentDB = db ; *************** *** 1098,1104 **** db_seq(db, key, value, flags) DB_File db DBTKEY key ! DBT value u_int flags INIT: CurrentDB = db ; --- 1104,1110 ---- db_seq(db, key, value, flags) DB_File db DBTKEY key ! DBT value = NO_INIT u_int flags INIT: CurrentDB = db ; Index: perl5.004_01_02/ext/DB_File/typemap *** perl5.004_01/ext/DB_File/typemap Fri Aug 16 20:41:48 1996 --- perl5.004_01_02/ext/DB_File/typemap Thu Jul 31 20:53:33 1997 *************** *** 34,36 **** --- 34,38 ---- OutputKey($arg, $var) T_dbtdatum OutputValue($arg, $var) + T_PTROBJ + sv_setref_pv($arg, dbtype, (void*)$var); Index: perl5.004_01_02/ext/GDBM_File/typemap *** perl5.004_01/ext/GDBM_File/typemap Tue Oct 18 17:28:59 1994 --- perl5.004_01_02/ext/GDBM_File/typemap Thu Jul 31 19:50:24 1997 *************** *** 23,25 **** --- 23,27 ---- sv_setpvn($arg, $var.dptr, $var.dsize); T_GDATUM sv_usepvn($arg, $var.dptr, $var.dsize); + T_PTROBJ + sv_setref_pv($arg, dbtype, (void*)$var); Index: perl5.004_01_02/ext/IO/IO.xs *** perl5.004_01/ext/IO/IO.xs Tue May 13 18:27:54 1997 --- perl5.004_01_02/ext/IO/IO.xs Thu Jul 31 20:54:38 1997 *************** *** 271,276 **** --- 271,278 ---- CODE: /* Should check HAS_SETVBUF once Configure tests for that */ #if defined(PERLIO_IS_STDIO) && defined(_IOFBF) + if (!handle) /* Try input stream. */ + handle = IoIFP(sv_2io(ST(0))); if (handle) RETVAL = setvbuf(handle, buf, type, size); else { Index: perl5.004_01_02/ext/IO/lib/IO/File.pm *** perl5.004_01/ext/IO/lib/IO/File.pm Thu May 15 20:15:57 1997 --- perl5.004_01_02/ext/IO/lib/IO/File.pm Tue Jul 29 01:20:54 1997 *************** *** 115,138 **** @ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader); ! $VERSION = "1.0602"; @EXPORT = @IO::Seekable::EXPORT; ! sub import { ! my $pkg = shift; ! my $callpkg = caller; ! Exporter::export $pkg, $callpkg, @_; ! ! # ! # If the Fcntl extension is available, ! # export its constants for sysopen(). ! # ! eval { ! require Fcntl; ! Exporter::export 'Fcntl', $callpkg, '/^O_/'; ! }; ! } ################################################ --- 115,131 ---- @ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader); ! $VERSION = "1.06021"; @EXPORT = @IO::Seekable::EXPORT; ! eval { ! # Make all Fcntl O_XXX constants available for importing ! require Fcntl; ! my @O = grep /^O_/, @Fcntl::EXPORT; ! Fcntl->import(@O); # first we import what we want to export ! push(@EXPORT, @O); ! }; ################################################ Index: perl5.004_01_02/ext/IO/lib/IO/Handle.pm *** perl5.004_01/ext/IO/lib/IO/Handle.pm Wed Apr 9 20:48:13 1997 --- perl5.004_01_02/ext/IO/lib/IO/Handle.pm Thu Jul 31 19:50:00 1997 *************** *** 20,25 **** --- 20,26 ---- $fh->print("Some text\n"); } + use IO::Handle '_IOLBF'; $fh->setvbuf($buffer_var, _IOLBF, 1024); undef $fh; # automatically closes the file if it's open *************** *** 151,157 **** specifies a scalar variable to use as a buffer. WARNING: A variable used as a buffer by C or C must not be modified in any way until the IO::Handle is closed or C or C is called ! again, or memory corruption may result! Lastly, there is a special method for working under B<-T> and setuid/gid scripts: --- 152,159 ---- specifies a scalar variable to use as a buffer. WARNING: A variable used as a buffer by C or C must not be modified in any way until the IO::Handle is closed or C or C is called ! again, or memory corruption may result! Note that you need to import ! the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Lastly, there is a special method for working under B<-T> and setuid/gid scripts: Index: perl5.004_01_02/ext/IO/lib/IO/Socket.pm *** perl5.004_01/ext/IO/lib/IO/Socket.pm Thu Apr 10 15:28:37 1997 --- perl5.004_01_02/ext/IO/lib/IO/Socket.pm Thu Jul 31 22:03:20 1997 *************** *** 380,385 **** --- 380,386 ---- my %socket_type = ( tcp => SOCK_STREAM, udp => SOCK_DGRAM, + icmp => SOCK_RAW, ); =head2 IO::Socket::INET *************** *** 557,563 **** } else { return _error($fh,'Cannot determine remote port') ! unless($rport || $type == SOCK_DGRAM); if($type == SOCK_STREAM || defined $raddr) { return _error($fh,'Bad peer address') --- 558,564 ---- } else { return _error($fh,'Cannot determine remote port') ! unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW); if($type == SOCK_STREAM || defined $raddr) { return _error($fh,'Bad peer address') Index: perl5.004_01_02/ext/NDBM_File/typemap *** perl5.004_01/ext/NDBM_File/typemap Tue Oct 18 17:29:10 1994 --- perl5.004_01_02/ext/NDBM_File/typemap Thu Jul 31 19:50:24 1997 *************** *** 23,25 **** --- 23,27 ---- sv_setpvn($arg, $var.dptr, $var.dsize); T_GDATUM sv_usepvn($arg, $var.dptr, $var.dsize); + T_PTROBJ + sv_setref_pv($arg, dbtype, (void*)$var); Index: perl5.004_01_02/ext/ODBM_File/ODBM_File.xs *** perl5.004_01/ext/ODBM_File/ODBM_File.xs Wed Apr 23 20:21:42 1997 --- perl5.004_01_02/ext/ODBM_File/ODBM_File.xs Thu Jul 31 19:50:24 1997 *************** *** 73,79 **** } RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); ST(0) = sv_mortalcopy(&sv_undef); ! sv_setptrobj(ST(0), RETVAL, "ODBM_File"); } void --- 73,79 ---- } RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); ST(0) = sv_mortalcopy(&sv_undef); ! sv_setptrobj(ST(0), RETVAL, dbtype); } void Index: perl5.004_01_02/ext/POSIX/POSIX.xs *** perl5.004_01/ext/POSIX/POSIX.xs Fri Mar 21 02:34:28 1997 --- perl5.004_01_02/ext/POSIX/POSIX.xs Thu Jul 31 21:52:49 1997 *************** *** 40,46 **** --- 40,48 ---- #include #include #include + #ifdef I_UNISTD #include + #endif #include #if defined(__VMS) && !defined(__POSIX_SOURCE) *************** *** 55,61 **** # define mkfifo(a,b) (not_here("mkfifo"),-1) # define tzset() not_here("tzset") ! # if __VMS_VER < 70000000 /* The default VMS emulation of Unix signals isn't very POSIXish */ typedef int sigset_t; # define sigpending(a) (not_here("sigpending"),0) --- 57,66 ---- # define mkfifo(a,b) (not_here("mkfifo"),-1) # define tzset() not_here("tzset") ! #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) ! # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */ ! # include ! #else /* The default VMS emulation of Unix signals isn't very POSIXish */ typedef int sigset_t; # define sigpending(a) (not_here("sigpending"),0) *************** *** 125,133 **** # define sa_handler sv_handler # define sa_mask sv_mask # define sigsuspend(set) sigpause(*set) ! # else ! # define HAS_TZNAME /* shows up in VMS 7.0 */ ! # endif /* __VMS_VER < 70000000 */ /* The POSIX notion of ttyname() is better served by getname() under VMS */ static char ttnambuf[64]; --- 130,136 ---- # define sa_handler sv_handler # define sa_mask sv_mask # define sigsuspend(set) sigpause(*set) ! # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */ /* The POSIX notion of ttyname() is better served by getname() under VMS */ static char ttnambuf[64]; Index: perl5.004_01_02/ext/SDBM_File/typemap *** perl5.004_01/ext/SDBM_File/typemap Tue Oct 18 17:29:55 1994 --- perl5.004_01_02/ext/SDBM_File/typemap Thu Jul 31 19:50:24 1997 *************** *** 23,25 **** --- 23,27 ---- sv_setpvn($arg, $var.dptr, $var.dsize); T_GDATUM sv_usepvn($arg, $var.dptr, $var.dsize); + T_PTROBJ + sv_setref_pv($arg, dbtype, (void*)$var); Index: perl5.004_01_02/global.sym *** perl5.004_01/global.sym Tue Jun 10 01:52:04 1997 --- perl5.004_01_02/global.sym Tue Jul 29 00:02:07 1997 *************** *** 1118,1123 **** --- 1118,1124 ---- sv_setnv sv_setptrobj sv_setpv + sv_setpviv sv_setpvn sv_setref_iv sv_setref_nv Index: perl5.004_01_02/gv.c *** perl5.004_01/gv.c Fri Jun 6 23:34:25 1997 --- perl5.004_01_02/gv.c Mon Jul 28 22:25:39 1997 *************** *** 827,833 **** sv_upgrade((SV *)io,SVt_PVIO); SvREFCNT(io) = 1; SvOBJECT_on(io); ! iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV); SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); return io; } --- 827,835 ---- sv_upgrade((SV *)io,SVt_PVIO); SvREFCNT(io) = 1; SvOBJECT_on(io); ! iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV); ! if (!iogv) ! iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV); SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); return io; } Index: perl5.004_01_02/hints/cxux.sh *** perl5.004_01/hints/cxux.sh Fri Mar 21 05:24:03 1997 --- perl5.004_01_02/hints/cxux.sh Thu Jul 31 18:32:39 1997 *************** *** 61,76 **** # glibpth="/usr/sde/elf/usr/lib $glibpth" ! # Need to use Concurrent cc for most of these options to be meaningful (if you ! # want to get this to work with gcc, you're on your own :-). Passing # -Bexport to the linker when linking perl is important because it leaves # the interpreter internal symbols visible to the shared libs that will be ! # loaded on demand (and will try to reference those symbols). The -u ! # option to drag 'sigaction' into the perl main program is to make sure ! # it gets defined for the posix shared library (for some reason sigaction ! # is static, rather than being defined in libc.so.1). # ! cc='/bin/cc -Xa' cccdlflags='-Zelf -Zpic' ccdlflags='-Zelf -Zlink=dynamic -Wl,-Bexport -u sigaction' lddlflags='-Zlink=so' --- 61,78 ---- # glibpth="/usr/sde/elf/usr/lib $glibpth" ! # Need to use Concurrent cc for most of these options to be meaningful (if ! # you want to get this to work with gcc, you're on your own :-). Passing # -Bexport to the linker when linking perl is important because it leaves # the interpreter internal symbols visible to the shared libs that will be ! # loaded on demand (and will try to reference those symbols). The -u option ! # to drag 'sigaction' into the perl main program is to make sure it gets ! # defined for the posix shared library (for some reason sigaction is static, ! # rather than being defined in libc.so.1). The 88110compat option makes sure ! # the code will run on both 88100 and 88110 machines. The define is added to ! # trigger a work around for a compiler bug which shows up in pp.c. # ! cc='/bin/cc -Xa -Qtarget=M88110compat -DCXUX_BROKEN_CONSTANT_CONVERT' cccdlflags='-Zelf -Zpic' ccdlflags='-Zelf -Zlink=dynamic -Wl,-Bexport -u sigaction' lddlflags='-Zlink=so' Index: perl5.004_01_02/hints/os2.sh *** perl5.004_01/hints/os2.sh Fri Mar 21 05:24:04 1997 --- perl5.004_01_02/hints/os2.sh Tue Jul 29 01:44:51 1997 *************** *** 189,194 **** --- 189,203 ---- d_getprior='define' d_setprior='define' + # Make denser object files and DLL + case "X$optimize" in + X) + optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2" + lddlflags="$lddlflags -s" # Strip symbol table + aout_ldflags="$aout_ldflags -s" # Strip symbol table + ;; + esac + ####### All the rest is commented # The next two are commented. pdksh handles #! Index: perl5.004_01_02/hints/svr4.sh *** perl5.004_01/hints/svr4.sh Wed Jun 11 17:21:10 1997 --- perl5.004_01_02/hints/svr4.sh Thu Jul 31 19:44:33 1997 *************** *** 33,44 **** d_lstat=define # UnixWare has a broken csh. The undocumented -X argument to uname is probably ! # a reasonable way of detecting UnixWare uw_ver=`uname -v` uw_isuw=`uname -X 2>&1 | grep Release` ! if [ "$uw_isuw" = "Release = 4.2MP" -a \ ! \( "$uw_ver" = "2.1" -o "$uw_ver" = "2.1.1" \) ]; then ! d_csh='undef' fi # DDE SMES Supermax Enterprise Server --- 33,55 ---- d_lstat=define # UnixWare has a broken csh. The undocumented -X argument to uname is probably ! # a reasonable way of detecting UnixWare. Also in 2.1.1 the fields in ! # FILE* got renamed! uw_ver=`uname -v` uw_isuw=`uname -X 2>&1 | grep Release` ! if [ "$uw_isuw" = "Release = 4.2MP" ]; then ! case $uw_ver in ! 2.1) ! d_csh='undef' ! ;; ! 2.1.*) ! d_csh='undef' ! stdio_cnt='((fp)->__cnt)' ! d_stdio_cnt_lval='define' ! stdio_ptr='((fp)->__ptr)' ! d_stdio_ptr_lval='define' ! ;; ! esac fi # DDE SMES Supermax Enterprise Server Index: perl5.004_01_02/installhtml *** perl5.004_01/installhtml Thu Jun 12 17:57:19 1997 --- perl5.004_01_02/installhtml Thu Jul 31 22:58:06 1997 *************** *** 93,106 **** perl documentation: ./installhtml --podpath=lib:ext:pod:vms \ ! --podroot=/usr/src/perl \ ! --htmldir=/perl/nmanual \ ! --htmlroot=/perl/nmanual \ ! --splithead=pod/perlipc \ ! --splititem=pod/perlfunc \ ! --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ ! --recurse \ ! --verbose =head1 AUTHOR --- 93,106 ---- perl documentation: ./installhtml --podpath=lib:ext:pod:vms \ ! --podroot=/usr/src/perl \ ! --htmldir=/perl/nmanual \ ! --htmlroot=/perl/nmanual \ ! --splithead=pod/perlipc \ ! --splititem=pod/perlfunc \ ! --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ ! --recurse \ ! --verbose =head1 AUTHOR Index: perl5.004_01_02/lib/CPAN.pm Prereq: 1.139 *** perl5.004_01/lib/CPAN.pm Sat Jun 7 02:00:48 1997 --- perl5.004_01_02/lib/CPAN.pm Thu Jul 31 21:36:22 1997 *************** *** 23,30 **** use Text::Wrap; my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; ! $Cwd = Cwd->$getcwd(); END { $End++; &cleanup; } --- 23,30 ---- use Text::Wrap; my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'Cwd::cwd'; ! $Cwd = &$getcwd(); END { $End++; &cleanup; } *************** *** 306,313 **** no strict; $META->checklock(); my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; ! my $cwd = Cwd->$getcwd(); my $rl_avail = $Suppress_readline ? "suppressed" : ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" : "available (get Term::ReadKey and Term::ReadLine::Perl ". --- 306,313 ---- no strict; $META->checklock(); my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'Cwd::cwd'; ! my $cwd = &$getcwd(); my $rl_avail = $Suppress_readline ? "suppressed" : ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" : "available (get Term::ReadKey and Term::ReadLine::Perl ". *************** *** 422,429 **** $self->debug("reading dir[$dir]") if $CPAN::DEBUG; $dir ||= $self->{ID}; my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; ! my($cwd) = Cwd->$getcwd(); chdir $dir or Carp::croak("Can't chdir to $dir: $!"); my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!"); my(@entries); --- 422,429 ---- $self->debug("reading dir[$dir]") if $CPAN::DEBUG; $dir ||= $self->{ID}; my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'Cwd::cwd'; ! my($cwd) = &$getcwd(); chdir $dir or Carp::croak("Can't chdir to $dir: $!"); my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!"); my(@entries); *************** *** 520,526 **** # print "caller[$caller]func[$func]line[$line]rest[@rest]\n"; # print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n"; if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){ ! if (ref $arg) { eval { require Data::Dumper }; if ($@) { print $arg->as_string; --- 520,526 ---- # print "caller[$caller]func[$func]line[$line]rest[@rest]\n"; # print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n"; if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){ ! if ($arg and ref $arg) { eval { require Data::Dumper }; if ($@) { print $arg->as_string; *************** *** 1615,1621 **** my($perms,%user,%group); my $pname = $name; ! if (defined $blocks) { $blocks = int(($blocks + 1) / 2); } else { --- 1615,1621 ---- my($perms,%user,%group); my $pname = $name; ! if ($blocks) { $blocks = int(($blocks + 1) / 2); } else { *************** *** 2242,2249 **** my $dir = $self->dir or $self->get; $dir = $self->dir; my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; ! my $pwd = Cwd->$getcwd(); chdir($dir); print qq{Working directory is $dir.\n}; system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error"; --- 2242,2249 ---- my $dir = $self->dir or $self->get; $dir = $self->dir; my $getcwd; ! $getcwd = $CPAN::Config->{'getcwd'} || 'Cwd::cwd'; ! my $pwd = &$getcwd(); chdir($dir); print qq{Working directory is $dir.\n}; system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error"; *************** *** 2411,2418 **** sub perl { my($self) = @_; my($perl) = MM->file_name_is_absolute($^X) ? $^X : ""; ! my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; ! my $pwd = Cwd->$getcwd(); my $candidate = $CPAN::META->catfile($pwd,$^X); $perl ||= $candidate if MM->maybe_command($candidate); unless ($perl) { --- 2411,2418 ---- sub perl { my($self) = @_; my($perl) = MM->file_name_is_absolute($^X) ? $^X : ""; ! my $getcwd = $CPAN::Config->{'getcwd'} || 'Cwd::cwd'; ! my $pwd = &$getcwd(); my $candidate = $CPAN::META->catfile($pwd,$^X); $perl ||= $candidate if MM->maybe_command($candidate); unless ($perl) { *************** *** 2684,2691 **** my $manifest = $CPAN::META->catfile($where,"MANIFEST"); unless (-f $manifest) { require ExtUtils::Manifest; ! my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; ! my $cwd = Cwd->$getcwd(); chdir $where; ExtUtils::Manifest::mkmanifest(); chdir $cwd; --- 2684,2691 ---- my $manifest = $CPAN::META->catfile($where,"MANIFEST"); unless (-f $manifest) { require ExtUtils::Manifest; ! my $getcwd = $CPAN::Config->{'getcwd'} || 'Cwd::cwd'; ! my $cwd = &$getcwd(); chdir $where; ExtUtils::Manifest::mkmanifest(); chdir $cwd; Index: perl5.004_01_02/lib/Class/Struct.pm *** perl5.004_01/lib/Class/Struct.pm Thu Apr 10 20:55:05 1997 --- perl5.004_01_02/lib/Class/Struct.pm Mon Jul 28 22:14:27 1997 *************** *** 146,154 **** # Create accessor methods. - if ( $got_class && $CHECK_CLASS_MEMBERSHIP ) { - $out .= " use UNIVERSAL;\n"; - } my( $pre, $pst, $sel ); $cnt = 0; foreach $name (@methods){ --- 146,151 ---- Index: perl5.004_01_02/lib/Exporter.pm *** perl5.004_01/lib/Exporter.pm Sat Apr 12 03:49:18 1997 --- perl5.004_01_02/lib/Exporter.pm Thu Jul 31 21:39:19 1997 *************** *** 108,114 **** last; } } elsif ($sym !~ s/^&// || !$exports{$sym}) { ! warn qq["$sym" is not exported by the $pkg module]; $oops++; } } --- 108,115 ---- last; } } elsif ($sym !~ s/^&// || !$exports{$sym}) { ! require Carp; ! Carp::carp(qq["$sym" is not exported by the $pkg module]); $oops++; } } *************** *** 137,144 **** if (@failed) { @failed = $pkg->export_fail(@failed); foreach $sym (@failed) { ! warn qq["$sym" is not implemented by the $pkg module ], ! "on this architecture"; } if (@failed) { require Carp; --- 138,146 ---- if (@failed) { @failed = $pkg->export_fail(@failed); foreach $sym (@failed) { ! require Carp; ! Carp::carp(qq["$sym" is not implemented by the $pkg module ], ! "on this architecture"); } if (@failed) { require Carp; Index: perl5.004_01_02/lib/ExtUtils/Command.pm *** perl5.004_01/lib/ExtUtils/Command.pm Tue Apr 1 21:16:53 1997 --- perl5.004_01_02/lib/ExtUtils/Command.pm Thu Jul 31 21:51:13 1997 *************** *** 10,16 **** use vars qw(@ISA @EXPORT $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f); ! $VERSION = '1.00'; =head1 NAME --- 10,16 ---- use vars qw(@ISA @EXPORT $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f); ! $VERSION = '1.01'; =head1 NAME *************** *** 18,33 **** =head1 SYNOPSIS ! perl -MExtUtils::command -e cat files... > destination ! perl -MExtUtils::command -e mv source... destination ! perl -MExtUtils::command -e cp source... destination ! perl -MExtUtils::command -e touch files... ! perl -MExtUtils::command -e rm_f file... ! perl -MExtUtils::command -e rm_rf directories... ! perl -MExtUtils::command -e mkpath directories... ! perl -MExtUtils::command -e eqtime source destination ! perl -MExtUtils::command -e chmod mode files... ! perl -MExtUtils::command -e test_f file =head1 DESCRIPTION --- 18,33 ---- =head1 SYNOPSIS ! perl -MExtUtils::Command -e cat files... > destination ! perl -MExtUtils::Command -e mv source... destination ! perl -MExtUtils::Command -e cp source... destination ! perl -MExtUtils::Command -e touch files... ! perl -MExtUtils::Command -e rm_f file... ! perl -MExtUtils::Command -e rm_rf directories... ! perl -MExtUtils::Command -e mkpath directories... ! perl -MExtUtils::Command -e eqtime source destination ! perl -MExtUtils::Command -e chmod mode files... ! perl -MExtUtils::Command -e test_f file =head1 DESCRIPTION Index: perl5.004_01_02/lib/ExtUtils/Install.pm *** perl5.004_01/lib/ExtUtils/Install.pm Fri Jun 6 22:44:10 1997 --- perl5.004_01_02/lib/ExtUtils/Install.pm Thu Jul 31 21:51:13 1997 *************** *** 1,14 **** package ExtUtils::Install; ! $VERSION = substr q$Revision: 1.16 $, 10; ! # $Date: 1996/12/17 00:31:26 $ use Exporter; use Carp (); ! use Config (); use vars qw(@ISA @EXPORT $VERSION); @ISA = ('Exporter'); ! @EXPORT = ('install','uninstall','pm_to_blib'); $Is_VMS = $^O eq 'VMS'; my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':'; --- 1,14 ---- package ExtUtils::Install; ! $VERSION = substr q$Revision: 1.18 $, 10; ! # $Date: 1997/06/28 15:16:44 $ use Exporter; use Carp (); ! use Config qw(%Config); use vars qw(@ISA @EXPORT $VERSION); @ISA = ('Exporter'); ! @EXPORT = ('install','uninstall','pm_to_blib', 'install_default'); $Is_VMS = $^O eq 'VMS'; my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':'; *************** *** 144,149 **** --- 144,171 ---- } } + sub install_default { + @_ < 2 or die "install_default should be called with 0 or 1 argument"; + my $FULLEXT = @_ ? shift : $ARGV[0]; + defined $FULLEXT or die "Do not know to where to write install log"; + my $INST_LIB = MM->catdir(MM->curdir,"blib","lib"); + my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch"); + my $INST_BIN = MM->catdir(MM->curdir,'blib','bin'); + my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script'); + my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1'); + my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3'); + install({ + read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist", + write => "$Config{installsitearch}/auto/$FULLEXT/.packlist", + $INST_LIB => $Config{installsitelib}, + $INST_ARCHLIB => $Config{installsitearch}, + $INST_BIN => $Config{installbin} , + $INST_SCRIPT => $Config{installscript}, + $INST_MAN1DIR => $Config{installman1dir}, + $INST_MAN3DIR => $Config{installman3dir}, + },1,0,0); + } + sub my_cmp { my($one,$two) = @_; local(*F,*T); *************** *** 192,198 **** my $MY = {}; bless $MY, 'MY'; my %seen_dir = (); ! foreach $dir (@INC, @PERL_ENV_LIB, @Config::Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) { next if $dir eq "."; next if $seen_dir{$dir}++; my($targetfile) = $MY->catfile($dir,$libdir,$file); --- 214,220 ---- my $MY = {}; bless $MY, 'MY'; my %seen_dir = (); ! foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) { next if $dir eq "."; next if $seen_dir{$dir}++; my($targetfile) = $MY->catfile($dir,$libdir,$file); *************** *** 332,337 **** --- 354,373 ---- be merged into the written file. The read and the written file may be identical, but on AFS it is quite likely, people are installing to a different directory than the one where the files later appear. + + install_default() takes one or less arguments. If no arguments are + specified, it takes $ARGV[0] as if it was specified as an argument. + The argument is the value of MakeMaker's C key, like F. + This function calls install() with the same arguments as the defaults + the MakeMaker would use. + + The argumement-less form is convenient for install scripts like + + perl -MExtUtils::Install -e install_default Tk/Canvas + + Assuming this command is executed in a directory with populated F + directory, it will proceed as if the F was build by MakeMaker on + this machine. This is useful for binary distributions. uninstall() takes as first argument a file containing filenames to be unlinked. The second argument is a verbose switch, the third is a Index: perl5.004_01_02/lib/ExtUtils/Liblist.pm *** perl5.004_01/lib/ExtUtils/Liblist.pm Sat Jun 7 01:19:44 1997 --- perl5.004_01_02/lib/ExtUtils/Liblist.pm Thu Jul 31 21:51:13 1997 *************** *** 2,8 **** use vars qw($VERSION); # Broken out of MakeMaker from version 4.11 ! $VERSION = substr q$Revision: 1.2201 $, 10; use Config; use Cwd 'cwd'; --- 2,8 ---- use vars qw($VERSION); # Broken out of MakeMaker from version 4.11 ! $VERSION = substr q$Revision: 1.24 $, 10; use Config; use Cwd 'cwd'; *************** *** 15,21 **** } sub _unix_os2_ext { ! my($self,$potential_libs, $Verbose) = @_; if ($^O =~ 'os2' and $Config{libs}) { # Dynamic libraries are not transitive, so we may need including # the libraries linked against perl.dll again. --- 15,21 ---- } sub _unix_os2_ext { ! my($self,$potential_libs, $verbose) = @_; if ($^O =~ 'os2' and $Config{libs}) { # Dynamic libraries are not transitive, so we may need including # the libraries linked against perl.dll again. *************** *** 24,30 **** $potential_libs .= $Config{libs}; } return ("", "", "", "") unless $potential_libs; ! print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose; my($so) = $Config{'so'}; my($libs) = $Config{'libs'}; --- 24,30 ---- $potential_libs .= $Config{libs}; } return ("", "", "", "") unless $potential_libs; ! print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose; my($so) = $Config{'so'}; my($libs) = $Config{'libs'}; *************** *** 50,56 **** my($ptype) = $1; unless (-d $thislib){ print STDOUT "$ptype$thislib ignored, directory does not exist\n" ! if $Verbose; next; } unless ($self->file_name_is_absolute($thislib)) { --- 50,56 ---- my($ptype) = $1; unless (-d $thislib){ print STDOUT "$ptype$thislib ignored, directory does not exist\n" ! if $verbose; next; } unless ($self->file_name_is_absolute($thislib)) { *************** *** 125,134 **** # # , the compilation tools expand the environment variables.) } else { ! print STDOUT "$thislib not found in $thispth\n" if $Verbose; next; } ! print STDOUT "'-l$thislib' found at $fullname\n" if $Verbose; my($fullnamedir) = dirname($fullname); push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++; $found++; --- 125,134 ---- # # , the compilation tools expand the environment variables.) } else { ! print STDOUT "$thislib not found in $thispth\n" if $verbose; next; } ! print STDOUT "'-l$thislib' found at $fullname\n" if $verbose; my($fullnamedir) = dirname($fullname); push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++; $found++; *************** *** 183,189 **** } sub _win32_ext { ! my($self, $potential_libs, $Verbose) = @_; # If user did not supply a list, we punt. # (caller should probably use the list in $Config{libs}) --- 183,189 ---- } sub _win32_ext { ! my($self, $potential_libs, $verbose) = @_; # If user did not supply a list, we punt. # (caller should probably use the list in $Config{libs}) *************** *** 202,208 **** $potential_libs .= " " if $potential_libs; $potential_libs .= $libs; } ! print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose; # compute $extralibs from $potential_libs --- 202,208 ---- $potential_libs .= " " if $potential_libs; $potential_libs .= $libs; } ! print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose; # compute $extralibs from $potential_libs *************** *** 219,225 **** # Handle possible linker path arguments. if ($thislib =~ s/^-L// and not -d $thislib) { print STDOUT "-L$thislib ignored, directory does not exist\n" ! if $Verbose; next; } elsif (-d $thislib) { --- 219,225 ---- # Handle possible linker path arguments. if ($thislib =~ s/^-L// and not -d $thislib) { print STDOUT "-L$thislib ignored, directory does not exist\n" ! if $verbose; next; } elsif (-d $thislib) { *************** *** 238,247 **** my($found_lib)=0; foreach $thispth (@searchpath, @libpath){ unless (-f ($fullname="$thispth\\$thislib")) { ! print STDOUT "$thislib not found in $thispth\n" if $Verbose; next; } ! print STDOUT "'$thislib' found at $fullname\n" if $Verbose; $found++; $found_lib++; push(@extralibs, $fullname); --- 238,247 ---- my($found_lib)=0; foreach $thispth (@searchpath, @libpath){ unless (-f ($fullname="$thispth\\$thislib")) { ! print STDOUT "$thislib not found in $thispth\n" if $verbose; next; } ! print STDOUT "'$thislib' found at $fullname\n" if $verbose; $found++; $found_lib++; push(@extralibs, $fullname); *************** *** 370,376 **** if ($ctype) { eval '$' . $ctype . "{'$cand'}++"; die "Error recording library: $@" if $@; ! print STDOUT "\tFound as $cand (really $ctest), type $ctype\n" if $verbose > 1; next LIB; } } --- 370,376 ---- if ($ctype) { eval '$' . $ctype . "{'$cand'}++"; die "Error recording library: $@" if $@; ! print STDOUT "\tFound as $cand (really $test), type $ctype\n" if $verbose > 1; next LIB; } } *************** *** 403,409 **** C ! C =head1 DESCRIPTION --- 403,409 ---- C ! C =head1 DESCRIPTION Index: perl5.004_01_02/lib/ExtUtils/MM_Unix.pm Prereq: 1.113 *** perl5.004_01/lib/ExtUtils/MM_Unix.pm Thu Jun 12 22:06:18 1997 --- perl5.004_01_02/lib/ExtUtils/MM_Unix.pm Thu Jul 31 21:51:13 1997 *************** *** 8,15 **** use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Verbose %pm %static $Xsubpp_Version); ! $VERSION = substr q$Revision: 1.114 $, 10; ! # $Id: MM_Unix.pm,v 1.113 1997/02/11 21:54:09 k Exp $ Exporter::import('ExtUtils::MakeMaker', qw( $Verbose &neatvalue)); --- 8,15 ---- use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Verbose %pm %static $Xsubpp_Version); ! $VERSION = substr q$Revision: 1.117 $, 10; ! # $Id: MM_Unix.pm,v 1.117 1997/06/28 15:16:44 k Exp $ Exporter::import('ExtUtils::MakeMaker', qw( $Verbose &neatvalue)); *************** *** 181,186 **** --- 181,187 ---- sub ExtUtils::MM_Unix::extliblist ; sub ExtUtils::MM_Unix::file_name_is_absolute ; sub ExtUtils::MM_Unix::find_perl ; + sub ExtUtils::MM_Unix::fixin ; sub ExtUtils::MM_Unix::force ; sub ExtUtils::MM_Unix::guess_name ; sub ExtUtils::MM_Unix::has_link_code ; *************** *** 1103,1108 **** --- 1104,1189 ---- =over 2 + =item fixin + + Inserts the sharpbang or equivalent magic number to a script + + =cut + + sub fixin { # stolen from the pink Camel book, more or less + my($self,@files) = @_; + my($does_shbang) = $Config::Config{'sharpbang'} =~ /^\s*\#\!/; + my($file,$interpreter); + for $file (@files) { + local(*FIXIN); + local(*FIXOUT); + open(FIXIN, $file) or Carp::croak "Can't process '$file': $!"; + local $/ = "\n"; + chomp(my $line = ); + next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file. + # Now figure out the interpreter name. + my($cmd,$arg) = split ' ', $line, 2; + $cmd =~ s!^.*/!!; + + # Now look (in reverse) for interpreter in absolute PATH (unless perl). + if ($cmd eq "perl") { + $interpreter = $Config{perlpath}; + } else { + my(@absdirs) = reverse grep {$self->file_name_is_absolute} $self->path; + $interpreter = ''; + my($dir); + foreach $dir (@absdirs) { + if ($self->maybe_command($cmd)) { + warn "Ignoring $interpreter in $file\n" if $Verbose && $interpreter; + $interpreter = $self->catfile($dir,$cmd); + } + } + } + # Figure out how to invoke interpreter on this machine. + + my($shb) = ""; + if ($interpreter) { + print STDOUT "Changing sharpbang in $file to $interpreter" if $Verbose; + if ($does_shbang) { + $shb .= "$Config{'sharpbang'}$interpreter"; + $shb .= ' ' . $arg if defined $arg; + $shb .= "\n"; + } + $shb .= qq{ + eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' + if \$running_under_some_shell; + }; + } else { + warn "Can't find $cmd in PATH, $file unchanged" + if $Verbose; + next; + } + + unless ( rename($file, "$file.bak") ) { + warn "Can't modify $file"; + next; + } + unless ( open(FIXOUT,">$file") ) { + warn "Can't create new $file: $!\n"; + next; + } + my($dev,$ino,$mode) = stat FIXIN; + $mode = 0755 unless $dev; + chmod $mode, $file; + + # Print out the new #! line (or equivalent). + local $\; + undef $/; + print FIXOUT $shb, ; + close FIXIN; + close FIXOUT; + unlink "$file.bak"; + } continue { + chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; + system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';; + } + } + =item force (o) Just writes FORCE: *************** *** 1280,1286 **** # my $fh = new FileHandle; local *FH; my($ispod)=0; - # one day test, if $/ can be set to '' safely (is the bug fixed that was in 5.001m?) # if ($fh->open("<$name")) { if (open(FH,"<$name")) { # while (<$fh>) { --- 1361,1366 ---- *************** *** 1297,1303 **** $ispod = 1; } if( $ispod ) { ! $manifypods{$name} = $self->catfile('$(INST_MAN1DIR)',basename($name).'.$(MAN1EXT)'); } } } --- 1377,1385 ---- $ispod = 1; } if( $ispod ) { ! $manifypods{$name} = ! $self->catfile('$(INST_MAN1DIR)', ! basename($name).'.$(MAN1EXT)'); } } } *************** *** 1901,1922 **** $fromto{$from}=$to; } @to = values %fromto; ! push(@m, " EXE_FILES = @{$self->{EXE_FILES}} all :: @to realclean :: $self->{RM_F} @to ! "); while (($from,$to) = each %fromto) { last unless defined $from; my $todir = dirname($to); push @m, " ! $to: $from $self->{MAKEFILE} ".$self->catfile($todir,'.exists')." $self->{NOECHO}$self->{RM_F} $to $self->{CP} $from $to "; } join "", @m; --- 1983,2008 ---- $fromto{$from}=$to; } @to = values %fromto; ! push(@m, qq{ EXE_FILES = @{$self->{EXE_FILES}} + FIXIN = \$(PERL) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) -MExtUtils::MakeMaker \\ + -e "MY->fixin(shift)" + all :: @to realclean :: $self->{RM_F} @to ! }); while (($from,$to) = each %fromto) { last unless defined $from; my $todir = dirname($to); push @m, " ! $to: $from $self->{MAKEFILE} $todir/.exists $self->{NOECHO}$self->{RM_F} $to $self->{CP} $from $to + \$(FIXIN) $to "; } join "", @m; *************** *** 2430,2443 **** $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if $inpod; chop; ! next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/; my $eval = qq{ package ExtUtils::MakeMaker::_version; no strict; ! \$$1=undef; do { $_ ! }; \$$1 }; local($^W) = 0; $result = eval($eval) || 0; --- 2516,2531 ---- $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if $inpod; chop; ! # next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/; ! next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/; my $eval = qq{ package ExtUtils::MakeMaker::_version; no strict; ! local $1$2; ! \$$2=undef; do { $_ ! }; \$$2 }; local($^W) = 0; $result = eval($eval) || 0; Index: perl5.004_01_02/lib/ExtUtils/MM_VMS.pm *** perl5.004_01/lib/ExtUtils/MM_VMS.pm Mon Jun 9 14:01:04 1997 --- perl5.004_01_02/lib/ExtUtils/MM_VMS.pm Thu Jul 31 19:42:52 1997 *************** *** 96,102 **** } my($fixedpath,$prefix,$name); ! if ($path =~ m#^\$\(.+\)$# || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])$/) { $fixedpath = vmspath($self->eliminate_macros($path)); } --- 96,102 ---- } my($fixedpath,$prefix,$name); ! if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])$/) { $fixedpath = vmspath($self->eliminate_macros($path)); } *************** *** 105,111 **** } } elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) { ! my($vmspre) = vmspath($self->eliminate_macros("\$($prefix)")) || ''; # is it a dir or just a name? $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; $fixedpath = vmspath($fixedpath) if $force_path; } --- 105,113 ---- } } elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) { ! my($vmspre) = $self->eliminate_macros("\$($prefix)"); ! # is it a dir or just a name? ! $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? vmspath($vmspre) : ''; $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; $fixedpath = vmspath($fixedpath) if $force_path; } Index: perl5.004_01_02/lib/ExtUtils/MakeMaker.pm *** perl5.004_01/lib/ExtUtils/MakeMaker.pm Fri Jun 6 22:44:12 1997 --- perl5.004_01_02/lib/ExtUtils/MakeMaker.pm Thu Jul 31 21:51:13 1997 *************** *** 2,11 **** package ExtUtils::MakeMaker; ! $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+$//; --- 2,11 ---- package ExtUtils::MakeMaker; ! $Version = $VERSION = "5.41"; $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.215 $, 10)) =~ s/\s+$//; *************** *** 1157,1162 **** --- 1157,1167 ---- and the values portion of the XS attribute hash. This is not currently used by MakeMaker but may be handy in Makefile.PLs. + =item CCFLAGS + + String that will be included in the compiler call command line between + the arguments INC and OPTIMIZE. + =item CONFIG Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from *************** *** 1257,1262 **** --- 1262,1271 ---- Ref to array of *.h file names. Similar to C. + =item IMPORTS + + IMPORTS is only used on OS/2. + =item INC Include file dirs eg: C<"-I/usr/5include -I/path/to/inc"> *************** *** 1564,1578 **** single line to compute the version number. The first line in the file that contains the regular expression ! /\$(([\w\:\']*)\bVERSION)\b.*\=/ will be evaluated with eval() and the value of the named variable B the eval() will be assigned to the VERSION attribute of the MakeMaker object. The following lines will be parsed o.k.: $VERSION = '1.00'; ! ( $VERSION ) = '$Revision: 1.211 $ ' =~ /\$Revision:\s+([^\s]+)/; $FOO::VERSION = '1.10'; but these will fail: --- 1573,1589 ---- single line to compute the version number. The first line in the file that contains the regular expression ! /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ will be evaluated with eval() and the value of the named variable B the eval() will be assigned to the VERSION attribute of the MakeMaker object. The following lines will be parsed o.k.: $VERSION = '1.00'; ! *VERSION = \'1.01'; ! ( $VERSION ) = '$Revision: 1.215 $ ' =~ /\$Revision:\s+([^\s]+)/; $FOO::VERSION = '1.10'; + *FOO::VERSION = \'1.11'; but these will fail: *************** *** 1580,1588 **** local $VERSION = '1.02'; local $FOO::VERSION = '1.30'; ! The file named in VERSION_FROM is added as a dependency to Makefile to ! guarantee, that the Makefile contains the correct VERSION macro after ! a change of the file. =item XS --- 1591,1606 ---- local $VERSION = '1.02'; local $FOO::VERSION = '1.30'; ! The file named in VERSION_FROM is not added as a dependency to ! Makefile. This is not really correct, but it would be a major pain ! during development to have to rewrite the Makefile for any smallish ! change in that file. If you want to make sure that the Makefile ! contains the correct VERSION macro after any change of the file, you ! would have to do something like ! ! depend => { Makefile => '$(VERSION_FROM)' } ! ! See attribute C below. =item XS Index: perl5.004_01_02/lib/ExtUtils/Mksymlists.pm *** perl5.004_01/lib/ExtUtils/Mksymlists.pm Fri Jun 6 22:44:12 1997 --- perl5.004_01_02/lib/ExtUtils/Mksymlists.pm Thu Jul 31 21:51:13 1997 *************** *** 7,13 **** use vars qw( @ISA @EXPORT $VERSION ); @ISA = 'Exporter'; @EXPORT = '&Mksymlists'; ! $VERSION = substr q$Revision: 1.13 $, 10; sub Mksymlists { my(%spec) = @_; --- 7,13 ---- use vars qw( @ISA @EXPORT $VERSION ); @ISA = 'Exporter'; @EXPORT = '&Mksymlists'; ! $VERSION = substr q$Revision: 1.15 $, 10; sub Mksymlists { my(%spec) = @_; *************** *** 106,121 **** open(DEF,">$data->{FILE}.def") or croak("Can't create $data->{FILE}.def: $!\n"); ! print DEF "LIBRARY $data->{DLBASE}\n"; print DEF "CODE LOADONCALL\n"; print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; print DEF "EXPORTS\n "; if ($Config::Config{'cc'} =~ /^bcc/i) { ! for (@{$data->{DL_VARS}}) { $_ = "$_ = _$_" } ! for (@{$data->{FUNCLIST}}) { $_ = "$_ = _$_" } } ! print DEF join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; ! print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; if (%{$data->{IMPORTS}}) { print DEF "IMPORTS\n"; my ($name, $exp); --- 106,133 ---- open(DEF,">$data->{FILE}.def") or croak("Can't create $data->{FILE}.def: $!\n"); ! # put library name in quotes (it could be a keyword, like 'Alias') ! print DEF "LIBRARY \"$data->{DLBASE}\"\n"; print DEF "CODE LOADONCALL\n"; print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; print DEF "EXPORTS\n "; + my @syms; + # Export public symbols both with and without underscores to + # ensure compatibility between DLLs from different compilers + # NOTE: DynaLoader itself only uses the names without underscores, + # so this is only to cover the case when the extension DLL may be + # linked to directly from C. GSAR 97-07-10 if ($Config::Config{'cc'} =~ /^bcc/i) { ! for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { ! push @syms, "_$_", "$_ = _$_"; ! } ! } ! else { ! for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { ! push @syms, "$_", "_$_ = $_"; ! } } ! print DEF join("\n ",@syms, "\n") if @syms; if (%{$data->{IMPORTS}}) { print DEF "IMPORTS\n"; my ($name, $exp); Index: perl5.004_01_02/lib/ExtUtils/xsubpp *** perl5.004_01/lib/ExtUtils/xsubpp Sat Jun 7 01:36:53 1997 --- perl5.004_01_02/lib/ExtUtils/xsubpp Thu Jul 31 20:50:56 1997 *************** *** 6,12 **** =head1 SYNOPSIS ! B [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-typemap typemap>]... file.xs =head1 DESCRIPTION --- 6,12 ---- =head1 SYNOPSIS ! B [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>]... file.xs =head1 DESCRIPTION *************** *** 55,60 **** --- 55,64 ---- from the C<.xs> file) and the C<.pm> files have the same version number. + =item B<-nolinenumbers> + + Prevents the inclusion of `#line' directives in the output. + =back =head1 ENVIRONMENT *************** *** 83,89 **** # Global Constants ! $XSUBPP_version = "1.9402"; my ($Is_VMS, $SymSet); if ($^O eq 'VMS') { --- 87,93 ---- # Global Constants ! $XSUBPP_version = "1.9504"; my ($Is_VMS, $SymSet); if ($^O eq 'VMS') { *************** *** 96,102 **** $FH = 'File0000' ; ! $usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n"; $proto_re = "[" . quotemeta('\$%&*@;') . "]" ; --- 100,106 ---- $FH = 'File0000' ; ! $usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-s pattern] [-typemap typemap]... file.xs\n"; $proto_re = "[" . quotemeta('\$%&*@;') . "]" ; *************** *** 104,109 **** --- 108,114 ---- $WantPrototypes = -1 ; $WantVersionChk = 1 ; $ProtoUsed = 0 ; + $WantLineNumbers = 1 ; SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) { $flag = shift @ARGV; $flag =~ s/^-// ; *************** *** 115,120 **** --- 120,127 ---- $WantVersionChk = 1, next SWITCH if $flag eq 'versioncheck'; $except = " TRY", next SWITCH if $flag eq 'except'; push(@tm,shift), next SWITCH if $flag eq 'typemap'; + $WantLineNumbers = 0, next SWITCH if $flag eq 'nolinenumbers'; + $WantLineNumbers = 1, next SWITCH if $flag eq 'linenumbers'; (print "xsubpp version $XSUBPP_version\n"), exit if $flag eq 'v'; die $usage; *************** *** 239,251 **** } sub print_section { ! my $count = 0; ! $_ = shift(@line) while !/\S/ && @line; for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { - print line_directive() unless ($count++); print "$_\n"; } } sub process_keyword($) --- 246,304 ---- } + if ($WantLineNumbers) { + { + package xsubpp::counter; + sub TIEHANDLE { + my ($class, $cfile) = @_; + my $buf = ""; + $SECTION_END_MARKER = "#line --- \"$cfile\""; + $line_no = 1; + bless \$buf; + } + + sub PRINT { + my $self = shift; + for (@_) { + $$self .= $_; + while ($$self =~ s/^([^\n]*\n)//) { + my $line = $1; + ++ $line_no; + $line =~ s|^\#line\s+---(?=\s)|#line $line_no|; + print STDOUT $line; + } + } + } + + sub PRINTF { + my $self = shift; + my $fmt = shift; + $self->PRINT(sprintf($fmt, @_)); + } + + sub DESTROY { + # Not necessary if we're careful to end with a "\n" + my $self = shift; + print STDOUT $$self; + } + } + + my $cfile = $filename; + $cfile =~ s/\.xs$/.c/i or $cfile .= ".c"; + tie(*PSEUDO_STDOUT, 'xsubpp::counter', $cfile); + select PSEUDO_STDOUT; + } + sub print_section { ! # the "do" is required for right semantics ! do { $_ = shift(@line) } while !/\S/ && @line; ! ! print("#line ", $line_no[@line_no - @line -1], " \"$filename\"\n") ! if $WantLineNumbers && !/^\s*#\s*line\b/; for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { print "$_\n"; } + print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers; } sub process_keyword($) *************** *** 255,261 **** &{"${kwd}_handler"}() while $kwd = check_keyword($pattern) ; - print line_directive(); } sub CASE_handler { --- 308,313 ---- *************** *** 332,338 **** unless defined($args_match{$outarg}); blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next unless defined $var_types{$outarg} ; - print line_directive(); if ($outcode) { print "\t$outcode\n"; } else { --- 384,389 ---- *************** *** 650,656 **** */ EOM ! print "#line 1 \"$filename\"\n"; while (<$FH>) { last if ($Module, $Package, $Prefix) = --- 701,710 ---- */ EOM ! ! ! print("#line 1 \"$filename\"\n") ! if $WantLineNumbers; while (<$FH>) { last if ($Module, $Package, $Prefix) = *************** *** 787,793 **** if (check_keyword("BOOT")) { &check_cpp; ! push (@BootCode, $_, line_directive(), @line, "") ; next PARAGRAPH ; } --- 841,849 ---- if (check_keyword("BOOT")) { &check_cpp; ! push (@BootCode, "#line $line_no[@line_no - @line] \"$filename\"") ! if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/; ! push (@BootCode, @line, "") ; next PARAGRAPH ; } *************** *** 1005,1011 **** } elsif ($gotRETVAL || $wantRETVAL) { &generate_output($ret_type, 0, 'RETVAL'); } - print line_directive(); # do cleanup process_keyword("CLEANUP|ALIAS|PROTOTYPE") ; --- 1061,1066 ---- *************** *** 1064,1074 **** if ($ProtoThisXSUB) { $newXS = "newXSproto"; ! if ($ProtoThisXSUB == 2) { # User has specified empty prototype $proto = ', ""' ; } ! elsif ($ProtoThisXSUB != 1) { # User has specified a prototype $proto = ', "' . $ProtoThisXSUB . '"'; } --- 1119,1129 ---- if ($ProtoThisXSUB) { $newXS = "newXSproto"; ! if ($ProtoThisXSUB eq 2) { # User has specified empty prototype $proto = ', ""' ; } ! elsif ($ProtoThisXSUB ne 1) { # User has specified a prototype $proto = ', "' . $ProtoThisXSUB . '"'; } *************** *** 1135,1142 **** if (@BootCode) { ! print "\n /* Initialisation Section */\n" ; ! print grep (s/$/\n/, @BootCode) ; print "\n /* End of Initialisation Section */\n\n" ; } --- 1190,1198 ---- if (@BootCode) { ! print "\n /* Initialisation Section */\n\n" ; ! @line = @BootCode; ! print_section(); print "\n /* End of Initialisation Section */\n\n" ; } *************** *** 1156,1170 **** local($arg) = "ST(" . ($num - 1) . ")"; eval qq/print " $init\\\n"/; - } - - sub line_directive - { - # work out the line number - my $line_no = $line_no[@line_no - @line -1] ; - - return "#line $line_no \"$filename\"\n" ; - } sub Warn --- 1212,1217 ---- Index: perl5.004_01_02/lib/File/Compare.pm *** perl5.004_01/lib/File/Compare.pm Wed Feb 5 17:59:54 1997 --- perl5.004_01_02/lib/File/Compare.pm Mon Jul 28 22:14:27 1997 *************** *** 5,11 **** require Exporter; use Carp; - use UNIVERSAL qw(isa); $VERSION = '1.1001'; @ISA = qw(Exporter); --- 5,10 ---- *************** *** 34,40 **** croak("from undefined") unless (defined $from); croak("to undefined") unless (defined $to); ! if (ref($from) && (isa($from,'GLOB') || isa($from,'IO::Handle'))) { *FROM = *$from; } elsif (ref(\$from) eq 'GLOB') { *FROM = $from; --- 33,40 ---- croak("from undefined") unless (defined $from); croak("to undefined") unless (defined $to); ! if (ref($from) && ! (UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) { *FROM = *$from; } elsif (ref(\$from) eq 'GLOB') { *FROM = $from; *************** *** 45,51 **** $fromsize = -s FROM; } ! if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) { *TO = *$to; } elsif (ref(\$to) eq 'GLOB') { *TO = $to; --- 45,52 ---- $fromsize = -s FROM; } ! if (ref($to) && ! (UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) { *TO = *$to; } elsif (ref(\$to) eq 'GLOB') { *TO = $to; Index: perl5.004_01_02/lib/File/Copy.pm *** perl5.004_01/lib/File/Copy.pm Tue Dec 31 07:09:37 1996 --- perl5.004_01_02/lib/File/Copy.pm Mon Jul 28 22:14:27 1997 *************** *** 9,15 **** use strict; use Carp; - use UNIVERSAL qw(isa); use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $Too_Big © &syscopy &cp &mv); --- 9,14 ---- *************** *** 48,58 **** my $from_a_handle = (ref($from) ? (ref($from) eq 'GLOB' ! || isa($from, 'GLOB') || isa($from, 'IO::Handle')) : (ref(\$from) eq 'GLOB')); my $to_a_handle = (ref($to) ? (ref($to) eq 'GLOB' ! || isa($to, 'GLOB') || isa($to, 'IO::Handle')) : (ref(\$to) eq 'GLOB')); if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) { --- 47,59 ---- my $from_a_handle = (ref($from) ? (ref($from) eq 'GLOB' ! || UNIVERSAL::isa($from, 'GLOB') ! || UNIVERSAL::isa($from, 'IO::Handle')) : (ref(\$from) eq 'GLOB')); my $to_a_handle = (ref($to) ? (ref($to) eq 'GLOB' ! || UNIVERSAL::isa($to, 'GLOB') ! || UNIVERSAL::isa($to, 'IO::Handle')) : (ref(\$to) eq 'GLOB')); if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) { Index: perl5.004_01_02/lib/File/Find.pm *** perl5.004_01/lib/File/Find.pm Thu Dec 19 22:11:40 1996 --- perl5.004_01_02/lib/File/Find.pm Thu Jul 31 22:10:02 1997 *************** *** 78,95 **** # compatibility. local($topdir,$topdev,$topino,$topmode,$topnlink); foreach $topdir (@_) { ! (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) || (warn("Can't stat $topdir: $!\n"), next); if (-d _) { if (chdir($topdir)) { ($dir,$_) = ($topdir,'.'); $name = $topdir; &$wanted; ! my $fixtopdir = $topdir; ! $fixtopdir =~ s,/$,, ; ! $fixtopdir =~ s/\.dir$// if $Is_VMS; ! $fixtopdir =~ s/\\dir$// if $Is_NT; ! &finddir($wanted,$fixtopdir,$topnlink); } else { warn "Can't cd to $topdir: $!\n"; --- 78,99 ---- # compatibility. local($topdir,$topdev,$topino,$topmode,$topnlink); foreach $topdir (@_) { ! (($topdev,$topino,$topmode,$topnlink) = ! ($Is_VMS ? stat($topdir) : lstat($topdir))) || (warn("Can't stat $topdir: $!\n"), next); if (-d _) { if (chdir($topdir)) { ($dir,$_) = ($topdir,'.'); $name = $topdir; + $prune = 0; &$wanted; ! if (!$prune) { ! my $fixtopdir = $topdir; ! $fixtopdir =~ s,/$,, ; ! $fixtopdir =~ s/\.dir$// if $Is_VMS; ! $fixtopdir =~ s/\\dir$// if $Is_NT; ! &finddir($wanted,$fixtopdir,$topnlink); ! } } else { warn "Can't cd to $topdir: $!\n"; *************** *** 169,175 **** # compatibility. local($topdir, $topdev, $topino, $topmode, $topnlink); foreach $topdir (@_) { ! (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) || (warn("Can't stat $topdir: $!\n"), next); if (-d _) { if (chdir($topdir)) { --- 173,180 ---- # compatibility. local($topdir, $topdev, $topino, $topmode, $topnlink); foreach $topdir (@_) { ! (($topdev,$topino,$topmode,$topnlink) = ! ($Is_VMS ? stat($topdir) : lstat($topdir))) || (warn("Can't stat $topdir: $!\n"), next); if (-d _) { if (chdir($topdir)) { *************** *** 190,195 **** --- 195,201 ---- unless (($_,$dir) = File::Basename::fileparse($topdir)) { ($dir,$_) = ('.', $topdir); } + $name = $topdir; chdir $dir && &$wanted; } chdir $cwd; Index: perl5.004_01_02/lib/File/Path.pm *** perl5.004_01/lib/File/Path.pm Thu Apr 24 17:39:44 1997 --- perl5.004_01_02/lib/File/Path.pm Thu Jul 31 23:57:26 1997 *************** *** 130,136 **** my $parent = File::Basename::dirname($path); push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent); print "mkdir $path\n" if $verbose; ! mkdir($path,$mode) || croak "mkdir $path: $!"; push(@created, $path); } @created; --- 130,139 ---- my $parent = File::Basename::dirname($path); push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent); print "mkdir $path\n" if $verbose; ! unless (mkdir($path,$mode)) { ! # allow for another process to have created it meanwhile ! croak "mkdir $path: $!" unless -d $path; ! } push(@created, $path); } @created; Index: perl5.004_01_02/lib/FileHandle.pm *** perl5.004_01/lib/FileHandle.pm Fri Jan 31 17:44:23 1997 --- perl5.004_01_02/lib/FileHandle.pm Thu Jul 31 23:38:31 1997 *************** *** 93,98 **** --- 93,103 ---- ($r, $w); } + # Rebless standard file handles + bless *STDIN{IO}, "FileHandle" if ref *STDIN{IO} eq "IO::Handle"; + bless *STDOUT{IO}, "FileHandle" if ref *STDOUT{IO} eq "IO::Handle"; + bless *STDERR{IO}, "FileHandle" if ref *STDERR{IO} eq "IO::Handle"; + 1; __END__ Index: perl5.004_01_02/lib/Net/hostent.pm *** perl5.004_01/lib/Net/hostent.pm Thu Apr 10 17:00:21 1997 --- perl5.004_01_02/lib/Net/hostent.pm Thu Jul 31 23:28:04 1997 *************** *** 76,84 **** gethostbyaddr() functions, replacing them with versions that return "Net::hostent" objects. This object has methods that return the similarly named structure field name from the C's hostent structure from F; ! namely name, aliases, addrtype, length, and addresses. The aliases and ! addresses methods return array reference, the rest scalars. The addr ! method is equivalent to the zeroth element in the addresses array reference. You may also import all the structure fields directly into your namespace --- 76,84 ---- gethostbyaddr() functions, replacing them with versions that return "Net::hostent" objects. This object has methods that return the similarly named structure field name from the C's hostent structure from F; ! namely name, aliases, addrtype, length, and addr_list. The aliases and ! addr_list methods return array reference, the rest scalars. The addr ! method is equivalent to the zeroth element in the addr_list array reference. You may also import all the structure fields directly into your namespace Index: perl5.004_01_02/lib/Pod/Html.pm *** perl5.004_01/lib/Pod/Html.pm Thu Jun 12 21:52:53 1997 --- perl5.004_01_02/lib/Pod/Html.pm Thu Jul 31 22:01:47 1997 *************** *** 761,767 **** # scan for =head directives, note their name, and build an index # pointing to each of them. foreach my $line (@data) { ! if ($line =~ /^\s*=(head)([1-6])\s+(.*)/) { ($tag,$which_head, $title) = ($1,$2,$3); chomp($title); $$sections{htmlify(0,$title)} = 1; --- 761,767 ---- # scan for =head directives, note their name, and build an index # pointing to each of them. foreach my $line (@data) { ! if ($line =~ /^=(head)([1-6])\s+(.*)/) { ($tag,$which_head, $title) = ($1,$2,$3); chomp($title); $$sections{htmlify(0,$title)} = 1; *************** *** 788,794 **** # get rid of bogus lists $index =~ s,\t*
    \s*
\n,,g; ! $ignore = 1; # retore old value; return $index; } --- 788,794 ---- # get rid of bogus lists $index =~ s,\t*
    \s*
\n,,g; ! $ignore = 1; # restore old value; return $index; } Index: perl5.004_01_02/lib/Sys/Hostname.pm *** perl5.004_01/lib/Sys/Hostname.pm Thu May 8 15:41:14 1997 --- perl5.004_01_02/lib/Sys/Hostname.pm Mon Jul 28 22:31:26 1997 *************** *** 39,45 **** if ($^O eq 'VMS') { # method 2 - no sockets ==> return DECnet node name ! eval {my($test) = gethostbyname('me')}; # returns 'me' on most systems if ($@) { return $host = $ENV{'SYS$NODE'}; } # method 3 - has someone else done the job already? It's common for the --- 39,45 ---- if ($^O eq 'VMS') { # method 2 - no sockets ==> return DECnet node name ! eval { local $SIG{__DIE__}; (gethostbyname('me'))[0] }; if ($@) { return $host = $ENV{'SYS$NODE'}; } # method 3 - has someone else done the job already? It's common for the *************** *** 69,74 **** --- 69,75 ---- # method 2 - syscall is preferred since it avoids tainting problems eval { + local $SIG{__DIE__}; { package main; require "syscall.ph"; *************** *** 79,94 **** --- 80,98 ---- # method 3 - trusty old hostname command || eval { + local $SIG{__DIE__}; $host = `(hostname) 2>/dev/null`; # bsdish } # method 4 - sysV uname command (may truncate) || eval { + local $SIG{__DIE__}; $host = `uname -n 2>/dev/null`; ## sysVish } # method 5 - Apollo pre-SR10 || eval { + local $SIG{__DIE__}; ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); } Index: perl5.004_01_02/lib/Sys/Syslog.pm *** perl5.004_01/lib/Sys/Syslog.pm Tue Jun 10 23:45:59 1997 --- perl5.004_01_02/lib/Sys/Syslog.pm Thu Jul 31 21:35:38 1997 *************** *** 54,59 **** --- 54,72 ---- Sets log mask I<$mask_priority> and returns the old mask. + =item setlogsock $sock_type + + Sets the socket type to be used for the next call to + C or C. + + A value of 'unix' will connect to the UNIX domain socket returned + by C<_PATH_LOG> in F. A value of 'inet' will connect + to an INET socket returned by getservbyname(). + Any other value croaks. + + The default is for the INET socket to be used. + + =item closelog Closes the log file. *************** *** 70,78 **** --- 83,94 ---- closelog(); syslog('debug', 'this is the last test'); + + setlogsock('unix'); openlog("$program $$", 'ndelay', 'user'); syslog('notice', 'fooprogram: this is really done'); + setlogsock('inet'); $! = 55; syslog('info', 'problem was %m'); # %m == $! in syslog(3) *************** *** 86,92 **** =head1 AUTHOR ! Tom Christiansen EFE and Larry Wall EFE =cut --- 102,110 ---- =head1 AUTHOR ! Tom Christiansen EFE and Larry Wall EFE. ! UNIX domain sockets added by Sean Robinson EFE ! with support from Tim Bunce and the perl5-porters mailing list. =cut *************** *** 114,119 **** --- 132,148 ---- $oldmask; } + sub setlogsock { + local($setsock) = shift; + if (lc($setsock) eq 'unix') { + $sock_unix = 1; + } elsif (lc($setsock) eq 'inet') { + undef($sock_unix); + } else { + croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'"; + } + } + sub syslog { local($priority) = shift; local($mask) = shift; *************** *** 172,178 **** $message = sprintf ($mask, @_); $sum = $numpri + $numfac; ! unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { if ($lo_cons) { if ($pid = fork) { unless ($lo_nowait) { --- 201,207 ---- $message = sprintf ($mask, @_); $sum = $numpri + $numfac; ! unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) { if ($lo_cons) { if ($pid = fork) { unless ($lo_nowait) { *************** *** 203,214 **** my($host_uniq) = Sys::Hostname::hostname(); ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _) } ! my $udp = getprotobyname('udp'); ! my $syslog = getservbyname('syslog','udp'); ! my $this = sockaddr_in($syslog, INADDR_ANY); ! my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host"); ! socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!"; ! connect(SYSLOG,$that) || croak "connect: $!"; local($old) = select(SYSLOG); $| = 1; select($old); $connected = 1; } --- 232,250 ---- my($host_uniq) = Sys::Hostname::hostname(); ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _) } ! unless ( $sock_unix ) { ! my $udp = getprotobyname('udp'); ! my $syslog = getservbyname('syslog','udp'); ! my $this = sockaddr_in($syslog, INADDR_ANY); ! my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host"); ! socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!"; ! connect(SYSLOG,$that) || croak "connect: $!"; ! } else { ! my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph"; ! my $that = sockaddr_un($syslog) || croak "Can't locate $syslog"; ! socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "open: $!"; ! connect(SYSLOG,$that) || croak "connect: $!"; ! } local($old) = select(SYSLOG); $| = 1; select($old); $connected = 1; } Index: perl5.004_01_02/lib/Term/ReadLine.pm *** perl5.004_01/lib/Term/ReadLine.pm Fri Jun 6 23:53:34 1997 --- perl5.004_01_02/lib/Term/ReadLine.pm Thu Jul 31 20:54:52 1997 *************** *** 105,118 **** All these commands are callable via method interface and have names which conform to standard conventions with the leading C stripped. ! The stub package included with the perl distribution allows two ! additional methods: C and C. The first one makes Tk event loop run when waiting for user input (i.e., during ! C method), the second one makes the command line stand out ! by using termcap data. The argument to C should be 0, 1, ! or a string of a form "aa,bb,cc,dd". Four components of this string ! should be names of I, first two will be issued to ! make the prompt standout, last two to make the input line standout. =head1 EXPORTS --- 105,137 ---- All these commands are callable via method interface and have names which conform to standard conventions with the leading C stripped. ! The stub package included with the perl distribution allows some ! additional methods: ! ! =over 12 ! ! =item C ! makes Tk event loop run when waiting for user input (i.e., during ! C method). ! ! =item C ! ! makes the command line stand out by using termcap data. The argument ! to C should be 0, 1, or a string of a form ! C<"aa,bb,cc,dd">. Four components of this string should be names of ! I, first two will be issued to make the prompt ! standout, last two to make the input line standout. ! ! =item C ! ! takes two arguments which are input filehandle and output filehandle. ! Switches to use these filehandles. ! ! =back ! ! One can check whether the currently loaded ReadLine package supports ! these methods by checking for corresponding C. =head1 EXPORTS *************** *** 206,217 **** bless [$FIN, $FOUT]; } } sub IN { shift->[0] } sub OUT { shift->[1] } sub MinLine { undef } sub Attribs { {} } ! my %features = (tkRunning => 1, ornaments => 1); sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? --- 225,246 ---- bless [$FIN, $FOUT]; } } + + sub newTTY { + my ($self, $in, $out) = @_; + $self->[0] = $in; + $self->[1] = $out; + my $sel = select($out); + $| = 1; # for DB::OUT + select($sel); + } + sub IN { shift->[0] } sub OUT { shift->[1] } sub MinLine { undef } sub Attribs { {} } ! my %features = (tkRunning => 1, ornaments => 1, newTTY => 1); sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? Index: perl5.004_01_02/lib/Time/Local.pm *** perl5.004_01/lib/Time/Local.pm Sun Nov 24 08:02:03 1996 --- perl5.004_01_02/lib/Time/Local.pm Mon Jul 28 22:22:25 1997 *************** *** 48,58 **** $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0; ! my $t = time; ! my @lt = localtime($t); ! my @gt = gmtime($t); ! $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; my($lday,$gday) = ($lt[7],$gt[7]); if($lt[5] > $gt[5]) { --- 48,69 ---- $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0; ! } ! ! sub timegm { ! $ym = pack(C2, @_[5,4]); ! $cheat = $cheat{$ym} || &cheat; ! return -1 if $cheat<0 and $^O ne 'VMS'; ! $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY; ! } ! ! sub timelocal { ! my $t = &timegm; ! ! my (@lt) = localtime($t); ! my (@gt) = gmtime($t); ! my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; my($lday,$gday) = ($lt[7],$gt[7]); if($lt[5] > $gt[5]) { *************** *** 65,82 **** $tzsec += ($gt[7] - $lt[7]) * $DAY; } ! $tzsec += $HR if($lt[8]); ! } ! ! sub timegm { ! $ym = pack(C2, @_[5,4]); ! $cheat = $cheat{$ym} || &cheat; ! return -1 if $cheat<0 and $^O ne 'VMS'; ! $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAY; ! } ! ! sub timelocal { ! $time = &timegm + $tzsec; return -1 if $cheat<0 and $^O ne 'VMS'; @test = localtime($time); $time -= $HR if $test[2] != $_[2]; --- 76,84 ---- $tzsec += ($gt[7] - $lt[7]) * $DAY; } ! $tzsec += $HR if($lt[8]); ! ! $time = $t + $tzsec; return -1 if $cheat<0 and $^O ne 'VMS'; @test = localtime($time); $time -= $HR if $test[2] != $_[2]; Index: perl5.004_01_02/lib/UNIVERSAL.pm *** perl5.004_01/lib/UNIVERSAL.pm Mon Mar 24 20:43:43 1997 --- perl5.004_01_02/lib/UNIVERSAL.pm Mon Jul 28 23:41:07 1997 *************** *** 1,7 **** package UNIVERSAL; require Exporter; ! @ISA = qw(Exporter); @EXPORT_OK = qw(isa can); 1; --- 1,10 ---- package UNIVERSAL; + # UNIVERSAL should not contain any extra subs/methods beyond those + # that it exists to define. The use of Exporter below is a historical + # accident that should be fixed sometime. require Exporter; ! *import = \&Exporter::import; @EXPORT_OK = qw(isa can); 1; *************** *** 13,24 **** =head1 SYNOPSIS - use UNIVERSAL qw(isa); - - $yes = isa($ref, "HASH"); $io = $fd->isa("IO::Handle"); $sub = $obj->can('print'); =head1 DESCRIPTION C is the base class which all bless references will inherit from, --- 16,26 ---- =head1 SYNOPSIS $io = $fd->isa("IO::Handle"); $sub = $obj->can('print'); + $yes = UNIVERSAL::isa($ref, "HASH"); + =head1 DESCRIPTION C is the base class which all bless references will inherit from, *************** *** 54,64 **** =back ! C also optionally exports the following subroutines =over 4 ! =item isa ( VAL, TYPE ) C returns I if the first argument is a reference and either of the following statements is true. --- 56,66 ---- =back ! The C and C methods can also be called as subroutines =over 4 ! =item UNIVERSAL::isa ( VAL, TYPE ) C returns I if the first argument is a reference and either of the following statements is true. *************** *** 76,82 **** =back ! =item can ( VAL, METHOD ) If C is a blessed reference which has a method called C, C returns a reference to the subroutine. If C is not --- 78,84 ---- =back ! =item UNIVERSAL::can ( VAL, METHOD ) If C is a blessed reference which has a method called C, C returns a reference to the subroutine. If C is not *************** *** 84,88 **** --- 86,97 ---- I is returned. =back + + These subroutines should I be imported via S>. + If you want simple local access to them you can do + + *isa = \&UNIVERSAL::isa; + + to import isa into your package. =cut Index: perl5.004_01_02/lib/ftp.pl Prereq: 1.17 *** perl5.004_01/lib/ftp.pl Thu Jun 12 00:58:24 1997 --- perl5.004_01_02/lib/ftp.pl Thu Jul 31 23:53:22 1997 *************** *** 88,102 **** # Initial revision # ! eval { require 'chat2.pl' }; ! die qq{$@ ! The obsolete and problematic chat2.pl library has been removed from the ! Perl distribution at the request of it's author. You can either get a ! copy yourself or, preferably, fetch the new and much better Net::FTP ! package from a CPAN ftp site. ! } if $@ && $@ =~ /locate chat2.pl/; ! die $@ if $@; ! eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n"; package ftp; --- 88,96 ---- # Initial revision # ! require 'chat2.pl'; # into main ! eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" ! || die "socket.ph missing: $!\n"; package ftp; Index: perl5.004_01_02/lib/perl5db.pl *** perl5.004_01/lib/perl5db.pl Tue Apr 15 17:09:27 1997 --- perl5.004_01_02/lib/perl5db.pl Thu Jul 31 20:54:52 1997 *************** *** 428,433 **** --- 428,434 ---- @typeahead = @$pretype, @typeahead; CMD: while (($term || &setterm), + ($term_pid == $$ or &resetterm), defined ($cmd=&readline(" DB" . ('<' x $level) . ($#hist+1) . ('>' x $level) . " "))) { *************** *** 1062,1068 **** $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval; if ($onetimeDump) { $onetimeDump = undef; ! } else { print $OUT "\n"; } } continue { # CMD: --- 1063,1069 ---- $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval; if ($onetimeDump) { $onetimeDump = undef; ! } elsif ($term_pid == $$) { print $OUT "\n"; } } continue { # CMD: *************** *** 1386,1391 **** --- 1387,1415 ---- $term->SetHistory(@hist); } ornaments($ornaments) if defined $ornaments; + $term_pid = $$; + } + + sub resetterm { # We forked, so we need a different TTY + $term_pid = $$; + if (defined &get_fork_TTY) { + &get_fork_TTY; + } elsif (not defined $fork_TTY + and defined $ENV{TERM} and $ENV{TERM} eq 'xterm' + and defined $ENV{WINDOWID} and defined $ENV{DISPLAY}) { + # Possibly _inside_ XTERM + open XT, q[3>&1 xterm -title 'Forked Perl debugger' -e sh -c 'tty 1>&3;\ + sleep 10000000' |]; + $fork_TTY = ; + chomp $fork_TTY; + } + if (defined $fork_TTY) { + TTY($fork_TTY); + undef $fork_TTY; + } else { + print $OUT "Forked, but do not know how to change a TTY.\n", + "Define \$DB::fork_TTY or get_fork_TTY().\n"; + } } sub readline { *************** *** 1511,1518 **** } sub TTY { ! if ($term) { ! &warn("Too late to set TTY, enabled on next `R'!\n") if @_; } $tty = shift if @_; $tty or $console; --- 1535,1555 ---- } sub TTY { ! if (@_ and $term and $term->Features->{newTTY}) { ! my ($in, $out) = shift; ! if ($in =~ /,/) { ! ($in, $out) = split /,/, $in, 2; ! } else { ! $out = $in; ! } ! open IN, $in or die "cannot open `$in' for read: $!"; ! open OUT, ">$out" or die "cannot open `$out' for write: $!"; ! $term->newTTY(\*IN, \*OUT); ! $IN = \*IN; ! $OUT = \*OUT; ! return $tty = $in; ! } elsif ($term and @_) { ! &warn("Too late to set TTY, enabled on next `R'!\n"); } $tty = shift if @_; $tty or $console; Index: perl5.004_01_02/malloc.c *** perl5.004_01/malloc.c Fri Mar 21 02:43:49 1997 --- perl5.004_01_02/malloc.c Mon Jul 28 23:55:47 1997 *************** *** 2,7 **** --- 2,11 ---- * */ + #if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS) + # define DEBUGGING_MSTATS + #endif + #ifndef lint # if defined(DEBUGGING) && !defined(NO_RCHECK) # define RCHECK *************** *** 781,786 **** --- 785,793 ---- #ifdef PERL_CORE reqsize = size; /* just for the DEBUG_m statement */ #endif + #ifdef PACK_MALLOC + size = (size + 0x7ff) & ~0x7ff; + #endif if (size <= Perl_sbrk_oldsize) { got = Perl_sbrk_oldchunk; Perl_sbrk_oldchunk += size; *************** *** 796,801 **** --- 803,811 ---- small = 1; } got = (IV)SYSTEM_ALLOC(size); + #ifdef PACK_MALLOC + got = (got + 0x7ff) & ~0x7ff; + #endif if (small) { /* Chunk is small, register the rest for future allocs. */ Perl_sbrk_oldchunk = got + reqsize; Index: perl5.004_01_02/mg.c *** perl5.004_01/mg.c Fri Jun 13 15:14:03 1997 --- perl5.004_01_02/mg.c Tue Jul 29 01:55:01 1997 *************** *** 1664,1669 **** --- 1664,1684 ---- return 0; } + static SV* sig_sv; + + static void + unwind_handler_stack(p) + void *p; + { + U32 flags = *(U32*)p; + + if (flags & 1) + savestack_ix -= 5; /* Unprotect save in progress. */ + /* cxstack_ix-- Not needed, die already unwound it. */ + if (flags & 64) + SvREFCNT_dec(sig_sv); + } + Signal_t sighandler(sig) int sig; *************** *** 1671,1685 **** dSP; GV *gv; HV *st; ! SV *sv; CV *cv; AV *oldstack; ! if (!psig_ptr[sig]) die("Signal SIG%s received, but no signal handler set.\n", sig_name[sig]); ! cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE); if (!cv || !CvROOT(cv)) { if (dowarn) warn("SIG%s handler \"%s\" not defined.\n", --- 1686,1741 ---- dSP; GV *gv; HV *st; ! SV *sv, *tSv = Sv; CV *cv; AV *oldstack; ! OP *myop = op; ! U32 flags = 0; ! I32 o_save_i = savestack_ix, type; ! CONTEXT *cx; ! XPV *tXpv = Xpv; ! ! if (savestack_ix + 15 <= savestack_max) ! flags |= 1; ! if (cxstack_ix < cxstack_max - 2) ! flags |= 2; ! if (markstack_ptr < markstack_max - 2) ! flags |= 4; ! if (retstack_ix < retstack_max - 2) ! flags |= 8; ! if (scopestack_ix < scopestack_max - 3) ! flags |= 16; ! ! if (flags & 2) { /* POPBLOCK may decrease cxstack too early. */ ! cxstack_ix++; /* Protect from overwrite. */ ! cx = &cxstack[cxstack_ix]; ! type = cx->cx_type; /* Can be during partial write. */ ! cx->cx_type = CXt_NULL; /* Make it safe for unwind. */ ! } if (!psig_ptr[sig]) die("Signal SIG%s received, but no signal handler set.\n", sig_name[sig]); ! /* Max number of items pushed there is 3*n or 4. We cannot fix ! infinity, so we fix 4 (in fact 5): */ ! if (flags & 1) { ! savestack_ix += 5; /* Protect save in progress. */ ! o_save_i = savestack_ix; ! SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags); ! } ! if (flags & 4) ! markstack_ptr++; /* Protect mark. */ ! if (flags & 8) { ! retstack_ix++; ! retstack[retstack_ix] = NULL; ! } ! if (flags & 16) ! scopestack_ix += 1; ! /* sv_2cv is too complicated, try a simpler variant first: */ ! if (!SvROK(psig_ptr[sig]) || !(cv = (CV*)SvRV(psig_ptr[sig])) ! || SvTYPE(cv) != SVt_PVCV) ! cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE); ! if (!cv || !CvROOT(cv)) { if (dowarn) warn("SIG%s handler \"%s\" not defined.\n", *************** *** 1692,1700 **** AvFILL(signalstack) = 0; SWITCHSTACK(curstack, signalstack); ! if(psig_name[sig]) sv = SvREFCNT_inc(psig_name[sig]); ! else { sv = sv_newmortal(); sv_setpv(sv,sig_name[sig]); } --- 1748,1758 ---- AvFILL(signalstack) = 0; SWITCHSTACK(curstack, signalstack); ! if(psig_name[sig]) { sv = SvREFCNT_inc(psig_name[sig]); ! flags |= 64; ! sig_sv = sv; ! } else { sv = sv_newmortal(); sv_setpv(sv,sig_name[sig]); } *************** *** 1705,1710 **** perl_call_sv((SV*)cv, G_DISCARD); SWITCHSTACK(signalstack, oldstack); ! return; } --- 1763,1785 ---- perl_call_sv((SV*)cv, G_DISCARD); SWITCHSTACK(signalstack, oldstack); ! if (flags & 1) ! savestack_ix -= 8; /* Unprotect save in progress. */ ! if (flags & 2) { ! cxstack[cxstack_ix].cx_type = type; ! cxstack_ix -= 1; ! } ! if (flags & 4) ! markstack_ptr--; ! if (flags & 8) ! retstack_ix--; ! if (flags & 16) ! scopestack_ix -= 1; ! if (flags & 64) ! SvREFCNT_dec(sv); ! op = myop; /* Apparently not needed... */ ! ! Sv = tSv; /* Restore global temporaries. */ ! Xpv = tXpv; return; } Index: perl5.004_01_02/op.c *** perl5.004_01/op.c Sat Jun 7 03:24:13 1997 --- perl5.004_01_02/op.c Tue Jul 29 01:38:15 1997 *************** *** 1059,1064 **** --- 1059,1066 ---- case OP_RV2AV: case OP_RV2HV: + if (!type && cUNOP->op_first->op_type != OP_GV) + croak("Can't localize through a reference"); if (type == OP_REFGEN && op->op_flags & OPf_PARENS) { modcount = 10000; return op; /* Treat \(@foo) like ordinary list. */ *************** *** 1080,1086 **** break; case OP_RV2SV: if (!type && cUNOP->op_first->op_type != OP_GV) ! croak("Can't localize a reference"); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_GV: --- 1082,1088 ---- break; case OP_RV2SV: if (!type && cUNOP->op_first->op_type != OP_GV) ! croak("Can't localize through a reference"); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_GV: *************** *** 1550,1555 **** --- 1552,1567 ---- if (!(opargs[type] & OA_FOLDCONST)) goto nope; + + switch (type) { + case OP_SPRINTF: + case OP_UCFIRST: + case OP_LCFIRST: + case OP_UC: + case OP_LC: + if (o->op_private & OPpLOCALE) + goto nope; + } if (error_count) goto nope; /* Don't try to run w/ errors */ Index: perl5.004_01_02/opcode.pl *** perl5.004_01/opcode.pl Tue Apr 29 15:28:40 1997 --- perl5.004_01_02/opcode.pl Thu Jul 31 20:53:24 1997 *************** *** 342,348 **** index index ck_index ist S S S? rindex rindex ck_index ist S S S? ! sprintf sprintf ck_fun_locale mst S L formline formline ck_fun ms S L ord ord ck_fun ifstu S? chr chr ck_fun fstu S? --- 342,348 ---- index index ck_index ist S S S? rindex rindex ck_index ist S S S? ! sprintf sprintf ck_fun_locale mfst S L formline formline ck_fun ms S L ord ord ck_fun ifstu S? chr chr ck_fun fstu S? Index: perl5.004_01_02/os2/Changes *** perl5.004_01/os2/Changes Fri Feb 21 14:59:57 1997 --- perl5.004_01_02/os2/Changes Tue Jul 29 01:44:49 1997 *************** *** 143,145 **** --- 143,151 ---- environment). Known problems: $$ does not work - is 0, waitpid returns immediately, thus Perl cannot wait for completion of started programs. + + after 5.004_01: + flock emulation added (disable by setting env PERL_USE_FLOCK=0), + thanks to Rocco Caputo; + RSX bug with missing waitpid circomvented; + -S bug with full path with \ corrected. Index: perl5.004_01_02/os2/Makefile.SHs *** perl5.004_01/os2/Makefile.SHs Thu Dec 19 00:30:35 1996 --- perl5.004_01_02/os2/Makefile.SHs Tue Jul 29 01:44:49 1997 *************** *** 54,59 **** --- 54,60 ---- echo ' "dlerror"' >>$@ echo ' "my_tmpfile"' >>$@ echo ' "my_tmpnam"' >>$@ + echo ' "my_flock"' >>$@ !NO!SUBS! if [ ! -z "$myttyname" ] ; then Index: perl5.004_01_02/os2/diff.configure *** perl5.004_01/os2/diff.configure Fri Feb 28 15:46:06 1997 --- perl5.004_01_02/os2/diff.configure Tue Jul 29 01:44:49 1997 *************** *** 51,57 **** case "$libs" in '') ;; *) for thislib in $libs; do ! @@ -4136,6 +4144,10 @@ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun --- 51,66 ---- case "$libs" in '') ;; *) for thislib in $libs; do ! @@ -3968,6 +3976,8 @@ ! : ! elif try=`./loc $thislib X $libpth`; $test -f "$try"; then ! : ! + elif try=`./loc $thislib$lib_ext X $libpth`; $test -f "$try"; then ! + : ! elif try=`./loc Slib$thislib$lib_ext X $xlibpth`; $test -f "$try"; then ! : ! else ! @@ -4152,6 +4162,10 @@ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun *************** *** 175,181 **** dflt=`./try` case "$dflt" in [1-4][1-4][1-4][1-4]|12345678|87654321) ! @@ -8692,7 +8714,7 @@ '') $echo $n ".$c" if $cc $ccflags \ $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \ --- 184,214 ---- dflt=`./try` case "$dflt" in [1-4][1-4][1-4][1-4]|12345678|87654321) ! @@ -8707,18 +8731,18 @@ ! $cc $ccflags -c bar1.c >/dev/null 2>&1 ! $cc $ccflags -c bar2.c >/dev/null 2>&1 ! $cc $ccflags -c foo.c >/dev/null 2>&1 ! -ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1 ! +$ar rc bar$lib_ext bar2.o bar1.o >/dev/null 2>&1 ! if $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 && ! ./foobar >/dev/null 2>&1; then ! - echo "ar appears to generate random libraries itself." ! + echo "$ar appears to generate random libraries itself." ! orderlib=false ! ranlib=":" ! -elif ar ts bar$lib_ext >/dev/null 2>&1 && ! +elif $ar ts bar$lib_ext >/dev/null 2>&1 && ! $cc $ccflags $ldflags -o foobar foo.o bar$lib_ext $libs > /dev/null 2>&1 && ! ./foobar >/dev/null 2>&1; then ! - echo "a table of contents needs to be added with 'ar ts'." ! + echo "a table of contents needs to be added with '$ar ts'." ! orderlib=false ! - ranlib="ar ts" ! + ranlib="$ar ts" ! else ! case "$ranlib" in ! :) ranlib='';; ! @@ -8790,7 +8814,7 @@ '') $echo $n ".$c" if $cc $ccflags \ $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \ Index: perl5.004_01_02/os2/os2.c *** perl5.004_01/os2/os2.c Wed Apr 30 20:30:09 1997 --- perl5.004_01_02/os2/os2.c Tue Jul 29 01:44:50 1997 *************** *** 1196,1198 **** --- 1196,1311 ---- return fopen(my_tmpnam(NULL), "w+b"); /* Race condition, but grants TMP. */ } + + #undef flock + + /* This code was contributed by Rocco Caputo. */ + int + my_flock(int handle, int op) + { + FILELOCK rNull, rFull; + ULONG timeout, handle_type, flag_word; + APIRET rc; + int blocking, shared; + static int use_my = -1; + + if (use_my == -1) { + char *s = getenv("USE_PERL_FLOCK"); + if (s) + use_my = atoi(s); + else + use_my = 1; + } + if (!(_emx_env & 0x200) || !use_my) + return flock(handle, op); /* Delegate to EMX. */ + + // is this a file? + if ((DosQueryHType(handle, &handle_type, &flag_word) != 0) || + (handle_type & 0xFF)) + { + errno = EBADF; + return -1; + } + // set lock/unlock ranges + rNull.lOffset = rNull.lRange = rFull.lOffset = 0; + rFull.lRange = 0x7FFFFFFF; + // set timeout for blocking + timeout = ((blocking = !(op & LOCK_NB))) ? 100 : 1; + // shared or exclusive? + shared = (op & LOCK_SH) ? 1 : 0; + // do not block the unlock + if (op & (LOCK_UN | LOCK_SH | LOCK_EX)) { + rc = DosSetFileLocks(handle, &rFull, &rNull, timeout, shared); + switch (rc) { + case 0: + errno = 0; + return 0; + case ERROR_INVALID_HANDLE: + errno = EBADF; + return -1; + case ERROR_SHARING_BUFFER_EXCEEDED: + errno = ENOLCK; + return -1; + case ERROR_LOCK_VIOLATION: + break; // not an error + case ERROR_INVALID_PARAMETER: + case ERROR_ATOMIC_LOCK_NOT_SUPPORTED: + case ERROR_READ_LOCKS_NOT_SUPPORTED: + errno = EINVAL; + return -1; + case ERROR_INTERRUPT: + errno = EINTR; + return -1; + default: + errno = EINVAL; + return -1; + } + } + // lock may block + if (op & (LOCK_SH | LOCK_EX)) { + // for blocking operations + for (;;) { + rc = + DosSetFileLocks( + handle, + &rNull, + &rFull, + timeout, + shared + ); + switch (rc) { + case 0: + errno = 0; + return 0; + case ERROR_INVALID_HANDLE: + errno = EBADF; + return -1; + case ERROR_SHARING_BUFFER_EXCEEDED: + errno = ENOLCK; + return -1; + case ERROR_LOCK_VIOLATION: + if (!blocking) { + errno = EWOULDBLOCK; + return -1; + } + break; + case ERROR_INVALID_PARAMETER: + case ERROR_ATOMIC_LOCK_NOT_SUPPORTED: + case ERROR_READ_LOCKS_NOT_SUPPORTED: + errno = EINVAL; + return -1; + case ERROR_INTERRUPT: + errno = EINTR; + return -1; + default: + errno = EINVAL; + return -1; + } + // give away timeslice + DosSleep(1); + } + } + + errno = 0; + return 0; + } Index: perl5.004_01_02/os2/os2ish.h *** perl5.004_01/os2/os2ish.h Thu Apr 10 17:31:36 1997 --- perl5.004_01_02/os2/os2ish.h Tue Jul 29 01:44:50 1997 *************** *** 15,20 **** --- 15,21 ---- #define HAS_KILL #define HAS_WAIT #define HAS_DLERROR + #define HAS_WAITPID_RUNTIME (_emx_env & 0x200) /* USEMYBINMODE * This symbol, if defined, indicates that the program should *************** *** 125,130 **** --- 126,132 ---- #define fwrite1 fwrite #define my_getenv(var) getenv(var) + #define flock my_flock void *emx_calloc (size_t, size_t); void emx_free (void *); Index: perl5.004_01_02/perl.c *** perl5.004_01/perl.c Tue Jun 10 01:52:05 1997 --- perl5.004_01_02/perl.c Thu Jul 31 20:09:10 1997 *************** *** 527,532 **** --- 527,533 ---- /* my_exit() was called */ while (scopestack_ix > oldscope) LEAVE; + FREETMPS; curstash = defstash; if (endav) call_list(oldscope, endav); *************** *** 771,777 **** boot_core_UNIVERSAL(); if (xsinit) (*xsinit)(); /* in case linked C routines want magical variables */ ! #ifdef VMS init_os_extras(); #endif --- 772,778 ---- boot_core_UNIVERSAL(); if (xsinit) (*xsinit)(); /* in case linked C routines want magical variables */ ! #if defined(VMS) || defined(WIN32) init_os_extras(); #endif *************** *** 815,821 **** LEAVE; FREETMPS; ! #ifdef DEBUGGING_MSTATS if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2) dump_mstats("after compilation:"); #endif --- 816,822 ---- LEAVE; FREETMPS; ! #ifdef MYMALLOC if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2) dump_mstats("after compilation:"); #endif *************** *** 848,858 **** /* my_exit() was called */ while (scopestack_ix > oldscope) LEAVE; curstash = defstash; if (endav) call_list(oldscope, endav); ! FREETMPS; ! #ifdef DEBUGGING_MSTATS if (getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); #endif --- 849,859 ---- /* my_exit() was called */ while (scopestack_ix > oldscope) LEAVE; + FREETMPS; curstash = defstash; if (endav) call_list(oldscope, endav); ! #ifdef MYMALLOC if (getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); #endif *************** *** 1017,1022 **** --- 1018,1024 ---- bool oldcatch = CATCH_GET; dJMPENV; int ret; + OP* oldop = op; if (flags & G_DISCARD) { ENTER; *************** *** 1139,1144 **** --- 1141,1147 ---- FREETMPS; LEAVE; } + op = oldop; return retval; } *************** *** 1156,1162 **** I32 oldscope; dJMPENV; int ret; ! if (flags & G_DISCARD) { ENTER; SAVETMPS; --- 1159,1166 ---- I32 oldscope; dJMPENV; int ret; ! OP* oldop = op; ! if (flags & G_DISCARD) { ENTER; SAVETMPS; *************** *** 1227,1232 **** --- 1231,1237 ---- FREETMPS; LEAVE; } + op = oldop; return retval; } *************** *** 1595,1600 **** --- 1600,1607 ---- defgv = gv_fetchpv("_",TRUE, SVt_PVAV); errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV)); GvMULTI_on(errgv); + (void)form("%240s",""); /* Preallocate temp - for immediate signals. */ + sv_grow(GvSV(errgv), 240); /* Preallocate - for immediate signals. */ sv_setpvn(GvSV(errgv), "", 0); curstash = defstash; compiling.cop_stash = defstash; *************** *** 1630,1640 **** /* additional extensions to try in each dir if scriptname not found */ #ifdef SEARCH_EXTS char *ext[] = { SEARCH_EXTS }; ! int extidx = (strchr(scriptname,'.')) ? -1 : 0; /* has ext already */ #else # define MAX_EXT_LEN 0 #endif #ifdef VMS if (dosearch) { int hasdir, idx = 0, deftypes = 1; --- 1637,1667 ---- /* additional extensions to try in each dir if scriptname not found */ #ifdef SEARCH_EXTS char *ext[] = { SEARCH_EXTS }; ! int extidx = 0, i = 0; ! char *curext = Nullch; #else # define MAX_EXT_LEN 0 #endif + /* + * If dosearch is true and if scriptname does not contain path + * delimiters, search the PATH for scriptname. + * + * If SEARCH_EXTS is also defined, will look for each + * scriptname{SEARCH_EXTS} whenever scriptname is not found + * while searching the PATH. + * + * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search + * proceeds as follows: + * If DOSISH: + * + look for ./scriptname{,.foo,.bar} + * + search the PATH for scriptname{,.foo,.bar} + * + * If !DOSISH: + * + look *only* in the PATH for scriptname{,.foo,.bar} (note + * this will not look in '.' if it's not in the PATH) + */ + #ifdef VMS if (dosearch) { int hasdir, idx = 0, deftypes = 1; *************** *** 1654,1691 **** continue; /* don't search dir with too-long name */ strcat(tokenbuf, scriptname); #else /* !VMS */ ! if (dosearch && !strchr(scriptname, '/') && (s = getenv("PATH"))) { ! bufend = s + strlen(s); ! while (s < bufend) { ! #ifndef atarist ! s = delimcpy(tokenbuf,