diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-21 12:25:58 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-21 12:25:58 +0000 |
commit | 225a5dca523a9706687cc7849f9ef644967ae510 (patch) | |
tree | e8823f53fbf3b824544750b25db712cfb52a9d6d /NetWare | |
parent | 84037bb083599c663af466e6d56eeb23fdebad94 (diff) | |
download | perl-225a5dca523a9706687cc7849f9ef644967ae510.tar.gz |
NetWare tweaks from Guruprasad.
p4raw-id: //depot/perl@10775
Diffstat (limited to 'NetWare')
-rw-r--r-- | NetWare/Makefile | 114 | ||||
-rw-r--r-- | NetWare/Nwmain.c | 6 | ||||
-rw-r--r-- | NetWare/config.wc | 2 | ||||
-rw-r--r-- | NetWare/config_H.wc | 194 | ||||
-rw-r--r-- | NetWare/nw5sck.c | 6 | ||||
-rw-r--r-- | NetWare/nw5sck.h | 1 | ||||
-rw-r--r-- | NetWare/nwperlsys.c | 6 | ||||
-rw-r--r-- | NetWare/t/NWModify.pl | 22 | ||||
-rw-r--r-- | NetWare/t/NWScripts.pl | 199 | ||||
-rw-r--r-- | NetWare/t/Readme.txt | 42 |
10 files changed, 429 insertions, 163 deletions
diff --git a/NetWare/Makefile b/NetWare/Makefile index a5a51f3093..091482858e 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -15,7 +15,7 @@ ## This file is created by using the makefile that creates Windows Perl as the reference ## Author: sgp ## Date Created: 13th July 2000 -## Date Modified: 19th June 2001 +## Date Modified: 03th April 2001 # Name of the NLM NLM_NAME = perl.nlm @@ -273,6 +273,11 @@ RE_NLP = $(AUTODIR)\re\re.nlp BYTELOADER_NLP = $(AUTODIR)\ByteLoader\ByteLoader.nlp DPROF_NLP = $(AUTODIR)\Devel\DProf\DProf.nlp GLOB_NLP = $(AUTODIR)\File\Glob\Glob.nlp +CWD_NLP = $(AUTODIR)\Cwd\Cwd.nlp +STORABLE_NLP = $(AUTODIR)\Storable\Storable.nlp +LISTUTIL_NLP = $(AUTODIR)\List\Util\Util.nlp +MIMEBASE64_NLP = $(AUTODIR)\MIME\Base64\Base64.nlp +XSTYPEMAP_NLP = $(AUTODIR)\XS\Typemap\Typemap.nlp EXTENSION_NLP = \ $(FCNTL_NLP) \ @@ -289,7 +294,13 @@ EXTENSION_NLP = \ $(GLOB_NLP) \ $(PEEK_NLP) \ $(RE_NLP) \ - $(DPROF_NLP) + $(DPROF_NLP) \ + $(STORABLE_NLP) \ + $(LISTUTIL_NLP) \ + $(MIMEBASE64_NLP) \ + $(XSTYPEMAP_NLP) \ +# $(CWD_NLP) \ +# cwd.pm needs to be modifed for NetWare. # Begin - Following is required to build NetWare specific extensions Perl2UCS & CGI2Perl @@ -686,36 +697,36 @@ XSUBPP = ..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ -C++ -prototypes MICROCORE_SRC = \ - ..\av.c \ - ..\deb.c \ - ..\doio.c \ - ..\doop.c \ - ..\dump.c \ + ..\av.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ ..\globals.c \ - ..\gv.c \ - ..\hv.c \ - ..\locale.c \ - ..\mg.c \ + ..\gv.c \ + ..\hv.c \ + ..\locale.c \ + ..\mg.c \ ..\numeric.c \ - ..\op.c \ - ..\perl.c \ + ..\op.c \ + ..\perl.c \ ..\perlapi.c \ - ..\perly.c \ - ..\pp.c \ - ..\pp_ctl.c \ - ..\pp_hot.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ ..\pp_pack.c \ - ..\pp_sys.c \ + ..\pp_sys.c \ ..\regcomp.c \ ..\regexec.c \ - ..\run.c \ - ..\scope.c \ - ..\sv.c \ - ..\taint.c \ - ..\toke.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.c \ ..\universal.c \ - ..\utf8.c \ - ..\util.c \ + ..\utf8.c \ + ..\util.c \ ..\xsutils.c #EXTRACORE_SRC = $(EXTRACORE_SRC) perllib.c @@ -805,6 +816,11 @@ PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf GLOB = $(EXTDIR)\File\Glob\Glob +CWD = $(EXTDIR)\Cwd\Cwd +STORABLE = $(EXTDIR)\Storable\Storable +LISTUTIL = $(EXTDIR)\List\Util +MIMEBASE64 = $(EXTDIR)\MIME\Base64\Base64 +XSTYPEMAP = $(EXTDIR)\XS\Typemap\Typemap EXTENSION_C = \ $(SOCKET).c \ @@ -821,7 +837,12 @@ EXTENSION_C = \ $(B).c \ $(BYTELOADER).c \ $(DPROF).c \ - $(GLOB).c + $(GLOB).c \ + $(CWD).c \ + $(STORABLE).c \ + $(LISTUTIL).c \ + $(MIMEBASE64).c \ + $(XSTYPEMAP).c \ POD2HTML = $(PODDIR)\pod2html POD2MAN = $(PODDIR)\pod2man @@ -1264,6 +1285,36 @@ $(SDBM_FILE_NLP): $(MAKE) cd ..\..\netware +$(CWD_NLP): + cd $(EXTDIR)\$(*B) + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\netware + +$(STORABLE_NLP): + cd $(EXTDIR)\$(*B) + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\netware + +$(LISTUTIL_NLP): + cd $(EXTDIR)\List\$(*B) + ..\..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\netware + +$(MIMEBASE64_NLP): + cd $(EXTDIR)\Mime\$(*B) + ..\..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\netware + +$(XSTYPEMAP_NLP): + cd $(EXTDIR)\XS\$(*B) + ..\..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\netware + $(ERRNO_PM_NW): cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl @@ -1442,7 +1493,16 @@ install : utils installwin installnw: $(MINIPERL) -I..\lib ..\installperl -netware -nwinstall: utils installnw +install_tests : + cd ..\t + xcopy /f /r /i /s /d *.* $(INST_NW_TOP2)\scripts\t + cd ..\lib + xcopy /f /r /i /s /d *.t $(INST_NW_TOP2)\scripts\t\lib + cd ..\ext + xcopy /f /r /i /s /d *.t $(INST_NW_TOP2)\scripts\t\ext + cd ..\netware + +nwinstall: utils installnw install_tests inst_lib : $(CONFIGPM) copy ..\win32\splittree.pl .. diff --git a/NetWare/Nwmain.c b/NetWare/Nwmain.c index a01fa5efdd..c6cea84438 100644 --- a/NetWare/Nwmain.c +++ b/NetWare/Nwmain.c @@ -1386,10 +1386,8 @@ char *** nw_getenviron() { if (genviron) - // This (and not the next line) is the correct operation since it matches with the return type. - // But it is leaking memory upto 11736 bytes!! So it is commented. -// return (&genviron); - return genviron; + return (&genviron); // This might leak memory upto 11736 bytes on some versions of NetWare. +// return genviron; // Abending on some versions of NetWare. else fnSetUpEnvBlock(&genviron); diff --git a/NetWare/config.wc b/NetWare/config.wc index 8f2d024859..1a55ef5ecf 100644 --- a/NetWare/config.wc +++ b/NetWare/config.wc @@ -464,7 +464,7 @@ i_sysdir='undef' i_sysfile='undef' i_sysfilio='define' i_sysin='undef' -i_sysioctl='undef' +i_sysioctl='define' i_syslog='undef' i_sysmman='undef' i_sysmode='undef' diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index bea1761422..93dd24f02d 100644 --- a/NetWare/config_H.wc +++ b/NetWare/config_H.wc @@ -13,7 +13,7 @@ /* * Package name : perl5 * Source directory : - * Configuration time: Wed Jun 6 09:31:53 2001 + * Configuration time: Thu Jun 21 17:44:02 2001 * Configured by : Administrator * Target system : */ @@ -121,26 +121,6 @@ */ #define HAS_DLERROR /**/ -/* SETUID_SCRIPTS_ARE_SECURE_NOW: - * This symbol, if defined, indicates that the bug that prevents - * setuid scripts from being secure is not present in this kernel. - */ -/* DOSUID: - * This symbol, if defined, indicates that the C program should - * check the script that it is executing for setuid/setgid bits, and - * attempt to emulate setuid/setgid on systems that have disabled - * setuid #! scripts because the kernel can't do it securely. - * It is up to the package designer to make sure that this emulation - * is done securely. Among other things, it should do an fstat on - * the script it just opened to make sure it really is a setuid/setgid - * script, it should make sure the arguments passed correspond exactly - * to the argument on the #! line, and it should not trust any - * subprocesses to which it must pass the filename rather than the - * file descriptor of the script to be executed. - */ -/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/ -/*#define DOSUID /**/ - /* HAS_DUP2: * This symbol, if defined, indicates that the dup2 routine is * available to duplicate file descriptors. @@ -822,7 +802,7 @@ * to get socket ioctl options, like SIOCATMARK. */ #define I_SYS_IOCTL /**/ - +#define I_SYS_SOCKIO /**/ /* I_SYS_NDIR: * This symbol, if defined, indicates to the C program that it should @@ -918,17 +898,6 @@ */ /*#define I_VALUES /**/ -/* I_STDARG: - * This symbol, if defined, indicates that <stdarg.h> exists and should - * be included. - */ -/* I_VARARGS: - * This symbol, if defined, indicates to the C program that it should - * include <varargs.h>. - */ -#define I_STDARG /**/ -/*#define I_VARARGS /**/ - /* I_VFORK: * This symbol, if defined, indicates to the C program that it should * include vfork.h. @@ -962,12 +931,6 @@ */ #define SH_PATH "cmd /x /c" /**/ -/* CROSSCOMPILE: - * This symbol, if defined, signifies that we our - * build process is a cross-compilation. - */ -/*#define CROSSCOMPILE /**/ - /* INTSIZE: * This symbol contains the value of sizeof(int) so that the C * preprocessor can make decisions based on it. @@ -1038,14 +1001,20 @@ * by Configure. You shouldn't rely on it too much; the specific * feature tests from Configure are generally more reliable. */ +/* OSVERS: + * This symbol contains the version of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ #define OSNAME "NetWare" /**/ +#define OSVERS "5.x" /**/ /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double, or a long double when applicable. Usual values are 2, * 4 and 8. The default is eight, for safety. */ -#if defined(CROSSCOMPILE) || defined(MULTIARCH) +#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH) # define MEM_ALIGNBYTES 8 #else #define MEM_ALIGNBYTES 8 @@ -1122,7 +1091,7 @@ * so the default case (for NeXT) is big endian to catch them. * This might matter for NeXT 3.0. */ -#if defined(CROSSCOMPILE) || defined(MULTIARCH) +#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH) # ifdef __LITTLE_ENDIAN__ # if LONGSIZE == 4 # define BYTEORDER 0x1234 @@ -1770,7 +1739,15 @@ * available to split a long double x into a fractional part f and * an integer part i such that |f| < 1.0 and (f + i) = x. */ +/* HAS_MODFL_POW32_BUG: + * This symbol, if defined, indicates that the modfl routine is + * broken for long doubles >= pow(2, 32). + * For example from 4294967303.150000 one would get 4294967302.000000 + * and 1.150000. The bug has been seen in certain versions of glibc, + * release 2.2.2 is known to be okay. + */ /*#define HAS_MODFL /**/ +/*#define HAS_MODFL_POW32_BUG /**/ /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is @@ -2401,8 +2378,25 @@ * in the <db.h> header file. In older versions of DB, it was * int, while in newer ones it is size_t. */ +/* DB_VERSION_MAJOR_CFG: + * This symbol, if defined, defines the major version number of + * Berkeley DB found in the <db.h> header when Perl was configured. + */ +/* DB_VERSION_MINOR_CFG: + * This symbol, if defined, defines the minor version number of + * Berkeley DB found in the <db.h> header when Perl was configured. + * For DB version 1 this is always 0. + */ +/* DB_VERSION_PATCH_CFG: + * This symbol, if defined, defines the patch version number of + * Berkeley DB found in the <db.h> header when Perl was configured. + * For DB version 1 this is always 0. + */ #define DB_Hash_t int /**/ #define DB_Prefix_t int /**/ +#define DB_VERSION_MAJOR_CFG undef /**/ +#define DB_VERSION_MINOR_CFG undef /**/ +#define DB_VERSION_PATCH_CFG undef /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should @@ -3212,12 +3206,18 @@ * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ +/* USE_REENTRANT_API: + * This symbol, if defined, indicates that Perl should + * try to use the various _r versions of library functions. + * This is extremely experimental. + */ /*#define USE_5005THREADS /**/ #define USE_ITHREADS /**/ #if defined(USE_5005THREADS) && !defined(USE_ITHREADS) #define USE_THREADS /* until src is revised*/ #endif /*#define OLD_PTHREADS_API /**/ +/*#define USE_REENTRANT_API /**/ /* PERL_VENDORARCH: * If defined, this symbol contains the name of a private library. @@ -3309,6 +3309,71 @@ #define PERL_XS_APIVERSION "5.6.0" #define PERL_PM_APIVERSION "5.005" +/* SETUID_SCRIPTS_ARE_SECURE_NOW: + * This symbol, if defined, indicates that the bug that prevents + * setuid scripts from being secure is not present in this kernel. + */ +/* DOSUID: + * This symbol, if defined, indicates that the C program should + * check the script that it is executing for setuid/setgid bits, and + * attempt to emulate setuid/setgid on systems that have disabled + * setuid #! scripts because the kernel can't do it securely. + * It is up to the package designer to make sure that this emulation + * is done securely. Among other things, it should do an fstat on + * the script it just opened to make sure it really is a setuid/setgid + * script, it should make sure the arguments passed correspond exactly + * to the argument on the #! line, and it should not trust any + * subprocesses to which it must pass the filename rather than the + * file descriptor of the script to be executed. + */ +/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/ +/*#define DOSUID /**/ + +/* I_STDARG: + * This symbol, if defined, indicates that <stdarg.h> exists and should + * be included. + */ +/* I_VARARGS: + * This symbol, if defined, indicates to the C program that it should + * include <varargs.h>. + */ +#define I_STDARG /**/ +/*#define I_VARARGS /**/ + +/* USE_CROSS_COMPILE: + * This symbol, if defined, indicates that Perl is being cross-compiled. + */ +/* PERL_TARGETARCH: + * This symbol, if defined, indicates the target architecture + * Perl has been cross-compiled to. Undefined if not a cross-compile. + */ +#ifndef USE_CROSS_COMPILE +/*#define USE_CROSS_COMPILE /**/ +#define PERL_TARGETARCH "undef" /**/ +#endif + +/* HAS_DBMINIT_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the dbminit() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int dbminit(char *); + */ +/*#define HAS_DBMINIT_PROTO /**/ + +/* HAS_FLOCK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the flock() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int flock(int, int); + */ +/*#define HAS_FLOCK_PROTO /**/ + +/* HAS_REALPATH: + * This symbol, if defined, indicates that the realpath routine is + * available to do resolve paths. + */ +/*#define HAS_REALPATH /**/ + /* HAS_SIGPROCMASK: * This symbol, if defined, indicates that the sigprocmask * system call is available to examine or change the signal mask @@ -3322,10 +3387,57 @@ */ /*#define HAS_SOCKATMARK /**/ +/* HAS_SOCKATMARK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the sockatmark() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int sockatmark _((int)); + */ +/*#define HAS_SOCKATMARK_PROTO /**/ + +/* HAS_SETRESGID_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the setresgid() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int setresgid(uid_t ruid, uid_t euid, uid_t suid); + */ +/*#define HAS_SETRESGID_PROTO /**/ + +/* HAS_SETRESUID_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the setresuid() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid); + */ +/*#define HAS_SETRESUID_PROTO /**/ + +/* HAS_STRFTIME: + * This symbol, if defined, indicates that the strftime routine is + * available to do time formatting. + */ +/*#define HAS_STRFTIME /**/ + +/* HAS_SYSCALL_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the syscall() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern int syscall(int, ...); + * extern int syscall(long, ...); + */ +/*#define HAS_SYSCALL_PROTO /**/ + /* U32_ALIGNMENT_REQUIRED: * This symbol, if defined, indicates that you must access * character data through U32-aligned pointers. */ /*#define U32_ALIGNMENT_REQUIRED /**/ +/* HAS_USLEEP_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the usleep() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern int usleep(useconds_t); + */ +/*#define HAS_USLEEP_PROTO /**/ + #endif diff --git a/NetWare/nw5sck.c b/NetWare/nw5sck.c index 8985f0c880..0f6c7369bf 100644 --- a/NetWare/nw5sck.c +++ b/NetWare/nw5sck.c @@ -226,6 +226,12 @@ nw_setservent(int stayopen) } int +nw_setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen) +{ + return setsockopt(s, level, optname, optval, optlen); +} + +int nw_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen) { return getsockname(s, addr, addrlen); diff --git a/NetWare/nw5sck.h b/NetWare/nw5sck.h index 1b0bc51bb5..4216dc81a2 100644 --- a/NetWare/nw5sck.h +++ b/NetWare/nw5sck.h @@ -98,6 +98,7 @@ void nw_sethostent(int stayopen); void nw_setnetent(int stayopen); void nw_setprotoent(int stayopen); void nw_setservent(int stayopen); +int nw_setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen); int nw_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen); int nw_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen); diff --git a/NetWare/nwperlsys.c b/NetWare/nwperlsys.c index b4406299fb..90b77a9c80 100644 --- a/NetWare/nwperlsys.c +++ b/NetWare/nwperlsys.c @@ -512,7 +512,7 @@ PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer) int PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) { - return 0; + return ioctl(i, (int) u, (void *) data); } int @@ -1163,9 +1163,7 @@ PerlSockSetservent(struct IPerlSock* piPerl, int stayopen) int PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen) { - dTHXo; - Perl_croak(aTHX_ "setsockopt not implemented!\n"); - return 0; + return nw_setsockopt(s, level, optname, optval, optlen); } int diff --git a/NetWare/t/NWModify.pl b/NetWare/t/NWModify.pl index 12521d7516..2b1d07beb8 100644 --- a/NetWare/t/NWModify.pl +++ b/NetWare/t/NWModify.pl @@ -5,28 +5,28 @@ print "\nModifying the '.t' files...\n\n"; use File::Basename; use File::Copy; -## Change the below line to the directory you want to process +## Change the below line to the folder you want to process $DirName = "/perl/scripts/t"; $FilesTotal = 0; $FilesRead = 0; $FilesModified = 0; -opendir(DIR, $DirName) or die "Unable to open the directory, $DirName for reading.\n"; +opendir(DIR, $DirName); @Dirs = readdir(DIR); foreach $DirItem(@Dirs) { $DirItem = $DirName."/".$DirItem; - push @DirNames, $DirItem; # All items under $DirName directory is copied into an array. + push @DirNames, $DirItem; # All items under $DirName folder is copied into an array. } foreach $FileName(@DirNames) { if(-d $FileName) - { # If an item is a directory, then open it further. + { # If an item is a folder, then open it further. - opendir(SUBDIR, $FileName) or die "Unable to open the directory, $FileName for reading.\n"; + opendir(SUBDIR, $FileName); @SubDirs = readdir(SUBDIR); close(SUBDIR); @@ -39,7 +39,7 @@ foreach $FileName(@DirNames) else { $SubFileName = $FileName."/".$SubFileName; - push @DirNames, $SubFileName; # If sub-directory, push it into the array. + push @DirNames, $SubFileName; # If sub-folder, push it into the array. } } } @@ -67,21 +67,19 @@ sub Process_File local($FileToProcess) = @_; # File name. local($Modified) = 0; - if(!(-w $FileToProcess)) { # If the file is a read-only file, then change its mode to read-write. chmod(0777, $FileToProcess); } - - $base = basename($FileToProcess); # Get the base name - $dir = dirname($FileToProcess); # Get the directory name - ($base, $dir, $ext) = fileparse($FileToProcess, '\..*'); # Get the extension of the file passed. - + ## For example: ## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then ## $dir = '/perl/scripts/t/pragma/' ## $base = 'warnings' ## $ext = '.t' + $dir = dirname($FileToProcess); # Get the folder name + $base = basename($FileToProcess); # Get the base name + ($base, $dir, $ext) = fileparse($FileToProcess, '\..*'); # Get the extension of the file passed. # Do the processing only if the file has '.t' extension. diff --git a/NetWare/t/NWScripts.pl b/NetWare/t/NWScripts.pl index 36ca8ecb25..dc43ddef22 100644 --- a/NetWare/t/NWScripts.pl +++ b/NetWare/t/NWScripts.pl @@ -9,99 +9,188 @@ use File::Copy; chdir '/perl/scripts/'; $DirName = "t"; - # These scripts have problems (either abend or hang) as of now (11 May 2001). # So, they are commented out in the corresponding auto scripts, io.pl and lib.pl -@ScriptsNotUsed = ("t/io/argv.t", "t/io/openpid.t", "t/lib/filehand.t"); +@ScriptsNotUsed = ("t/io/argv.t", "t/io/openpid.t", "t/lib/filehandle.t"); +opendir(DIR, $DirName); +@Dirs = readdir(DIR); +close(DIR); +foreach $DirItem(@Dirs) +{ + $DirItem1 = $DirName."/".$DirItem; + push @DirNames, $DirItem1; # All items under $DirName folder is copied into an array. -print "Generating t/auto.pl ...\n\n\n"; + if(-d $DirItem1) + { # If an item is a folder, then open it further. -open(FHWA, "> t/auto.pl") or die "Unable to open the file, t/auto.pl for writing.\n"; -seek(FHWA, 0 ,0); -flock(FHWA, LOCK_EX); # Lock the file for safety purposes. + # Intemediary automated script like base.pl, lib.pl, cmd.pl etc. + $IntAutoScript = "t/".$DirItem.".pl"; -$version = sprintf("%vd",$^V); -print FHWA "\n\nprint \"Automated Unit Testing of Perl$version\\n\\n\\n\"\;\n\n\n"; + # Open once in write mode since later files are opened in append mode, + # and if there already exists a file with the same name, all further opens + # will append to that file!! + open(FHW, "> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for writing.\n"; + seek(FHW, 0, 0); # seek to the beginning of the file. + close FHW; # close the file. + } +} -opendir(DIR, $DirName) or die "Unable to open the directory, $DirName for reading.\n"; -@Dirs = readdir(DIR); +print "Generating t/nwauto.pl ...\n\n\n"; + +open(FHWA, "> t/nwauto.pl") or die "Unable to open the file, t/nwauto.pl for writing.\n"; +seek(FHWA, 0, 0); # seek to the beginning of the file. +flock(FHWA, LOCK_EX); # Lock the file for safety purposes. + +$version = sprintf("%vd",$^V); +print FHWA "\n\nprint \"Automated Unit Testing of Perl$version for NetWare\\n\\n\\n\"\;\n\n\n"; -foreach $DirItem(@Dirs) -{ - $DirItem = $DirName."/".$DirItem; - push @DirNames, $DirItem; # All items under $DirName directory is copied into an array. -} foreach $FileName(@DirNames) { + $index = 0; if(-d $FileName) - { # If an item is a directory, then open it further. + { # If an item is a folder, then open it further. - opendir(SUBDIR, $FileName) or die "Unable to open the directory, $FileName for reading.\n"; - @SubDirs = readdir(SUBDIR); - close(SUBDIR); - - - $base = basename($FileName); # Get the base name - $dir = dirname($FileName); # Get the directory name - ($base, $dir, $ext) = fileparse($FileName, '\..*'); # Get the extension of the file passed. - - # Intemediary automated script like base.pl, lib.pl, cmd.pl etc. - $IntAutoScript = "t/".$base.".pl"; + $dir = dirname($FileName); # Get the folder name + foreach $DirItem1(@Dirs) + { + $DirItem2 = $DirItem1; + if($FileName =~ m/$DirItem2/) + { + $DirItem = $DirItem1; - # Write into auto.pl - print FHWA "print \`perl $IntAutoScript\`\;\n"; - print FHWA "print \"\\n\\n\\n\"\;\n\n"; + # Intemediary automated script like base.pl, lib.pl, cmd.pl etc. + $IntAutoScript = "t/".$DirItem.".pl"; + } + } - - print "Generating $IntAutoScript...\n"; # Write into the intermediary auto script. - open(FHW, "> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for writing.\n"; - seek(FHW, 0 ,0); + open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n"; + seek(FHW, 0, 2); # seek to the end of the file. flock(FHW, LOCK_EX); # Lock the file for safety purposes. - print FHW "\n\nprint \"Testing $base directory:\\n\\n\\n\"\;\n\n\n"; - + $pos = tell(FHW); + if($pos <= 0) + { + print "Generating $IntAutoScript...\n"; + print FHW "\n\nprint \"Testing $DirItem folder:\\n\\n\\n\"\;\n\n\n"; + } + opendir(SUBDIR, $FileName); + @SubDirs = readdir(SUBDIR); + close(SUBDIR); foreach $SubFileName(@SubDirs) { + $SubFileName = $FileName."/".$SubFileName; if(-d $SubFileName) { - $SubFileName = $FileName."/".$SubFileName; - push @DirNames, $SubFileName; # If sub-directory, push it into the array. + push @DirNames, $SubFileName; # If sub-folder, push it into the array. } else { - $SubFileName = $FileName."/".$SubFileName; &Process_File($SubFileName); # If file, process it. } - } - # Write into the intermediary auto script. - print FHW "\nprint \"Testing of $base directory done!\\n\\n\"\;\n\n"; + $index++; + } flock(FHW, LOCK_UN); # unlock the file. close FHW; # close the file. - print "$IntAutoScript Done!\n\n"; + + if($index <= 0) + { + # The folder is empty and delete the corresponding '.pl' file. + unlink($IntAutoScript); + print "Deleted $IntAutoScript since it corresponded to an empty folder.\n"; + } + else + { + if($pos <= 0) + { # This logic to make sure that it is written only once. + # Only if something is written into the intermediary auto script, + # only then make an entry of the intermediary auto script in nwauto.pl + print FHWA "print \`perl $IntAutoScript\`\;\n"; + print FHWA "print \"\\n\\n\\n\"\;\n\n"; + } + } + } + else + { + if(-f $FileName) + { + $dir = dirname($FileName); # Get the folder name + $base = basename($FileName); # Get the base name + ($base, $dir, $ext) = fileparse($FileName, '\..*'); # Get the extension of the file passed. + + # Do the processing only if the file has '.t' extension. + if($ext eq '.t') + { + print FHWA "print \`perl $FileName\`\;\n"; + print FHWA "print \"\\n\\n\\n\"\;\n\n"; + } + } } } + +## Below adds the ending comments into all the intermediary auto scripts: + +opendir(DIR, $DirName); +@Dirs = readdir(DIR); close(DIR); +foreach $DirItem(@Dirs) +{ + $index = 0; + + $FileName = $DirName."/".$DirItem; + if(-d $FileName) + { # If an item is a folder, then open it further. + opendir(SUBDIR, $FileName); + @SubDirs = readdir(SUBDIR); + close(SUBDIR); -# Write into auto.pl -print FHWA "\nprint \"Automated Unit Testing of Perl$version done!\\n\\n\"\;\n\n"; + # To not to write into the file if the corresponding folder was empty. + foreach $SubDir(@SubDirs) + { + $index++; + } + + if($index > 0) + { + # The folder not empty. + + # Intemediary automated script like base.pl, lib.pl, cmd.pl etc. + $IntAutoScript = "t/".$DirItem.".pl"; + + # Write into the intermediary auto script. + open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n"; + seek(FHW, 0, 2); # seek to the end of the file. + flock(FHW, LOCK_EX); # Lock the file for safety purposes. + + # Write into the intermediary auto script. + print FHW "\nprint \"Testing of $DirItem folder done!\\n\\n\"\;\n\n"; + + flock(FHW, LOCK_UN); # unlock the file. + close FHW; # close the file. + } + } +} + + +# Write into nwauto.pl +print FHWA "\nprint \"Automated Unit Testing of Perl$version for NetWare done!\\n\\n\"\;\n\n"; flock(FHWA, LOCK_UN); # unlock the file. close FHWA; # close the file. -print "\nt/auto.pl Done!\n\n"; +print "\n\nGeneration of t/nwauto.pl Done!\n\n"; +print "\nGeneration of automated scripts for NetWare DONE!\n"; -print "\nGeneration of automated scripts for NetWare DONE!\n"; @@ -112,23 +201,25 @@ sub Process_File local($Script) = 0; local($HeadCut) = 0; - - $base1 = basename($FileToProcess); # Get the base name - $dir1 = dirname($FileToProcess); # Get the directory name - ($base1, $dir1, $ext1) = fileparse($FileToProcess, '\..*'); # Get the extension of the file passed. - + ## For example: ## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then ## $dir1 = '/perl/scripts/t/pragma/' ## $base1 = 'warnings' ## $ext1 = '.t' - + $dir1 = dirname($FileToProcess); # Get the folder name + $base1 = basename($FileToProcess); # Get the base name + ($base1, $dir1, $ext1) = fileparse($FileToProcess, '\..*'); # Get the extension of the file passed. # Do the processing only if the file has '.t' extension. if($ext1 eq '.t') { foreach $Script(@ScriptsNotUsed) { - if($Script eq $FileToProcess) + # The variables are converted to lower case before they are compared. + # This is done to remove the case-sensitive comparison done by 'eq'. + $Script1 = lc($Script); + $FileToProcess1 = lc($FileToProcess); + if($Script1 eq $FileToProcess1) { $HeadCut = 1; } diff --git a/NetWare/t/Readme.txt b/NetWare/t/Readme.txt index 148fa2dbda..6f82a3f9c1 100644 --- a/NetWare/t/Readme.txt +++ b/NetWare/t/Readme.txt @@ -1,40 +1,45 @@ - Automated Testing of Perl5.6.1 Interpreter for NetWare. + Automated Testing of Perl5 Interpreter for NetWare. -A set of Standard Unit Test Scripts to test all the functionalities of Perl 5.6.1 Interpreter are available along with the CPAN download. They are all located under 't' folder. These include sub-folders under 't' folder: 'base', 'cmd', 'comp', 'io', lib', 'op', 'pod', 'pragma', 'run'. Each of these sub-folders contain few test scripts ('.t' files) under them. +A set of Standard Unit Test Scripts to test all the functionalities of Perl5 Interpreter are available along with the CPAN download. They are all located under 't' folder. These include sub-folders under 't' such as: 'base', 'cmd', 'comp', 'io', lib', 'op', 'pod', 'pragma' and 'run'. Each of these sub-folders contain few test scripts ('.t' files) under them. Executing these test scripts on NetWare can be automated as per the following: -1. Automated scripts, 'base.pl', 'cmd.pl', 'comp.pl', 'io.pl', 'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' can be generated that are used to execute all the test scripts ('.t' files) under the corresponding folder. -For example, 'base.pl' tests all the test scripts under 'sys:\perl\scripts\t\base' folder, 'comp.pl' test all scripts under 'sys:\perl\scripts\t\comp' folder and so on. +1. Generate automated scripts like 'base.pl', 'cmd.pl', 'comp.pl', 'io.pl', 'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' that execute all the test scripts ('.t' files) under the corresponding folder. +For example, 'base.pl' to test all the scripts under 'sys:\perl\scripts\t\base' folder, + 'comp.pl' to test all the scripts under 'sys:\perl\scripts\t\comp' folder and so on. -2. An automated script, 'auto.pl' can also be generated that executes all the above mentioned '.pl' automated scripts, thus executing all the '.t' scripts. +2. Generate an automated script, 'nwauto.pl' that executes all the above mentioned '.pl' automated scripts, thus in turn executing all the '.t' scripts. -There is a script 'NWScripts.pl' available under the 'NetWare\t' folder of the CPAN download. This is written to generate these automated scripts when executed on a NetWare server. It generates the automated scripts, 'base.pl', 'cmd.pl', 'comp.pl', 'io.pl', 'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' and also 'auto.pl' by including all the corresponding '.t' scripts in them. For example, all the scripts that are under 't\base' folder will be entered in 'base.pl' and so on. 'auto.pl will include all these '.pl' scripts like 'base.pl', 'comp.pl' etc. +The script, 'NWScripts.pl' available under the 'NetWare\t' folder of the CPAN download, is written to generate these automated scripts when executed on a NetWare server. It generates 'base.pl', 'cmd.pl', 'comp.pl', 'io.pl', 'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' and also 'nwauto.pl' by including all the corresponding '.t' scripts in them in backtick operators. +For example, all the scripts that are under 't\base' folder will be entered in 'base.pl' and so on. 'nwauto.pl' includes all these '.pl' scripts like 'base.pl', 'comp.pl' etc. The following steps elicits the procedure for executing the automated scripts: -1. Copy the 't' folder from the CPAN download to 'sys:\perl\scripts' folder on the NetWare server. +1. Make sure that your NetWare server is mapped to "i:". -2. Copy all the files from 'NetWare\t' folder of the CPAN download into 'sys:\perl\scripts\t' folder. +2. Execute "nmake nwinstall" (after complete build) in the 'NetWare' folder of the CPAN download. This installs all the library files, perl modules and all the 't' scripts in appropriate folders onto your server. -3. Execute the command "perl t\NWModify.pl" on the console command prompt. This script replaces +3. Copy all the files from 'NetWare\t' folder of the CPAN download into 'sys:\perl\scripts\t' folder. + +4. Execute the command "perl t\NWModify.pl" on the console command prompt of your server. This script replaces "@INC = " with "unshift @INC, " and "push @INC, " with "unshift @INC, " from all the scripts under 'sys:\perl\scripts\t' folder. This is done to include the correct path for libraries into the scripts when executed on NetWare. If this is not done, some of the scripts will not get executed since they cannot locate the corresponding libraries. -4. Execute the command "perl t\NWScripts.pl" on the console command prompt to generate the automated scripts mentioned above under the 'sys:\perl\scripts\t' folder. - (See above for details). +5. Execute the command "perl t\NWScripts.pl" on the console command prompt to generate the automated scripts mentioned above under the 'sys:\perl\scripts\t' folder. + +6. Execute the command "perl t\nwauto.pl" on the server console command prompt. This runs all the standard test scripts. If you desire to redirect or save the results into a file, say 'nwauto.txt', then the console command to execute is: "perl t\nwauto.pl > nwauto.txt". -5. Execute 'auto.pl' script using the server console command, "perl t\auto.pl" to run all the standard test scripts. If you want the results to be redirected into a file, say 'auto.txt', then the console command is: "perl t\auto.pl > auto.txt" +7. If you wish to execute only a certain set of scripts, then run the corresponding '.pl' file. +For example, if you wish to execute only the 'lib' scripts, then execute 'lib.pl' through the server console command, "perl t\lib.pl'. To redirect the results into a file, the console command is, "perl t\lib.pl > lib.txt". -6. If you want to execute certain set of scripts, then run the corresponding '.pl' file. For example, if you want to execute only the 'lib' scripts, then execute 'run.pl' through the server console command, "perl t\run.pl'. To redirect the results into a file, the console command could be, "perl t\run.pl > run.txt". Known Issues: @@ -43,16 +48,13 @@ The following scripts are commented out in the corresponding autoscript: 1. 'openpid.t' in 'sys:\perl\scripts\t\io.pl' script Reason: - This either hangs or abends the server when executing through auto scripts. - When run individually, the script execution goes through fine. + This either hangs or abends the server when executing through auto scripts. When run individually, the script execution goes through fine. 2. 'argv.t' in 'sys:\perl\scripts\t\io.pl' script Reason: - This either hangs or abends the server when executing through auto scripts. - When run individually, the script execution goes through fine. + This either hangs or abends the server when executing through auto scripts. When run individually, the script execution goes through fine. -3. 'filehand.t' in 'sys:\perl\scripts\t\lib.pl' script +3. 'filehandle.t' in 'sys:\perl\scripts\t\lib.pl' script Reason: - This hangs in the last test case where it uses FileHandle::Pipe whether run individually - or through an auto script. + This hangs in the last test case where it uses FileHandle::Pipe whether run individually or through an auto script. |