diff options
| author | Karl Williamson <khw@cpan.org> | 2016-03-11 14:43:33 -0700 |
|---|---|---|
| committer | Karl Williamson <khw@cpan.org> | 2016-03-11 14:49:26 -0700 |
| commit | e46aa1ddb7d58d270bbc45cef016b0577cfdecaa (patch) | |
| tree | 2c2bae16536e85b2786e98dda62579ffa5c90c27 | |
| parent | fa6c7d00a8b0cf48c0f78066f87065cfb43d601b (diff) | |
| download | perl-e46aa1ddb7d58d270bbc45cef016b0577cfdecaa.tar.gz | |
Fix various pod errors.
Mostly these are too long verbatim lines.
41 files changed, 1206 insertions, 1099 deletions
diff --git a/Porting/expand-macro.pl b/Porting/expand-macro.pl index f422a44dcf..cf2c9c81c7 100755 --- a/Porting/expand-macro.pl +++ b/Porting/expand-macro.pl @@ -138,12 +138,14 @@ expand-macro.pl - expand C macros using the C preprocessor =head1 SYNOPSIS - expand-macro.pl [options] [ < macro-name | macro-expression | - > [headers] ] + expand-macro.pl [options] + [ < macro-name | macro-expression | - > [headers] ] options: -f use 'indent' to format output -F <tool> use <tool> to format output (instead of -f) - -e erase try.[ic] instead of failing when they're present (errdetect) + -e erase try.[ic] instead of failing when they're present + (errdetect) -k keep them after generating (for handy inspection) -v verbose -I <indent-opts> passed into indent diff --git a/Porting/todo.pod b/Porting/todo.pod index 9701d3053f..d7988bbe91 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -550,7 +550,8 @@ none of the above (nor sprintf(), vsprintf(), or *SHUDDER* gets()) ever creep back to libperl.a. nm libperl.a | ./miniperl -alne '$o = $F[0] if /:$/; - print "$o $F[1]" if $F[0] eq "U" && $F[1] =~ /^(?:strn?c(?:at|py)|v?sprintf|gets)$/' + print "$o $F[1]" if $F[0] eq "U" && $F[1] + =~ /^(?:strn?c(?:at|py)|v?sprintf|gets)$/' Note, of course, that this will only tell whether B<your> platform is using those naughty interfaces. diff --git a/README.cygwin b/README.cygwin index 9d1164b11d..d54c030c53 100644 --- a/README.cygwin +++ b/README.cygwin @@ -83,7 +83,8 @@ binaries to be stripped, you can either add a B<-s> option when Configure prompts you, Any additional ld flags (NOT including libraries)? [none] -s - Any special flags to pass to g++ to create a dynamically loaded library? + Any special flags to pass to g++ to create a dynamically loaded + library? [none] -s Any special flags to pass to gcc to use dynamic linking? [none] -s @@ -208,12 +209,13 @@ You may see some messages during Configure that seem suspicious. Win9x does not correctly report C<EOF> with a non-blocking read on a closed pipe. You will see the following messages: - But it also returns -1 to signal EOF, so be careful! - WARNING: you can't distinguish between EOF and no data! + But it also returns -1 to signal EOF, so be careful! + WARNING: you can't distinguish between EOF and no data! - *** WHOA THERE!!! *** - The recommended value for $d_eofnblk on this machine was "define"! - Keep the recommended value? [y] + *** WHOA THERE!!! *** + The recommended value for $d_eofnblk on this machine was + "define"! + Keep the recommended value? [y] At least for consistency with WinNT, you should keep the recommended value. @@ -404,14 +406,15 @@ Using C<fork()> or C<system()> out to another perl after loading multiple dlls may result on a DLL baseaddress conflict. The internal cygwin error looks like like the following: - 0 [main] perl 8916 child_info_fork::abort: data segment start: parent - (0xC1A000) != child(0xA6A000) + 0 [main] perl 8916 child_info_fork::abort: data segment start: + parent (0xC1A000) != child(0xA6A000) or: - 183 [main] perl 3588 C:\cygwin\bin\perl.exe: *** fatal error - unable to remap - C:\cygwin\bin\cygsvn_subr-1-0.dll to same address as parent(0x6FB30000) != 0x6FE60000 - 46 [main] perl 3488 fork: child 3588 - died waiting for dll loading, errno11 + 183 [main] perl 3588 C:\cygwin\bin\perl.exe: *** fatal error - + unable to remap C:\cygwin\bin\cygsvn_subr-1-0.dll to same address + as parent(0x6FB30000) != 0x6FE60000 46 [main] perl 3488 fork: child + 3588 - died waiting for dll loading, errno11 See L<http://cygwin.com/faq/faq-nochunks.html#faq.using.fixing-fork-failures> It helps if not too many DLLs are loaded in memory so the available address space is larger, @@ -566,11 +569,11 @@ be kept as clean as possible. ext/Compress-Raw-Zlib/README ext/Compress-Zlib/Changes ext/DB_File/Changes ext/Encode/Changes ext/Sys-Syslog/Changes ext/Win32API-File/Changes - lib/ExtUtils/CBuilder/Changes lib/ExtUtils/Changes lib/ExtUtils/NOTES - lib/ExtUtils/PATCHING lib/ExtUtils/README + lib/ExtUtils/CBuilder/Changes lib/ExtUtils/Changes + lib/ExtUtils/NOTES lib/ExtUtils/PATCHING lib/ExtUtils/README lib/Net/Ping/Changes lib/Test/Harness/Changes - lib/Term/ANSIColor/ChangeLog lib/Term/ANSIColor/README README.symbian - symbian/TODO + lib/Term/ANSIColor/ChangeLog lib/Term/ANSIColor/README + README.symbian symbian/TODO =item Build, Configure, Make, Install @@ -599,14 +602,16 @@ be kept as clean as possible. =item Tests t/io/fs.t - no file mode checks if not ntsec - skip rename() check when not check_case:relaxed + skip rename() check when not + check_case:relaxed t/io/tell.t - binmode t/lib/cygwin.t - builtin cygwin function tests t/op/groups.t - basegroup has ID = 0 t/op/magic.t - $^X/symlink WORKAROUND, s/.exe// t/op/stat.t - no /dev, skip Win32 ftCreationTime quirk - (cache manager sometimes preserves ctime of file - previously created and deleted), no -u (setuid) + (cache manager sometimes preserves ctime of + file previously created and deleted), no -u + (setuid) t/op/taint.t - can't use empty path under Cygwin Perl t/op/time.t - no tzset() @@ -614,14 +619,17 @@ be kept as clean as possible. EXTERN.h - __declspec(dllimport) XSUB.h - __declspec(dllexport) - cygwin/cygwin.c - os_extras (getcwd, spawn, and several Cygwin:: functions) + cygwin/cygwin.c - os_extras (getcwd, spawn, and several + Cygwin:: functions) perl.c - os_extras, -i.bak perl.h - binmode doio.c - win9x can not rename a file when it is open - pp_sys.c - do not define h_errno, init _pwent_struct.pw_comment + pp_sys.c - do not define h_errno, init + _pwent_struct.pw_comment util.c - use setenv util.h - PERL_FILE_IS_ABSOLUTE macro - pp.c - Comment about Posix vs IEEE math under Cygwin + pp.c - Comment about Posix vs IEEE math under + Cygwin perlio.c - CR/LF mode perliol.c - Comment about EXTCONST under Cygwin @@ -631,10 +639,12 @@ be kept as clean as possible. - Can't install via CPAN shell under Cygwin ext/Compress-Raw-Zlib/zlib-src/zutil.h - Cygwin is Unix-like and has vsnprintf - ext/Errno/Errno_pm.PL - Special handling for Win32 Perl under Cygwin + ext/Errno/Errno_pm.PL - Special handling for Win32 Perl under + Cygwin ext/POSIX/POSIX.xs - tzname defined externally ext/SDBM_File/sdbm/pair.c - - EXTCONST needs to be redefined from EXTERN.h + - EXTCONST needs to be redefined from + EXTERN.h ext/SDBM_File/sdbm/sdbm.c - binary open ext/Sys/Syslog/Syslog.xs @@ -648,13 +658,15 @@ be kept as clean as possible. ext/Win32/Makefile.PL - Use various libraries under Cygwin ext/Win32/Win32.xs - Child dir and child env under Cygwin ext/Win32API-File/File.xs - - _open_osfhandle not implemented under Cygwin + - _open_osfhandle not implemented under + Cygwin ext/Win32CORE/Win32CORE.c - __declspec(dllexport) =item Perl Modules/Scripts - ext/B/t/OptreeCheck.pm - Comment about stderr/stdout order under Cygwin + ext/B/t/OptreeCheck.pm - Comment about stderr/stdout order under + Cygwin ext/Digest-SHA/bin/shasum - Use binary mode under Cygwin ext/Sys/Syslog/win32/Win32.pm @@ -662,7 +674,8 @@ be kept as clean as possible. ext/Time-HiRes/HiRes.pm - Comment about various timers not available ext/Win32API-File/File.pm - - _open_osfhandle not implemented under Cygwin + - _open_osfhandle not implemented under + Cygwin ext/Win32CORE/Win32CORE.pm - History of Win32CORE under Cygwin lib/Cwd.pm - hook to internal Cwd::cwd @@ -678,7 +691,8 @@ be kept as clean as possible. lib/ExtUtils/MM_Cygwin.pm - canonpath, cflags, manifypods, perl_archive lib/File/Fetch.pm - Comment about quotes using a Cygwin example - lib/File/Find.pm - on remote drives stat() always sets st_nlink to 1 + lib/File/Find.pm - on remote drives stat() always sets + st_nlink to 1 lib/File/Spec/Cygwin.pm - case_tolerant lib/File/Spec/Unix.pm - preserve //unc lib/File/Spec/Win32.pm - References a message on cygwin.com diff --git a/README.hpux b/README.hpux index b36b4dd0e5..e1857e08dc 100644 --- a/README.hpux +++ b/README.hpux @@ -40,17 +40,21 @@ on /cdrom), issue this command: # swlist -s /cdrom perl # perl D.5.8.8.B 5.8.8 Perl Programming Language - perl.Perl5-32 D.5.8.8.B 32-bit 5.8.8 Perl Programming Language with Extensions - perl.Perl5-64 D.5.8.8.B 64-bit 5.8.8 Perl Programming Language with Extensions + perl.Perl5-32 D.5.8.8.B 32-bit 5.8.8 Perl Programming Language + with Extensions + perl.Perl5-64 D.5.8.8.B 64-bit 5.8.8 Perl Programming Language + with Extensions To see what is installed on your system: # swlist -R perl # perl E.5.8.8.J Perl Programming Language - # perl.Perl5-32 E.5.8.8.J 32-bit Perl Programming Language with Extensions + # perl.Perl5-32 E.5.8.8.J 32-bit Perl Programming Language + with Extensions perl.Perl5-32.PERL-MAN E.5.8.8.J 32-bit Perl Man Pages for IA perl.Perl5-32.PERL-RUN E.5.8.8.J 32-bit Perl Binaries for IA - # perl.Perl5-64 E.5.8.8.J 64-bit Perl Programming Language with Extensions + # perl.Perl5-64 E.5.8.8.J 64-bit Perl Programming Language + with Extensions perl.Perl5-64.PERL-MAN E.5.8.8.J 64-bit Perl Man Pages for IA perl.Perl5-64.PERL-RUN E.5.8.8.J 64-bit Perl Binaries for IA @@ -666,8 +670,12 @@ best fix is to patch the header to match: The following compilation warnings may happen in HP-UX releases earlier than 11.31 but are harmless: - cc: "/usr/include/sys/socket.h", line 535: warning 562: Redeclaration of "sendfile" with a different storage class specifier: "sendfile" will have internal linkage. - cc: "/usr/include/sys/socket.h", line 536: warning 562: Redeclaration of "sendpath" with a different storage class specifier: "sendpath" will have internal linkage. + cc: "/usr/include/sys/socket.h", line 535: warning 562: + Redeclaration of "sendfile" with a different storage class + specifier: "sendfile" will have internal linkage. + cc: "/usr/include/sys/socket.h", line 536: warning 562: + Redeclaration of "sendpath" with a different storage class + specifier: "sendpath" will have internal linkage. They seem to be caused by broken system header files, and also other open source projects are seeing them. The following HP-UX patches diff --git a/README.hurd b/README.hurd index 7f9b4a9886..26fd0ee5dd 100644 --- a/README.hurd +++ b/README.hurd @@ -28,12 +28,13 @@ information. Here are the statistics for Perl 5.005_62 on my system: Failed Test Status Wstat Total Fail Failed List of failed - ------------------------------------------------------------------------- + ----------------------------------------------------------------------- lib/anydbm.t 12 1 8.33% 12 pragma/warnings 333 1 0.30% 215 8 tests and 24 subtests skipped. - Failed 2/229 test scripts, 99.13% okay. 2/10850 subtests failed, 99.98% okay. + Failed 2/229 test scripts, 99.13% okay. 2/10850 subtests failed, + 99.98% okay. There are quite a few systems out there that do worse! diff --git a/README.irix b/README.irix index 23cc17bd79..3fa47a4cd5 100644 --- a/README.irix +++ b/README.irix @@ -106,8 +106,8 @@ Ignore them: in IRIX 5.3 there is no way to quieten ld about this. During compilation you will see this warning from toke.c: uopt: Warning: Perl_yylex: this procedure not optimized because it - exceeds size threshold; to optimize this procedure, use -Olimit option - with value >= 4252. + exceeds size threshold; to optimize this procedure, use -Olimit + option with value >= 4252. Ignore the warning. @@ -115,12 +115,13 @@ In IRIX 5.3 and with Perl 5.8.1 (Perl 5.8.0 didn't compile in IRIX 5.3) the following failures are known. Failed Test Stat Wstat Total Fail Failed List of Failed - -------------------------------------------------------------------------- + ----------------------------------------------------------------------- ../ext/List/Util/t/shuffle.t 0 139 ?? ?? % ?? ../lib/Math/Trig.t 255 65280 29 12 41.38% 24-29 ../lib/sort.t 0 138 119 72 60.50% 48-119 56 tests and 474 subtests skipped. - Failed 3/811 test scripts, 99.63% okay. 78/75813 subtests failed, 99.90% okay. + Failed 3/811 test scripts, 99.63% okay. 78/75813 subtests failed, + 99.90% okay. They are suspected to be compiler errors (at least the shuffle.t failure is known from some IRIX 6 setups) and math library errors diff --git a/README.macosx b/README.macosx index 39d925ccea..8db0222525 100644 --- a/README.macosx +++ b/README.macosx @@ -63,7 +63,7 @@ on a file server and used by many Macs. First, export the path to the SDK into the build environment: - export SDK=/Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.8.sdk + export SDK=/Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.8.sdk Please make sure the SDK version (i.e. the numbers right before '.sdk') matches your system's (in this case, Mac OS X 10.8 "Mountain Lion"), as it is @@ -100,11 +100,12 @@ Mac OS X 10.5 "Leopard" and above do not require the 'u' variant. In addition to the compiler flags used to select the SDK, also add the flags for creating a universal binary: - ./Configure -Accflags="-arch i686 -arch ppc -nostdinc -B$SDK/usr/include/gcc \ - -B$SDK/usr/lib/gcc -isystem$SDK/usr/include \ - -F$SDK/System/Library/Frameworks" \ - -Aldflags="-arch i686 -arch ppc -Wl,-syslibroot,$SDK" \ - -de + ./Configure -Accflags="-arch i686 -arch ppc -nostdinc \ + -B$SDK/usr/include/gcc \ + -B$SDK/usr/lib/gcc -isystem$SDK/usr/include \ + -F$SDK/System/Library/Frameworks" \ + -Aldflags="-arch i686 -arch ppc -Wl,-syslibroot,$SDK" \ + -de Keep in mind that these compiler and linker settings will also be used when building CPAN modules. For XS modules to be compiled as a universal binary, any diff --git a/README.netware b/README.netware index d8c0416eb5..4e35f39c30 100644 --- a/README.netware +++ b/README.netware @@ -151,11 +151,13 @@ Run the following command at the command prompt: Example: - perl -Ic:/perl/5.6.1/lib/NetWare-x86-multi-thread -Ic:\perl\5.6.1\lib MakeFile.pl + perl -Ic:/perl/5.6.1/lib/NetWare-x86-multi-thread \ + -Ic:\perl\5.6.1\lib MakeFile.pl or - perl -Ic:/perl/5.8.0/lib/NetWare-x86-multi-thread -Ic:\perl\5.8.0\lib MakeFile.pl + perl -Ic:/perl/5.8.0/lib/NetWare-x86-multi-thread \ + -Ic:\perl\5.8.0\lib MakeFile.pl =item * @@ -174,12 +176,14 @@ typing I<nmake install>, will copy the files onto the NetWare server. Example: You can execute the following on the command prompt. - perl -Ic:/perl/5.6.1/lib/NetWare-x86-multi-thread -Ic:\perl\5.6.1\lib MakeFile.pl + perl -Ic:/perl/5.6.1/lib/NetWare-x86-multi-thread \ + -Ic:\perl\5.6.1\lib MakeFile.pl INSTALLSITELIB=i:\perl\lib or - perl -Ic:/perl/5.8.0/lib/NetWare-x86-multi-thread -Ic:\perl\5.8.0\lib MakeFile.pl + perl -Ic:/perl/5.8.0/lib/NetWare-x86-multi-thread \ + -Ic:\perl\5.8.0\lib MakeFile.pl INSTALLSITELIB=i:\perl\lib =item * diff --git a/README.os2 b/README.os2 index e2d7851d26..86461f880f 100644 --- a/README.os2 +++ b/README.os2 @@ -41,7 +41,7 @@ in EMX docs). Contents (This may be a little bit obsolete) - perlos2 - Perl under OS/2, DOS, Win0.3*, Win0.95 and WinNT. + perlos2 - Perl under OS/2, DOS, Win0.3*, Win0.95 and WinNT. NAME SYNOPSIS @@ -1002,11 +1002,12 @@ To get finer test reports, call The report with F<io/pipe.t> failing may look like this: - Failed Test Status Wstat Total Fail Failed List of failed - ------------------------------------------------------------ - io/pipe.t 12 1 8.33% 9 - 7 tests skipped, plus 56 subtests skipped. - Failed 1/195 test scripts, 99.49% okay. 1/6542 subtests failed, 99.98% okay. + Failed Test Status Wstat Total Fail Failed List of failed + ------------------------------------------------------------ + io/pipe.t 12 1 8.33% 9 + 7 tests skipped, plus 56 subtests skipped. + Failed 1/195 test scripts, 99.49% okay. 1/6542 subtests failed, + 99.98% okay. The reasons for most important skipped tests are: @@ -1132,15 +1133,15 @@ to manually install C<Net::FTP>. Install the bundle C<Bundle::OS2_default> - perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_1 + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_1 This may take a couple of hours on 1GHz processor (when run the first time). And this should not be necessarily a smooth procedure. Some modules may not specify required dependencies, so one may need to repeat this procedure several times until the results stabilize. - perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_2 - perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_3 + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_2 + perl5.8.2 -MCPAN -e "install Bundle::OS2_default" < nul |& tee 00cpan_i_3 Even after they stabilize, some tests may fail. @@ -1415,109 +1416,134 @@ an EMX applications, e.g., if compiled with Here is the sample C file: - #define INCL_DOS - #define INCL_NOPM - /* These are needed for compile if os2.h includes os2tk.h, not os2emx.h */ - #define INCL_DOSPROCESS - #include <os2.h> - - #include "EXTERN.h" - #define PERL_IN_MINIPERLMAIN_C - #include "perl.h" - - static char *me; - HMODULE handle; - - static void - die_with(char *msg1, char *msg2, char *msg3, char *msg4) - { - ULONG c; - char *s = " error: "; - - DosWrite(2, me, strlen(me), &c); - DosWrite(2, s, strlen(s), &c); - DosWrite(2, msg1, strlen(msg1), &c); - DosWrite(2, msg2, strlen(msg2), &c); - DosWrite(2, msg3, strlen(msg3), &c); - DosWrite(2, msg4, strlen(msg4), &c); - DosWrite(2, "\r\n", 2, &c); - exit(255); - } - - typedef ULONG (*fill_extLibpath_t)(int type, char *pre, char *post, int replace, char *msg); - typedef int (*main_t)(int type, char *argv[], char *env[]); - typedef int (*handler_t)(void* data, int which); - - #ifndef PERL_DLL_BASENAME - # define PERL_DLL_BASENAME "perl" - #endif - - static HMODULE - load_perl_dll(char *basename) - { - char buf[300], fail[260]; - STRLEN l, dirl; - fill_extLibpath_t f; - ULONG rc_fullname; - HMODULE handle, handle1; - - if (_execname(buf, sizeof(buf) - 13) != 0) - die_with("Can't find full path: ", strerror(errno), "", ""); - /* XXXX Fill 'me' with new value */ - l = strlen(buf); - while (l && buf[l-1] != '/' && buf[l-1] != '\\') - l--; - dirl = l - 1; - strcpy(buf + l, basename); - l += strlen(basename); - strcpy(buf + l, ".dll"); - if ( (rc_fullname = DosLoadModule(fail, sizeof fail, buf, &handle)) != 0 - && DosLoadModule(fail, sizeof fail, basename, &handle) != 0 ) - die_with("Can't load DLL ", buf, "", ""); - if (rc_fullname) - return handle; /* was loaded with short name; all is fine */ - if (DosQueryProcAddr(handle, 0, "fill_extLibpath", (PFN*)&f)) - die_with(buf, ": DLL exports no symbol ", "fill_extLibpath", ""); - buf[dirl] = 0; - if (f(0 /*BEGINLIBPATH*/, buf /* prepend */, NULL /* append */, - 0 /* keep old value */, me)) - die_with(me, ": prepending BEGINLIBPATH", "", ""); - if (DosLoadModule(fail, sizeof fail, basename, &handle1) != 0) - die_with(me, ": finding perl DLL again via BEGINLIBPATH", "", ""); - buf[dirl] = '\\'; - if (handle1 != handle) { - if (DosQueryModuleName(handle1, sizeof(fail), fail)) - strcpy(fail, "???"); - die_with(buf, ":\n\tperl DLL via BEGINLIBPATH is different: \n\t", - fail, - "\n\tYou may need to manipulate global BEGINLIBPATH and LIBPATHSTRICT" - "\n\tso that the other copy is loaded via BEGINLIBPATH."); - } - return handle; - } - - int - main(int argc, char **argv, char **env) - { - main_t f; - handler_t h; - - me = argv[0]; - /**/ - handle = load_perl_dll(PERL_DLL_BASENAME); - - if (DosQueryProcAddr(handle, 0, "Perl_OS2_handler_install", (PFN*)&h)) - die_with(PERL_DLL_BASENAME, ": DLL exports no symbol ", "Perl_OS2_handler_install", ""); - if ( !h((void *)"~installprefix", Perlos2_handler_perllib_from) - || !h((void *)"~dll", Perlos2_handler_perllib_to) - || !h((void *)"~dll/sh/ksh.exe", Perlos2_handler_perl_sh) ) - die_with(PERL_DLL_BASENAME, ": Can't install @INC manglers", "", ""); - - if (DosQueryProcAddr(handle, 0, "dll_perlmain", (PFN*)&f)) - die_with(PERL_DLL_BASENAME, ": DLL exports no symbol ", "dll_perlmain", ""); - return f(argc, argv, env); - } - + #define INCL_DOS + #define INCL_NOPM + /* These are needed for compile if os2.h includes os2tk.h, not + * os2emx.h */ + #define INCL_DOSPROCESS + #include <os2.h> + + #include "EXTERN.h" + #define PERL_IN_MINIPERLMAIN_C + #include "perl.h" + + static char *me; + HMODULE handle; + + static void + die_with(char *msg1, char *msg2, char *msg3, char *msg4) + { + ULONG c; + char *s = " error: "; + + DosWrite(2, me, strlen(me), &c); + DosWrite(2, s, strlen(s), &c); + DosWrite(2, msg1, strlen(msg1), &c); + DosWrite(2, msg2, strlen(msg2), &c); + DosWrite(2, msg3, strlen(msg3), &c); + DosWrite(2, msg4, strlen(msg4), &c); + DosWrite(2, "\r\n", 2, &c); + exit(255); + } + + typedef ULONG (*fill_extLibpath_t)(int type, + char *pre, + char *post, + int replace, + char *msg); + typedef int (*main_t)(int type, char *argv[], char *env[]); + typedef int (*handler_t)(void* data, int which); + + #ifndef PERL_DLL_BASENAME + # define PERL_DLL_BASENAME "perl" + #endif + + static HMODULE + load_perl_dll(char *basename) + { + char buf[300], fail[260]; + STRLEN l, dirl; + fill_extLibpath_t f; + ULONG rc_fullname; + HMODULE handle, handle1; + + if (_execname(buf, sizeof(buf) - 13) != 0) + die_with("Can't find full path: ", strerror(errno), "", ""); + /* XXXX Fill 'me' with new value */ + l = strlen(buf); + while (l && buf[l-1] != '/' && buf[l-1] != '\\') + l--; + dirl = l - 1; + strcpy(buf + l, basename); + l += strlen(basename); + strcpy(buf + l, ".dll"); + if ( (rc_fullname = DosLoadModule(fail, sizeof fail, buf, &handle)) + != 0 + && DosLoadModule(fail, sizeof fail, basename, &handle) != 0 ) + die_with("Can't load DLL ", buf, "", ""); + if (rc_fullname) + return handle; /* was loaded with short name; all is fine */ + if (DosQueryProcAddr(handle, 0, "fill_extLibpath", (PFN*)&f)) + die_with(buf, + ": DLL exports no symbol ", + "fill_extLibpath", + ""); + buf[dirl] = 0; + if (f(0 /*BEGINLIBPATH*/, buf /* prepend */, NULL /* append */, + 0 /* keep old value */, me)) + die_with(me, ": prepending BEGINLIBPATH", "", ""); + if (DosLoadModule(fail, sizeof fail, basename, &handle1) != 0) + die_with(me, + ": finding perl DLL again via BEGINLIBPATH", + "", + ""); + buf[dirl] = '\\'; + if (handle1 != handle) { + if (DosQueryModuleName(handle1, sizeof(fail), fail)) + strcpy(fail, "???"); + die_with(buf, + ":\n\tperl DLL via BEGINLIBPATH is different: \n\t", + fail, + "\n\tYou may need to manipulate global BEGINLIBPATH" + " and LIBPATHSTRICT" + "\n\tso that the other copy is loaded via" + BEGINLIBPATH."); + } + return handle; + } + + int + main(int argc, char **argv, char **env) + { + main_t f; + handler_t h; + + me = argv[0]; + /**/ + handle = load_perl_dll(PERL_DLL_BASENAME); + + if (DosQueryProcAddr(handle, + 0, + "Perl_OS2_handler_install", + (PFN*)&h)) + die_with(PERL_DLL_BASENAME, + ": DLL exports no symbol ", + "Perl_OS2_handler_install", + ""); + if ( !h((void *)"~installprefix", Perlos2_handler_perllib_from) + || !h((void *)"~dll", Perlos2_handler_perllib_to) + || !h((void *)"~dll/sh/ksh.exe", Perlos2_handler_perl_sh) ) + die_with(PERL_DLL_BASENAME, + ": Can't install @INC manglers", + "", + ""); + if (DosQueryProcAddr(handle, 0, "dll_perlmain", (PFN*)&f)) + die_with(PERL_DLL_BASENAME, + ": DLL exports no symbol ", + "dll_perlmain", + ""); + return f(argc, argv, env); + } =head1 Build FAQ @@ -2124,12 +2150,12 @@ points available for such linking is provided (see C<entries_ordinals> - and also C<PMWIN_entries> - in F<os2ish.h>). These ordinals can be accessed via the APIs: - CallORD(), DeclFuncByORD(), DeclVoidFuncByORD(), - DeclOSFuncByORD(), DeclWinFuncByORD(), AssignFuncPByORD(), - DeclWinFuncByORD_CACHE(), DeclWinFuncByORD_CACHE_survive(), - DeclWinFuncByORD_CACHE_resetError_survive(), - DeclWinFunc_CACHE(), DeclWinFunc_CACHE_resetError(), - DeclWinFunc_CACHE_survive(), DeclWinFunc_CACHE_resetError_survive() + CallORD(), DeclFuncByORD(), DeclVoidFuncByORD(), + DeclOSFuncByORD(), DeclWinFuncByORD(), AssignFuncPByORD(), + DeclWinFuncByORD_CACHE(), DeclWinFuncByORD_CACHE_survive(), + DeclWinFuncByORD_CACHE_resetError_survive(), + DeclWinFunc_CACHE(), DeclWinFunc_CACHE_resetError(), + DeclWinFunc_CACHE_survive(), DeclWinFunc_CACHE_resetError_survive() See the header files and the C code in the supplied OS/2-related modules for the details on usage of these functions. @@ -2567,7 +2593,8 @@ F<perl5shim.def-leader> with modifying the versions/names as needed. Run - perl -wnle "next if 0../EXPORTS/; print qq( \"$1\") if /\"(\w+)\"/" perl5.def >lst + perl -wnle "next if 0../EXPORTS/; print qq( \"$1\") + if /\"(\w+)\"/" perl5.def >lst in the Perl build directory (to make the DLL smaller replace perl5.def with the definition file for the older version of Perl if present). diff --git a/README.os390 b/README.os390 index 899e50e321..0386209f39 100644 --- a/README.os390 +++ b/README.os390 @@ -50,7 +50,7 @@ or If you get lots of errors of the form - tar: FSUM7171 ...: cannot set uid/gid: EDC5139I Operation not permitted. + tar: FSUM7171 ...: cannot set uid/gid: EDC5139I Operation not permitted you didn't read the above and tried to use tar instead of pax, you'll first have to remove the (now corrupt) perl directory @@ -125,8 +125,9 @@ to watch out for include: A message of the form: - (I see you are using the Korn shell. Some ksh's blow up on Configure, - mainly on older exotic systems. If yours does, try the Bourne shell instead.) + (I see you are using the Korn shell. Some ksh's blow up on + Configure, mainly on older exotic systems. If yours does, try the + Bourne shell instead.) is nothing to worry about at all. @@ -154,7 +155,8 @@ for perl to work. See the config.sh file for the value of $archlibexp. If in trying to use Perl you see an error message similar to: CEE3501S The module libperl.dll was not found. - From entry point __dllstaticinit at compile unit offset +00000194 at + From entry point __dllstaticinit at compile unit offset +00000194 + at then your LIBPATH does not have the location of libperl.x and either libperl.dll or libperl.so in it. Add that directory to your LIBPATH and @@ -246,10 +248,11 @@ with extraneous messages on stderr from CEE. A message of the form: - lib/ftmp-security....File::Temp::_gettemp: Parent directory (/tmp/) is not safe - (sticky bit not set when world writable?) at lib/ftmp-security.t line 100 - File::Temp::_gettemp: Parent directory (/tmp/) is not safe (sticky bit not - set when world writable?) at lib/ftmp-security.t line 100 + lib/ftmp-security....File::Temp::_gettemp: Parent directory (/tmp/) + is not safe (sticky bit not set when world writable?) at + lib/ftmp-security.t line 100 + File::Temp::_gettemp: Parent directory (/tmp/) is not safe (sticky + bit not set when world writable?) at lib/ftmp-security.t line 100 ok indicates a problem with the permissions on your /tmp directory within the HFS. @@ -399,17 +402,17 @@ Thanks to John Goodyear for dynamic loading help. L<INSTALL>, L<perlport>, L<perlebcdic>, L<ExtUtils::MakeMaker>. - http://www.ibm.com/servers/eserver/zseries/zos/unix/bpxa1toy.html + http://www.ibm.com/servers/eserver/zseries/zos/unix/bpxa1toy.html - http://www.redbooks.ibm.com/redbooks/SG245944.html + http://www.redbooks.ibm.com/redbooks/SG245944.html - http://www.ibm.com/servers/eserver/zseries/zos/unix/bpxa1ty1.html#opensrc + http://www.ibm.com/servers/eserver/zseries/zos/unix/bpxa1ty1.html#opensrc - http://www.xray.mpe.mpg.de/mailing-lists/perl-mvs/ + http://www.xray.mpe.mpg.de/mailing-lists/perl-mvs/ - http://publibz.boulder.ibm.com:80/cgi-bin/bookmgr_OS390/BOOKS/ceea3030/ + http://publibz.boulder.ibm.com:80/cgi-bin/bookmgr_OS390/BOOKS/ceea3030/ - http://publibz.boulder.ibm.com:80/cgi-bin/bookmgr_OS390/BOOKS/CBCUG030/ + http://publibz.boulder.ibm.com:80/cgi-bin/bookmgr_OS390/BOOKS/CBCUG030/ =head2 Mailing list for Perl on OS/390 diff --git a/README.solaris b/README.solaris index 4ee45590a9..8f76305557 100644 --- a/README.solaris +++ b/README.solaris @@ -694,7 +694,8 @@ but if one patiently waits, one gets these results: uni/tr_eucjp.t 29 7424 6 12 200.00% 1-6 uni/tr_sjis.t 29 7424 6 12 200.00% 1-6 56 tests and 467 subtests skipped. - Failed 27/811 test scripts, 96.67% okay. 1383/75399 subtests failed, 98.17% okay. + Failed 27/811 test scripts, 96.67% okay. 1383/75399 subtests failed, + 98.17% okay. The alarm() test failure is caused by system() apparently blocking alarm(). That is probably a libc bug, and given that SunOS 4.x diff --git a/README.symbian b/README.symbian index 2572631c12..c111f30391 100644 --- a/README.symbian +++ b/README.symbian @@ -30,182 +30,182 @@ mainly as demonstrations. (0) You need to have the appropriate Symbian SDK installed. - These instructions have been tested under various Nokia Series 60 - Symbian SDKs (1.2 to 2.6, 2.8 should also work, 1.2 compiles but - does not work), Series 80 2.0, and Nokia 7710 (Series 90) SDK. - You can get the SDKs from Forum Nokia (L<http://www.forum.nokia.com/>). - A very rough port ("it compiles") to UIQ 2.1 has also been made. +These instructions have been tested under various Nokia Series 60 +Symbian SDKs (1.2 to 2.6, 2.8 should also work, 1.2 compiles but +does not work), Series 80 2.0, and Nokia 7710 (Series 90) SDK. +You can get the SDKs from Forum Nokia (L<http://www.forum.nokia.com/>). +A very rough port ("it compiles") to UIQ 2.1 has also been made. - A prerequisite for any of the SDKs is to install ActivePerl - from ActiveState, L<http://www.activestate.com/Products/ActivePerl/> +A prerequisite for any of the SDKs is to install ActivePerl +from ActiveState, L<http://www.activestate.com/Products/ActivePerl/> - Having the SDK installed also means that you need to have either - the Metrowerks CodeWarrior installed (2.8 and 3.0 were used in testing) - or the Microsoft Visual C++ 6.0 installed (SP3 minimum, SP5 recommended). +Having the SDK installed also means that you need to have either +the Metrowerks CodeWarrior installed (2.8 and 3.0 were used in testing) +or the Microsoft Visual C++ 6.0 installed (SP3 minimum, SP5 recommended). - Note that for example the Series 60 2.0 VC SDK installation talks - about ActivePerl build 518, which does no more (as of mid-2005) exist - at the ActiveState website. The ActivePerl 5.8.4 build 810 was - used successfully for compiling Perl on Symbian. The 5.6.x ActivePerls - do not work. +Note that for example the Series 60 2.0 VC SDK installation talks +about ActivePerl build 518, which does no more (as of mid-2005) exist +at the ActiveState website. The ActivePerl 5.8.4 build 810 was +used successfully for compiling Perl on Symbian. The 5.6.x ActivePerls +do not work. - Other SDKs or compilers like Visual.NET, command-line-only - Visual.NET, Borland, GnuPoc, or sdk2unix have not been tried. +Other SDKs or compilers like Visual.NET, command-line-only +Visual.NET, Borland, GnuPoc, or sdk2unix have not been tried. - These instructions almost certainly won't work with older Symbian - releases or other SDKs. Patches to get this port running in other - releases, SDKs, compilers, platforms, or devices are naturally welcome. +These instructions almost certainly won't work with older Symbian +releases or other SDKs. Patches to get this port running in other +releases, SDKs, compilers, platforms, or devices are naturally welcome. (1) Get a Perl source code distribution (for example the file - perl-5.9.2.tar.gz is fine) from L<http://www.cpan.org/src/> - and unpack it in your the C:/Symbian directory of your Windows - system. +perl-5.9.2.tar.gz is fine) from L<http://www.cpan.org/src/> +and unpack it in your the C:/Symbian directory of your Windows +system. (2) Change to the perl source directory. - cd c:\Symbian\perl-5.x.x + cd c:\Symbian\perl-5.x.x (3) Run the following script using the perl coming with the SDK - perl symbian\config.pl + perl symbian\config.pl - You must use the cmd.exe, the Cygwin shell will not work. - The PATH must include the SDK tools, including a Perl, - which should be the case under cmd.exe. If you do not - have that, see the end of symbian\sdk.pl for notes of - how your environment should be set up for Symbian compiles. +You must use the cmd.exe, the Cygwin shell will not work. +The PATH must include the SDK tools, including a Perl, +which should be the case under cmd.exe. If you do not +have that, see the end of symbian\sdk.pl for notes of +how your environment should be set up for Symbian compiles. (4) Build the project, either by - make all + make all - in cmd.exe or by using either the Metrowerks CodeWarrior - or the Visual C++ 6.0, or the Visual Studio 8 (the Visual C++ - 2005 Express Edition works fine). +in cmd.exe or by using either the Metrowerks CodeWarrior +or the Visual C++ 6.0, or the Visual Studio 8 (the Visual C++ +2005 Express Edition works fine). - If you use the VC IDE, you will have to run F<symbian\config.pl> - first using the cmd.exe, and then run 'make win.mf vc6.mf' to generate - the VC6 makefiles and workspaces. "make vc6" will compile for the VC6, - and "make cw" for the CodeWarrior. +If you use the VC IDE, you will have to run F<symbian\config.pl> +first using the cmd.exe, and then run 'make win.mf vc6.mf' to generate +the VC6 makefiles and workspaces. "make vc6" will compile for the VC6, +and "make cw" for the CodeWarrior. - The following SDK and compiler configurations and Nokia phones were - tested at some point in time (+ = compiled and PerlApp run, - = not), - both for Perl 5.8.x and 5.9.x: +The following SDK and compiler configurations and Nokia phones were +tested at some point in time (+ = compiled and PerlApp run, - = not), +both for Perl 5.8.x and 5.9.x: - SDK | VC | CW | - --------+----+----+--- - S60 1.2 | + | + | 3650 (*) - S60 2.0 | + | + | 6600 - S60 2.1 | - | + | 6670 - S60 2.6 | + | + | 6630 - S60 2.8 | + | + | (not tested in a device) - S80 2.6 | - | + | 9300 - S90 1.1 | + | - | 7710 - UIQ 2.1 | - | + | (not tested in a device) + SDK | VC | CW | + --------+----+----+--- + S60 1.2 | + | + | 3650 (*) + S60 2.0 | + | + | 6600 + S60 2.1 | - | + | 6670 + S60 2.6 | + | + | 6630 + S60 2.8 | + | + | (not tested in a device) + S80 2.6 | - | + | 9300 + S90 1.1 | + | - | 7710 + UIQ 2.1 | - | + | (not tested in a device) - (*) Compiles but does not work, unfortunately, a problem with Symbian. + (*) Compiles but does not work, unfortunately, a problem with Symbian. - If you are using the 'make' directly, it is the GNU make from the SDKs, - and it will invoke the right make commands for the Windows emulator - build and the Arm target builds ('thumb' by default) as necessary. +If you are using the 'make' directly, it is the GNU make from the SDKs, +and it will invoke the right make commands for the Windows emulator +build and the Arm target builds ('thumb' by default) as necessary. - The build scripts assume the 'absolute style' SDK installs under C:, - the 'subst style' will not work. +The build scripts assume the 'absolute style' SDK installs under C:, +the 'subst style' will not work. - If using the VC IDE, to build use for example the File->Open Workspace-> - C:\Symbian\8.0a\S60_2nd_FP2\epoc32\build\symbian\perl\perl\wins\perl.dsw - The emulator binaries will appear in the same directory. +If using the VC IDE, to build use for example the File->Open Workspace-> +C:\Symbian\8.0a\S60_2nd_FP2\epoc32\build\symbian\perl\perl\wins\perl.dsw +The emulator binaries will appear in the same directory. - If using the VC IDE, you will a lot of warnings in the beginning of - the build because a lot of headers mentioned by the source cannot - be found, but this is not serious since those headers are not used. +If using the VC IDE, you will a lot of warnings in the beginning of +the build because a lot of headers mentioned by the source cannot +be found, but this is not serious since those headers are not used. - The Metrowerks will give a lot of warnings about unused variables and - empty declarations, you can ignore those. +The Metrowerks will give a lot of warnings about unused variables and +empty declarations, you can ignore those. - When the Windows and Arm DLLs are built do not be scared by a very long - messages whizzing by: it is the "export freeze" phase where the whole - (rather large) API of Perl is listed. +When the Windows and Arm DLLs are built do not be scared by a very long +messages whizzing by: it is the "export freeze" phase where the whole +(rather large) API of Perl is listed. - Once the build is completed you need to create the DLL SIS file by +Once the build is completed you need to create the DLL SIS file by - make perldll.sis + make perldll.sis - which will create the file perlXYZ.sis (the XYZ being the Perl version) - which you can then install into your Symbian device: an easy way - to do this is to send them via Bluetooth or infrared and just open - the messages. +which will create the file perlXYZ.sis (the XYZ being the Perl version) +which you can then install into your Symbian device: an easy way +to do this is to send them via Bluetooth or infrared and just open +the messages. - Since the total size of all Perl SIS files once installed is - over 2 MB, it is recommended to do the installation into a - memory card (drive E:) instead of the C: drive. +Since the total size of all Perl SIS files once installed is +over 2 MB, it is recommended to do the installation into a +memory card (drive E:) instead of the C: drive. - The size of the perlXYZ.SIS is about 370 kB but once it is in the - device it is about one 750 kB (according to the application manager). +The size of the perlXYZ.SIS is about 370 kB but once it is in the +device it is about one 750 kB (according to the application manager). - The perlXYZ.sis includes only the Perl DLL: to create an additional - SIS file which includes some of the standard (pure) Perl libraries, - issue the command +The perlXYZ.sis includes only the Perl DLL: to create an additional +SIS file which includes some of the standard (pure) Perl libraries, +issue the command - make perllib.sis + make perllib.sis - Some of the standard Perl libraries are included, but not all: - see L</HISTORY> or F<symbian\install.cfg> for more details - (250 kB -> 700 kB). +Some of the standard Perl libraries are included, but not all: +see L</HISTORY> or F<symbian\install.cfg> for more details +(250 kB -> 700 kB). - Some of the standard Perl XS extensions (see L</HISTORY> are - also available: +Some of the standard Perl XS extensions (see L</HISTORY> are +also available: - make perlext.sis + make perlext.sis - which will create perlXYZext.sis (290 kB -> 770 kB). +which will create perlXYZext.sis (290 kB -> 770 kB). - To compile the demonstration application PerlApp you need first to - install the Perl headers under the SDK. +To compile the demonstration application PerlApp you need first to +install the Perl headers under the SDK. - To install the Perl headers and the class CPerlBase documentation - so that you no more need the Perl sources around to compile Perl - applications using the SDK: +To install the Perl headers and the class CPerlBase documentation +so that you no more need the Perl sources around to compile Perl +applications using the SDK: - make sdkinstall + make sdkinstall - The destination directory is C:\Symbian\perl\X.Y.Z. For more - details, see F<symbian\PerlBase.pod>. +The destination directory is C:\Symbian\perl\X.Y.Z. For more +details, see F<symbian\PerlBase.pod>. - Once the headers have been installed, you can create a SIS for - the PerlApp: +Once the headers have been installed, you can create a SIS for +the PerlApp: - make perlapp.sis + make perlapp.sis - The perlapp.sis (11 kB -> 16 kB) will be built in the symbian - subdirectory, but a copy will also be made to the main directory. +The perlapp.sis (11 kB -> 16 kB) will be built in the symbian +subdirectory, but a copy will also be made to the main directory. - If you want to package the Perl DLLs (one for WINS, one for ARMI), - the headers, and the documentation: +If you want to package the Perl DLLs (one for WINS, one for ARMI), +the headers, and the documentation: - make perlsdk.zip + make perlsdk.zip - which will create perlXYZsdk.zip that can be used in another - Windows system with the SDK, without having to compile Perl in - that system. +which will create perlXYZsdk.zip that can be used in another +Windows system with the SDK, without having to compile Perl in +that system. - If you want to package the PerlApp sources: +If you want to package the PerlApp sources: - make perlapp.zip + make perlapp.zip - If you want to package the perl.exe and miniperl.exe, you - can use the perlexe.sis and miniperlexe.sis make targets. - You also probably want the perllib.sis for the libraries - and maybe even the perlapp.sis for the recognizer. +If you want to package the perl.exe and miniperl.exe, you +can use the perlexe.sis and miniperlexe.sis make targets. +You also probably want the perllib.sis for the libraries +and maybe even the perlapp.sis for the recognizer. - The make target 'allsis' combines all the above SIS targets. +The make target 'allsis' combines all the above SIS targets. - To clean up after compilation you can use either of +To clean up after compilation you can use either of - make clean - make distclean + make clean + make distclean - depending on how clean you want to be. +depending on how clean you want to be. =head2 Compilation problems @@ -349,28 +349,30 @@ The Symbian port is licensed under the same terms as Perl itself. (This will show as "0.01" in the Symbian Installer.) - - The console window is a very simple console indeed: one can - get the newline with "000" and the "C" button is a backspace. - Do not expect a terminal capable of vt100 or ANSI sequences. - The console is also "ASCII", you cannot input e.g. any accented - letters. Because of obvious physical constraints the console is - also very small: (in Nokia 6600) 22 columns, 17 rows. - - The following libraries are available: - AnyDBM_File AutoLoader base Carp Config Cwd constant - DynaLoader Exporter File::Spec integer lib strict Symbol - vars warnings XSLoader - - The following extensions are available: - attributes Compress::Zlib Cwd Data::Dumper Devel::Peek Digest::MD5 DynaLoader - Fcntl File::Glob Filter::Util::Call IO List::Util MIME::Base64 - PerlIO::scalar PerlIO::via SDBM_File Socket Storable Time::HiRes - - The following extensions are missing for various technical reasons: - B ByteLoader Devel::DProf Devel::PPPort Encode GDBM_File - I18N::Langinfo IPC::SysV NDBM_File Opcode PerlIO::encoding POSIX - re Safe Sys::Hostname Sys::Syslog - threads threads::shared Unicode::Normalize - - Using MakeMaker or the Module::* to build and install modules - is not supported. - - Building XS other than the ones in the core is not supported. + - The console window is a very simple console indeed: one can + get the newline with "000" and the "C" button is a backspace. + Do not expect a terminal capable of vt100 or ANSI sequences. + The console is also "ASCII", you cannot input e.g. any accented + letters. Because of obvious physical constraints the console is + also very small: (in Nokia 6600) 22 columns, 17 rows. + - The following libraries are available: + AnyDBM_File AutoLoader base Carp Config Cwd constant + DynaLoader Exporter File::Spec integer lib strict Symbol + vars warnings XSLoader + - The following extensions are available: + attributes Compress::Zlib Cwd Data::Dumper Devel::Peek + Digest::MD5 DynaLoader Fcntl File::Glob Filter::Util::Call + IO List::Util MIME::Base64 + PerlIO::scalar PerlIO::via SDBM_File Socket Storable Time::HiRes + - The following extensions are missing for various technical + reasons: + B ByteLoader Devel::DProf Devel::PPPort Encode GDBM_File + I18N::Langinfo IPC::SysV NDBM_File Opcode PerlIO::encoding POSIX + re Safe Sys::Hostname Sys::Syslog + threads threads::shared Unicode::Normalize + - Using MakeMaker or the Module::* to build and install modules + is not supported. + - Building XS other than the ones in the core is not supported. Since this is 0.something release, any future releases are almost guaranteed to be binary incompatible. As a sign of this the Symbian diff --git a/README.tru64 b/README.tru64 index 39cb27fa03..7b596a9910 100644 --- a/README.tru64 +++ b/README.tru64 @@ -39,8 +39,8 @@ gives advice on how to raise the process limits Also, Configure might abort with - Build a threading Perl? [n] - Configure[2437]: Syntax error at line 1 : 'config.sh' is not expected. + Build a threading Perl? [n] + Configure[2437]: Syntax error at line 1 : 'config.sh' is not expected. This indicates that Configure is being run with a broken Korn shell (even though you think you are using a Bourne shell by using @@ -123,17 +123,17 @@ since pointers are automatically 64-bit wide. When compiling Perl in Tru64 you may (depending on the compiler release) see two warnings like this - cc: Warning: numeric.c, line 104: In this statement, floating-point - overflow occurs in evaluating the expression "1.8e308". (floatoverfl) - return HUGE_VAL; - -----------^ + cc: Warning: numeric.c, line 104: In this statement, floating-point + overflow occurs in evaluating the expression "1.8e308". (floatoverfl) + return HUGE_VAL; + -----------^ and when compiling the POSIX extension - cc: Warning: const-c.inc, line 2007: In this statement, floating-point - overflow occurs in evaluating the expression "1.8e308". (floatoverfl) - return HUGE_VAL; - -------------------^ + cc: Warning: const-c.inc, line 2007: In this statement, floating-point + overflow occurs in evaluating the expression "1.8e308". (floatoverfl) + return HUGE_VAL; + -------------------^ The exact line numbers may vary between Perl releases. The warnings are benign and can be ignored: in later C compiler releases the warnings diff --git a/dist/Module-CoreList/lib/Module/CoreList.pod b/dist/Module-CoreList/lib/Module/CoreList.pod index d8807bf8b4..0ab1f611d0 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pod +++ b/dist/Module-CoreList/lib/Module/CoreList.pod @@ -8,9 +8,14 @@ Module::CoreList - what modules shipped with versions of perl print $Module::CoreList::version{5.00503}{CPAN}; # prints 1.48 - print Module::CoreList->first_release('File::Spec'); # prints 5.00405 - print Module::CoreList->first_release_by_date('File::Spec'); # prints 5.005 - print Module::CoreList->first_release('File::Spec', 0.82); # prints 5.006001 + print Module::CoreList->first_release('File::Spec'); + # prints 5.00405 + + print Module::CoreList->first_release_by_date('File::Spec'); + # prints 5.005 + + print Module::CoreList->first_release('File::Spec', 0.82); + # prints 5.006001 if (Module::CoreList::is_core('File::Spec')) { print "File::Spec is a core module\n"; @@ -19,7 +24,7 @@ Module::CoreList - what modules shipped with versions of perl print join ', ', Module::CoreList->find_modules(qr/Data/); # prints 'Data::Dumper' print join ', ', - Module::CoreList->find_modules(qr/test::h.*::.*s/i, 5.008008); + Module::CoreList->find_modules(qr/test::h.*::.*s/i, 5.008008); # prints 'Test::Harness::Assert, Test::Harness::Straps' print join ", ", @{ $Module::CoreList::families{5.005} }; diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index a550da0568..a1148bac16 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -6,7 +6,7 @@ use vars qw[$VERSION %utilities]; use Module::CoreList; use Module::CoreList::TieHashDelta; -$VERSION = '5.20160228'; +$VERSION = '5.20160311'; sub utilities { my $perl = shift; @@ -1182,8 +1182,11 @@ Module::CoreList::Utils - what utilities shipped with versions of perl print $Module::CoreList::Utils::utilities{5.009003}{ptar}; # prints 1 - print Module::CoreList::Utils->first_release('corelist'); # prints 5.008009 - print Module::CoreList::Utils->first_release_by_date('corelist'); # prints 5.009002 + print Module::CoreList::Utils->first_release('corelist'); + # prints 5.008009 + + print Module::CoreList::Utils->first_release_by_date('corelist'); + # prints 5.009002 =head1 DESCRIPTION diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm index 075c36acdb..9182d5e6cb 100644 --- a/dist/PathTools/lib/File/Spec/AmigaOS.pm +++ b/dist/PathTools/lib/File/Spec/AmigaOS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.63'; +$VERSION = ';.64'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); @@ -15,7 +15,8 @@ File::Spec::AmigaOS - File::Spec for AmigaOS =head1 SYNOPSIS - require File::Spec::AmigaOS; # Done automatically by File::Spec if needed + require File::Spec::AmigaOS; # Done automatically by File::Spec + # if needed =head1 DESCRIPTION diff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm index 586dc57621..e36cb923d9 100644 --- a/dist/SelfLoader/lib/SelfLoader.pm +++ b/dist/SelfLoader/lib/SelfLoader.pm @@ -2,7 +2,7 @@ package SelfLoader; use 5.008; use strict; use IO::Handle; -our $VERSION = "1.22"; +our $VERSION = "1.23"; # The following bit of eval-magic is necessary to make this work on # perls < 5.009005. @@ -395,54 +395,61 @@ can benefit from bug fixes. This package has the same copyright and license as the perl core: - Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, - 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others - - All rights reserved. - - This program is free software; you can redistribute it and/or modify - it under the terms of either: - - a) the GNU General Public License as published by the Free - Software Foundation; either version 1, or (at your option) any - later version, or - - b) the "Artistic License" which comes with this Kit. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either - the GNU General Public License or the Artistic License for more details. - - You should have received a copy of the Artistic License with this - Kit, in the file named "Artistic". If not, I'll be glad to provide one. - - You should also have received a copy of the GNU General Public License - along with this program in the file named "Copying". If not, write to the - Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, - MA 02110-1301, USA or visit their web page on the internet at - http://www.gnu.org/copyleft/gpl.html. - - For those of you that choose to use the GNU General Public License, - my interpretation of the GNU General Public License is that no Perl - script falls under the terms of the GPL unless you explicitly put - said script under the terms of the GPL yourself. Furthermore, any - object code linked with perl does not automatically fall under the - terms of the GPL, provided such object code only adds definitions - of subroutines and variables, and does not otherwise impair the - resulting interpreter from executing any standard Perl script. I - consider linking in C subroutines in this manner to be the moral - equivalent of defining subroutines in the Perl language itself. You - may sell such an object file as proprietary provided that you provide - or offer to provide the Perl source, as specified by the GNU General - Public License. (This is merely an alternate way of specifying input - to the program.) You may also sell a binary produced by the dumping of - a running Perl script that belongs to you, provided that you provide or - offer to provide the Perl source as specified by the GPL. (The - fact that a Perl interpreter and your code are in the same binary file - is, in this case, a form of mere aggregation.) This is my interpretation - of the GPL. If you still have concerns or difficulties understanding - my intent, feel free to contact me. Of course, the Artistic License - spells all this out for your protection, so you may prefer to use that. +Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, +2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others + +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of either: + +=over 4 + +=item a) + +the GNU General Public License as published by the Free Software Foundation; +either version 1, or (at your option) any later version, or + +=item b) + +the "Artistic License" which comes with this Kit. + +=back + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either +the GNU General Public License or the Artistic License for more details. + +You should have received a copy of the Artistic License with this +Kit, in the file named "Artistic". If not, I'll be glad to provide one. + +You should also have received a copy of the GNU General Public License +along with this program in the file named "Copying". If not, write to the +Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, +MA 02110-1301, USA or visit their web page on the internet at +http://www.gnu.org/copyleft/gpl.html. + +For those of you that choose to use the GNU General Public License, +my interpretation of the GNU General Public License is that no Perl +script falls under the terms of the GPL unless you explicitly put +said script under the terms of the GPL yourself. Furthermore, any +object code linked with perl does not automatically fall under the +terms of the GPL, provided such object code only adds definitions +of subroutines and variables, and does not otherwise impair the +resulting interpreter from executing any standard Perl script. I +consider linking in C subroutines in this manner to be the moral +equivalent of defining subroutines in the Perl language itself. You +may sell such an object file as proprietary provided that you provide +or offer to provide the Perl source, as specified by the GNU General +Public License. (This is merely an alternate way of specifying input +to the program.) You may also sell a binary produced by the dumping of +a running Perl script that belongs to you, provided that you provide or +offer to provide the Perl source as specified by the GPL. (The +fact that a Perl interpreter and your code are in the same binary file +is, in this case, a form of mere aggregation.) This is my interpretation +of the GPL. If you still have concerns or difficulties understanding +my intent, feel free to contact me. Of course, the Artistic License +spells all this out for your protection, so you may prefer to use that. =cut diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index 0aa23ab559..c8f6db107d 100644 --- a/dist/Storable/Storable.pm +++ b/dist/Storable/Storable.pm @@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter); use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.55'; +$VERSION = '2.56'; BEGIN { if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) { @@ -979,43 +979,43 @@ such. Here are some code samples showing a possible usage of Storable: - use Storable qw(store retrieve freeze thaw dclone); + use Storable qw(store retrieve freeze thaw dclone); - %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1); + %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1); - store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n"; + store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n"; - $colref = retrieve('mycolors'); - die "Unable to retrieve from mycolors!\n" unless defined $colref; - printf "Blue is still %lf\n", $colref->{'Blue'}; + $colref = retrieve('mycolors'); + die "Unable to retrieve from mycolors!\n" unless defined $colref; + printf "Blue is still %lf\n", $colref->{'Blue'}; - $colref2 = dclone(\%color); + $colref2 = dclone(\%color); - $str = freeze(\%color); - printf "Serialization of %%color is %d bytes long.\n", length($str); - $colref3 = thaw($str); + $str = freeze(\%color); + printf "Serialization of %%color is %d bytes long.\n", length($str); + $colref3 = thaw($str); which prints (on my machine): - Blue is still 0.100000 - Serialization of %color is 102 bytes long. + Blue is still 0.100000 + Serialization of %color is 102 bytes long. Serialization of CODE references and deserialization in a safe compartment: =for example begin - use Storable qw(freeze thaw); - use Safe; - use strict; - my $safe = new Safe; + use Storable qw(freeze thaw); + use Safe; + use strict; + my $safe = new Safe; # because of opcodes used in "use strict": - $safe->permit(qw(:default require)); - local $Storable::Deparse = 1; - local $Storable::Eval = sub { $safe->reval($_[0]) }; - my $serialized = freeze(sub { 42 }); - my $code = thaw($serialized); - $code->() == 42; + $safe->permit(qw(:default require)); + local $Storable::Deparse = 1; + local $Storable::Eval = sub { $safe->reval($_[0]) }; + my $serialized = freeze(sub { 42 }); + my $code = thaw($serialized); + $code->() == 42; =for example end diff --git a/dist/Thread-Queue/lib/Thread/Queue.pm b/dist/Thread-Queue/lib/Thread/Queue.pm index 5a031ff5bd..f1a08c73b1 100644 --- a/dist/Thread-Queue/lib/Thread/Queue.pm +++ b/dist/Thread-Queue/lib/Thread/Queue.pm @@ -3,7 +3,7 @@ package Thread::Queue; use strict; use warnings; -our $VERSION = '3.07'; +our $VERSION = '3.08'; $VERSION = eval $VERSION; use threads::shared 1.21; @@ -485,13 +485,14 @@ Sets the size of the queue. If set, calls to C<enqueue()> will block until the number of pending items in the queue drops below the C<limit>. The C<limit> does not prevent enqueuing items beyond that count: - my $q = Thread::Queue->new(1, 2); - $q->limit = 4; - $q->enqueue(3, 4, 5); # Does not block - $q->enqueue(6); # Blocks until at least 2 items are dequeued - - my $size = $q->limit; # Returns the current limit (may return 'undef') - $q->limit = 0; # Queue size is now unlimited + my $q = Thread::Queue->new(1, 2); + $q->limit = 4; + $q->enqueue(3, 4, 5); # Does not block + $q->enqueue(6); # Blocks until at least 2 items are + # dequeued + my $size = $q->limit; # Returns the current limit (may return + # 'undef') + $q->limit = 0; # Queue size is now unlimited =item ->end() @@ -513,14 +514,14 @@ To prevent the contents of a queue from being modified by another thread while it is being examined and/or changed, L<lock|threads::shared/"lock VARIABLE"> the queue inside a local block: - { - lock($q); # Keep other threads from changing the queue's contents - my $item = $q->peek(); - if ($item ...) { - ... - } - } - # Queue is now unlocked + { + lock($q); # Keep other threads from changing the queue's contents + my $item = $q->peek(); + if ($item ...) { + ... + } + } + # Queue is now unlocked =over @@ -593,11 +594,12 @@ of the queue (similar to C<dequeue_nb>) if the count overlaps the head of the queue from the specified position (i.e. if queue size + index + count is greater than zero): - $q->enqueue(qw/foo bar baz/); - my @nada = $q->extract(-6, 2); # Returns () - (3+(-6)+2) <= 0 - my @some = $q->extract(-6, 4); # Returns (foo) - (3+(-6)+4) > 0 - # Queue now contains: bar, baz - my @rest = $q->extract(-3, 4); # Returns (bar, baz) - (2+(-3)+4) > 0 + $q->enqueue(qw/foo bar baz/); + my @nada = $q->extract(-6, 2); # Returns () - (3+(-6)+2) <= 0 + my @some = $q->extract(-6, 4); # Returns (foo) - (3+(-6)+4) > 0 + # Queue now contains: bar, baz + my @rest = $q->extract(-3, 4); # Returns + # (bar, baz) - (2+(-3)+4) > 0 =back diff --git a/dist/Tie-File/lib/Tie/File.pm b/dist/Tie-File/lib/Tie/File.pm index df8a197867..d546b81f44 100644 --- a/dist/Tie-File/lib/Tie/File.pm +++ b/dist/Tie-File/lib/Tie/File.pm @@ -7,7 +7,7 @@ use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX', 'LOCK_SH', 'O_WRONLY', 'O_RDONLY'; sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY } -$VERSION = "1.01"; +$VERSION = "1.02"; my $DEFAULT_MEMORY_SIZE = 1<<21; # 2 megabytes my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful @@ -2013,32 +2013,32 @@ Tie::File - Access the lines of a disk file via a Perl array =head1 SYNOPSIS - # This file documents Tie::File version 0.98 - use Tie::File; + # This file documents Tie::File version 0.98 + use Tie::File; - tie @array, 'Tie::File', filename or die ...; + tie @array, 'Tie::File', filename or die ...; - $array[13] = 'blah'; # line 13 of the file is now 'blah' - print $array[42]; # display line 42 of the file + $array[13] = 'blah'; # line 13 of the file is now 'blah' + print $array[42]; # display line 42 of the file - $n_recs = @array; # how many records are in the file? - $#array -= 2; # chop two records off the end + $n_recs = @array; # how many records are in the file? + $#array -= 2; # chop two records off the end - for (@array) { - s/PERL/Perl/g; # Replace PERL with Perl everywhere in the file - } + for (@array) { + s/PERL/Perl/g; # Replace PERL with Perl everywhere in the file + } - # These are just like regular push, pop, unshift, shift, and splice - # Except that they modify the file in the way you would expect + # These are just like regular push, pop, unshift, shift, and splice + # Except that they modify the file in the way you would expect - push @array, new recs...; - my $r1 = pop @array; - unshift @array, new recs...; - my $r2 = shift @array; - @old_recs = splice @array, 3, 7, new recs...; + push @array, new recs...; + my $r1 = pop @array; + unshift @array, new recs...; + my $r2 = shift @array; + @old_recs = splice @array, 3, 7, new recs...; - untie @array; # all finished + untie @array; # all finished =head1 DESCRIPTION @@ -2174,8 +2174,8 @@ The default memory limit is 2Mib. You can adjust the maximum read cache size by supplying the C<memory> option. The argument is the desired cache size, in bytes. - # I have a lot of memory, so use a large cache to speed up access - tie @array, 'Tie::File', $file, memory => 20_000_000; + # I have a lot of memory, so use a large cache to speed up access + tie @array, 'Tie::File', $file, memory => 20_000_000; Setting the memory limit to 0 will inhibit caching; records will be fetched from disk every time you examine them. diff --git a/dist/Tie-File/t/00_version.t b/dist/Tie-File/t/00_version.t index 1bd714ec0c..3a404ff38c 100644 --- a/dist/Tie-File/t/00_version.t +++ b/dist/Tie-File/t/00_version.t @@ -2,7 +2,7 @@ print "1..1\n"; -my $testversion = "1.01"; +my $testversion = "1.02"; use Tie::File; if ($Tie::File::VERSION != $testversion) { diff --git a/dist/Time-HiRes/HiRes.pm b/dist/Time-HiRes/HiRes.pm index ebd084e7e4..289ee06c89 100644 --- a/dist/Time-HiRes/HiRes.pm +++ b/dist/Time-HiRes/HiRes.pm @@ -120,7 +120,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers getitimer ($which); use Time::HiRes qw( clock_gettime clock_getres clock_nanosleep - ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF ); + ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF + ITIMER_REALPROF ); $realtime = clock_gettime(CLOCK_REALTIME); $resolution = clock_getres(CLOCK_REALTIME); diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm index 1a6316f64a..f4dee58fd6 100644 --- a/dist/threads/lib/threads.pm +++ b/dist/threads/lib/threads.pm @@ -363,10 +363,10 @@ If you add the C<stringify> import option to your C<use threads> declaration, then using a threads object in a string or a string context (e.g., as a hash key) will cause its ID to be used as the value: - use threads qw(stringify); + use threads qw(stringify); - my $thr = threads->create(...); - print("Thread $thr started...\n"); # Prints out: Thread 1 started... + my $thr = threads->create(...); + print("Thread $thr started...\n"); # Prints: Thread 1 started... =item threads->object($tid) @@ -691,15 +691,16 @@ threaded applications. To specify a particular stack size for any individual thread, call C<-E<gt>create()> with a hash reference as the first argument: - my $thr = threads->create({'stack_size' => 32*4096}, \&foo, @args); + my $thr = threads->create({'stack_size' => 32*4096}, \&foo, @args); =item $thr2 = $thr1->create(FUNCTION, ARGS) This creates a new thread (C<$thr2>) that inherits the stack size from an existing thread (C<$thr1>). This is shorthand for the following: - my $stack_size = $thr1->get_stack_size(); - my $thr2 = threads->create({'stack_size' => $stack_size}, FUNCTION, ARGS); + my $stack_size = $thr1->get_stack_size(); + my $thr2 = threads->create({'stack_size' => $stack_size}, + FUNCTION, ARGS); =back diff --git a/ext/Amiga-ARexx/ARexx.pm b/ext/Amiga-ARexx/ARexx.pm index 4fe2390d4a..44057680f3 100644 --- a/ext/Amiga-ARexx/ARexx.pm +++ b/ext/Amiga-ARexx/ARexx.pm @@ -26,7 +26,7 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); -our $VERSION = '0.02'; +our $VERSION = '0.04'; require XSLoader; XSLoader::load('Amiga::ARexx', $VERSION); @@ -209,7 +209,7 @@ The API is loosley modeled on the python arexx module supplied by with AmigaOS4. # Create a new host use Amiga::ARexx; - my $host = Amiga::ARexx->new('HostName' => "PERLREXX" ); ); + my $host = Amiga::ARexx->new('HostName' => "PERLREXX" ); # Wait for and process rexxcommands @@ -262,7 +262,7 @@ is no need to access the low level methods directly and they are not exported by =head2 new - my $host = Amiga::ARexx->new( HostName => "PERLREXX"); ); + my $host = Amiga::ARexx->new( HostName => "PERLREXX"); Create an ARexx host for your script / program. diff --git a/ext/Amiga-Exec/Exec.pm b/ext/Amiga-Exec/Exec.pm index f9d48385f5..03ecaff602 100644 --- a/ext/Amiga-Exec/Exec.pm +++ b/ext/Amiga-Exec/Exec.pm @@ -26,7 +26,7 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); -our $VERSION = '0.01'; +our $VERSION = '0.02'; require XSLoader; XSLoader::load('Amiga::Exec', $VERSION); @@ -86,7 +86,8 @@ is no need to access the low level methods directly and they are not exported by =head2 Wait - $signals = Amiga::Exec->Wait('SignalMask' => $signalmask, 'TimeOut' => $timeoutinusecs ); + $signals = Amiga::Exec->Wait('SignalMask' => $signalmask, + 'TimeOut' => $timeoutinusecs ); Wait on a signal set with optional timeout. The result ($signals) should be checked to determine which signal was raised. It will be 0 for timeout. diff --git a/ext/File-Find/lib/File/Find.pm b/ext/File-Find/lib/File/Find.pm index 505cdc776d..03dac9fbda 100644 --- a/ext/File-Find/lib/File/Find.pm +++ b/ext/File-Find/lib/File/Find.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; use warnings::register; -our $VERSION = '1.33'; +our $VERSION = '1.34'; require Exporter; require Cwd; @@ -1056,16 +1056,16 @@ App-find2perl CPAN distribution), which when fed, produces something like: - sub wanted { - /^\.nfs.*\z/s && - (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && - int(-M _) > 7 && - unlink($_) - || - ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) && - $dev < 0 && - ($File::Find::prune = 1); - } + sub wanted { + /^\.nfs.*\z/s && + (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && + int(-M _) > 7 && + unlink($_) + || + ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) && + $dev < 0 && + ($File::Find::prune = 1); + } Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical filehandle that caches the information from the preceding diff --git a/ext/File-Glob/Glob.pm b/ext/File-Glob/Glob.pm index c23b7df006..c0b5a4720d 100644 --- a/ext/File-Glob/Glob.pm +++ b/ext/File-Glob/Glob.pm @@ -37,7 +37,7 @@ pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob" @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.25'; +$VERSION = '1.26'; sub import { require Exporter; @@ -363,35 +363,47 @@ E<lt>gsar@activestate.comE<gt>, and Thomas Wegner E<lt>wegner_thomas@yahoo.comE<gt>. The C glob code has the following copyright: - Copyright (c) 1989, 1993 The Regents of the University of California. - All rights reserved. - - This code is derived from software contributed to Berkeley by - Guido van Rossum. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - 2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - 3. Neither the name of the University nor the names of its contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS "AS IS" AND - ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE - FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS - OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) - HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY - OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF - SUCH DAMAGE. +Copyright (c) 1989, 1993 The Regents of the University of California. +All rights reserved. + +This code is derived from software contributed to Berkeley by +Guido van Rossum. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +=over 4 + +=item 1. + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +=item 2. + +Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +=item 3. + +Neither the name of the University nor the names of its contributors +may be used to endorse or promote products derived from this software +without specific prior written permission. + +=back + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. =cut diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index 3f983c1183..9305b5dc13 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -10,7 +10,7 @@ use vars qw(@ISA @EXPORT $VERSION use strict; # This is not a dual-life module, so no need for development version numbers -$VERSION = '1.32'; +$VERSION = '1.33'; @ISA = qw(Exporter); @EXPORT = qw(&xsinit &ldopts @@ -350,7 +350,8 @@ This will generate code for linking with C<DynaLoader> and each static extension found in C<$Config{static_ext}>. The code is written to the default file name F<perlxsi.c>. - perl -MExtUtils::Embed -e xsinit -- -o xsinit.c -std DBI DBD::Oracle + perl -MExtUtils::Embed -e xsinit -- -o xsinit.c \ + -std DBI DBD::Oracle Here, code is written for all the currently linked extensions along with code for C<DBI> and C<DBD::Oracle>. @@ -424,9 +425,11 @@ are picked up from the F<extralibs.ld> file in the same directory. perl -MExtUtils::Embed -e ldopts -- -std Socket -This will do the same as the above example, along with printing additional arguments for linking with the C<Socket> extension. +This will do the same as the above example, along with printing additional +arguments for linking with the C<Socket> extension. - perl -MExtUtils::Embed -e ldopts -- -std Msql -- -L/usr/msql/lib -lmsql + perl -MExtUtils::Embed -e ldopts -- -std Msql -- \ + -L/usr/msql/lib -lmsql Any arguments after the second '--' token are additional linker arguments that will be examined for potential conflict. If there is no diff --git a/pod/perlcall.pod b/pod/perlcall.pod index c405153945..c41d835791 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -910,48 +910,48 @@ result, the subroutine calls I<die>. and some C to call it - static void - call_Subtract(a, b) - int a; - int b; - { - dSP; - int count; - SV *err_tmp; - - ENTER; - SAVETMPS; - - PUSHMARK(SP); - EXTEND(SP, 2); - PUSHs(sv_2mortal(newSViv(a))); - PUSHs(sv_2mortal(newSViv(b))); - PUTBACK; - - count = call_pv("Subtract", G_EVAL|G_SCALAR); - - SPAGAIN; - - /* Check the eval first */ - err_tmp = ERRSV; - if (SvTRUE(err_tmp)) - { - printf ("Uh oh - %s\n", SvPV_nolen(err_tmp)); - POPs; - } - else - { - if (count != 1) - croak("call_Subtract: wanted 1 value from 'Subtract', got %d\n", - count); - - printf ("%d - %d = %d\n", a, b, POPi); - } - - PUTBACK; - FREETMPS; - LEAVE; - } + static void + call_Subtract(a, b) + int a; + int b; + { + dSP; + int count; + SV *err_tmp; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 2); + PUSHs(sv_2mortal(newSViv(a))); + PUSHs(sv_2mortal(newSViv(b))); + PUTBACK; + + count = call_pv("Subtract", G_EVAL|G_SCALAR); + + SPAGAIN; + + /* Check the eval first */ + err_tmp = ERRSV; + if (SvTRUE(err_tmp)) + { + printf ("Uh oh - %s\n", SvPV_nolen(err_tmp)); + POPs; + } + else + { + if (count != 1) + croak("call_Subtract: wanted 1 value from 'Subtract', got %d\n", + count); + + printf ("%d - %d = %d\n", a, b, POPi); + } + + PUTBACK; + FREETMPS; + LEAVE; + } If I<call_Subtract> is called thus @@ -1909,9 +1909,10 @@ done inside our C code: ... - SV *cvrv = eval_pv("sub { - print 'You will not find me cluttering any namespace!' - }", TRUE); + SV *cvrv + = eval_pv("sub { + print 'You will not find me cluttering any namespace!' + }", TRUE); ... diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 7cb162a3c9..18d2e4065c 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -943,12 +943,12 @@ With EXPR, it returns some extra information that the debugger uses to print a stack trace. The value of EXPR indicates how many call frames to go back before the current one. - # 0 1 2 3 4 - my ($package, $filename, $line, $subroutine, $hasargs, + # 0 1 2 3 4 + my ($package, $filename, $line, $subroutine, $hasargs, - # 5 6 7 8 9 10 - $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) - = caller($i); + # 5 6 7 8 9 10 + $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) + = caller($i); Here, $subroutine is the function that the caller called (rather than the function containing the caller). Note that $subroutine may be C<(eval)> if @@ -3472,7 +3472,7 @@ X<join> Joins the separate strings of LIST into a single string with fields separated by the value of EXPR, and returns that new string. Example: - my $rec = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell); + my $rec = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell); Beware that unlike L<C<split>|/split E<sol>PATTERNE<sol>,EXPR,LIMIT>, L<C<join>|/join EXPR,LIST> doesn't take a pattern as its first argument. @@ -4020,14 +4020,14 @@ encounters the missing (or unexpected) comma. The syntax error will be reported close to the C<}>, but you'll need to change something near the C<{> such as using a unary C<+> or semicolon to give Perl some help: - my %hash = map { "\L$_" => 1 } @array # perl guesses EXPR. wrong - my %hash = map { +"\L$_" => 1 } @array # perl guesses BLOCK. right - my %hash = map {; "\L$_" => 1 } @array # this also works - my %hash = map { ("\L$_" => 1) } @array # as does this - my %hash = map { lc($_) => 1 } @array # and this. - my %hash = map +( lc($_) => 1 ), @array # this is EXPR and works! + my %hash = map { "\L$_" => 1 } @array # perl guesses EXPR. wrong + my %hash = map { +"\L$_" => 1 } @array # perl guesses BLOCK. right + my %hash = map {; "\L$_" => 1 } @array # this also works + my %hash = map { ("\L$_" => 1) } @array # as does this + my %hash = map { lc($_) => 1 } @array # and this. + my %hash = map +( lc($_) => 1 ), @array # this is EXPR and works! - my %hash = map ( lc($_), 1 ), @array # evaluates to (1, @array) + my %hash = map ( lc($_), 1 ), @array # evaluates to (1, @array) or to force an anon hash constructor use C<+{>: @@ -4427,28 +4427,29 @@ See L<perliol> for detailed info on PerlIO. General examples: - open(my $log, ">>", "/usr/spool/news/twitlog"); - # if the open fails, output is discarded + open(my $log, ">>", "/usr/spool/news/twitlog"); + # if the open fails, output is discarded - open(my $dbase, "+<", "dbase.mine") # open for update - or die "Can't open 'dbase.mine' for update: $!"; + open(my $dbase, "+<", "dbase.mine") # open for update + or die "Can't open 'dbase.mine' for update: $!"; - open(my $dbase, "+<dbase.mine") # ditto - or die "Can't open 'dbase.mine' for update: $!"; + open(my $dbase, "+<dbase.mine") # ditto + or die "Can't open 'dbase.mine' for update: $!"; - open(my $article_fh, "-|", "caesar <$article") # decrypt article - or die "Can't start caesar: $!"; + open(my $article_fh, "-|", "caesar <$article") # decrypt + # article + or die "Can't start caesar: $!"; - open(my $article_fh, "caesar <$article |") # ditto - or die "Can't start caesar: $!"; + open(my $article_fh, "caesar <$article |") # ditto + or die "Can't start caesar: $!"; - open(my $out_fh, "|-", "sort >Tmp$$") # $$ is our process id - or die "Can't start sort: $!"; + open(my $out_fh, "|-", "sort >Tmp$$") # $$ is our process id + or die "Can't start sort: $!"; - # in-memory files - open(my $memory, ">", \$var) - or die "Can't open memory file: $!"; - print $memory "foo!\n"; # output will appear in $var + # in-memory files + open(my $memory, ">", \$var) + or die "Can't open memory file: $!"; + print $memory "foo!\n"; # output will appear in $var You may also, in the Bourne shell tradition, specify an EXPR beginning with C<< >& >>, in which case the rest of the string is interpreted @@ -4528,11 +4529,11 @@ Use C<defined($pid)> or C<//> to determine whether the open was successful. For example, use either - my $child_pid = open(my $from_kid, "-|") // die "Can't fork: $!"; + my $child_pid = open(my $from_kid, "-|") // die "Can't fork: $!"; or - my $child_pid = open(my $to_kid, "|-") // die "Can't fork: $!"; + my $child_pid = open(my $to_kid, "|-") // die "Can't fork: $!"; followed by @@ -6761,13 +6762,14 @@ subroutine like this: The usual idiom is: - my ($nfound, $timeleft) = - select(my $rout = $rin, my $wout = $win, my $eout = $ein, $timeout); + my ($nfound, $timeleft) = + select(my $rout = $rin, my $wout = $win, my $eout = $ein, + $timeout); or to block until something becomes ready just do this - my $nfound = - select(my $rout = $rin, my $wout = $win, my $eout = $ein, undef); + my $nfound = + select(my $rout = $rin, my $wout = $win, my $eout = $ein, undef); Most systems do not bother to return anything useful in C<$timeleft>, so calling L<C<select>|/select RBITS,WBITS,EBITS,TIMEOUT> in scalar context diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 8091fe50a6..ba6cd16692 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -341,14 +341,15 @@ copy-on-write is skipped. First have a look at an empty string: Notice here the LEN is 10. (It may differ on your platform.) Extend the length of the string to one less than 10, and do a substitution: - % ./perl -Ilib -MDevel::Peek -le '$a=""; $a.="123456789"; $a=~s/.//; Dump($a)' - SV = PV(0x7ffa04008a70) at 0x7ffa04030390 - REFCNT = 1 - FLAGS = (POK,OOK,pPOK) - OFFSET = 1 - PV = 0x7ffa03c05b61 ( "\1" . ) "23456789"\0 - CUR = 8 - LEN = 9 + % ./perl -Ilib -MDevel::Peek -le '$a=""; $a.="123456789"; $a=~s/.//; \ + Dump($a)' + SV = PV(0x7ffa04008a70) at 0x7ffa04030390 + REFCNT = 1 + FLAGS = (POK,OOK,pPOK) + OFFSET = 1 + PV = 0x7ffa03c05b61 ( "\1" . ) "23456789"\0 + CUR = 8 + LEN = 9 Here the number of bytes chopped off (1) is shown next as the OFFSET. The portion of the string between the "real" and the "fake" beginnings is diff --git a/pod/perliol.pod b/pod/perliol.pod index ab600bd3b2..55aaf147f7 100644 --- a/pod/perliol.pod +++ b/pod/perliol.pod @@ -135,45 +135,51 @@ member of C<PerlIOl>. The functions (methods of the layer "class") are fixed, and are defined by the C<PerlIO_funcs> type. They are broadly the same as the public C<PerlIO_xxxxx> functions: - struct _PerlIO_funcs - { - Size_t fsize; - char * name; - Size_t size; - IV kind; - IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg, PerlIO_funcs *tab); - IV (*Popped)(pTHX_ PerlIO *f); - PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab, - PerlIO_list_t *layers, IV n, - const char *mode, - int fd, int imode, int perm, - PerlIO *old, - int narg, SV **args); - IV (*Binmode)(pTHX_ PerlIO *f); - SV * (*Getarg)(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) - IV (*Fileno)(pTHX_ PerlIO *f); - PerlIO * (*Dup)(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) - /* Unix-like functions - cf sfio line disciplines */ - SSize_t (*Read)(pTHX_ PerlIO *f, void *vbuf, Size_t count); - SSize_t (*Unread)(pTHX_ PerlIO *f, const void *vbuf, Size_t count); - SSize_t (*Write)(pTHX_ PerlIO *f, const void *vbuf, Size_t count); - IV (*Seek)(pTHX_ PerlIO *f, Off_t offset, int whence); - Off_t (*Tell)(pTHX_ PerlIO *f); - IV (*Close)(pTHX_ PerlIO *f); - /* Stdio-like buffered IO functions */ - IV (*Flush)(pTHX_ PerlIO *f); - IV (*Fill)(pTHX_ PerlIO *f); - IV (*Eof)(pTHX_ PerlIO *f); - IV (*Error)(pTHX_ PerlIO *f); - void (*Clearerr)(pTHX_ PerlIO *f); - void (*Setlinebuf)(pTHX_ PerlIO *f); - /* Perl's snooping functions */ - STDCHAR * (*Get_base)(pTHX_ PerlIO *f); - Size_t (*Get_bufsiz)(pTHX_ PerlIO *f); - STDCHAR * (*Get_ptr)(pTHX_ PerlIO *f); - SSize_t (*Get_cnt)(pTHX_ PerlIO *f); - void (*Set_ptrcnt)(pTHX_ PerlIO *f,STDCHAR *ptr,SSize_t cnt); - }; + struct _PerlIO_funcs + { + Size_t fsize; + char * name; + Size_t size; + IV kind; + IV (*Pushed)(pTHX_ PerlIO *f, + const char *mode, + SV *arg, + PerlIO_funcs *tab); + IV (*Popped)(pTHX_ PerlIO *f); + PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab, + PerlIO_list_t *layers, IV n, + const char *mode, + int fd, int imode, int perm, + PerlIO *old, + int narg, SV **args); + IV (*Binmode)(pTHX_ PerlIO *f); + SV * (*Getarg)(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) + IV (*Fileno)(pTHX_ PerlIO *f); + PerlIO * (*Dup)(pTHX_ PerlIO *f, + PerlIO *o, + CLONE_PARAMS *param, + int flags) + /* Unix-like functions - cf sfio line disciplines */ + SSize_t (*Read)(pTHX_ PerlIO *f, void *vbuf, Size_t count); + SSize_t (*Unread)(pTHX_ PerlIO *f, const void *vbuf, Size_t count); + SSize_t (*Write)(pTHX_ PerlIO *f, const void *vbuf, Size_t count); + IV (*Seek)(pTHX_ PerlIO *f, Off_t offset, int whence); + Off_t (*Tell)(pTHX_ PerlIO *f); + IV (*Close)(pTHX_ PerlIO *f); + /* Stdio-like buffered IO functions */ + IV (*Flush)(pTHX_ PerlIO *f); + IV (*Fill)(pTHX_ PerlIO *f); + IV (*Eof)(pTHX_ PerlIO *f); + IV (*Error)(pTHX_ PerlIO *f); + void (*Clearerr)(pTHX_ PerlIO *f); + void (*Setlinebuf)(pTHX_ PerlIO *f); + /* Perl's snooping functions */ + STDCHAR * (*Get_base)(pTHX_ PerlIO *f); + Size_t (*Get_bufsiz)(pTHX_ PerlIO *f); + STDCHAR * (*Get_ptr)(pTHX_ PerlIO *f); + SSize_t (*Get_cnt)(pTHX_ PerlIO *f); + void (*Set_ptrcnt)(pTHX_ PerlIO *f,STDCHAR *ptr,SSize_t cnt); + }; The first few members of the struct give a function table size for compatibility check "name" for the layer, the size to C<malloc> for the per-instance data, @@ -443,7 +449,7 @@ flag is used it's up to the layer to validate the args. =item Pushed - IV (*Pushed)(pTHX_ PerlIO *f,const char *mode, SV *arg); + IV (*Pushed)(pTHX_ PerlIO *f,const char *mode, SV *arg); The only absolutely mandatory method. Called when the layer is pushed onto the stack. The C<mode> argument may be NULL if this occurs @@ -837,8 +843,9 @@ The following table summarizes the behaviour: Unread PerlIOBase_unread Write FAILURE - FAILURE Set errno (to EINVAL in Unixish, to LIB$_INVARG in VMS) and - return -1 (for numeric return values) or NULL (for pointers) + FAILURE Set errno (to EINVAL in Unixish, to LIB$_INVARG in VMS) + and return -1 (for numeric return values) or NULL (for + pointers) INHERITED Inherited from the layer below SUCCESS Return 0 (for numeric return values) or a pointer diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 6be276384e..e3b74a55b9 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -316,8 +316,9 @@ Instead of setting C<$SIG{ALRM}>: try something like the following: - use POSIX qw(SIGALRM); - POSIX::sigaction(SIGALRM, POSIX::SigAction->new(sub { die "alarm" })) + use POSIX qw(SIGALRM); + POSIX::sigaction(SIGALRM, + POSIX::SigAction->new(sub { die "alarm" })) || die "Error setting SIGALRM handler: $!\n"; Another way to disable the safe signal behavior locally is to use @@ -515,17 +516,17 @@ containing the directory from which it was launched, and redirect its standard file descriptors from and to F</dev/null> so that random output doesn't wind up on the user's terminal. - use POSIX "setsid"; + use POSIX "setsid"; - sub daemonize { - chdir("/") || die "can't chdir to /: $!"; - open(STDIN, "< /dev/null") || die "can't read /dev/null: $!"; - open(STDOUT, "> /dev/null") || die "can't write to /dev/null: $!"; - defined(my $pid = fork()) || die "can't fork: $!"; - exit if $pid; # non-zero now means I am the parent - (setsid() != -1) || die "Can't start a new session: $!"; - open(STDERR, ">&STDOUT") || die "can't dup stdout: $!"; - } + sub daemonize { + chdir("/") || die "can't chdir to /: $!"; + open(STDIN, "< /dev/null") || die "can't read /dev/null: $!"; + open(STDOUT, "> /dev/null") || die "can't write to /dev/null: $!"; + defined(my $pid = fork()) || die "can't fork: $!"; + exit if $pid; # non-zero now means I am the parent + (setsid() != -1) || die "Can't start a new session: $!"; + open(STDERR, ">&STDOUT") || die "can't dup stdout: $!"; + } The fork() has to come before the setsid() to ensure you aren't a process group leader; the setsid() will fail if you are. If your @@ -812,70 +813,70 @@ this together by hand. This example only talks to itself, but you could reopen the appropriate handles to STDIN and STDOUT and call other processes. (The following example lacks proper error checking.) - #!/usr/bin/perl -w - # pipe1 - bidirectional communication using two pipe pairs - # designed for the socketpair-challenged - use IO::Handle; # thousands of lines just for autoflush :-( - pipe(PARENT_RDR, CHILD_WTR); # XXX: check failure? - pipe(CHILD_RDR, PARENT_WTR); # XXX: check failure? - CHILD_WTR->autoflush(1); - PARENT_WTR->autoflush(1); - - if ($pid = fork()) { - close PARENT_RDR; - close PARENT_WTR; - print CHILD_WTR "Parent Pid $$ is sending this\n"; - chomp($line = <CHILD_RDR>); - print "Parent Pid $$ just read this: '$line'\n"; - close CHILD_RDR; close CHILD_WTR; - waitpid($pid, 0); - } else { - die "cannot fork: $!" unless defined $pid; - close CHILD_RDR; - close CHILD_WTR; - chomp($line = <PARENT_RDR>); - print "Child Pid $$ just read this: '$line'\n"; - print PARENT_WTR "Child Pid $$ is sending this\n"; - close PARENT_RDR; - close PARENT_WTR; - exit(0); - } + #!/usr/bin/perl -w + # pipe1 - bidirectional communication using two pipe pairs + # designed for the socketpair-challenged + use IO::Handle; # thousands of lines just for autoflush :-( + pipe(PARENT_RDR, CHILD_WTR); # XXX: check failure? + pipe(CHILD_RDR, PARENT_WTR); # XXX: check failure? + CHILD_WTR->autoflush(1); + PARENT_WTR->autoflush(1); + + if ($pid = fork()) { + close PARENT_RDR; + close PARENT_WTR; + print CHILD_WTR "Parent Pid $$ is sending this\n"; + chomp($line = <CHILD_RDR>); + print "Parent Pid $$ just read this: '$line'\n"; + close CHILD_RDR; close CHILD_WTR; + waitpid($pid, 0); + } else { + die "cannot fork: $!" unless defined $pid; + close CHILD_RDR; + close CHILD_WTR; + chomp($line = <PARENT_RDR>); + print "Child Pid $$ just read this: '$line'\n"; + print PARENT_WTR "Child Pid $$ is sending this\n"; + close PARENT_RDR; + close PARENT_WTR; + exit(0); + } But you don't actually have to make two pipe calls. If you have the socketpair() system call, it will do this all for you. - #!/usr/bin/perl -w - # pipe2 - bidirectional communication using socketpair - # "the best ones always go both ways" - - use Socket; - use IO::Handle; # thousands of lines just for autoflush :-( - - # We say AF_UNIX because although *_LOCAL is the - # POSIX 1003.1g form of the constant, many machines - # still don't have it. - socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC) - || die "socketpair: $!"; - - CHILD->autoflush(1); - PARENT->autoflush(1); - - if ($pid = fork()) { - close PARENT; - print CHILD "Parent Pid $$ is sending this\n"; - chomp($line = <CHILD>); - print "Parent Pid $$ just read this: '$line'\n"; - close CHILD; - waitpid($pid, 0); - } else { - die "cannot fork: $!" unless defined $pid; - close CHILD; - chomp($line = <PARENT>); - print "Child Pid $$ just read this: '$line'\n"; - print PARENT "Child Pid $$ is sending this\n"; - close PARENT; - exit(0); - } + #!/usr/bin/perl -w + # pipe2 - bidirectional communication using socketpair + # "the best ones always go both ways" + + use Socket; + use IO::Handle; # thousands of lines just for autoflush :-( + + # We say AF_UNIX because although *_LOCAL is the + # POSIX 1003.1g form of the constant, many machines + # still don't have it. + socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC) + || die "socketpair: $!"; + + CHILD->autoflush(1); + PARENT->autoflush(1); + + if ($pid = fork()) { + close PARENT; + print CHILD "Parent Pid $$ is sending this\n"; + chomp($line = <CHILD>); + print "Parent Pid $$ just read this: '$line'\n"; + close CHILD; + waitpid($pid, 0); + } else { + die "cannot fork: $!" unless defined $pid; + close CHILD; + chomp($line = <PARENT>); + print "Child Pid $$ just read this: '$line'\n"; + print PARENT "Child Pid $$ is sending this\n"; + close PARENT; + exit(0); + } =head1 Sockets: Client/Server Communication @@ -954,131 +955,133 @@ the appropriate interface on multihomed hosts. If you want sit on a particular interface (like the external side of a gateway or firewall machine), fill this in with your real address instead. - #!/usr/bin/perl -Tw - use strict; - BEGIN { $ENV{PATH} = "/usr/bin:/bin" } - use Socket; - use Carp; - my $EOL = "\015\012"; + #!/usr/bin/perl -Tw + use strict; + BEGIN { $ENV{PATH} = "/usr/bin:/bin" } + use Socket; + use Carp; + my $EOL = "\015\012"; - sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" } + sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" } - my $port = shift || 2345; - die "invalid port" unless $port =~ /^ \d+ $/x; + my $port = shift || 2345; + die "invalid port" unless $port =~ /^ \d+ $/x; - my $proto = getprotobyname("tcp"); + my $proto = getprotobyname("tcp"); - socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; - setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) - || die "setsockopt: $!"; - bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; - listen(Server, SOMAXCONN) || die "listen: $!"; + socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) + || die "setsockopt: $!"; + bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; + listen(Server, SOMAXCONN) || die "listen: $!"; - logmsg "server started on port $port"; + logmsg "server started on port $port"; - my $paddr; + my $paddr; - for ( ; $paddr = accept(Client, Server); close Client) { - my($port, $iaddr) = sockaddr_in($paddr); - my $name = gethostbyaddr($iaddr, AF_INET); + for ( ; $paddr = accept(Client, Server); close Client) { + my($port, $iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr, AF_INET); - logmsg "connection from $name [", - inet_ntoa($iaddr), "] - at port $port"; + logmsg "connection from $name [", + inet_ntoa($iaddr), "] + at port $port"; - print Client "Hello there, $name, it's now ", - scalar localtime(), $EOL; - } + print Client "Hello there, $name, it's now ", + scalar localtime(), $EOL; + } And here's a multitasking version. It's multitasked in that like most typical servers, it spawns (fork()s) a slave server to handle the client request so that the master server can quickly go back to service a new client. - #!/usr/bin/perl -Tw - use strict; - BEGIN { $ENV{PATH} = "/usr/bin:/bin" } - use Socket; - use Carp; - my $EOL = "\015\012"; - - sub spawn; # forward declaration - sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" } - - my $port = shift || 2345; - die "invalid port" unless $port =~ /^ \d+ $/x; + #!/usr/bin/perl -Tw + use strict; + BEGIN { $ENV{PATH} = "/usr/bin:/bin" } + use Socket; + use Carp; + my $EOL = "\015\012"; - my $proto = getprotobyname("tcp"); + sub spawn; # forward declaration + sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" } - socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; - setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) - || die "setsockopt: $!"; - bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; - listen(Server, SOMAXCONN) || die "listen: $!"; + my $port = shift || 2345; + die "invalid port" unless $port =~ /^ \d+ $/x; - logmsg "server started on port $port"; + my $proto = getprotobyname("tcp"); - my $waitedpid = 0; - my $paddr; + socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) + || die "setsockopt: $!"; + bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; + listen(Server, SOMAXCONN) || die "listen: $!"; - use POSIX ":sys_wait_h"; - use Errno; + logmsg "server started on port $port"; - sub REAPER { - local $!; # don't let waitpid() overwrite current error - while ((my $pid = waitpid(-1, WNOHANG)) > 0 && WIFEXITED($?)) { - logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ""); - } - $SIG{CHLD} = \&REAPER; # loathe SysV - } + my $waitedpid = 0; + my $paddr; - $SIG{CHLD} = \&REAPER; + use POSIX ":sys_wait_h"; + use Errno; - while (1) { - $paddr = accept(Client, Server) || do { - # try again if accept() returned because got a signal - next if $!{EINTR}; - die "accept: $!"; - }; - my ($port, $iaddr) = sockaddr_in($paddr); - my $name = gethostbyaddr($iaddr, AF_INET); - - logmsg "connection from $name [", - inet_ntoa($iaddr), - "] at port $port"; + sub REAPER { + local $!; # don't let waitpid() overwrite current error + while ((my $pid = waitpid(-1, WNOHANG)) > 0 && WIFEXITED($?)) { + logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ""); + } + $SIG{CHLD} = \&REAPER; # loathe SysV + } - spawn sub { - $| = 1; - print "Hello there, $name, it's now ", scalar localtime(), $EOL; - exec "/usr/games/fortune" # XXX: "wrong" line terminators - or confess "can't exec fortune: $!"; - }; - close Client; - } + $SIG{CHLD} = \&REAPER; + + while (1) { + $paddr = accept(Client, Server) || do { + # try again if accept() returned because got a signal + next if $!{EINTR}; + die "accept: $!"; + }; + my ($port, $iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr, AF_INET); + + logmsg "connection from $name [", + inet_ntoa($iaddr), + "] at port $port"; + + spawn sub { + $| = 1; + print "Hello there, $name, it's now ", + scalar localtime(), + $EOL; + exec "/usr/games/fortune" # XXX: "wrong" line terminators + or confess "can't exec fortune: $!"; + }; + close Client; + } - sub spawn { - my $coderef = shift; + sub spawn { + my $coderef = shift; - unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") { - confess "usage: spawn CODEREF"; - } + unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") { + confess "usage: spawn CODEREF"; + } - my $pid; - unless (defined($pid = fork())) { - logmsg "cannot fork: $!"; - return; - } - elsif ($pid) { - logmsg "begat $pid"; - return; # I'm the parent - } - # else I'm the child -- go spawn + my $pid; + unless (defined($pid = fork())) { + logmsg "cannot fork: $!"; + return; + } + elsif ($pid) { + logmsg "begat $pid"; + return; # I'm the parent + } + # else I'm the child -- go spawn - open(STDIN, "<&Client") || die "can't dup client to stdin"; - open(STDOUT, ">&Client") || die "can't dup client to stdout"; - ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; - exit($coderef->()); - } + open(STDIN, "<&Client") || die "can't dup client to stdin"; + open(STDOUT, ">&Client") || die "can't dup client to stdout"; + ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; + exit($coderef->()); + } This server takes the trouble to clone off a child version via fork() for each incoming request. That way it can handle many requests at @@ -1294,7 +1297,7 @@ that the server there cares to provide. PeerAddr => "localhost", PeerPort => "daytime(13)", ) - || die "can't connect to daytime service on localhost"; + || die "can't connect to daytime service on localhost"; while (<$remote>) { print } When you run this program, you should get something back that @@ -1569,15 +1572,16 @@ Here's the code. We'll $client->autoflush(1); print $client "Welcome to $0; type help for command list.\n"; $hostinfo = gethostbyaddr($client->peeraddr); - printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost; + printf "[Connect from %s]\n", + $hostinfo ? $hostinfo->name : $client->peerhost; print $client "Command? "; while ( <$client>) { - next unless /\S/; # blank line - if (/quit|exit/i) { last } - elsif (/date|time/i) { printf $client "%s\n", scalar localtime() } - elsif (/who/i ) { print $client `who 2>&1` } - elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1` } - elsif (/motd/i ) { print $client `cat /etc/motd 2>&1` } + next unless /\S/; # blank line + if (/quit|exit/i) { last } + elsif (/date|time/i) { printf $client "%s\n", scalar localtime() } + elsif (/who/i ) { print $client `who 2>&1` } + elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1` } + elsif (/motd/i ) { print $client `cat /etc/motd 2>&1` } else { print $client "Commands: quit date who cookie motd\n"; } @@ -1610,49 +1614,49 @@ will check many of them asynchronously by simulating a multicast and then using select() to do a timed-out wait for I/O. To do something similar with TCP, you'd have to use a different socket handle for each host. - #!/usr/bin/perl -w - use strict; - use Socket; - use Sys::Hostname; - - my ( $count, $hisiaddr, $hispaddr, $histime, - $host, $iaddr, $paddr, $port, $proto, - $rin, $rout, $rtime, $SECS_OF_70_YEARS); - - $SECS_OF_70_YEARS = 2_208_988_800; - - $iaddr = gethostbyname(hostname()); - $proto = getprotobyname("udp"); - $port = getservbyname("time", "udp"); - $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick - - socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!"; - bind(SOCKET, $paddr) || die "bind: $!"; - - $| = 1; - printf "%-12s %8s %s\n", "localhost", 0, scalar localtime(); - $count = 0; - for $host (@ARGV) { - $count++; - $hisiaddr = inet_aton($host) || die "unknown host"; - $hispaddr = sockaddr_in($port, $hisiaddr); - defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!"; - } + #!/usr/bin/perl -w + use strict; + use Socket; + use Sys::Hostname; + + my ( $count, $hisiaddr, $hispaddr, $histime, + $host, $iaddr, $paddr, $port, $proto, + $rin, $rout, $rtime, $SECS_OF_70_YEARS); + + $SECS_OF_70_YEARS = 2_208_988_800; + + $iaddr = gethostbyname(hostname()); + $proto = getprotobyname("udp"); + $port = getservbyname("time", "udp"); + $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick + + socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!"; + bind(SOCKET, $paddr) || die "bind: $!"; + + $| = 1; + printf "%-12s %8s %s\n", "localhost", 0, scalar localtime(); + $count = 0; + for $host (@ARGV) { + $count++; + $hisiaddr = inet_aton($host) || die "unknown host"; + $hispaddr = sockaddr_in($port, $hisiaddr); + defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!"; + } - $rin = ""; - vec($rin, fileno(SOCKET), 1) = 1; - - # timeout after 10.0 seconds - while ($count && select($rout = $rin, undef, undef, 10.0)) { - $rtime = ""; - $hispaddr = recv(SOCKET, $rtime, 4, 0) || die "recv: $!"; - ($port, $hisiaddr) = sockaddr_in($hispaddr); - $host = gethostbyaddr($hisiaddr, AF_INET); - $histime = unpack("N", $rtime) - $SECS_OF_70_YEARS; - printf "%-12s ", $host; - printf "%8d %s\n", $histime - time(), scalar localtime($histime); - $count--; - } + $rin = ""; + vec($rin, fileno(SOCKET), 1) = 1; + + # timeout after 10.0 seconds + while ($count && select($rout = $rin, undef, undef, 10.0)) { + $rtime = ""; + $hispaddr = recv(SOCKET, $rtime, 4, 0) || die "recv: $!"; + ($port, $hisiaddr) = sockaddr_in($hispaddr); + $host = gethostbyaddr($hisiaddr, AF_INET); + $histime = unpack("N", $rtime) - $SECS_OF_70_YEARS; + printf "%-12s ", $host; + printf "%8d %s\n", $histime - time(), scalar localtime($histime); + $count--; + } This example does not include any retries and may consequently fail to contact a reachable host. The most prominent reason for this is congestion diff --git a/pod/perllol.pod b/pod/perllol.pod index b35a0febb3..7eee1ec9a1 100644 --- a/pod/perllol.pod +++ b/pod/perllol.pod @@ -200,13 +200,14 @@ but not earlier, you should place a prominent directive at the top of the file that needs it. That way when somebody tries to run the new code under an old perl, rather than getting an error like - Type of arg 1 to push must be array (not array element) at /tmp/a line 8, near ""betty";" + Type of arg 1 to push must be array (not array element) at /tmp/a + line 8, near ""betty";" Execution of /tmp/a aborted due to compilation errors. they'll be politely informed that - Perl v5.14.0 required--this is only v5.12.3, stopped at /tmp/a line 1. - BEGIN failed--compilation aborted at /tmp/a line 1. + Perl v5.14.0 required--this is only v5.12.3, stopped at /tmp/a line 1. + BEGIN failed--compilation aborted at /tmp/a line 1. =head2 Access and Printing @@ -270,26 +271,28 @@ you might look at the standard L<Dumpvalue> or L<Data::Dumper> modules. The former is what the Perl debugger uses, while the latter generates parsable Perl code. For example: - use v5.14; # using the + prototype, new to v5.14 + use v5.14; # using the + prototype, new to v5.14 - sub show(+) { + sub show(+) { require Dumpvalue; state $prettily = new Dumpvalue:: tick => q("), - compactDump => 1, # comment these two lines out - veryCompact => 1, # if you want a bigger dump + compactDump => 1, # comment these two lines + # out + veryCompact => 1, # if you want a bigger + # dump ; dumpValue $prettily @_; - } + } - # Assign a list of array references to an array. - my @AoA = ( + # Assign a list of array references to an array. + my @AoA = ( [ "fred", "barney" ], [ "george", "jane", "elroy" ], [ "homer", "marge", "bart" ], - ); - push $AoA[0], "wilma", "betty"; - show @AoA; + ); + push $AoA[0], "wilma", "betty"; + show @AoA; will print out: diff --git a/pod/perlmodstyle.pod b/pod/perlmodstyle.pod index 6f0cb96c12..62390a4917 100644 --- a/pod/perlmodstyle.pod +++ b/pod/perlmodstyle.pod @@ -636,7 +636,8 @@ A correct CPAN version number is a floating point number with at least 2 digits after the decimal. You can test whether it conforms to CPAN by using - perl -MExtUtils::MakeMaker -le 'print MM->parse_version(shift)' 'Foo.pm' + perl -MExtUtils::MakeMaker -le 'print MM->parse_version(shift)' \ + 'Foo.pm' If you want to release a 'beta' or 'alpha' version of a module but don't want CPAN.pm to list it as most recent use an '_' after the diff --git a/pod/perlnewmod.pod b/pod/perlnewmod.pod index 26c4c13979..eae2997aad 100644 --- a/pod/perlnewmod.pod +++ b/pod/perlnewmod.pod @@ -164,8 +164,8 @@ the caller and not your module. For instance, if you say this: the user will see something like this: - No hostname given at /usr/local/lib/perl5/site_perl/5.6.0/Net/Acme.pm - line 123. + No hostname given at + /usr/local/lib/perl5/site_perl/5.6.0/Net/Acme.pm line 123. which looks like your module is doing something wrong. Instead, you want to put the blame on the user, and say this: diff --git a/pod/perlperf.pod b/pod/perlperf.pod index 5884a54f97..87d632f0d1 100644 --- a/pod/perlperf.pod +++ b/pod/perlperf.pod @@ -281,11 +281,16 @@ report on the contents. my $i_word = 0; foreach my $word ( @words ) { $i_word++; - $count{$i_LINES}{spec} += matches($i_word, $word, '[^a-zA-Z0-9]'); - $count{$i_LINES}{only} += matches($i_word, $word, '^[^a-zA-Z0-9]+$'); - $count{$i_LINES}{cons} += matches($i_word, $word, '^[(?i:bcdfghjklmnpqrstvwxyz)]+$'); - $count{$i_LINES}{vows} += matches($i_word, $word, '^[(?i:aeiou)]+$'); - $count{$i_LINES}{caps} += matches($i_word, $word, '^[(A-Z)]+$'); + $count{$i_LINES}{spec} += matches($i_word, $word, + '[^a-zA-Z0-9]'); + $count{$i_LINES}{only} += matches($i_word, $word, + '^[^a-zA-Z0-9]+$'); + $count{$i_LINES}{cons} += matches($i_word, $word, + '^[(?i:bcdfghjklmnpqrstvwxyz)]+$'); + $count{$i_LINES}{vows} += matches($i_word, $word, + '^[(?i:aeiou)]+$'); + $count{$i_LINES}{caps} += matches($i_word, $word, + '^[(A-Z)]+$'); } } @@ -301,7 +306,9 @@ report on the contents. $has++ if $1; } - debug("word: $i_wd ".($has ? 'matches' : 'does not match')." chars: /$regex/"); + debug( "word: $i_wd " + . ($has ? 'matches' : 'does not match') + . " chars: /$regex/"); return $has; } @@ -967,7 +974,8 @@ any way an issue, this approach is wrong. A common sight is code which looks something like this: - logger->debug( "A logging message via process-id: $$ INC: " . Dumper(\%INC) ) + logger->debug( "A logging message via process-id: $$ INC: " + . Dumper(\%INC) ) The problem is that this code will always be parsed and executed, even when the debug level set in the logging configuration file is zero. Once the debug() @@ -977,7 +985,8 @@ the program will continue. In the example given though, the C<\%INC> hash will already have been dumped, and the message string constructed, all of which work could be bypassed by a debug variable at the statement level, like this: - logger->debug( "A logging message via process-id: $$ INC: " . Dumper(\%INC) ) if $DEBUG; + logger->debug( "A logging message via process-id: $$ INC: " + . Dumper(\%INC) ) if $DEBUG; This effect can be demonstrated by setting up a test script with both forms, including a C<debug()> subroutine to emulate typical C<logger()> functionality. diff --git a/pod/perlrun.pod b/pod/perlrun.pod index fb0c271db5..1ff3ce2472 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -1326,7 +1326,7 @@ C<key_traversal_mask()> in L<Hash::Util>. An example output might be: - HASH_FUNCTION = ONE_AT_A_TIME_HARD HASH_SEED = 0x652e9b9349a7a032 PERTURB_KEYS = 1 (RANDOM) + HASH_FUNCTION = ONE_AT_A_TIME_HARD HASH_SEED = 0x652e9b9349a7a032 PERTURB_KEYS = 1 (RANDOM) =item PERL_MEM_LOG X<PERL_MEM_LOG> diff --git a/pod/perltie.pod b/pod/perltie.pod index db01b448a3..7b89f570ad 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -82,22 +82,22 @@ This is the constructor for the class. That means it is expected to return a blessed reference to a new scalar (probably anonymous) that it's creating. For example: - sub TIESCALAR { - my $class = shift; - my $pid = shift || $$; # 0 means me + sub TIESCALAR { + my $class = shift; + my $pid = shift || $$; # 0 means me - if ($pid !~ /^\d+$/) { - carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W; - return undef; - } + if ($pid !~ /^\d+$/) { + carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W; + return undef; + } - unless (kill 0, $pid) { # EPERM or ERSCH, no doubt - carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W; - return undef; - } + unless (kill 0, $pid) { # EPERM or ERSCH, no doubt + carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W; + return undef; + } - return bless \$pid, $class; - } + return bless \$pid, $class; + } This tie class has chosen to return an error rather than raising an exception if its constructor should fail. While this is how dbmopen() works, @@ -138,30 +138,33 @@ argument: the new value the user is trying to assign. Don't worry about returning a value from STORE; the semantic of assignment returning the assigned value is implemented with FETCH. - sub STORE { - my $self = shift; - confess "wrong type" unless ref $self; - my $new_nicety = shift; - croak "usage error" if @_; - - if ($new_nicety < PRIO_MIN) { - carp sprintf - "WARNING: priority %d less than minimum system priority %d", - $new_nicety, PRIO_MIN if $^W; - $new_nicety = PRIO_MIN; - } - - if ($new_nicety > PRIO_MAX) { - carp sprintf - "WARNING: priority %d greater than maximum system priority %d", - $new_nicety, PRIO_MAX if $^W; - $new_nicety = PRIO_MAX; - } - - unless (defined setpriority(PRIO_PROCESS, $$self, $new_nicety)) { - confess "setpriority failed: $!"; - } - } + sub STORE { + my $self = shift; + confess "wrong type" unless ref $self; + my $new_nicety = shift; + croak "usage error" if @_; + + if ($new_nicety < PRIO_MIN) { + carp sprintf + "WARNING: priority %d less than minimum system priority %d", + $new_nicety, PRIO_MIN if $^W; + $new_nicety = PRIO_MIN; + } + + if ($new_nicety > PRIO_MAX) { + carp sprintf + "WARNING: priority %d greater than maximum system priority %d", + $new_nicety, PRIO_MAX if $^W; + $new_nicety = PRIO_MAX; + } + + unless (defined setpriority(PRIO_PROCESS, + $$self, + $new_nicety)) + { + confess "setpriority failed: $!"; + } + } =item UNTIE this X<UNTIE> @@ -291,17 +294,17 @@ there. In our example, C<undef> is really C<$self-E<gt>{ELEMSIZE}> number of spaces so we have a little more work to do here: - sub STORE { - my $self = shift; - my( $index, $value ) = @_; - if ( length $value > $self->{ELEMSIZE} ) { - croak "length of $value is greater than $self->{ELEMSIZE}"; - } - # fill in the blanks - $self->EXTEND( $index ) if $index > $self->FETCHSIZE(); - # right justify to keep element size for smaller elements - $self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s", $value; - } + sub STORE { + my $self = shift; + my( $index, $value ) = @_; + if ( length $value > $self->{ELEMSIZE} ) { + croak "length of $value is greater than $self->{ELEMSIZE}"; + } + # fill in the blanks + $self->EXTEND( $index ) if $index > $self->FETCHSIZE(); + # right justify to keep element size for smaller elements + $self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s", $value; + } Negative indexes are treated the same as with FETCH. @@ -366,13 +369,13 @@ Verify that the element at index I<key> exists in the tied array I<this>. In our example, we will determine that if an element consists of C<$self-E<gt>{ELEMSIZE}> spaces only, it does not exist: - sub EXISTS { - my $self = shift; - my $index = shift; - return 0 if ! defined $self->{ARRAY}->[$index] || - $self->{ARRAY}->[$index] eq ' ' x $self->{ELEMSIZE}; - return 1; - } + sub EXISTS { + my $self = shift; + my $index = shift; + return 0 if ! defined $self->{ARRAY}->[$index] || + $self->{ARRAY}->[$index] eq ' ' x $self->{ELEMSIZE}; + return 1; + } =item DELETE this, key X<DELETE> @@ -706,19 +709,19 @@ This method is triggered when we remove an element from the hash, typically by using the delete() function. Again, we'll be careful to check whether they really want to clobber files. - sub DELETE { - carp &whowasi if $DEBUG; + sub DELETE { + carp &whowasi if $DEBUG; - my $self = shift; - my $dot = shift; - my $file = $self->{HOME} . "/.$dot"; - croak "@{[&whowasi]}: won't remove file $file" - unless $self->{CLOBBER}; - delete $self->{LIST}->{$dot}; - my $success = unlink($file); - carp "@{[&whowasi]}: can't unlink $file: $!" unless $success; - $success; - } + my $self = shift; + my $dot = shift; + my $file = $self->{HOME} . "/.$dot"; + croak "@{[&whowasi]}: won't remove file $file" + unless $self->{CLOBBER}; + delete $self->{LIST}->{$dot}; + my $success = unlink($file); + carp "@{[&whowasi]}: can't unlink $file: $!" unless $success; + $success; + } The value returned by DELETE becomes the return value of the call to delete(). If you want to emulate the normal behavior of delete(), @@ -736,16 +739,16 @@ In our example, that would remove all the user's dot files! It's such a dangerous thing that they'll have to set CLOBBER to something higher than 1 to make it happen. - sub CLEAR { - carp &whowasi if $DEBUG; - my $self = shift; - croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}" - unless $self->{CLOBBER} > 1; - my $dot; - foreach $dot ( keys %{$self->{LIST}}) { - $self->DELETE($dot); - } - } + sub CLEAR { + carp &whowasi if $DEBUG; + my $self = shift; + croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}" + unless $self->{CLOBBER} > 1; + my $dot; + foreach $dot ( keys %{$self->{LIST}}) { + $self->DELETE($dot); + } + } =item EXISTS this, key X<EXISTS> @@ -770,7 +773,7 @@ to iterate through the hash, such as via a keys(), values(), or each() call. sub FIRSTKEY { carp &whowasi if $DEBUG; my $self = shift; - my $a = keys %{$self->{LIST}}; # reset each() iterator + my $a = keys %{$self->{LIST}}; # reset each() iterator each %{$self->{LIST}} } @@ -904,11 +907,11 @@ X<WRITE> This method will be called when the handle is written to via the C<syswrite> function. - sub WRITE { - $r = shift; - my($buf,$len,$offset) = @_; - print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset"; - } + sub WRITE { + $r = shift; + my($buf,$len,$offset) = @_; + print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset"; + } =item PRINT this, LIST X<PRINT> @@ -917,7 +920,7 @@ This method will be triggered every time the tied handle is printed to with the C<print()> or C<say()> functions. Beyond its self reference it also expects the list that was passed to the print function. - sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ } + sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ } C<say()> acts just like C<print()> except $\ will be localized to C<\n> so you need do nothing special to handle C<say()> in C<PRINT()>. @@ -942,14 +945,14 @@ X<READ> This method will be called when the handle is read from via the C<read> or C<sysread> functions. - sub READ { - my $self = shift; - my $bufref = \$_[0]; - my(undef,$len,$offset) = @_; - print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset"; - # add to $$bufref, set $len to number of characters read - $len; - } + sub READ { + my $self = shift; + my $bufref = \$_[0]; + my(undef,$len,$offset) = @_; + print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset"; + # add to $$bufref, set $len to number of characters read + $len; + } =item READLINE this X<READLINE> @@ -1178,11 +1181,12 @@ UNTIE method is passed the count of "extra" references and can issue its own warning if appropriate. e.g. to replicate the no UNTIE case this method can be used: - sub UNTIE - { - my ($obj,$count) = @_; - carp "untie attempted while $count inner references still exist" if $count; - } + sub UNTIE + { + my ($obj,$count) = @_; + carp "untie attempted while $count inner references still exist" + if $count; + } =head1 SEE ALSO diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 14c0bb9b05..c0c4107b35 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -1,4 +1,4 @@ -# This file is the data file for porting/podcheck.t. +# This file is the data file for t/porting/podcheck.t. # There are three types of lines. # Comment lines are white-space only or begin with a '#', like this one. Any # changes you make to the comment lines will be lost when the file is @@ -29,6 +29,7 @@ B::Utils basename(1) Benchmark::Perl::Formance bind(2) +BSD::Resource ByteLoader bzip2(1) Carp::Always @@ -279,6 +280,7 @@ Text::Soundex Text::Template Text::Unidecode Time::Object +Time::TAI64 Tk Tk::Pod touch(1) @@ -309,22 +311,9 @@ YAML YAML::Syck YAML::Tiny dist/data-dumper/dumper.pm ? Should you be using L<...> instead of 1 -dist/module-corelist/lib/module/corelist.pod Verbatim line length including indents exceeds 79 by 4 -dist/module-corelist/lib/module/corelist/utils.pm Verbatim line length including indents exceeds 79 by 2 -dist/pathtools/lib/file/spec/amigaos.pm Verbatim line length including indents exceeds 79 by 1 -dist/selfloader/lib/selfloader.pm Verbatim line length including indents exceeds 79 by 13 -dist/storable/storable.pm Verbatim line length including indents exceeds 79 by 4 -dist/thread-queue/lib/thread/queue.pm Verbatim line length including indents exceeds 79 by 6 -dist/threads/lib/threads.pm Verbatim line length including indents exceeds 79 by 3 -dist/tie-file/lib/tie/file.pm Verbatim line length including indents exceeds 79 by 3 -dist/time-hires/hires.pm Apparent broken link 2 -dist/time-hires/hires.pm Verbatim line length including indents exceeds 79 by 1 -ext/amiga-arexx/arexx.pm Verbatim line length including indents exceeds 79 by 2 -ext/amiga-exec/exec.pm Verbatim line length including indents exceeds 79 by 2 +ext/amiga-exec/exec.pm Verbatim line length including indents exceeds 79 by 1 ext/devel-peek/peek.pm ? Should you be using L<...> instead of 2 ext/dynaloader/dynaloader.pm Verbatim line length including indents exceeds 79 by 1 -ext/file-find/lib/file/find.pm Verbatim line length including indents exceeds 79 by 1 -ext/file-glob/glob.pm Verbatim line length including indents exceeds 79 by 6 ext/hash-util/lib/hash/util.pm Verbatim line length including indents exceeds 79 by 2 ext/pod-html/testdir/perlpodspec-copy.pod Verbatim line length including indents exceeds 79 by 2 ext/pod-html/testdir/perlvar-copy.pod ? Should you be using L<...> instead of 3 @@ -335,48 +324,33 @@ install ? Should you be using F<...> or maybe L<...> instead of 1 pod/perl.pod Verbatim line length including indents exceeds 79 by 8 pod/perlandroid.pod Verbatim line length including indents exceeds 79 by 3 pod/perlbook.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlcall.pod Verbatim line length including indents exceeds 79 by 2 pod/perlce.pod Verbatim line length including indents exceeds 79 by 3 -pod/perlcygwin.pod Verbatim line length including indents exceeds 79 by 20 pod/perldebguts.pod Verbatim line length including indents exceeds 79 by 27 pod/perldebtut.pod Verbatim line length including indents exceeds 79 by 3 pod/perldtrace.pod Verbatim line length including indents exceeds 79 by 7 pod/perlgit.pod Verbatim line length including indents exceeds 79 by 1 pod/perlguts.pod ? Should you be using L<...> instead of 1 -pod/perlguts.pod Verbatim line length including indents exceeds 79 by 1 pod/perlhack.pod ? Should you be using L<...> instead of 1 pod/perlhist.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlhpux.pod Verbatim line length including indents exceeds 79 by 7 -pod/perlhurd.pod Verbatim line length including indents exceeds 79 by 2 +pod/perlhpux.pod Verbatim line length including indents exceeds 79 by 1 pod/perlinterp.pod ? Should you be using L<...> instead of 1 -pod/perliol.pod Verbatim line length including indents exceeds 79 by 8 -pod/perlipc.pod Verbatim line length including indents exceeds 79 by 19 -pod/perlirix.pod Verbatim line length including indents exceeds 79 by 4 -pod/perllol.pod Verbatim line length including indents exceeds 79 by 4 -pod/perlmacosx.pod Verbatim line length including indents exceeds 79 by 4 +pod/perlirix.pod Verbatim line length including indents exceeds 79 by 1 +pod/perlmacosx.pod Verbatim line length including indents exceeds 79 by 3 pod/perlmodlib.pod Verbatim line length including indents exceeds 79 by 3 -pod/perlmodstyle.pod Verbatim line length including indents exceeds 79 by 1 pod/perlmroapi.pod ? Should you be using L<...> instead of 1 -pod/perlnetware.pod Verbatim line length including indents exceeds 79 by 4 -pod/perlnewmod.pod Verbatim line length including indents exceeds 79 by 1 pod/perlos2.pod ? Should you be using L<...> instead of 2 -pod/perlos2.pod Verbatim line length including indents exceeds 79 by 21 -pod/perlos390.pod Verbatim line length including indents exceeds 79 by 11 -pod/perlperf.pod Verbatim line length including indents exceeds 79 by 122 +pod/perlos2.pod Verbatim line length including indents exceeds 79 by 5 +pod/perlos390.pod Verbatim line length including indents exceeds 79 by 2 +pod/perlperf.pod Verbatim line length including indents exceeds 79 by 114 pod/perlport.pod ? Should you be using L<...> instead of 1 pod/perlrun.pod Verbatim line length including indents exceeds 79 by 3 -pod/perlsolaris.pod Verbatim line length including indents exceeds 79 by 14 -pod/perlsymbian.pod Verbatim line length including indents exceeds 79 by 20 -pod/perltie.pod Verbatim line length including indents exceeds 79 by 13 -pod/perltru64.pod Verbatim line length including indents exceeds 79 by 5 +pod/perlsolaris.pod Verbatim line length including indents exceeds 79 by 13 +pod/perltie.pod Verbatim line length including indents exceeds 79 by 3 +pod/perltru64.pod Verbatim line length including indents exceeds 79 by 1 pod/perlwin32.pod Verbatim line length including indents exceeds 79 by 7 porting/epigraphs.pod Verbatim line length including indents exceeds 79 by 16 -porting/expand-macro.pl Verbatim line length including indents exceeds 79 by 2 porting/release_managers_guide.pod Verbatim line length including indents exceeds 79 by 1 -porting/todo.pod Verbatim line length including indents exceeds 79 by 1 -utils/c2ph Verbatim line length including indents exceeds 79 by 44 utils/encguess There is no NAME 1 lib/benchmark.pm Verbatim line length including indents exceeds 79 by 2 lib/config.pod ? Should you be using L<...> instead of -1 -lib/extutils/embed.pm Verbatim line length including indents exceeds 79 by 2 lib/perl5db.pl ? Should you be using L<...> instead of 1 diff --git a/utils/c2ph.PL b/utils/c2ph.PL index 13389ec075..466223c800 100644 --- a/utils/c2ph.PL +++ b/utils/c2ph.PL @@ -80,7 +80,8 @@ c2ph, pstruct - Dump C structures as generated from C<cc -g -S> stabs Options: -w wide; short for: type_width=45 member_width=35 offset_width=8 - -x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04 + -x hex; short for: offset_fmt=x offset_width=08 size_fmt=x \ + size_width=04 -n do not generate perl code (default when invoked as pstruct) -p generate perl code (default when invoked as c2ph) @@ -119,41 +120,41 @@ the format it is going to massage them into anyway, and spits out listings like this: struct tty { - int tty.t_locker 000 4 - int tty.t_mutex_index 004 4 - struct tty * tty.t_tp_virt 008 4 - struct clist tty.t_rawq 00c 20 - int tty.t_rawq.c_cc 00c 4 - int tty.t_rawq.c_cmax 010 4 - int tty.t_rawq.c_cfx 014 4 - int tty.t_rawq.c_clx 018 4 - struct tty * tty.t_rawq.c_tp_cpu 01c 4 - struct tty * tty.t_rawq.c_tp_iop 020 4 - unsigned char * tty.t_rawq.c_buf_cpu 024 4 - unsigned char * tty.t_rawq.c_buf_iop 028 4 - struct clist tty.t_canq 02c 20 - int tty.t_canq.c_cc 02c 4 - int tty.t_canq.c_cmax 030 4 - int tty.t_canq.c_cfx 034 4 - int tty.t_canq.c_clx 038 4 - struct tty * tty.t_canq.c_tp_cpu 03c 4 - struct tty * tty.t_canq.c_tp_iop 040 4 - unsigned char * tty.t_canq.c_buf_cpu 044 4 - unsigned char * tty.t_canq.c_buf_iop 048 4 - struct clist tty.t_outq 04c 20 - int tty.t_outq.c_cc 04c 4 - int tty.t_outq.c_cmax 050 4 - int tty.t_outq.c_cfx 054 4 - int tty.t_outq.c_clx 058 4 - struct tty * tty.t_outq.c_tp_cpu 05c 4 - struct tty * tty.t_outq.c_tp_iop 060 4 - unsigned char * tty.t_outq.c_buf_cpu 064 4 - unsigned char * tty.t_outq.c_buf_iop 068 4 - (*int)() tty.t_oproc_cpu 06c 4 - (*int)() tty.t_oproc_iop 070 4 - (*int)() tty.t_stopproc_cpu 074 4 - (*int)() tty.t_stopproc_iop 078 4 - struct thread * tty.t_rsel 07c 4 + int tty.t_locker 000 4 + int tty.t_mutex_index 004 4 + struct tty * tty.t_tp_virt 008 4 + struct clist tty.t_rawq 00c 20 + int tty.t_rawq.c_cc 00c 4 + int tty.t_rawq.c_cmax 010 4 + int tty.t_rawq.c_cfx 014 4 + int tty.t_rawq.c_clx 018 4 + struct tty * tty.t_rawq.c_tp_cpu 01c 4 + struct tty * tty.t_rawq.c_tp_iop 020 4 + unsigned char * tty.t_rawq.c_buf_cpu 024 4 + unsigned char * tty.t_rawq.c_buf_iop 028 4 + struct clist tty.t_canq 02c 20 + int tty.t_canq.c_cc 02c 4 + int tty.t_canq.c_cmax 030 4 + int tty.t_canq.c_cfx 034 4 + int tty.t_canq.c_clx 038 4 + struct tty * tty.t_canq.c_tp_cpu 03c 4 + struct tty * tty.t_canq.c_tp_iop 040 4 + unsigned char * tty.t_canq.c_buf_cpu 044 4 + unsigned char * tty.t_canq.c_buf_iop 048 4 + struct clist tty.t_outq 04c 20 + int tty.t_outq.c_cc 04c 4 + int tty.t_outq.c_cmax 050 4 + int tty.t_outq.c_cfx 054 4 + int tty.t_outq.c_clx 058 4 + struct tty * tty.t_outq.c_tp_cpu 05c 4 + struct tty * tty.t_outq.c_tp_iop 060 4 + unsigned char * tty.t_outq.c_buf_cpu 064 4 + unsigned char * tty.t_outq.c_buf_iop 068 4 + (*int)() tty.t_oproc_cpu 06c 4 + (*int)() tty.t_oproc_iop 070 4 + (*int)() tty.t_stopproc_cpu 074 4 + (*int)() tty.t_stopproc_iop 078 4 + struct thread * tty.t_rsel 07c 4 etc. @@ -202,7 +203,7 @@ them in terms of packages and functions. Consider the following program: $ru = "\0" x &rusage'sizeof(); - syscall(&SYS_getrusage, &RUSAGE_SELF, $ru) && die "getrusage: $!"; + syscall(&SYS_getrusage, &RUSAGE_SELF, $ru) && die "getrusage: $!"; @ru = unpack($t = &rusage'typedef(), $ru); @@ -219,47 +220,46 @@ As you see, the name of the package is the name of the structure. Regular fields are just their own names. Plus the following accessor functions are provided for your convenience: - struct This takes no arguments, and is merely the number of first-level - elements in the structure. You would use this for indexing - into arrays of structures, perhaps like this + struct This takes no arguments, and is merely the number of first- + level elements in the structure. You would use this for + indexing into arrays of structures, perhaps like this + $usec = $u[ &user'u_utimer + + (&ITIMER_VIRTUAL * &itimerval'struct) + + &itimerval'it_value + + &timeval'tv_usec + ]; - $usec = $u[ &user'u_utimer - + (&ITIMER_VIRTUAL * &itimerval'struct) - + &itimerval'it_value - + &timeval'tv_usec - ]; + sizeof Returns the bytes in the structure, or the member if + you pass it an argument, such as - sizeof Returns the bytes in the structure, or the member if - you pass it an argument, such as + &rusage'sizeof(&rusage'ru_utime) - &rusage'sizeof(&rusage'ru_utime) + typedef This is the perl format definition for passing to pack and + unpack. If you ask for the typedef of a nothing, you get + the whole structure, otherwise you get that of the member + you ask for. Padding is taken care of, as is the magic to + guarantee that a union is unpacked into all its aliases. + Bitfields are not quite yet supported however. - typedef This is the perl format definition for passing to pack and - unpack. If you ask for the typedef of a nothing, you get - the whole structure, otherwise you get that of the member - you ask for. Padding is taken care of, as is the magic to - guarantee that a union is unpacked into all its aliases. - Bitfields are not quite yet supported however. + offsetof This function is the byte offset into the array of that + member. You may wish to use this for indexing directly + into the packed structure with vec() if you're too lazy + to unpack it. - offsetof This function is the byte offset into the array of that - member. You may wish to use this for indexing directly - into the packed structure with vec() if you're too lazy - to unpack it. - - typeof Not to be confused with the typedef accessor function, this - one returns the C type of that field. This would allow - you to print out a nice structured pretty print of some - structure without knoning anything about it beforehand. - No args to this one is a noop. Someday I'll post such - a thing to dump out your u structure for you. + typeof Not to be confused with the typedef accessor function, this + one returns the C type of that field. This would allow + you to print out a nice structured pretty print of some + structure without knoning anything about it beforehand. + No args to this one is a noop. Someday I'll post such + a thing to dump out your u structure for you. The way I see this being used is like basically this: - % h2ph <some_include_file.h > /usr/lib/perl/tmp.ph - % c2ph some_include_file.h >> /usr/lib/perl/tmp.ph - % install + % h2ph <some_include_file.h > /usr/lib/perl/tmp.ph + % c2ph some_include_file.h >> /usr/lib/perl/tmp.ph + % install It's a little tricker with c2ph because you have to get the includes right. I can't know this for your system, but it's not usually too terribly difficult. |