diff options
78 files changed, 7861 insertions, 4291 deletions
diff --git a/Changes.Conf b/Changes.Conf index cfff8a121b..0f383ce39e 100644 --- a/Changes.Conf +++ b/Changes.Conf @@ -22,6 +22,10 @@ This is a brief summary of the most important changes: Many hint file updates. + Improve and simplify detection of local libraries and header files. + + Expand documentation of installation process in new INSTALL file. + Upgrade Traps and Pitfalls: Since a lot has changed in the build process, you are probably best off @@ -33,7 +37,8 @@ versions, and which answer to keep can be difficult to sort out. Therefore, you are probably better off ignoring your old config.sh, as in the following: - make distclean # (if you've built perl before) + make distclean # (if you've built perl before) + rm -f config.sh # (in case distclean mysteriously fails) sh Configure [whatever options you like] make depend make @@ -18,9 +18,9 @@ # archive site. Check with Archie if you don't know where that can be.) # -# $Id: Head.U,v 3.0.1.7 1995/03/21 08:46:15 ram Exp $ +# $Id: Head.U,v 3.0.1.8 1995/07/25 13:40:02 ram Exp $ # -# Generated on Thu Jun 22 10:38:35 EDT 1995 [metaconfig 3.0 PL55] +# Generated on Thu Oct 19 10:47:09 EDT 1995 [metaconfig 3.0 PL58] cat >/tmp/c1$$ <<EOF ARGGGHHHH!!!!! @@ -55,6 +55,14 @@ case "$0" in ;; esac +: Proper PATH separator +p_=: +: On OS/2 this directory should exist if this is not floppy only system :-] +if test -d c:/.; then + p_=\; + PATH=`cmd /c "echo %PATH%" | tr '\\\\' / ` + OS2_SHELL=`cmd /c "echo %OS2_SHELL%" | tr '\\\\' / | tr '[A-Z]' '[a-z]'` +fi : Proper PATH setting paths='/bin /usr/bin /usr/local/bin /usr/ucb /usr/local /usr/lbin' @@ -68,13 +76,13 @@ paths="$paths /sbin /usr/sbin /usr/libexec" for p in $paths do - case ":$PATH:" in - *:$p:*) ;; - *) test -d $p && PATH=$PATH:$p ;; + case "$p_$PATH$p_" in + *$p_$p$p_*) ;; + *) test -d $p && PATH=$PATH$p_$p ;; esac done -PATH=.:$PATH +PATH=.$p_$PATH export PATH : Sanity checks @@ -105,7 +113,7 @@ fi : Configure runs within the UU subdirectory test -d UU || mkdir UU -cd UU && rm -f * +cd UU && rm -f ./* dynamic_ext='' extensions='' @@ -217,7 +225,9 @@ ccflags='' cppflags='' ldflags='' lkflags='' +locincpth='' optimize='' +cf_email='' cf_by='' cf_time='' contains='' @@ -305,6 +315,7 @@ d_fpathconf='' d_pathconf='' d_pause='' d_pipe='' +d_poll='' d_portable='' d_readdir='' d_rewinddir='' @@ -408,6 +419,7 @@ db_hashtype='' db_prefixtype='' i_db='' i_dbm='' +i_rpcsvcdbm='' d_dirnamlen='' direntrytype='' i_dirent='' @@ -466,6 +478,7 @@ intsize='' libc='' glibpth='' libpth='' +loclibpth='' plibpth='' xlibpth='' libs='' @@ -497,6 +510,10 @@ myhostname='' phostname='' c='' n='' +d_eofnblk='' +eagain='' +o_nonblock='' +rd_nodata='' groupcat='' hostcat='' passcat='' @@ -505,6 +522,7 @@ ranlib='' package='' spackage='' patchlevel='' +perladmin='' prefix='' prefixexp='' installprivlib='' @@ -517,6 +535,8 @@ scriptdir='' scriptdirexp='' selecttype='' sig_name='' +sig_max='' +sig_num='' d_sitelib='' installsitelib='' sitelib='' @@ -623,29 +643,37 @@ al="$al xenix z8000" groupstype='' i_whoami='' +: default library list +libswanted='' +: set useposix=false in your hint file to disable the POSIX extension. +useposix=true +: Possible local include directories to search. +locincpth="/usr/local/include /opt/local/include /usr/gnu/include" +locincpth="$locincpth /opt/gnu/include /usr/GNU/include /opt/GNU/include" +: +: no include file wanted by default +inclwanted='' + : change the next line if compiling for Xenix/286 on Xenix/386 xlibpth='/usr/lib/386 /lib/386' +: Possible local library directories to search. +loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib" +loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" + : general looking path for locating libraries -glibpth="/lib/pa1.1 /usr/lib/large /lib /usr/lib $xlibpth" -glibpth="$glibpth /lib/large /usr/lib/small /lib/small" -glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib /usr/shlib" +glibpth="/lib/pa1.1 /usr/shlib /usr/lib/large /lib /usr/lib" +glibpth="$glibpth $xlibpth /lib/large /usr/lib/small /lib/small" +glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/shlib" : Private path used by Configure to find libraries. Its value : is prepended to libpth. This variable takes care of special : machines, like the mips. Usually, it should be empty. plibpth='' -: default library list -libswanted='' : full support for void wanted by default defvoidused=15 -: set useposix=false in your hint file to disable the POSIX extension. -useposix=true -: no include file wanted by default -inclwanted='' - : List of libraries we want. libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl' libswanted="$libswanted dld ld sun m c cposix posix ndir dir crypt" @@ -656,9 +684,6 @@ glibpth=`echo " $glibpth " | sed -e 's! /usr/shlib ! !'` glibpth="/usr/shlib $glibpth" : Do not use vfork unless overridden by a hint file. usevfork=false -: We might as well always be portable. It makes no difference for -: perl5, and makes people happy. -d_portable=define : script used to extract .SH files with variable substitutions cat >extract <<'EOS' @@ -818,7 +843,7 @@ while test $# -gt 0; do esac shift ;; - -V) echo "$me generated by metaconfig 3.0 PL55." >&2 + -V) echo "$me generated by metaconfig 3.0 PL58." >&2 exit 0;; --) break;; -*) echo "$me: unknown option $1" >&2; shift; error=true;; @@ -1297,6 +1322,7 @@ mkdir rm sed sort +tail touch tr uniq @@ -1314,7 +1340,7 @@ perl test uname " -pth=`echo $PATH | sed -e 's/:/ /g'` +pth=`echo $PATH | sed -e "s/$p_/ /g"` pth="$pth /lib /usr/lib" for file in $loclist; do xxx=`./loc $file $file $pth` @@ -1324,6 +1350,9 @@ for file in $loclist; do /*) echo $file is in $xxx. ;; + ?:[\\/]*) + echo $file is in $xxx. + ;; *) echo "I don't know where $file is. I hope it's in everyone's PATH." ;; @@ -1340,6 +1369,9 @@ for file in $trylist; do /*) echo $file is in $xxx. ;; + ?:[\\/]*) + echo $file is in $xxx. + ;; *) echo "I don't see $file out there, $say." say=either @@ -1679,6 +1711,10 @@ EOM osname=news_os fi $rm -f ../UU/kernel.what + elif test -d c:/.; then + set X $myuname + osname=os2 + osvers="$5" fi fi @@ -2142,29 +2178,10 @@ case "$gccversion" in 1*) cpp=`./loc gcc-cpp $cpp $pth` ;; esac -: decide how portable to be +: decide how portable to be. Allow command line overrides. case "$d_portable" in -"$define") dflt=y;; -*) dflt=n;; -esac -$cat <<'EOH' - -I can set things up so that your shell scripts and binaries are more portable, -at what may be a noticable cost in performance. In particular, if you -ask to be portable, the following happens: - - 1) Shell scripts will rely on the PATH variable rather than using - the paths derived above. - 2) ~username interpretations will be done at run time rather than - by Configure. - -EOH -rp="Do you expect to run these scripts and binaries on multiple machines?" -. ./myread -case "$ans" in - y*) d_portable="$define" - ;; - *) d_portable="$undef" ;; +"$undef") ;; +*) d_portable="$define" ;; esac : set up shell script to do ~ expansion @@ -2433,9 +2450,11 @@ EOCP fi $rm -f usr.c usr.out echo "and you're compiling with the $mips_type compiler and libraries." + xxx_prompt=y echo "exit 0" >mips else echo "Doesn't look like a MIPS system." + xxx_prompt=n echo "exit 1" >mips fi chmod +x mips @@ -2445,10 +2464,15 @@ case "$usrinc" in '') ;; *) dflt="$usrinc";; esac -fn=d/ -rp='Where are the include files you want to use?' -. ./getfile -usrinc="$ans" +case "$xxx_prompt" in +y) fn=d/ + rp='Where are the include files you want to use?' + . ./getfile + usrinc="$ans" + ;; +*) usrinc="$dflt" + ;; +esac : see how we invoke the C preprocessor echo " " @@ -2588,6 +2612,908 @@ case "$cppstdin" in esac $rm -f testcpp.c testcpp.out +: Set private lib path +case "$plibpth" in +'') if ./mips; then + plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" + fi;; +esac +case "$libpth" in +' ') dlist='';; +'') dlist="$loclibpth $plibpth $glibpth";; +*) dlist="$libpth";; +esac + +: Now check and see which directories actually exist, avoiding duplicates +libpth='' +for xxx in $dlist +do + if $test -d $xxx; then + case " $libpth " in + *" $xxx "*) ;; + *) libpth="$libpth $xxx";; + esac + fi +done +$cat <<'EOM' + +Some systems have incompatible or broken versions of libraries. Among +the directories listed in the question below, please remove any you +know not to be holding relevant libraries, and add any that are needed. +Say "none" for none. + +EOM +case "$libpth" in +'') dflt='none';; +*) + set X $libpth + shift + dflt=${1+"$@"} + ;; +esac +rp="Directories to use for library searches?" +. ./myread +case "$ans" in +none) libpth=' ';; +*) libpth="$ans";; +esac + +: determine root of directory hierarchy where package will be installed. +case "$prefix" in +'') + dflt=`./loc . /usr/local /usr/local /local /opt /usr` + ;; +*) + dflt="$prefix" + ;; +esac +$cat <<EOM + +By default, $package will be installed in $dflt/bin, manual +pages under $dflt/man, etc..., i.e. with $dflt as prefix for +all installation directories. Typically set to /usr/local, but you +may choose /usr if you wish to install $package among your system +binaries. If you wish to have binaries under /bin but manual pages +under /usr/local/man, that's ok: you will be prompted separately +for each of the installation directories, the prefix being only used +to set the defaults. + +EOM +fn=d~ +rp='Installation prefix to use?' +. ./getfile +oldprefix='' +case "$prefix" in +'') ;; +*) + case "$ans" in + "$prefix") ;; + *) oldprefix="$prefix";; + esac + ;; +esac +prefix="$ans" +prefixexp="$ansexp" + +: set the prefixit variable, to compute a suitable default value +prefixit='case "$3" in +""|none) + case "$oldprefix" in + "") eval "$1=\"\$$2\"";; + *) + case "$3" in + "") eval "$1=";; + none) + eval "tp=\"\$$2\""; + case "$tp" in + ""|" ") eval "$1=\"\$$2\"";; + *) eval "$1=";; + esac;; + esac;; + esac;; +*) + eval "tp=\"$oldprefix-\$$2-\""; eval "tp=\"$tp\""; + case "$tp" in + --|/*--|\~*--) eval "$1=\"$prefix/$3\"";; + /*-$oldprefix/*|\~*-$oldprefix/*) + eval "$1=\`echo \$$2 | sed \"s,^$oldprefix,$prefix,\"\`";; + *) eval "$1=\"\$$2\"";; + esac;; +esac' + +: is AFS running? +echo " " +if test -d /afs; then + echo "AFS may be running... I'll be extra cautious then..." >&4 + afs=true +else + echo "AFS does not seem to be running..." >&4 + afs=false +fi + +: determine where public executables go +echo " " +set dflt bin bin +eval $prefixit +fn=d~ +rp='Pathname where the public executables will reside?' +. ./getfile +if $test "X$ansexp" != "X$binexp"; then + installbin='' +fi +bin="$ans" +binexp="$ansexp" +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +executables reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installbin" in + '') dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installbin";; + esac + fn=de~ + rp='Where will public executables be installed?' + . ./getfile + installbin="$ans" +else + installbin="$binexp" +fi + +: set the prefixup variable, to restore leading tilda escape +prefixup='case "$prefixexp" in +"$prefix") ;; +*) eval "$1=\`echo \$$1 | sed \"s,^$prefixexp,$prefix,\"\`";; +esac' + +: determine where public executable scripts go +set scriptdir scriptdir +eval $prefixit +case "$scriptdir" in +'') + dflt="$bin" + : guess some guesses + $test -d /usr/share/scripts && dflt=/usr/share/scripts + $test -d /usr/share/bin && dflt=/usr/share/bin + $test -d /usr/local/script && dflt=/usr/local/script + $test -d $prefixexp/script && dflt=$prefixexp/script + set dflt + eval $prefixup + ;; +*) dflt="$scriptdir" + ;; +esac +$cat <<EOM + +Some installations have a separate directory just for executable scripts so +that they can mount it across multiple architectures but keep the scripts in +one spot. You might, for example, have a subdirectory of /usr/share for this. +Or you might just lump your scripts in with all your other executables. + +EOM +fn=d~ +rp='Where do you keep publicly executable scripts?' +. ./getfile +if $test "X$ansexp" != "X$scriptdirexp"; then + installscript='' +fi +scriptdir="$ans" +scriptdirexp="$ansexp" +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +scripts reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installscript" in + '') dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installscript";; + esac + fn=de~ + rp='Where will public scripts be installed?' + . ./getfile + installscript="$ans" +else + installscript="$scriptdirexp" +fi + +: determine where private executables go +set dflt privlib lib/$package +eval $prefixit +$cat <<EOM + +There are some auxiliary files for $package that need to be put into a +private library directory that is accessible by everyone. + +EOM +fn=d~+ +rp='Pathname where the private library files will reside?' +. ./getfile +if $test "X$privlibexp" != "X$ansexp"; then + installprivlib='' +fi +privlib="$ans" +privlibexp="$ansexp" +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +private files reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installprivlib" in + '') dflt=`echo $privlibexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installprivlib";; + esac + fn=de~ + rp='Where will private files be installed?' + . ./getfile + installprivlib="$ans" +else + installprivlib="$privlibexp" +fi + +: determine the architecture name +echo " " +if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then + tarch=`arch`"-$osname" +elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then + if uname -m > tmparch 2>&1 ; then + tarch=`$sed -e 's/ /_/g' -e 's/$/'"-$osname/" tmparch` + else + tarch="$osname" + fi + $rm -f tmparch +else + tarch="$osname" +fi +case "$myarchname" in +''|"$tarch") ;; +*) + echo "(Your architecture name used to be $myarchname.)" + archname='' + ;; +esac +case "$archname" in +'') dflt="$tarch";; +*) dflt="$archname";; +esac +rp='What is your architecture name' +. ./myread +archname="$ans" +myarchname="$tarch" + +: determine where public architecture dependent libraries go +set archlib archlib +eval $prefixit +case "$archlib" in +'') + case "$privlib" in + '') + dflt=`./loc . "." $prefixexp/lib /usr/local/lib /usr/lib /lib` + set dflt + eval $prefixup + ;; + *) dflt="$privlib/$archname";; + esac + ;; +*) dflt="$archlib";; +esac +cat <<EOM + +$spackage contains architecture-dependent library files. If you are +sharing libraries in a heterogeneous environment, you might store +these files in a separate location. Otherwise, you can just include +them with the rest of the public library files. + +EOM +fn=d~ +rp='Where do you want to put the public architecture-dependent libraries?' +. ./getfile +archlib="$ans" +archlibexp="$ansexp" + +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +private files reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installarchlib" in + '') dflt=`echo $archlibexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installarchlib";; + esac + fn=de~ + rp='Where will architecture-dependent library files be installed?' + . ./getfile + installarchlib="$ans" +else + installarchlib="$archlibexp" +fi +if $test X"$archlib" = X"$privlib"; then + d_archlib="$undef" +else + d_archlib="$define" +fi + +: determine whether the user wants to include a site-specific library +: in addition to privlib. +$cat <<EOM + +Some sites may wish to specify a local directory for $package +to search by default in addition to $privlib. +If you don't want to use such an additional directory, answer 'none'. + +EOM +case "$sitelib" in +'') dflt=none ;; +*) dflt="$sitelib" ;; +esac +fn=d~+n +rp='Local directory for additional library files?' +. ./getfile +if $test "X$sitelibexp" != "X$ansexp"; then + installsitelib='' +fi +sitelib="$ans" +sitelibexp="$ansexp" +if $afs; then + case "$sitelib" in + '') installsitelib="$sitelibexp" + ;; + *) $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +private files reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installsitelib" in + '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installsitelib";; + esac + fn=de~ + rp='Where will additional local files be installed?' + . ./getfile + installsitelib="$ans" + ;; + esac +else + installsitelib="$sitelibexp" +fi + +case "$sitelibexp" in +'') d_sitelib=undef ;; +*) d_sitelib=define ;; +esac + +: determine where manual pages go +set man1dir man1dir none +eval $prefixit +$cat <<EOM + +$spackage has manual pages available in source form. +EOM +case "$nroff" in +nroff) + echo "However, you don't have nroff, so they're probably useless to you." + case "$man1dir" in + '') man1dir="none";; + esac;; +esac +echo "If you don't want the manual sources installed, answer 'none'." +case "$man1dir" in +'') + lookpath="$prefixexp/man/man1 $prefixexp/man/u_man/man1" + lookpath="$lookpath $prefixexp/man/l_man/man1" + lookpath="$lookpath /usr/local/man/man1 /opt/man/man1 /usr/man/manl" + lookpath="$lookpath /usr/man/local/man1 /usr/man/l_man/man1" + lookpath="$lookpath /usr/local/man/u_man/man1 /usr/local/man/l_man/man1" + lookpath="$lookpath /usr/man/man.L" + man1dir=`./loc . $prefixexp/man/man1 $lookpath` + if $test -d "$man1dir"; then + dflt="$man1dir" + else + dflt="$sysman" + fi + set dflt + eval $prefixup + ;; +' ') dflt=none;; +*) dflt="$man1dir" + ;; +esac +echo " " +fn=dn~ +rp="Where do the main $spackage manual pages (source) go?" +. ./getfile +if test "X$man1direxp" != "X$ansexp"; then + installman1dir='' +fi +man1dir="$ans" +man1direxp="$ansexp" +case "$man1dir" in +'') man1dir=' ' + installman1dir='';; +esac +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +manual pages reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installman1dir" in + '') dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installman1dir";; + esac + fn=de~ + rp='Where will man pages be installed?' + . ./getfile + installman1dir="$ans" +else + installman1dir="$man1direxp" +fi + +: What suffix to use on installed man pages + +case "$man1dir" in +' ') + man1ext='0' + ;; +*) + rp="What suffix should be used for the main $spackage man pages?" + case "$man1dir" in + *1) dflt=1 ;; + *1p) dflt=1p ;; + *1pm) dflt=1pm ;; + *l) dflt=l;; + *n) dflt=n;; + *o) dflt=o;; + *p) dflt=p;; + *C) dflt=C;; + *L) dflt=L;; + *L1) dflt=L1;; + *) dflt=1;; + esac + . ./myread + man1ext="$ans" + ;; +esac + +: set up the script used to warn in case of inconsistency +cat <<'EOSC' >whoa +dflt=y +echo " " +echo "*** WHOA THERE!!! ***" >&4 +echo " The $hint value for \$$var on this machine was \"$was\"!" >&4 +rp=" Keep the $hint value?" +. ./myread +case "$ans" in +y) td=$was; tu=$was;; +esac +EOSC + +: function used to set $1 to $val +setvar='var=$1; eval "was=\$$1"; td=$define; tu=$undef; +case "$val$was" in +$define$undef) . ./whoa; eval "$var=\$td";; +$undef$define) . ./whoa; eval "$var=\$tu";; +*) eval "$var=$val";; +esac' + +: see if we can have long filenames +echo " " +rmlist="$rmlist /tmp/cf$$" +$test -d /tmp/cf$$ || mkdir /tmp/cf$$ +first=123456789abcdef +second=/tmp/cf$$/$first +$rm -f $first $second +if (echo hi >$first) 2>/dev/null; then + if $test -f 123456789abcde; then + echo 'You cannot have filenames longer than 14 characters. Sigh.' >&4 + val="$undef" + else + if (echo hi >$second) 2>/dev/null; then + if $test -f /tmp/cf$$/123456789abcde; then + $cat <<'EOM' +That's peculiar... You can have filenames longer than 14 characters, but only +on some of the filesystems. Maybe you are using NFS. Anyway, to avoid problems +I shall consider your system cannot support long filenames at all. +EOM + val="$undef" + else + echo 'You can have filenames longer than 14 characters.' >&4 + val="$define" + fi + else + $cat <<'EOM' +How confusing! Some of your filesystems are sane enough to allow filenames +longer than 14 characters but some others like /tmp can't even think about them. +So, for now on, I shall assume your kernel does not allow them at all. +EOM + val="$undef" + fi + fi +else + $cat <<'EOM' +You can't have filenames longer than 14 chars. You can't even think about them! +EOM + val="$undef" +fi +set d_flexfnam +eval $setvar +$rm -rf /tmp/cf$$ 123456789abcde* + +: determine where library module manual pages go +set man3dir man3dir none +eval $prefixit +$cat <<EOM + +$spackage has manual pages for many of the library modules. +EOM + +case "$nroff" in +nroff) + $cat <<'EOM' +However, you don't have nroff, so they're probably useless to you. +You can use the supplied perldoc script instead. +EOM + case "$man3dir" in + '') man3dir="none";; + esac;; +esac + +case "$d_flexfnam" in +undef) + $cat <<'EOM' +However, your system can't handle the long file names like File::Basename.3. +You can use the supplied perldoc script instead. +EOM + case "$man3dir" in + '') man3dir="none";; + esac;; +esac + +echo "If you don't want the manual sources installed, answer 'none'." +case "$man3dir" in +'') dflt="$privlib/man/man3" ;; +' ') dflt=none;; +*) dflt="$man3dir" ;; +esac +echo " " + +fn=dn~ +rp="Where do the $spackage library man pages (source) go?" +. ./getfile +if test "X$man3direxp" != "X$ansexp"; then + installman3dir='' +fi + +man3dir="$ans" +man3direxp="$ansexp" +case "$man3dir" in +'') man3dir=' ' + installman3dir='';; +esac +if $afs; then + $cat <<EOM + +Since you are running AFS, I need to distinguish the directory in which +manual pages reside from the directory in which they are installed (and from +which they are presumably copied to the former directory by occult means). + +EOM + case "$installman3dir" in + '') dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;; + *) dflt="$installman3dir";; + esac + fn=de~ + rp='Where will man pages be installed?' + . ./getfile + installman3dir="$ans" +else + installman3dir="$man3direxp" +fi + +: What suffix to use on installed man pages + +case "$man3dir" in +' ') + man3ext='0' + ;; +*) + rp="What suffix should be used for the $spackage library man pages?" + case "$man3dir" in + *3) dflt=3 ;; + *3p) dflt=3p ;; + *3pm) dflt=3pm ;; + *l) dflt=l;; + *n) dflt=n;; + *o) dflt=o;; + *p) dflt=p;; + *C) dflt=C;; + *L) dflt=L;; + *L3) dflt=L3;; + *) dflt=3;; + esac + . ./myread + man3ext="$ans" + ;; +esac + +: see if we have to deal with yellow pages, now NIS. +if $test -d /usr/etc/yp || $test -d /etc/yp; then + if $test -f /usr/etc/nibindd; then + echo " " + echo "I'm fairly confident you're on a NeXT." + echo " " + rp='Do you get the hosts file via NetInfo?' + dflt=y + case "$hostcat" in + nidump*) ;; + '') ;; + *) dflt=n;; + esac + . ./myread + case "$ans" in + y*) hostcat='nidump hosts .';; + *) case "$hostcat" in + nidump*) hostcat='';; + esac + ;; + esac + fi + case "$hostcat" in + nidump*) ;; + *) + case "$hostcat" in + *ypcat*) dflt=y;; + '') if $contains '^\+' /etc/passwd >/dev/null 2>&1; then + dflt=y + else + dflt=n + fi;; + *) dflt=n;; + esac + echo " " + rp='Are you getting the hosts file via yellow pages?' + . ./myread + case "$ans" in + y*) hostcat='ypcat hosts';; + *) hostcat='cat /etc/hosts';; + esac + ;; + esac +fi + +: now get the host name +echo " " +echo "Figuring out host name..." >&4 +case "$myhostname" in +'') cont=true + echo 'Maybe "hostname" will work...' + if tans=`sh -c hostname 2>&1` ; then + myhostname=$tans + phostname=hostname + cont='' + fi + ;; +*) cont='';; +esac +if $test "$cont"; then + if ./xenix; then + echo 'Oh, dear. Maybe "/etc/systemid" is the key...' + if tans=`cat /etc/systemid 2>&1` ; then + myhostname=$tans + phostname='cat /etc/systemid' + echo "Whadyaknow. Xenix always was a bit strange..." + cont='' + fi + elif $test -r /etc/systemid; then + echo "(What is a non-Xenix system doing with /etc/systemid?)" + fi +fi +if $test "$cont"; then + echo 'No, maybe "uuname -l" will work...' + if tans=`sh -c 'uuname -l' 2>&1` ; then + myhostname=$tans + phostname='uuname -l' + else + echo 'Strange. Maybe "uname -n" will work...' + if tans=`sh -c 'uname -n' 2>&1` ; then + myhostname=$tans + phostname='uname -n' + else + echo 'Oh well, maybe I can mine it out of whoami.h...' + if tans=`sh -c $contains' sysname $usrinc/whoami.h' 2>&1` ; then + myhostname=`echo "$tans" | $sed 's/^.*"\(.*\)"/\1/'` + phostname="sed -n -e '"'/sysname/s/^.*\"\\(.*\\)\"/\1/{'"' -e p -e q -e '}' <$usrinc/whoami.h" + else + case "$myhostname" in + '') echo "Does this machine have an identity crisis or something?" + phostname='';; + *) + echo "Well, you said $myhostname before..." + phostname='echo $myhostname';; + esac + fi + fi + fi +fi +: you do not want to know about this +set $myhostname +myhostname=$1 + +: verify guess +if $test "$myhostname" ; then + dflt=y + rp='Your host name appears to be "'$myhostname'".'" Right?" + . ./myread + case "$ans" in + y*) ;; + *) myhostname='';; + esac +fi + +: bad guess or no guess +while $test "X$myhostname" = X ; do + dflt='' + rp="Please type the (one word) name of your host:" + . ./myread + myhostname="$ans" +done + +: translate upper to lower if necessary +case "$myhostname" in +*[A-Z]*) + echo "(Normalizing case in your host name)" + myhostname=`echo $myhostname | ./tr '[A-Z]' '[a-z]'` + ;; +esac + +case "$myhostname" in +*.*) + dflt=`expr "X$myhostname" : "X[^.]*\(\..*\)"` + myhostname=`expr "X$myhostname" : "X\([^.]*\)\."` + echo "(Trimming domain name from host name--host name is now $myhostname)" + ;; +*) case "$mydomain" in + '') + $hostcat >hosts + dflt=.`$awk "/[0-9].*$myhostname/ {for(i=2; i<=NF;i++) print \\\$i}" \ + hosts | $sort | $uniq | \ + $sed -n -e "s/$myhostname\.\([a-zA-Z_.]\)/\1/p"` + case "$dflt" in + .) echo "(You do not have fully-qualified names in /etc/hosts)" + tans=`./loc resolv.conf X /etc /usr/etc` + if $test -f "$tans"; then + echo "(Attempting domain name extraction from $tans)" + dflt=.`egrep '^domain' $tans | $sed 's/domain[ ]*\(.*\)/\1/' \ + | ./tr '[A-Z]' '[a-z]' 2>/dev/null` + fi + ;; + esac + case "$dflt" in + .) echo "(No help from resolv.conf either -- attempting clever guess)" + dflt=.`sh -c domainname 2>/dev/null` + case "$dflt" in + '') dflt='.';; + .nis.*|.yp.*|.main.*) dflt=`echo $dflt | $sed -e 's/^\.[^.]*//'`;; + esac + ;; + esac + case "$dflt" in + .) echo "(Lost all hope -- silly guess then)" + dflt='.uucp' + ;; + esac + $rm -f hosts + ;; + *) dflt="$mydomain";; + esac;; +esac +echo " " +rp="What is your domain name?" +. ./myread +tans="$ans" +case "$ans" in +'') ;; +.*) ;; +*) tans=".$tans";; +esac +mydomain="$tans" + +: translate upper to lower if necessary +case "$mydomain" in +*[A-Z]*) + echo "(Normalizing case in your domain name)" + mydomain=`echo $mydomain | ./tr '[A-Z]' '[a-z]'` + ;; +esac + +: a little sanity check here +case "$phostname" in +'') ;; +*) + case `$phostname | ./tr '[A-Z]' '[a-z]'` in + $myhostname$mydomain|$myhostname) ;; + *) + case "$phostname" in + sed*) + echo "(That doesn't agree with your whoami.h file, by the way.)" + ;; + *) + echo "(That doesn't agree with your $phostname command, by the way.)" + ;; + esac + ;; + esac + ;; +esac + +$cat <<EOM + +I need to get your e-mail address in Internet format if possible, i.e. +something like user@host.domain. Please answer accurately since I have +no easy means to double check it. The default value provided below +is most probably close to the reality but may not be valid from outside +your organization... + +EOM +cont=x +while test "$cont"; do + case "$cf_email" in + '') dflt="$cf_by@$myhostname$mydomain";; + *) dflt="$cf_email";; + esac + rp='What is your e-mail address?' + . ./myread + cf_email="$ans" + case "$cf_email" in + *@*.*) cont='' ;; + *) + rp='Address does not look like an Internet one. Use it anyway?' + case "$fastread" in + yes) dflt=y ;; + *) dflt=n ;; + esac + . ./myread + case "$ans" in + y*) cont='' ;; + *) echo " " ;; + esac + ;; + esac +done + +$cat <<EOM + +If you or somebody else will be maintaining perl at your site, please +fill in the correct e-mail address here so that they may be contacted +if necessary. Currently, the "perlbug" program included with perl +will send mail to this address in addition to perlbug@perl.com. You may +enter "none" for no administrator. + +EOM +case "$perladmin" in +'') dflt="$cf_email";; +*) dflt="$perladmin";; +esac +rp='Perl administrator e-mail address' +. ./myread +perladmin="$ans" + + : determine optimize, if desired, or use for debug flag also case "$optimize" in ' ') dflt='none';; @@ -2631,9 +3557,8 @@ case "$ccflags" in esac case "$mips_type" in -*BSD*) ;; -'') ;; -*) inclwanted="$inclwanted $usrinc/bsd";; +*BSD*|'') inclwanted="$locincpth $usrinc";; +*) inclwanted="$locincpth $inclwanted $usrinc/bsd";; esac for thisincl in $inclwanted; do if $test -d $thisincl; then @@ -2750,6 +3675,7 @@ EOM esac : flags used in final linking phase + case "$ldflags" in '') if ./venix; then dflt='-i -z' @@ -2759,13 +3685,40 @@ case "$ldflags" in case "$ccflags" in *-posix*) dflt="$dflt -posix" ;; esac - case "$dflt" in - '') dflt='none' ;; - esac ;; *) dflt="$ldflags";; esac -echo " " + +: Try to guess additional flags to pick up local libraries. +for thislibdir in $libpth; do + case " $loclibpth " in + *" $thislibdir "*) + case "$dflt " in + "-L$thislibdir ") ;; + *) dflt="$dflt -L$thislibdir" ;; + esac + ;; + esac +done + +case "$dflt" in +'') dflt='none' ;; +esac + +$cat <<EOH + +Your C linker may need flags. For this question you should +include -L/whatever and any other flags used by the C linker, but you +should NOT include libraries like -lwhatever. + +Make sure you include the appropriate -L/path flags if your C linker +does not normally search all of the directories you specified above, +namely + $libpth +To use no flags, specify the word "none". + +EOH + rp="Any additional ld flags (NOT including libraries)?" . ./myread case "$ans" in @@ -2777,7 +3730,7 @@ rmlist="$rmlist pdp11" : coherency check echo " " echo "Checking your choice of C compiler and flags for coherency..." >&4 -set X $cc $optimize $ccflags try.c -o try $ldflags +set X $cc $optimize $ccflags $ldflags try.c -o try shift $cat >try.msg <<EOM I've tried to compile and run a simple program with: @@ -2828,52 +3781,6 @@ n) echo "OK, that should do.";; esac $rm -f try try.* core -: Set private lib path -case "$plibpth" in -'') if ./mips; then - plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" - fi;; -esac -case "$libpth" in -' ') dlist='';; -'') dlist="$plibpth $glibpth";; -*) dlist="$libpth";; -esac - -: Now check and see which directories actually exist, avoiding duplicates -libpth='' -for xxx in $dlist -do - if $test -d $xxx; then - case " $libpth " in - *" $xxx "*) ;; - *) libpth="$libpth $xxx";; - esac - fi -done -$cat <<'EOM' - -Some systems have incompatible or broken versions of libraries. Among -the directories listed in the question below, please remove any you -know not to be holding relevant libraries, and add any that are needed. -Say "none" for none. - -EOM -case "$libpth" in -'') dflt='none';; -*) - set X $libpth - shift - dflt=${1+"$@"} - ;; -esac -rp="Directories to use for library searches?" -. ./myread -case "$ans" in -none) libpth=' ';; -*) libpth="$ans";; -esac - : compute shared library extension case "$so" in '') @@ -2926,6 +3833,12 @@ for thislib in $libswanted; do *"-l$thislib "*);; *) dflt="$dflt -l$thislib";; esac + elif xxx=`./loc $thislib.a X $libpth`; $test -f "$xxx"; then + echo "Found -l$thislib." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; + esac elif xxx=`./loc lib${thislib}_s.a X $libpth`; $test -f "$xxx"; then echo "Found -l${thislib}_s." case " $dflt " in @@ -3218,6 +4131,10 @@ elif com="$sed -n -e '/Def. Text/s/.* \([^ ]*\)\$/\1/p'";\ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun +elif com="$sed -n -e 's/^[-0-9a-f ]*_\(.*\)=.*/\1/p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun else nm -p $* 2>/dev/null >libc.tmp $grep fprintf libc.tmp > libc.ptf @@ -3268,7 +4185,7 @@ $rm -f libnames libpath csym='tlook=$1; case "$3" in -v) tf=libc.tmp; tc=""; tdc="";; --a) tf=libc.tmp; tc="[0]"; tdc=[];; +-a) tf=libc.tmp; tc="[0]"; tdc="[]";; *) tlook="^$1\$"; tf=libc.list; tc="()"; tdc="()";; esac; tx=yes; @@ -3286,7 +4203,7 @@ yes) fi;; *) echo "main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c; - if $cc $ccflags -o t t.c $ldflags $libs >/dev/null 2>&1; + if $cc $ccflags $ldflags -o t t.c $libs >/dev/null 2>&1; then tval=true; else tval=false; fi; @@ -3300,19 +4217,6 @@ yes) esac; eval "$2=$tval"' -: set up the script used to warn in case of inconsistency -cat <<'EOSC' >whoa -dflt=y -echo " " -echo "*** WHOA THERE!!! ***" >&4 -echo " The $hint value for \$$var on this machine was \"$was\"!" >&4 -rp=" Keep the $hint value?" -. ./myread -case "$ans" in -y) td=$was; tu=$was;; -esac -EOSC - : define an is-in-libc? function inlibc='echo " "; td=$define; tu=$undef; sym=$1; var=$2; eval "was=\$$2"; @@ -3340,67 +4244,62 @@ yes) esac;; esac' -: see if gconvert exists -: On some SVR4 systems, gconvert is present but can not be used -: because it requires some other unavailable functions. -: Therefore, do not use the nm extraction, but use a real compile -: and link test instead. -xxx_runnm="$runnm" -runnm=false -set gconvert d_gconvert -eval $inlibc -runnm="$xxx_runnm" - -case "$d_gconvert" in -$define) - echo "We'll use it to convert floats into a string then." >&4 - d_Gconvert="gconvert((x),(n),(t),(b))" - ;; -*) - : Maybe we can emulate it with gcvt. - set gcvt d_gcvt - eval $inlibc - - case "$d_gcvt" in - $define) - : Test whether gcvt drops a trailing decimal point - $cat >try.c <<'EOP' +: Check how to convert floats to strings. +echo " " +echo "Checking for an efficient way to convert floats to strings." +$cat >try.c <<'EOP' +#ifdef TRY_gconvert +#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b)) +#endif +#ifdef TRY_gcvt +#define Gconvert(x,n,t,b) gcvt((x),(n),(b)) +#endif +#ifdef TRY_sprintf +#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) +#endif main() { char buf[64]; - gcvt(1.0, 8, buf); + Gconvert(1.0, 8, 0, buf); if (buf[0] != '1' || buf[1] != '\0') exit(1); - gcvt(0.0, 8, buf); + Gconvert(0.0, 8, 0, buf); if (buf[0] != '0' || buf[1] != '\0') exit(1); - gcvt(-1.0, 8, buf); + Gconvert(-1.0, 8, 0, buf); if (buf[0] != '-' || buf[1] != '1' || buf[2] != '\0') exit(1); exit(0); } EOP - if $cc $ccflags $ldflags -o try try.c $libs > /dev/null 2>&1; then - if ./try; then - echo "Good, your gcvt() drops a trailing decimal point." - echo "We'll use it to convert floats into a string." >&4 - d_Gconvert="gcvt((x),(n),(b))" - else - echo "But your gcvt() keeps a trailing decimal point". - d_Gconvert='' - fi +case "$d_Gconvert" in +gconvert*) xxx_list='gconvert gcvt sprintf' ;; +gcvt*) xxx_list='gcvt gconvert sprintf' ;; +sprintf*) xxx_list='sprintf gconvert gcvt' ;; +*) xxx_list='gconvert gcvt sprintf' ;; +esac + +for xxx_convert in $xxx_list; do + echo "Trying $xxx_convert" + $rm -f try try.o + if $cc $ccflags -DTRY_$xxx_convert $ldflags -o try \ + try.c $libs > /dev/null 2>&1 ; then + echo "$xxx_convert" found. >&4 + if ./try; then + echo "Good, $xxx_convert drops a trailing decimal point." + echo "I'll use $xxx_convert to convert floats into a string." >&4 + break; else - echo "Hmm. I can't compile the gcvt test program." - d_Gconvert='' + echo "But $xxx_convert keeps a trailing decimal point". fi - $rm -f try.c try - ;; - esac - case "$d_Gconvert" in - '') - echo "I'll use sprintf instead to convert floats into a string." >&4 - d_Gconvert='sprintf((b),"%.*g",(n),(x))' - ;; - esac + else + echo "$xxx_convert NOT found." >&4 + fi +done + +case "$xxx_convert" in +gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;; +gcvt) d_Gconvert='gcvt((x),(n),(b))' ;; +*) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;; esac : Initialize h_fcntl @@ -3515,215 +4414,6 @@ $rm -f access* set alarm d_alarm eval $inlibc -: determine the architecture name -echo " " -if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then - tarch=`arch`"-$osname" -elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then - if uname -m > tmparch 2>&1 ; then - tarch=`$sed -e 's/ /_/g' -e 's/$/'"-$osname/" tmparch` - else - tarch="$osname" - fi - $rm -f tmparch -else - tarch="$osname" -fi -case "$myarchname" in -''|"$tarch") ;; -*) - echo "(Your architecture name used to be $myarchname.)" - archname='' - ;; -esac -case "$archname" in -'') dflt="$tarch";; -*) dflt="$archname";; -esac -rp='What is your architecture name' -. ./myread -archname="$ans" -myarchname="$tarch" - -: is AFS running? -echo " " -if test -d /afs; then - echo "AFS may be running... I'll be extra cautious then..." >&4 - afs=true -else - echo "AFS does not seem to be running..." >&4 - afs=false -fi - -: determine root of directory hierarchy where package will be installed. -case "$prefix" in -'') - dflt=`./loc . /usr/local /usr/local /local /opt /usr` - ;; -*) - dflt="$prefix" - ;; -esac -$cat <<EOM - -By default, $package will be installed in $dflt/bin, manual -pages under $dflt/man, etc..., i.e. with $dflt as prefix for -all installation directories. Typically set to /usr/local, but you -may choose /usr if you wish to install $package among your system -binaries. If you wish to have binaries under /bin but manual pages -under /usr/local/man, that's ok: you will be prompted separately -for each of the installation directories, the prefix being only used -to set the defaults. - -EOM -fn=d~ -rp='Installation prefix to use?' -. ./getfile -oldprefix='' -case "$prefix" in -'') ;; -*) - case "$ans" in - "$prefix") ;; - *) oldprefix="$prefix";; - esac - ;; -esac -prefix="$ans" -prefixexp="$ansexp" - -: set the prefixit variable, to compute a suitable default value -prefixit='case "$3" in -""|none) - case "$oldprefix" in - "") eval "$1=\"\$$2\"";; - *) - case "$3" in - "") eval "$1=";; - none) - eval "tp=\"\$$2\""; - case "$tp" in - ""|" ") eval "$1=\"\$$2\"";; - *) eval "$1=";; - esac;; - esac;; - esac;; -*) - eval "tp=\"$oldprefix-\$$2-\""; eval "tp=\"$tp\""; - case "$tp" in - --|/*--|\~*--) eval "$1=\"$prefix/$3\"";; - /*-$oldprefix/*|\~*-$oldprefix/*) - eval "$1=\`echo \$$2 | sed \"s,^$oldprefix,$prefix,\"\`";; - *) eval "$1=\"\$$2\"";; - esac;; -esac' - -: determine where private executables go -set dflt privlib lib/$package -eval $prefixit -$cat <<EOM - -There are some auxiliary files for $package that need to be put into a -private library directory that is accessible by everyone. - -EOM -fn=d~+ -rp='Pathname where the private library files will reside?' -. ./getfile -if $test "X$privlibexp" != "X$ansexp"; then - installprivlib='' -fi -privlib="$ans" -privlibexp="$ansexp" -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -private files reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installprivlib" in - '') dflt=`echo $privlibexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installprivlib";; - esac - fn=de~ - rp='Where will private files be installed?' - . ./getfile - installprivlib="$ans" -else - installprivlib="$privlibexp" -fi - -: set the prefixup variable, to restore leading tilda escape -prefixup='case "$prefixexp" in -"$prefix") ;; -*) eval "$1=\`echo \$$1 | sed \"s,^$prefixexp,$prefix,\"\`";; -esac' - -: determine where public architecture dependent libraries go -set archlib archlib -eval $prefixit -case "$archlib" in -'') - case "$privlib" in - '') - dflt=`./loc . "." $prefixexp/lib /usr/local/lib /usr/lib /lib` - set dflt - eval $prefixup - ;; - *) dflt="$privlib/$archname";; - esac - ;; -*) dflt="$archlib";; -esac -cat <<EOM - -$spackage contains architecture-dependent library files. If you are -sharing libraries in a heterogeneous environment, you might store -these files in a separate location. Otherwise, you can just include -them with the rest of the public library files. - -EOM -fn=d~ -rp='Where do you want to put the public architecture-dependent libraries?' -. ./getfile -archlib="$ans" -archlibexp="$ansexp" - -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -private files reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installarchlib" in - '') dflt=`echo $archlibexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installarchlib";; - esac - fn=de~ - rp='Where will architecture-dependent library files be installed?' - . ./getfile - installarchlib="$ans" -else - installarchlib="$archlibexp" -fi -if $test X"$archlib" = X"$privlib"; then - d_archlib="$undef" -else - d_archlib="$define" -fi - -: function used to set $1 to $val -setvar='var=$1; eval "was=\$$1"; td=$define; tu=$undef; -case "$val$was" in -$define$undef) . ./whoa; eval "$var=\$td";; -$undef$define) . ./whoa; eval "$var=\$tu";; -*) eval "$var=$val";; -esac' - : Look for GNU-cc style attribute checking echo " " echo "Checking whether your compiler can handle __attribute__ ..." >&4 @@ -3775,7 +4465,7 @@ main() exit(0); } EOP - if $cc $ccflags -o set set.c $ldflags $libs >/dev/null 2>&1; then + if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then ./set 2>/dev/null case $? in 0) echo "You have to use setpgrp() instead of setpgrp(pid, pgrp)." >&4 @@ -3814,22 +4504,21 @@ case "$intsize" in main() { printf("%d\n", sizeof(int)); + exit(0); } EOCP - if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then - dflt=`./try` + if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then + intsize=`./try` + echo "Your integers are $intsize bytes long." else dflt='4' echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of an integer (in bytes)?" + . ./myread + intsize="$ans" fi ;; -*) - dflt="$intsize" - ;; esac -rp="What is the size of an integer (in bytes)?" -. ./myread -intsize="$ans" $rm -f try.c try : see if signal is declared as pointer to function returning int or void @@ -4253,9 +4942,6 @@ eval $setvar $rm -f try.c : see if dlerror exists -: On NetBSD and FreeBSD, dlerror might be available, but it is in -: /usr/lib/crt0.o, not in any of the libraries. Therefore, do not -: use the nm extraction, but use a real compile and link test instead. xxx_runnm="$runnm" runnm=false set dlerror d_dlerror @@ -4267,9 +4953,6 @@ set dld.h i_dld eval $inhdr : see if dlopen exists -: On NetBSD and FreeBSD, dlopen is available, but it is in -: /usr/lib/crt0.o, not in any of the libraries. Therefore, do not -: use the nm extraction, but use a real compile and link test instead. xxx_runnm="$runnm" runnm=false set dlopen d_dlopen @@ -4420,6 +5103,23 @@ EOM ;; *) dflt="$lddlflags" ;; esac + +: Try to guess additional flags to pick up local libraries. +for thisflag in $ldflags; do + case "$thisflag" in + -L*) + case " $dflt " in + *" $thisflag "*) ;; + *) dflt="$dflt $thisflag" ;; + esac + ;; + esac +done + +case "$dflt" in +'') dflt='none' ;; +esac + rp="Any special flags to pass to $ld to create a dynamically loaded library?" . ./myread case "$ans" in @@ -4720,6 +5420,225 @@ eval $setvar set dup2 d_dup2 eval $inlibc +: Locate the flags for 'open()' +echo " " +$cat >open3.c <<'EOCP' +#include <sys/types.h> +#ifdef I_FCNTL +#include <fcntl.h> +#endif +#ifdef I_SYS_FILE +#include <sys/file.h> +#endif +main() { + if(O_RDONLY); +#ifdef O_TRUNC + exit(0); +#else + exit(1); +#endif +} +EOCP +: check sys/file.h first to get FREAD on Sun +if $test `./findhdr sys/file.h` && \ + $cc $cppflags "-DI_SYS_FILE" open3.c -o open3 >/dev/null 2>&1 ; then + h_sysfile=true; + echo "<sys/file.h> defines the O_* constants..." >&4 + if ./open3; then + echo "and you have the 3 argument form of open()." >&4 + val="$define" + else + echo "but not the 3 argument form of open(). Oh, well." >&4 + val="$undef" + fi +elif $test `./findhdr fcntl.h` && \ + $cc "-DI_FCNTL" open3.c -o open3 >/dev/null 2>&1 ; then + h_fcntl=true; + echo "<fcntl.h> defines the O_* constants..." >&4 + if ./open3; then + echo "and you have the 3 argument form of open()." >&4 + val="$define" + else + echo "but not the 3 argument form of open(). Oh, well." >&4 + val="$undef" + fi +else + val="$undef" + echo "I can't find the O_* constant definitions! You got problems." >&4 +fi +set d_open3 +eval $setvar +$rm -f open3* + +: check for non-blocking I/O stuff +case "$h_sysfile" in +true) echo "#include <sys/file.h>" > head.c;; +*) + case "$h_fcntl" in + true) echo "#include <fcntl.h>" > head.c;; + *) echo "#include <sys/fcntl.h>" > head.c;; + esac + ;; +esac +echo " " +echo "Figuring out the flag used by open() for non-blocking I/O..." >&4 +case "$o_nonblock" in +'') + $cat head.c > try.c + $cat >>try.c <<'EOCP' +main() { +#ifdef O_NONBLOCK + printf("O_NONBLOCK\n"); + exit(0); +#endif +#ifdef O_NDELAY + printf("O_NDELAY\n"); + exit(0); +#endif +#ifdef FNDELAY + printf("FNDELAY\n"); + exit(0); +#endif + exit(0); +} +EOCP + if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then + o_nonblock=`./try` + case "$o_nonblock" in + '') echo "I can't figure it out, assuming O_NONBLOCK will do.";; + *) echo "Seems like we can use $o_nonblock.";; + esac + else + echo "(I can't compile the test program; pray O_NONBLOCK is right!)" + fi + ;; +*) echo "Using $hint value $o_nonblock.";; +esac +$rm -f try try.* .out core + +echo " " +echo "Let's see what value errno gets from read() on a $o_nonblock file..." >&4 +case "$eagain" in +'') + $cat head.c > try.c + $cat >>try.c <<EOCP +#include <errno.h> +#include <sys/types.h> +#include <signal.h> +extern int errno; +$signal_t blech(x) int x; { exit(3); } +main() +{ + int pd[2]; + int pu[2]; + char buf[1]; + char string[100]; + + pipe(pd); /* Down: child -> parent */ + pipe(pu); /* Up: parent -> child */ + if (0 != fork()) { + int ret; + close(pd[1]); /* Parent reads from pd[0] */ + close(pu[0]); /* Parent writes (blocking) to pu[1] */ + if (-1 == fcntl(pd[0], F_SETFL, $o_nonblock)) + exit(1); + signal(SIGALRM, blech); + alarm(5); + if ((ret = read(pd[0], buf, 1)) > 0) /* Nothing to read! */ + exit(2); + sprintf(string, "%d\n", ret); + write(2, string, strlen(string)); + alarm(0); +#ifdef EAGAIN + if (errno == EAGAIN) { + printf("EAGAIN\n"); + goto ok; + } +#endif +#ifdef EWOULDBLOCK + if (errno == EWOULDBLOCK) + printf("EWOULDBLOCK\n"); +#endif + ok: + write(pu[1], buf, 1); /* Unblocks child, tell it to close our pipe */ + sleep(2); /* Give it time to close our pipe */ + alarm(5); + ret = read(pd[0], buf, 1); /* Should read EOF */ + alarm(0); + sprintf(string, "%d\n", ret); + write(3, string, strlen(string)); + exit(0); + } + + close(pd[0]); /* We write to pd[1] */ + close(pu[1]); /* We read from pu[0] */ + read(pu[0], buf, 1); /* Wait for parent to signal us we may continue */ + close(pd[1]); /* Pipe pd is now fully closed! */ + exit(0); /* Bye bye, thank you for playing! */ +} +EOCP + if $cc $ccflags $ldflags try.c -o try >/dev/null; 2>&1; then + echo "./try >try.out 2>try.ret 3>try.err || exit 4" >mtry + chmod +x mtry + ./mtry >/dev/null 2>&1 + case $? in + 0) eagain=`$cat try.out`;; + 1) echo "Could not perform non-blocking setting!";; + 2) echo "I did a successful read() for something that was not there!";; + 3) echo "Hmm... non-blocking I/O does not seem to be working!";; + *) echo "Something terribly wrong happened during testing.";; + esac + rd_nodata=`$cat try.ret` + echo "A read() system call with no data present returns $rd_nodata." + case "$rd_nodata" in + 0|-1) ;; + *) + echo "(That's peculiar, fixing that to be -1.)" + rd_nodata=-1 + ;; + esac + case "$eagain" in + '') + echo "Forcing errno EAGAIN on read() with no data available." + eagain=EAGAIN + ;; + *) + echo "Your read() sets errno to $eagain when no data is available." + ;; + esac + status=`$cat try.err` + case "$status" in + 0) echo "And it correctly returns 0 to signal EOF.";; + -1) echo "But it also returns -1 to signal EOF, so be careful!";; + *) echo "However, your read() returns '$status' on EOF??";; + esac + val="$define" + if test "$status" -eq "$rd_nodata"; then + echo "WARNING: you can't distinguish between EOF and no data!" + val="$undef" + fi + else + echo "I can't compile the test program--assuming errno EAGAIN will do." + eagain=EAGAIN + fi + set d_eofnblk + eval $setvar + ;; +*) + echo "Using $hint value $eagain." + echo "Your read() returns $rd_nodata when no data is present." + case "$d_eofnblk" in + "$define") echo "And you can see EOF because read() returns 0.";; + "$undef") echo "But you can't see EOF status from read() returned value.";; + *) + echo "(Assuming you can't see EOF status from read anyway.)" + d_eofnblk=$undef + ;; + esac + ;; +esac +$rm -f try try.* .out core head.c mtry + : see if fchmod exists set fchmod d_fchmod eval $inlibc @@ -4736,49 +5655,6 @@ eval $inlibc set fgetpos d_fgetpos eval $inlibc -: see if we can have long filenames -echo " " -rmlist="$rmlist /tmp/cf$$" -$test -d /tmp/cf$$ || mkdir /tmp/cf$$ -first=123456789abcdef -second=/tmp/cf$$/$first -$rm -f $first $second -if (echo hi >$first) 2>/dev/null; then - if $test -f 123456789abcde; then - echo 'You cannot have filenames longer than 14 characters. Sigh.' >&4 - val="$undef" - else - if (echo hi >$second) 2>/dev/null; then - if $test -f /tmp/cf$$/123456789abcde; then - $cat <<'EOM' -That's peculiar... You can have filenames longer than 14 characters, but only -on some of the filesystems. Maybe you are using NFS. Anyway, to avoid problems -I shall consider your system cannot support long filenames at all. -EOM - val="$undef" - else - echo 'You can have filenames longer than 14 characters.' >&4 - val="$define" - fi - else - $cat <<'EOM' -How confusing! Some of your filesystems are sane enough to allow filenames -longer than 14 characters but some others like /tmp can't even think about them. -So, for now on, I shall assume your kernel does not allow them at all. -EOM - val="$undef" - fi - fi -else - $cat <<'EOM' -You can't have filenames longer than 14 chars. You can't even think about them! -EOM - val="$undef" -fi -set d_flexfnam -eval $setvar -$rm -rf /tmp/cf$$ 123456789abcde* - : see if flock exists set flock d_flock eval $inlibc @@ -5122,56 +5998,6 @@ $rm -f malloc.[co] set nice d_nice eval $inlibc -: Locate the flags for 'open()' -echo " " -$cat >open3.c <<'EOCP' -#include <sys/types.h> -#ifdef I_FCNTL -#include <fcntl.h> -#endif -#ifdef I_SYS_FILE -#include <sys/file.h> -#endif -main() { - if(O_RDONLY); -#ifdef O_TRUNC - exit(0); -#else - exit(1); -#endif -} -EOCP -: check sys/file.h first to get FREAD on Sun -if $test `./findhdr sys/file.h` && \ - $cc $cppflags "-DI_SYS_FILE" open3.c -o open3 >/dev/null 2>&1 ; then - h_sysfile=true; - echo "<sys/file.h> defines the O_* constants..." >&4 - if ./open3; then - echo "and you have the 3 argument form of open()." >&4 - val="$define" - else - echo "but not the 3 argument form of open(). Oh, well." >&4 - val="$undef" - fi -elif $test `./findhdr fcntl.h` && \ - $cc "-DI_FCNTL" open3.c -o open3 >/dev/null 2>&1 ; then - h_fcntl=true; - echo "<fcntl.h> defines the O_* constants..." >&4 - if ./open3; then - echo "and you have the 3 argument form of open()." >&4 - val="$define" - else - echo "but not the 3 argument form of open(). Oh, well." >&4 - val="$undef" - fi -else - val="$undef" - echo "I can't find the O_* constant definitions! You got problems." >&4 -fi -set d_open3 -eval $setvar -$rm -f open3* - : see if pause exists set pause d_pause eval $inlibc @@ -5180,6 +6006,10 @@ eval $inlibc set pipe d_pipe eval $inlibc +: see if poll exists +set poll d_poll +eval $inlibc + : see if this is a pwd.h system set pwd.h i_pwd eval $inhdr @@ -5304,7 +6134,7 @@ for (align = 7; align >= 0; align--) { exit(0); } EOCP - if $cc foo.c -o safebcpy $ccflags $ldflags $libs >/dev/null 2>&1 ; then + if $cc $ccflags $ldflags foo.c -o safebcpy $libs >/dev/null 2>&1; then if ./safebcpy 2>/dev/null; then echo "Yes, it can." val="$define" @@ -5352,7 +6182,7 @@ for (align = 7; align >= 0; align--) { exit(0); } EOCP - if $cc foo.c -o safemcpy $ccflags $ldflags $libs >/dev/null 2>&1 ; then + if $cc $ccflags $ldflags foo.c -o safemcpy $libs >/dev/null 2>&1; then if ./safemcpy 2>/dev/null; then echo "Yes, it can." val="$define" @@ -5515,57 +6345,6 @@ fi set d_shm eval $setvar -: determine whether the user wants to include a site-specific library -: in addition to privlib. -$cat <<EOM - -Some sites may wish to specify a local directory for $package -to search by default in addition to $privlib. -If you don't want to use such an additional directory, answer 'none'. - -EOM -case "$sitelib" in -'') dflt=none ;; -*) dflt="$sitelib" ;; -esac -fn=d~+n -rp='Local directory for additional library files?' -. ./getfile -if $test "X$sitelibexp" != "X$ansexp"; then - installsitelib='' -fi -sitelib="$ans" -sitelibexp="$ansexp" -if $afs; then - case "$sitelib" in - '') installsitelib="$sitelibexp" - ;; - *) $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -private files reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installsitelib" in - '') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installsitelib";; - esac - fn=de~ - rp='Where will additional local files be installed?' - . ./getfile - installsitelib="$ans" - ;; - esac -else - installsitelib="$sitelibexp" -fi - -case "$sitelibexp" in -'') d_sitelib=undef ;; -*) d_sitelib=define ;; -esac - socketlib='' sockethdr='' : see whether socket exists @@ -5645,15 +6424,13 @@ if $contains '_IO_fpos_t' `./findhdr stdio.h` >/dev/null 2>&1 ; then '') stdio_ptr='((fp)->_IO_read_ptr)' ptr_lval=$define ;; - *) ptr_lval=$d_stdio_ptr_lval - ;; + *) ptr_lval=$d_stdio_ptr_lval;; esac case "$stdio_cnt" in '') stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)' cnt_lval=$undef ;; - *) cnt_lval=$d_stdio_cnt_lval - ;; + *) cnt_lval=$d_stdio_cnt_lval;; esac case "$stdio_base" in '') stdio_base='((fp)->_IO_read_base)';; @@ -5666,15 +6443,13 @@ else '') stdio_ptr='((fp)->_ptr)' ptr_lval=$define ;; - *) ptr_lval=$d_stdio_ptr_lval - ;; + *) ptr_lval=$d_stdio_ptr_lval;; esac case "$stdio_cnt" in '') stdio_cnt='((fp)->_cnt)' cnt_lval=$define ;; - *) cnt_lval=$d_stdio_cnt_lval - ;; + *) cnt_lval=$d_stdio_cnt_lval;; esac case "$stdio_base" in '') stdio_base='((fp)->_base)';; @@ -5715,8 +6490,7 @@ $rm -f try.c try set d_stdstdio eval $setvar -: Can _ptr be used as an lvalue. Only makes sense if we -: have a known stdio implementation. +: Can _ptr be used as an lvalue? case "$d_stdstdio$ptr_lval" in $define$define) val=$define ;; *) val=$undef ;; @@ -5724,9 +6498,7 @@ esac set d_stdio_ptr_lval eval $setvar - -: Can _cnt be used as an lvalue. Only makes sense if we -: have a known stdio implementation. +: Can _cnt be used as an lvalue? case "$d_stdstdio$cnt_lval" in $define$define) val=$define ;; *) val=$undef ;; @@ -5734,7 +6506,6 @@ esac set d_stdio_cnt_lval eval $setvar - : see if _base is also standard val="$undef" case "$d_stdstdio" in @@ -5877,12 +6648,12 @@ case "$varval" in done; $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; if $contains $type temp.E >/dev/null 2>&1; then - eval "$var=$type"; + eval "$var=\$type"; else - eval "$var=$def"; + eval "$var=\$def"; fi; $rm -f temp.?;; -*) eval "$var=$varval";; +*) eval "$var=\$varval";; esac' : see if this is a sys/times.h system @@ -5931,156 +6702,6 @@ eval $setvar set umask d_umask eval $inlibc -: see if we have to deal with yellow pages, now NIS. -if $test -d /usr/etc/yp || $test -d /etc/yp; then - if $test -f /usr/etc/nibindd; then - echo " " - echo "I'm fairly confident you're on a NeXT." - echo " " - rp='Do you get the hosts file via NetInfo?' - dflt=y - case "$hostcat" in - nidump*) ;; - '') ;; - *) dflt=n;; - esac - . ./myread - case "$ans" in - y*) hostcat='nidump hosts .';; - *) case "$hostcat" in - nidump*) hostcat='';; - esac - ;; - esac - fi - case "$hostcat" in - nidump*) ;; - *) - case "$hostcat" in - *ypcat*) dflt=y;; - '') if $contains '^\+' /etc/passwd >/dev/null 2>&1; then - dflt=y - else - dflt=n - fi;; - *) dflt=n;; - esac - echo " " - rp='Are you getting the hosts file via yellow pages?' - . ./myread - case "$ans" in - y*) hostcat='ypcat hosts';; - *) hostcat='cat /etc/hosts';; - esac - ;; - esac -fi - -: now get the host name -echo " " -echo "Figuring out host name..." >&4 -case "$myhostname" in -'') cont=true - echo 'Maybe "hostname" will work...' - if tans=`sh -c hostname 2>&1` ; then - myhostname=$tans - phostname=hostname - cont='' - fi - ;; -*) cont='';; -esac -if $test "$cont"; then - if ./xenix; then - echo 'Oh, dear. Maybe "/etc/systemid" is the key...' - if tans=`cat /etc/systemid 2>&1` ; then - myhostname=$tans - phostname='cat /etc/systemid' - echo "Whadyaknow. Xenix always was a bit strange..." - cont='' - fi - elif $test -r /etc/systemid; then - echo "(What is a non-Xenix system doing with /etc/systemid?)" - fi -fi -if $test "$cont"; then - echo 'No, maybe "uuname -l" will work...' - if tans=`sh -c 'uuname -l' 2>&1` ; then - myhostname=$tans - phostname='uuname -l' - else - echo 'Strange. Maybe "uname -n" will work...' - if tans=`sh -c 'uname -n' 2>&1` ; then - myhostname=$tans - phostname='uname -n' - else - echo 'Oh well, maybe I can mine it out of whoami.h...' - if tans=`sh -c $contains' sysname $usrinc/whoami.h' 2>&1` ; then - myhostname=`echo "$tans" | $sed 's/^.*"\(.*\)"/\1/'` - phostname="sed -n -e '"'/sysname/s/^.*\"\\(.*\\)\"/\1/{'"' -e p -e q -e '}' <$usrinc/whoami.h" - else - case "$myhostname" in - '') echo "Does this machine have an identity crisis or something?" - phostname='';; - *) - echo "Well, you said $myhostname before..." - phostname='echo $myhostname';; - esac - fi - fi - fi -fi -: you do not want to know about this -set $myhostname -myhostname=$1 - -: verify guess -if $test "$myhostname" ; then - dflt=y - rp='Your host name appears to be "'$myhostname'".'" Right?" - . ./myread - case "$ans" in - y*) ;; - *) myhostname='';; - esac -fi - -: bad guess or no guess -while $test "X$myhostname" = X ; do - dflt='' - rp="Please type the (one word) name of your host:" - . ./myread - myhostname="$ans" -done - -: translate upper to lower if necessary -case "$myhostname" in -*[A-Z]*) - echo "(Normalizing case in your host name)" - myhostname=`echo $myhostname | ./tr '[A-Z]' '[a-z]'` - ;; -esac - -: a little sanity check here -case "$phostname" in -'') ;; -*) - case `$phostname | ./tr '[A-Z]' '[a-z]'` in - $myhostname$mydomain|$myhostname) ;; - *) - case "$phostname" in - sed*) - echo "(That doesn't agree with your whoami.h file, by the way.)" - ;; - *) - echo "(That doesn't agree with your $phostname command, by the way.)" - ;; - esac - ;; - esac - ;; -esac - : see how we will look up host name echo " " if false; then @@ -6299,38 +6920,6 @@ rp="Doubles must be aligned on a how-many-byte boundary?" alignbytes="$ans" $rm -f try.c try -: determine where public executables go -echo " " -set dflt bin bin -eval $prefixit -fn=d~ -rp='Pathname where the public executables will reside?' -. ./getfile -if $test "X$ansexp" != "X$binexp"; then - installbin='' -fi -bin="$ans" -binexp="$ansexp" -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -executables reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installbin" in - '') dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installbin";; - esac - fn=de~ - rp='Where will public executables be installed?' - . ./getfile - installbin="$ans" -else - installbin="$binexp" -fi - : check for ordering of bytes in a long case "$byteorder" in '') @@ -6360,13 +6949,20 @@ main() for (i = 0; i < sizeof(long); i++) printf("%c", u.c[i]+'0'); printf("\n"); + exit(0); } EOCP - if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then + xxx_prompt=y + if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then dflt=`./try` case "$dflt" in - ????|????????) echo "(The test program ran ok.)";; - *) echo "(The test program didn't run right for some reason.)";; + [1-4][1-4][1-4][1-4]|12345678|87654321) + echo "(The test program ran ok.)" + echo "byteorder=$dflt" + xxx_prompt=n + ;; + ????|????????) echo "(The test program ran ok.)" ;; + *) echo "(The test program didn't run right for some reason.)" ;; esac else dflt='4321' @@ -6374,15 +6970,17 @@ EOCP (I can't seem to compile the test program. Guessing big-endian...) EOM fi - ;; -*) - echo " " - dflt="$byteorder" + case "$xxx_prompt" in + y) + rp="What is the order of bytes in a long?" + . ./myread + byteorder="$ans" + ;; + *) byteorder=$dflt + ;; + esac ;; esac -rp="What is the order of bytes in a long?" -. ./myread -byteorder="$ans" $rm -f try.c try : how do we catenate cpp tokens here? @@ -6580,31 +7178,47 @@ echo "Hmm, your compiler has some difficulty with void. Checking further..." >&4 fi fi esac -dflt="$voidflags"; -rp="Your void support flags add up to what?" -. ./myread -voidflags="$ans" +: Only prompt user if voidflags is not 15. If voidflags is 15, then +: we presume all is well. +case "$voidflags" in +15) ;; +*) dflt="$voidflags"; + rp="Your void support flags add up to what?" + . ./myread + voidflags="$ans" + ;; +esac $rm -f try.* .out : see if dbm.h is available -set dbm.h t_dbm -eval $inhdr -case "$t_dbm" in +: see if dbmclose exists +set dbmclose d_dbmclose +eval $inlibc + +case "$d_dbmclose" in $define) - : see if dbmclose exists - set dbmclose d_dbmclose - eval $inlibc - case "$d_dbmclose" in - $undef) - t_dbm="$undef" - echo "We won't be including <dbm.h>" + set dbm.h i_dbm + eval $inhdr + case "$i_dbm" in + $define) + val="$undef" + set i_rpcsvcdbm + eval $setvar + ;; + *) set rpcsvc/dbm.h i_rpcsvcdbm + eval $inhdr ;; esac ;; +*) echo "We won't be including <dbm.h>" + val="$undef" + set i_dbm + eval $setvar + val="$undef" + set i_rpcsvcdbm + eval $setvar + ;; esac -val="$t_dbm" -set i_dbm -eval $setvar : see if ndbm.h is available set ndbm.h t_ndbm @@ -6692,8 +7306,8 @@ for xxx in $known_extensions ; do $define) avail_ext="$avail_ext $xxx" ;; esac ;; - ODBM_File) case "$i_dbm" in - $define) avail_ext="$avail_ext $xxx" ;; + ODBM_File) case "${i_dbm}${i_rpcsvcdbm}" in + *"${define}"*) avail_ext="$avail_ext $xxx" ;; esac ;; POSIX) case "$useposix" in @@ -6855,170 +7469,6 @@ rp="What type is lseek's offset on this system declared as?" . ./myread lseektype="$ans" -: determine where manual pages go -set man1dir man1dir none -eval $prefixit -$cat <<EOM - -$spackage has manual pages available in source form. -EOM -case "$nroff" in -nroff) - echo "However, you don't have nroff, so they're probably useless to you." - case "$man1dir" in - '') man1dir="none";; - esac;; -esac -echo "If you don't want the manual sources installed, answer 'none'." -case "$man1dir" in -'') - lookpath="$prefixexp/man/man1 $prefixexp/man/u_man/man1" - lookpath="$lookpath $prefixexp/man/l_man/man1" - lookpath="$lookpath /usr/local/man/man1 /opt/man/man1 /usr/man/manl" - lookpath="$lookpath /usr/man/local/man1 /usr/man/l_man/man1" - lookpath="$lookpath /usr/local/man/u_man/man1 /usr/local/man/l_man/man1" - lookpath="$lookpath /usr/man/man.L" - man1dir=`./loc . $prefixexp/man/man1 $lookpath` - if $test -d "$man1dir"; then - dflt="$man1dir" - else - dflt="$sysman" - fi - set dflt - eval $prefixup - ;; -' ') dflt=none;; -*) dflt="$man1dir" - ;; -esac -echo " " -fn=dn~ -rp="Where do the main $spackage manual pages (source) go?" -. ./getfile -if test "X$man1direxp" != "X$ansexp"; then - installman1dir='' -fi -man1dir="$ans" -man1direxp="$ansexp" -case "$man1dir" in -'') man1dir=' ' - installman1dir='';; -esac -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -manual pages reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installman1dir" in - '') dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installman1dir";; - esac - fn=de~ - rp='Where will man pages be installed?' - . ./getfile - installman1dir="$ans" -else - installman1dir="$man1direxp" -fi - -case "$man1dir" in -' ') man1ext='0';; -*l) man1ext=l;; -*n) man1ext=n;; -*o) man1ext=l;; -*p) man1ext=n;; -*C) man1ext=C;; -*L) man1ext=L;; -*L1) man1ext=L1;; -*) man1ext=1;; -esac - -: determine where library module manual pages go -set man3dir man3dir none -eval $prefixit -$cat <<EOM - -$spackage has manual pages for many of the library modules. -EOM - -case "$nroff" in -nroff) - $cat <<'EOM' -However, you don't have nroff, so they're probably useless to you. -You can use the supplied perldoc script instead. -EOM - case "$man3dir" in - '') man3dir="none";; - esac;; -esac - -case "$d_flexfnam" in -undef) - $cat <<'EOM' -However, your system can't handle the long file names like File::Basename.3. -You can use the supplied perldoc script instead. -EOM - case "$man3dir" in - '') man3dir="none";; - esac;; -esac - -echo "If you don't want the manual sources installed, answer 'none'." -case "$man3dir" in -'') dflt="$privlib/man/man3" ;; -' ') dflt=none;; -*) dflt="$man3dir" ;; -esac -echo " " - -fn=dn~ -rp="Where do the $spackage library man pages (source) go?" -. ./getfile -if test "X$man3direxp" != "X$ansexp"; then - installman3dir='' -fi - -man3dir="$ans" -man3direxp="$ansexp" -case "$man3dir" in -'') man3dir=' ' - installman3dir='';; -esac -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -manual pages reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installman3dir" in - '') dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installman3dir";; - esac - fn=de~ - rp='Where will man pages be installed?' - . ./getfile - installman3dir="$ans" -else - installman3dir="$man3direxp" -fi - -case "$man3dir" in -' ') man3ext='0';; -*l) man3ext=l;; -*n) man3ext=n;; -*o) man3ext=l;; -*p) man3ext=n;; -*C) man3ext=C;; -*L) man3ext=L;; -*L3) man3ext=L3;; -*) man3ext=3;; -esac - : see what type is used for mode_t set mode_t modetype int stdio.h sys/types.h eval $typedef @@ -7140,59 +7590,6 @@ else fi $rm -f foo* bar* -: determine where public executable scripts go -set scriptdir scriptdir -eval $prefixit -case "$scriptdir" in -'') - dflt="$bin" - : guess some guesses - $test -d /usr/share/scripts && dflt=/usr/share/scripts - $test -d /usr/share/bin && dflt=/usr/share/bin - $test -d /usr/local/script && dflt=/usr/local/script - $test -d $prefixexp/script && dflt=$prefixexp/script - set dflt - eval $prefixup - ;; -*) dflt="$scriptdir" - ;; -esac -$cat <<EOM - -Some installations have a separate directory just for executable scripts so -that they can mount it across multiple architectures but keep the scripts in -one spot. You might, for example, have a subdirectory of /usr/share for this. -Or you might just lump your scripts in with all your other executables. - -EOM -fn=d~ -rp='Where do you keep publicly executable scripts?' -. ./getfile -if $test "X$ansexp" != "X$scriptdirexp"; then - installscript='' -fi -scriptdir="$ans" -scriptdirexp="$ansexp" -if $afs; then - $cat <<EOM - -Since you are running AFS, I need to distinguish the directory in which -scripts reside from the directory in which they are installed (and from -which they are presumably copied to the former directory by occult means). - -EOM - case "$installscript" in - '') dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;; - *) dflt="$installscript";; - esac - fn=de~ - rp='Where will public scripts be installed?' - . ./getfile - installscript="$ans" -else - installscript="$scriptdirexp" -fi - : see if sys/select.h has to be included set sys/select.h i_sysselct eval $inhdr @@ -7419,51 +7816,85 @@ EOCP fi $rm -f try.[co] ;; -*) selecttype = 'int *' +*) selecttype='int *' ;; esac -: generate list of signal names -echo " " -case "$sig_name" in -'') - echo "Generating a list of signal names..." >&4 - xxx=`./findhdr signal.h`" "`./findhdr sys/signal.h` - xxx="$xxx "`./findhdr linux/signal.h` - set X `cat $xxx 2>&1 | $awk ' -$1 ~ /^#define$/ && $2 ~ /^SIG[A-Z0-9]*$/ && $3 ~ /^[1-9][0-9]*$/ { - sig[$3] = substr($2,4,20) - if (max < $3 && $3 < 60) { - max = $3 - } +: Trace out the files included by signal.h, then look for SIGxxx names. +: Remove SIGARRAYSIZE used by HPUX. +xxx=`echo '#include <signal.h>' | + $cppstdin $cppminus $cppflags 2>/dev/null | + $grep '^[ ]*#.*include' | + $awk "{print \\$$fieldn}" | $sed 's!"!!g' | $sort | $uniq` +: Check this list of files to be sure we have parsed the cpp output ok. +: This will also avoid potentially non-existent files, such +: as ../foo/bar.h +xxxfiles='' +for xx in $xxx /dev/null ; do + $test -f "$xx" && xxxfiles="$xxxfiles $xx" +done +: If we have found no files, at least try signal.h +case "$xxxfiles" in +'') xxxfiles=`./findhdr signal.h` ;; +esac +xxx=`awk ' +$1 ~ /^#define$/ && $2 ~ /^SIG[A-Z0-9]*$/ && $2 !~ /SIGARRAYSIZE/ { + print substr($2, 4, 20) +} +$1 == "#" && $2 ~ /^define$/ && $3 ~ /^SIG[A-Z0-9]*$/ && $3 !~ /SIGARRAYSIZE/ { + print substr($3, 4, 20) +}' $xxxfiles` +: Append some common names just in case the awk scan failed. +xxx="$xxx ABRT ALRM BUS CHLD CLD CONT DIL EMT FPE HUP ILL INT IO IOT KILL" +xxx="$xxx LOST PHONE PIPE POLL PROF PWR QUIT SEGV STKFLT STOP SYS TERM TRAP" +xxx="$xxx TSTP TTIN TTOU URG USR1 USR2 USR3 USR4 VTALRM" +xxx="$xxx WINCH WIND WINDOW XCPU XFSZ" +: generate a few handy files for later +echo $xxx | $tr ' ' '\012' | $awk ' +BEGIN { + printf "#include <signal.h>\n"; + printf "main() {\n"; +} +{ + printf "#ifdef SIG"; printf $1; printf "\n" + printf "printf(\""; printf $1; printf " %%d\\n\",SIG"; + printf $1; printf ");\n" + printf "#endif\n" } - END { - for (i = 1; i <= max; i++) { - if (sig[i] == "") - printf "%d", i - else - printf "%s", sig[i] - if (i < max) - printf " " - } - printf "\n" + printf "}\n"; } -'` +' >signal.c +$cat >signal.cmd <<EOS +$startsh +$test -s signal.lst && exit 0 +if $cc $ccflags signal.c -o signal $ldflags >/dev/null 2>&1; then + ./signal | $sort -n +1 | $uniq >signal.lst +else + echo "(I can't seem be able to compile the test program -- Guessing)" + echo 'kill -l' >signal + set X \`csh -f <signal\` + $rm -f signal shift - case $# in - 0) - echo 'kill -l' >/tmp/foo$$ - set X `csh -f </tmp/foo$$` - $rm -f /tmp/foo$$ - shift - case $# in - 0)set HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM - ;; - esac - ;; + case \$# in + 0) set HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM;; esac - sig_name="ZERO $*" + echo \$@ | $tr ' ' '\012' | \ + $awk '{ printf $1; printf " %d\n", ++s; }' >signal.lst +fi +$rm -f signal.c signal signal.o +EOS +chmod a+x signal.cmd +$eunicefix signal.cmd + +: generate list of signal names +echo " " +case "$sig_name" in +'') + echo "Generating a list of signal names..." >&4 + ./signal.cmd + sig_name=`$awk '{printf "%s ", $1}' signal.lst` + sig_name="ZERO $sig_name" ;; esac echo "The following signals are available:" @@ -7471,7 +7902,7 @@ echo " " echo $sig_name | $awk \ 'BEGIN { linelen = 0 } { - for (i = 1; i < NF; i++) { + for (i = 1; i <= NF; i++) { name = "SIG" $i " " linelen = linelen + length(name) if (linelen > 70) { @@ -7480,8 +7911,23 @@ echo $sig_name | $awk \ } printf "%s", name } + printf "\n" }' + +: generate list of signal numbers echo " " +case "$sig_num" in +'') + echo "Generating a list of signal numbers..." >&4 + ./signal.cmd + sig_num=`$awk '{printf "%d ", $2}' signal.lst` + sig_num="0 $sig_num" + ;; +esac +case "$sig_max" in +'') sig_max=`$tail -1 signal.lst | $awk '{print $2}'` ;; +esac +echo "The maximum signal number defined is $sig_max." : see what type is used for size_t set size_t sizetype 'unsigned int' stdio.h sys/types.h @@ -7583,7 +8029,7 @@ val='' set sys/file.h val eval $inhdr -: do we need to #include <sys/file.h> ? +: do we need to include sys/file.h ? case "$val" in "$define") echo " " @@ -8104,6 +8550,7 @@ cccdlflags='$cccdlflags' ccdlflags='$ccdlflags' ccflags='$ccflags' cf_by='$cf_by' +cf_email='$cf_email' cf_time='$cf_time' chgrp='$chgrp' chmod='$chmod' @@ -8152,6 +8599,7 @@ d_dlopen='$d_dlopen' d_dlsymun='$d_dlsymun' d_dosuid='$d_dosuid' d_dup2='$d_dup2' +d_eofnblk='$d_eofnblk' d_eunice='$d_eunice' d_fchmod='$d_fchmod' d_fchown='$d_fchown' @@ -8204,6 +8652,7 @@ d_pathconf='$d_pathconf' d_pause='$d_pause' d_phostname='$d_phostname' d_pipe='$d_pipe' +d_poll='$d_poll' d_portable='$d_portable' d_pwage='$d_pwage' d_pwchange='$d_pwchange' @@ -8295,6 +8744,7 @@ direntrytype='$direntrytype' dlext='$dlext' dlsrc='$dlsrc' dynamic_ext='$dynamic_ext' +eagain='$eagain' echo='$echo' egrep='$egrep' emacs='$emacs' @@ -8337,6 +8787,7 @@ i_ndbm='$i_ndbm' i_neterrno='$i_neterrno' i_niin='$i_niin' i_pwd='$i_pwd' +i_rpcsvcdbm='$i_rpcsvcdbm' i_sgtty='$i_sgtty' i_stdarg='$i_stdarg' i_stddef='$i_stddef' @@ -8390,6 +8841,8 @@ lint='$lint' lkflags='$lkflags' ln='$ln' lns='$lns' +locincpth='$locincpth' +loclibpth='$loclibpth' lp='$lp' lpr='$lpr' ls='$ls' @@ -8421,6 +8874,7 @@ myuname='$myuname' n='$n' nm_opt='$nm_opt' nroff='$nroff' +o_nonblock='$o_nonblock' optimize='$optimize' orderlib='$orderlib' osname='$osname' @@ -8429,6 +8883,7 @@ package='$package' passcat='$passcat' patchlevel='$patchlevel' perl='$perl' +perladmin='$perladmin' pg='$pg' phostname='$phostname' plibpth='$plibpth' @@ -8441,6 +8896,7 @@ privlibexp='$privlibexp' prototype='$prototype' randbits='$randbits' ranlib='$ranlib' +rd_nodata='$rd_nodata' rm='$rm' rmail='$rmail' runnm='$runnm' @@ -8455,7 +8911,9 @@ sharpbang='$sharpbang' shmattype='$shmattype' shrpdir='$shrpdir' shsharp='$shsharp' +sig_max='$sig_max' sig_name='$sig_name' +sig_num='$sig_num' signal_t='$signal_t' sitelib='$sitelib' sitelibexp='$sitelibexp' diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000000..b72e43ce34 --- /dev/null +++ b/INSTALL @@ -0,0 +1,484 @@ +=head1 NAME + +Install - Build and Installation guide for perl5. + +=head1 SYNOPSIS + +The basic steps to build and install perl5 are: + + rm -f config.sh + sh Configure + make + make test + make install + +Each of these is explained in further detail below. + +=head1 BUILDING PERL5 + +=head1 Start with a Fresh Distribution. + +The results of a Configure run are stored in the config.sh file. If +you are upgrading from a previous version of perl, or if you change +systems or compilers or make other significant changes, or if you are +experiencing difficulties building perl, you should probably I<not> +re-use your old config.sh. Simply remove it or rename it, e.g. + + mv config.sh config.sh.old + +Then run Configure. + +=head1 Run Configure. + +Configure will figure out various things about your system. Some +things Configure will figure out for itself, other things it will ask +you about. To accept the default, just press C<RETURN>. The default +is almost always ok. + +After it runs, Configure will perform variable substitution on all the +F<*.SH> files and offer to run B<make depend>. + +Configure supports a number of useful options. Run B<Configure -h> +to get a listing. To compile with gcc, for example, you can run + + sh Configure -Dcc=gcc + +This is the preferred way to specify gcc (or another alternative +compiler) so that the hints files can set appropriate defaults. + +If you are willing to accept all the defaults, and you want terse +output, you can run + + sh Configure -des + +By default, for most systems, perl will be installed in +/usr/local/{bin, lib, man}. You can specify a different 'prefix' for +the default installation directory, when Configure prompts you or by +using the Configure command line option -Dprefix='/some/directory', +e.g. + + Configure -Dprefix=/opt/local + +By default, Configure will compile perl to use dynamic loading, if +your system supports it. If you want to force perl to be compiled +statically, you can either choose this when Configure prompts you or by +using the Configure command line option -Uusedl. + +=head2 GNU-style configure + +If you prefer the GNU-style B<configure> command line interface, you can +use the supplied B<configure> command, e.g. + + CC=gcc ./configure + +The B<configure> script emulates several of the more common configure +options. Try + + ./configure --help + +for a listing. + +Cross compiling is currently not supported. + +=head2 Including locally-installed libraries + +Perl5 comes with a number of database extensions, including interfaces +to dbm, ndbm, gdbm, and Berkeley db. For each extension, if Configure +can find the appropriate header files and libraries, it will automatically +include that extension. + +I<Note:> If your database header (.h) files are not in a +directory normally searched by your C compiler, then you will need to +include the appropriate B<-I/your/directory> option when prompted by +Configure. If your database library (.a) files are not in a directory +normally searched by your C compiler and linker, then you will need to +include the appropriate B<-L/your/directory> option when prompted by +Configure. See the examples below. + +=head2 Examples + +=over 4 + +=item gdbm in /usr/local. + +Suppose you have gdbm and want Configure to find it and build the +GDBM_File extension. This examples assumes you have F<gdbm.h> +installed in F</usr/local/include/gdbm.h> and F<libgdbm.a> installed in +F</usr/local/lib/libgdbm.a>. Configure should figure all the +necessary steps out automatically. + +Specifically, when Configure prompts you for flags for +your C compiler, you should include C<-I/usr/local/include>. + +When Configure prompts you for linker flags, you should include +C<-L/usr/local/lib>. + +If you are using dynamic loading, then when Configure prompts you for +linker flags for dynamic loading, you should again include +C<-L/usr/local/lib>. + +Again, this should all happen automatically. If you want to accept the +defaults for all the questions and have Configure print out only terse +messages, then you can just run + + sh Configure -des + +and Configure should include the GDBM_File extension automatically. + +This should actually work if you have gdbm installed in any of +(/usr/local, /opt/local, /usr/gnu, /opt/gnu, /usr/GNU, or /opt/GNU). + +=item gdbm in /usr/you + +Suppose you have gdbm installed in some place other than /usr/local/, +but you still want Configure to find it. To be specific, assume you +have F</usr/you/include/gdbm.h> and F</usr/you/lib/libgdbm.a>. You +still have to add B<-I/usr/you/include> to cc flags, but you have to take +an extra step to help Configure find F<libgdbm.a>. Specifically, when +Configure prompts you for library directories, you have to add +F</usr/you/lib> to the list. + +It is possible to specify this from the command line too (all on one +line): + + sh Configure -des \ + -Dlocincpth="/usr/you/include" \ + -Dloclibpth="/usr/you/lib" + +C<locincpth> is a space-separated list of include directories to search. +Configure will automatically add the appropriate B<-I> directives. + +C<loclibpth> is a space-separated list of library directories to search. +Configure will automatically add the appropriate B<-L> directives. If +you have some libraries under F</usr/local/> and others under +F</usr/you>, then you have to include both, namely + + sh Configure -des \ + -Dlocincpth="/usr/you/include /usr/local/include" \ + -Dloclibpth="/usr/you/lib /usr/local/lib" + +=back + +=head2 Changing the installation directory + +Configure distinguishes between the directory in which perl (and its +associated files) should be installed and the directory in which it +will eventually reside. For most sites, these two are the same; for +sites that use AFS, this distinction is handled automatically. +However, sites that use software such as B<depot> to manage software +packages may also wish to install perl into a different directory and +use that management software to move perl to its final destination. +This section describes how to do this. Someday, Configure may support +an option C<-Dinstallprefix=/foo> to simplify this. + +Suppose you want to install perl under the F</tmp/perl5> directory. +You can edit F<config.sh> and change all the install* variables to +point to F</tmp/perl5> instead of F</usr/local/wherever>. You could +also set them all from the Configure command line. Or, you can +automate this process by placing the following lines in a file +F<config.over> B<before> you run Configure (replace /tmp/perl5 by a +directory of your choice): + + installprefix=/tmp/perl5 + test -d $installprefix || mkdir $installprefix + test -d $installprefix/bin || mkdir $installprefix/bin + installarchlib=`echo $installarchlib | sed "s!$prefix!$installprefix!"` + installbin=`echo $installbin | sed "s!$prefix!$installprefix!"` + installman1dir=`echo $installman1dir | sed "s!$prefix!$installprefix!"` + installman3dir=`echo $installman3dir | sed "s!$prefix!$installprefix!"` + installprivlib=`echo $installprivlib | sed "s!$prefix!$installprefix!"` + installscript=`echo $installscript | sed "s!$prefix!$installprefix!"` + installsitelib=`echo $installsitelib | sed "s!$prefix!$installprefix!"` + +Then, you can Configure and install in the usual way: + + sh ./Configure -des + make + make test + make install + +=head2 Creating an installable tar archive + +If you need to install perl on many identical systems, it is +convenient to compile it once and create an archive that can be +installed on multiple systems. Here's one way to do that: + + # Set up config.over to install perl into a different directory, + # e.g. /tmp/perl5 (see previous part). + sh ./Configure -des + make + make test + make install + cd /tmp/perl5 + tar cvf ../perl5-archive.tar . + # Then, on each machine where you want to install perl, + cd /usr/local # Or wherever you specified as $prefix + tar xvf perl5-archive.tar + +=head2 What if it doesn't work? + +=over 4 + +=item Hint files. + +The perl distribution includes a number of system-specific hints files +in the hints/ directory. If one of them matches your system, Configure +will offer to use that hint file. + +Several of the hint files contain additional important information. +If you have any problems, it is a good idea to read the relevant hint +file for further information. See F<hints/solaris_2.sh> for an +extensive example. + +=item Changing Compilers + +If you change compilers or make other significant changes, you should +probably I<not> re-use your old config.sh. Simply remove it or +rename it, e.g. mv config.sh config.sh.old. Then rerun Configure +with the options you want to use. + +This is a common source of problems. If you change from B<cc> to +B<gcc>, you should almost always remove your old config.sh. + +=item Propagating your changes + +If you later make any changes to F<config.sh>, you should propagate +them to all the .SH files by running B<Configure -S>. + +=item config.over + +You can also supply a shell script config.over to over-ride Configure's +guesses. It will get loaded up at the very end, just before config.sh +is created. You have to be careful with this, however, as Configure +does no checking that your changes make sense. + +=item config.h + +Many of the system dependencies are contained in F<config.h>. +F<Configure> builds F<config.h> by running the F<config_h.SH> script. +The values for the variables are taken from F<config.sh>. + +If there are any problems, you can edit F<config.h> directly. Beware, +though, that the next time you run B<Configure>, your changes will be +lost. + +=item cflags + +If you have any additional changes to make to the C compiler command +line, they can be made in F<cflags.SH>. For instance, to turn off the +optimizer on F<toke.c>, find the line in the switch structure for +F<toke.c> and put the command C<optimize='-g'> before the C<;;>. You +can also edit F<cflags> directly, but beware that your changes will be +lost the next time you run B<Configure>. + +To change the C flags for all the files, edit F<config.sh> +and change either C<$ccflags> or C<$optimize>, +and then re-run B<Configure -S ; make depend>. + +=item No sh. + +If you don't have sh, you'll have to copy the sample file config_H to +config.h and edit the config.h to reflect your system's peculiarities. +You'll probably also have to extensively modify the extension building +mechanism. + +=back + +=head1 make depend + +This will look for all the includes. +The output is stored in F<makefile>. The only difference between +F<Makefile> and F<makefile> is the dependencies at the bottom of +F<makefile>. If you have to make any changes, you should edit +F<makefile>, not F<Makefile> since the Unix B<make> command reads +F<makefile>. + +Configure will offer to do this step for you, so it isn't listed +explicitly above. + +=head1 make + +This will attempt to make perl in the current directory. + +If you can't compile successfully, try some of the following ideas. + +=over 4 + +=item * + +If you used a hint file, try reading the comments in the hint file +for further tips and information. + +=item * + +If you can't compile successfully, try adding a C<-DCRIPPLED_CC> flag. +(Just because you get no errors doesn't mean it compiled right!) +This simplifies some complicated expressions for compilers that +get indigestion easily. If that has no effect, try turning off +optimization. If you have missing routines, you probably need to +add some library or other, or you need to undefine some feature that +Configure thought was there but is defective or incomplete. + +=item * + +Some compilers will not compile or optimize the larger files without +some extra switches to use larger jump offsets or allocate larger +internal tables. You can customize the switches for each file in +F<cflags>. It's okay to insert rules for specific files into +F<makefile> since a default rule only takes effect in the absence of a +specific rule. + +=item * + +If you can successfully build F<miniperl>, but the process crashes +during the building of extensions, you should run + + make minitest + +to test your version of miniperl. + +=item * + +Some additional things that have been reported for either perl4 or perl5: + +Genix may need to use libc rather than libc_s, or #undef VARARGS. + +NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR. + +UTS may need one or more of B<-DCRIPPLED_CC>, B<-K> or B<-g>, and undef LSTAT. + +If you get syntax errors on '(', try -DCRIPPLED_CC. + +Machines with half-implemented dbm routines will need to #undef I_ODBM + +SCO prior to 3.2.4 may be missing dbmclose(). An upgrade to 3.2.4 +that includes libdbm.nfs (which includes dbmclose()) may be available. + +If you get duplicates upon linking for malloc et al, say -DHIDEMYMALLOC. + +If you get duplicate function definitions (a perl function has the +same name as another function on your system) try -DEMBED. + +If you get varags problems with gcc, be sure that gcc is installed +correctly. When using gcc, you should probably have i_stdarg='define' +and i_varags='undef' in config.sh. The problem is usually solved +by running fixincludes correctly. + +If you wish to use dynamic loading on SunOS or Solaris, and you +have GNU as and GNU ld installed, you may need to add B<-B/bin/> to +your $ccflags and $ldflags so that the system's versions of as +and ld are used. + +If you run into dynamic loading problems, check your setting of +the LD_LIBRARY_PATH environment variable. Perl should build +fine with LD_LIBRARY_PATH unset, though that may depend on details +of your local set-up. + +=back + +=head1 make test + +This will run the regression tests on the perl you just made. If it +doesn't say "All tests successful" then something went wrong. See the +file F<t/README> in the F<t> subdirectory. Note that you can't run it +in background if this disables opening of /dev/tty. If B<make test> +bombs out, just B<cd> to the F<t> directory and run B<TEST> by hand +to see if it makes any difference. +If individual tests bomb, you can run them by hand, e.g., + + ./perl op/groups.t + +=head1 INSTALLING PERL5 + +=head1 make install + +This will put perl into the public directory you specified to +B<Configure>; by default this is F</usr/local/bin>. It will also try +to put the man pages in a reasonable place. It will not nroff the man +page, however. You may need to be root to run B<make install>. If you +are not root, you must own the directories in question and you should +ignore any messages about chown not working. + +If you want to see exactly what will happen without installing +anything, you can run + + ./perl installperl -n + ./perl installman -n + +B<make install> will install the following: + + perl, + perl5.nnn where nnn is the current release number. This + will be a link to perl. + suidperl, + sperl5.nnn If you requested setuid emulation. + a2p awk-to-perl translator + cppstdin This is used by perl -P, if your cc -E can't + read from stdin. + c2ph, pstruct Scripts for handling C structures in header files. + s2p sed-to-perl translator + find2perl find-to-perl translator + h2xs Converts C .h header files to Perl extensions. + perldoc Tool to read perl's pod documentation. + pod2html, Converters from perl's pod documentation format + pod2latex, and to other useful formats. + pod2man + + library files in $privlib and $archlib specified to + Configure, usually under /usr/local/lib/perl5/. + man pages in the location specified to Configure, usually + something like /usr/local/man/man1. + module in the location specified to Configure, usually + man pages under /usr/local/lib/perl5/man/man3. + pod/*.pod in $privlib/pod/. + +Perl's *.h header files and the libperl.a library are also +installed under $archlib so that any user may later build new +extensions even if the Perl source is no longer available. + +The libperl.a library is only needed for building new +extensions and linking them statically into a new perl executable. +If you will not be doing that, then you may safely delete +$archlib/libperl.a after perl is installed. + +make install may also offer to install perl in a "standard" location. + +Most of the documentation in the pod/ directory is also available +in HTML and LaTeX format. Type + + cd pod; make html; cd .. + +to generate the html versions, and + + cd pod; make tex; cd .. + +to generate the LaTeX versions. + +=head1 Coexistence with perl4 + +You can safely install perl5 even if you want to keep perl4 around. + +By default, the perl5 libraries go into F</usr/local/lib/perl5/>, so +they don't override the perl4 libraries in F</usr/local/lib/perl/>. + +In your /usr/local/bin directory, you should have a binary named +F<perl4.036>. That will not be touched by the perl5 installation +process. Most perl4 scripts should run just fine under perl5. +However, if you have any scripts that require perl4, you can replace +the C<#!> line at the top of them by C<#!/usr/local/bin/perl4.036> +(or whatever the appropriate pathname is). + +=head1 DOCUMENTATION + +Read the manual entries before running perl. The main documentation is +in the pod/ subdirectory and should have been installed during the +build process. Type B<man perl> to get started. Alternatively, you +can type B<perldoc perl> to use the supplied B<perldoc> script. This +is sometimes useful for finding things in the library modules. + +=head1 AUTHOR + +Andy Dougherty <doughera@lafcol.lafayette.edu>, borrowing I<very> heavily +from the original README by Larry Wall. + +18 October 1995 @@ -1,10 +1,12 @@ Artistic The "Artistic License" Changes Differences from previous versions. Changes.Conf Recent changes in the Configure & build process +configure Crude emulation of GNU configure Configure Portability tool Copying The GNU General Public License Doc/perl5-notes Samples of new functionality EXTERN.h Included before foreign .h files +INSTALL Detailed installation instructions. INTERN.h Included before domestic .h files MANIFEST This list of files Makefile.SH A script that generates Makefile @@ -20,7 +22,6 @@ cflags.SH A script that emits C compilation flags per file config_H Sample config.h config_h.SH Produces config.h configpm Produces lib/Config.pm -configure Crude emulation of GNU configure cop.h Control operator header cv.h Code value header deb.c Debugging routines @@ -85,6 +86,12 @@ ext/DB_File/DB_File.xs Berkeley DB extension external subroutines ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder ext/DB_File/Makefile.PL Berkeley DB extension makefile writer ext/DB_File/typemap Berkeley DB extension interface types +ext/Devel/DProf/DProf.pm Perl Profiler extension Perl module +ext/Devel/DProf/DProf.xs Perl Profiler extension external subroutines +ext/Devel/DProf/Makefile.PL Perl Profiler extension makefile writer +ext/Devel/DProf/README Perl Profiler extension info +ext/Devel/DProf/dprofpp Perl Profiler extension utility +ext/Devel/DProf/test.pl Perl Profiler extension test ext/DynaLoader/DynaLoader.pm Dynamic Loader perl module ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer ext/DynaLoader/README Dynamic Loader notes and intro @@ -195,7 +202,7 @@ hints/fps.sh Hints for named architecture hints/freebsd.sh Hints for named architecture hints/genix.sh Hints for named architecture hints/greenhills.sh Hints for named architecture -hints/hpux_9.sh Hints for named architecture +hints/hpux.sh Hints for named architecture hints/i386.sh Hints for named architecture hints/irix_4.sh Hints for named architecture hints/irix_5.sh Hints for named architecture @@ -352,7 +359,6 @@ perly.y Yacc grammar for perl pl2pm A pl to pm translator pod/Makefile Make pods into something else pod/perl.pod Top level perl man page -pod/perlapi.pod XS api info pod/perlbook.pod Book info pod/perlbot.pod Object-oriented Bag o' Tricks pod/perlcall.pod Callback info @@ -378,6 +384,7 @@ pod/perlsub.pod Subroutine info pod/perlsyn.pod Syntax info pod/perltrap.pod Trap info pod/perlvar.pod Variable info +pod/perlxs.pod XS api info pod/pod2html.SH Precursor for translator to turn pod into HTML pod/pod2latex.SH Precursor for translator to turn pod into LaTeX pod/pod2man.SH Precursor for translator to turn pod into manpage @@ -437,6 +444,7 @@ t/lib/ndbm.t See if NDBM_File works t/lib/odbm.t See if ODBM_File works t/lib/posix.t See if POSIX works t/lib/sdbm.t See if SDBM_File works +t/lib/socket.t See if Socket works t/lib/soundex.t See if Soundex works t/op/append.t See if . works t/op/array.t See if array operations work diff --git a/Makefile.SH b/Makefile.SH index 1dabfdeac5..1f1b11b613 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -92,7 +92,7 @@ ranlib = $ranlib # The following are mentioned only to make metaconfig include the # appropriate questions in Configure. If you want to change these, -# edit config.sh instead, or specify --man1dir=/wherever on +# edit config.sh instead, or specify --man1dir=/wherever on # installman commandline. bin = $installbin scriptdir = $scriptdir @@ -180,7 +180,7 @@ SHELL = /bin/sh all: makefile miniperl $(private) $(public) $(dynamic_ext) @echo " "; echo " Making x2p stuff"; cd x2p; $(MAKE) all - + # This is now done by installman only if you actually want the man pages. # @echo " "; echo " Making docs"; cd pod; $(MAKE) all; @@ -318,7 +318,7 @@ regen_headers: FORCE perl keywords.pl perl opcode.pl perl embed.pl - + # Extensions: # Names added to $(dynamic_ext) or $(static_ext) will automatically # get built. There should ordinarily be no need to change any of @@ -351,7 +351,7 @@ clean: realclean: clean -cd x2p; $(MAKE) realclean -cd pod; $(MAKE) realclean - @for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \ + -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \ sh ext/util/make_ext realclean $$x ; \ done rm -f *.orig */*.orig *~ */*~ core t/core t/c t/perl @@ -6,7 +6,7 @@ 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 @@ -62,205 +62,34 @@ in MANIFEST. Installation -1) Run Configure. This will figure out various things about your - system. Some things Configure will figure out for itself, other - things it will ask you about. If the test scripts and programs - run ok, the defaults will usually be right. It will then proceed to - make config.h, config.sh, and Makefile. You may have to explicitly - say sh Configure to ensure that Configure is run under sh. - If you're a hotshot, run Configure -d to take all the defaults - and edit config.sh to patch up any flaws. - - If you later make any changes to config.sh, you should propagate - them to all the .SH files by running Configure -S. - - Configure supports a number of useful options. Run Configure -h - to get a listing. To compile with gcc, for example, you can run - Configure -Dcc=gcc, or answer 'gcc' at the cc prompt. - - If you wish to use gcc (or another alternative compiler) - you should use Configure -Dcc=gcc. That way, the the hints - files can set appropriate defaults. - - By default, perl will be installed in /usr/local/{bin, lib, man}. - You can specify a different 'prefix' for the default installation - directory, when Configure prompts you or by using the Configure - command line option -Dprefix='/some/directory'. - - By default, perl will use dynamic extensions if your system - supports it. If you want to force perl to be compiled statically, - you can either choose this when Configure prompts you or by using - the Configure command line option -Uusedl - - If you change compilers or make other significant changes, you should - probably _not_ re-use your old config.sh. Simply remove it or - rename it, e.g. mv config.sh config.sh.old. Then rerun Configure - with the options you want to use. - - You can also supply a file config.over to over-ride Configure's - guesses. It will get loaded up at the very end, just before - config.sh is created. - - You might possibly have to trim # comments from the front of Configure - if your sh doesn't handle them, but all other # comments will be taken - care of. - - (If you don't have sh, you'll have to copy the sample file config_H to - config.h and edit the config.h to reflect your system's peculiarities.) - -2) Glance through config.h to make sure system dependencies are correct. - Most of them should have been taken care of by running the Configure script. - - If you have any additional changes to make to the C definitions, they - can be done in cflags.SH. For instance, to turn off the optimizer - on toke.c, find the line in the switch structure for toke.c and - put the command optimize='-g' before the ;;. To change the C flags - for all the files, edit config.sh and change either $ccflags or $optimize, - and then re-run Configure -S ; make depend. - - -3) make depend - - This will look for all the includes and modify Makefile accordingly. - Configure will offer to do this for you. - -4) make - - This will attempt to make perl in the current directory. - - If you can't compile successfully, try adding a -DCRIPPLED_CC flag. - (Just because you get no errors doesn't mean it compiled right!) - This simplifies some complicated expressions for compilers that - get indigestion easily. If that has no effect, try turning off - optimization. If you have missing routines, you probably need to - add some library or other, or you need to undefine some feature that - Configure thought was there but is defective or incomplete. - - Some compilers will not compile or optimize the larger files without - some extra switches to use larger jump offsets or allocate larger - internal tables. You can customize the switches for each file in - cflags.SH. It's okay to insert rules for specific files into - Makefile.SH, since a default rule only takes effect in the - absence of a specific rule. - - If you used a hint file, try reading the comments in the hint file - for further tips and information. - - If you can successfully build miniperl, but the process crashes - during the building of extensions, you should run - make minitest - to test your version of miniperl. - - Some additional things that have been reported for either perl4 or - perl5: - - Genix may need to use libc rather than libc_s, or #undef VARARGS. - - NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR. - - UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT. - - If you get syntax errors on '(', try -DCRIPPLED_CC. - - Machines with half-implemented dbm routines will need to #undef I_ODBM - - SCO prior to 3.2.4 may be missing dbmclose(). An upgrade to 3.2.4 - that includes libdbm.nfs (which includes dbmclose()) may be available. - - If you get duplicates upon linking for malloc et al, say -DHIDEMYMALLOC. - - If you get duplicate function definitions (a perl function has the - same name as another function on your system) try -DEMBED. - - If you get varags problems with gcc, be sure that gcc is installed - correctly. When using gcc, you should probably have i_stdarg='define' - and i_varags='undef' in config.sh. The problem is usually solved - by running fixincludes correctly. - - If you wish to use dynamic loading on SunOS or Solaris, and you - have GNU as and GNU ld installed, you may need to add -B/bin/ to - your $ccflags and $ldflags so that the system's versions of as - and ld are used. - - If you run into dynamic loading problems, check your setting of - the LD_LIBRARY_PATH environment variable. Perl should build - fine with LD_LIBRARY_PATH unset, though that may depend on details - of your local set-up. - -5) make test - - This will run the regression tests on the perl you just made. - If it doesn't say "All tests successful" then something went wrong. - See the README in the t subdirectory. Note that you can't run it - in background if this disables opening of /dev/tty. If "make test" - bombs out, just cd to the t directory and run TEST by hand to see if - it makes any difference. If individual tests bomb, you can run - them by hand, e.g., ./perl op/groups.t - -6) make install - - This will put perl into a public directory (such as - /usr/local/bin). It will also try to put the man pages in a - reasonable place. It will not nroff the man page, however. You - may need to be root to run make install. If you are not root, you - must own the directories in question and you should ignore any - messages about chown not working. - - make install will install the following: - perl, - perl5.nnn where nnn is the current release number. This - will be a link to perl. - suidperl, - sperl5.nnn If you requested setuid emulation. - a2p awk-to-perl translator - cppstdin This is used by perl -P, if your cc -E can't - read from stdin. - c2ph, pstruct Scripts for handling C structures in header files. - s2p sed-to-perl translator - find2perl find-to-perl translator - h2xs Converts C .h header files to Perl extensions. - perldoc Tool to read perl's pod documentation. - pod2html, Converters from perl's pod documentation format - pod2latex, and to other useful formats. - pod2man - - library files in $privlib and $archlib specified to - Configure, usually under /usr/local/lib/perl5/. - man pages in the location specified to Configure, usually - something like /usr/local/man/man1. - module in the location specified to Configure, usually - man pages under /usr/local/lib/perl5/man/man3. - pod/*.pod in $privlib/pod/. - - Perl's *.h header files and the libperl.a library are also - installed under $archlib so that you may later build new - extensions even if the Perl source is no longer available. - - make install may also offer to install perl in a "standard" location. - - Most of the documentation in the pod/ directory is also available - in HTML and LaTeX format. Type - cd pod; make html; cd .. - to generate the html versions, and - cd pod; make tex; cd .. - to generate the LaTeX versions. - -7) Read the manual entries before running perl. - -8) IMPORTANT! Help save the world! Communicate any problems and suggested - patches to me, lwall@netlabs.com (Larry Wall), so we can - keep the world in sync. If you have a problem, there's someone else - out there who either has had or will have the same problem. - - If possible, send in patches such that the patch program will apply them. - Context diffs are the best, then normal diffs. Don't send ed scripts-- - I've probably changed my copy since the version you have. It's also - helpful if you send the output of "uname -a". - - Watch for perl patches in comp.lang.perl. Patches will generally be - in a form usable by the patch program. If you are just now bringing up - perl and aren't sure how many patches there are, write to me and I'll - send any you don't have. Your current patch level is shown in patchlevel.h. +1) Detailed instructions are in the file INSTALL. In brief, the +following should work on most systems: + rm -f config.sh + sh Configure + make + make test + make install +For most systems, it should be safe to accept all the Configure +defaults. + +2) Read the manual entries before running perl. + +3) IMPORTANT! Help save the world! Communicate any problems and suggested +patches to me, lwall@netlabs.com (Larry Wall), so we can +keep the world in sync. If you have a problem, there's someone else +out there who either has had or will have the same problem. +It's usually helpful if you send the output of the "myconfig" script +in the main perl directory. + +If possible, send in patches such that the patch program will apply them. +Context diffs are the best, then normal diffs. Don't send ed scripts-- +I've probably changed my copy since the version you have. + +Watch for perl patches in comp.lang.perl.announce. Patches will generally +be in a form usable by the patch program. If you are just now bringing +up perl and aren't sure how many patches there are, write to me and I'll +send any you don't have. Your current patch level is shown in +patchlevel.h. Just a personal note: I want you to know that I create nice things like this @@ -37,7 +37,7 @@ $spitshell >>c2ph <<'!NO!SUBS!' # See the usage message for more. If this isn't enough, read the code. # -$RCSID = 'c2ph.SH'; +$RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $'; ###################################################################### @@ -283,7 +283,18 @@ STAB: while (<>) { next unless /^\s*\.stabs\s+/; $line = $_; s/^\s*\.stabs\s+//; + if (s/\\\\"[d,]+$//) { + $saveline .= $line; + $savebar = $_; + next STAB; + } + if ($saveline) { + s/^"//; + $_ = $savebar . $_; + $line = $saveline; + } &stab; + $savebar = $saveline = undef; } print STDERR "$.\n" if $trace; unlink $TMP if $TMP; @@ -299,24 +310,31 @@ STAB: while (<>) { $pmask1 = "%-${type_width}s %-${member_width}s"; $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s"; + + if ($perl) { # resolve template -- should be in stab define order, but even this isn't enough. print STDERR "\nbuilding type templates: " if $trace; for $i (reverse 0..$#type) { next unless defined($name = $type[$i]); next unless defined $struct{$name}; + ($iname = $name) =~ s/\..*//; $build_recursed = 0; &build_template($name) unless defined $template{&psou($name)} || - $opt_s && !$interested{$name}; + $opt_s && !$interested{$iname}; } print STDERR "\n\n" if $trace; } print STDERR "dumping structs: " if $trace; + local($iam); + + foreach $name (sort keys %struct) { - next if $opt_s && !$interested{$name}; + ($iname = $name) =~ s/\..*//; + next if $opt_s && !$interested{$iname}; print STDERR "$name " if $trace; undef @sizeof; @@ -324,6 +342,7 @@ STAB: while (<>) { undef @offsetof; undef @indices; undef @typeof; + undef @fieldnames; $mname = &munge($name); @@ -379,6 +398,19 @@ sub ${mname}'typeof { } EOF + print <<EOF; +sub ${mname}'fieldnames { + \@${mname}'fieldnames; +} +EOF + + $iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u'); + + print <<EOF; +sub ${mname}'isastruct { + '$iam'; +} +EOF print "\$${mname}'typedef = '" . &scrunch($template{$fname}) . "';\n"; @@ -398,6 +430,8 @@ EOF join("\n\t", '', @offsetof), "\n );\n\n"; print "\@${mname}'typeof[\@${mname}'indices] = (", join("\n\t", '', @typeof), "\n );\n\n"; + print "\@${mname}'fieldnames[\@${mname}'indices] = (", + join("\n\t", '', @fieldnames), "\n );\n\n"; $template_printed{$fname}++; $size_printed{$fname}++; @@ -408,7 +442,7 @@ EOF print STDERR "\n" if $trace; unless ($perl && $opt_a) { - print "\n1;\n"; + print "\n1;\n" if $perl; exit; } @@ -428,7 +462,7 @@ EOF print '$',&munge($name),"'typedef = '", $template{$name}, "';\n"; } - print "\n1;\n"; + print "\n1;\n" if $perl; exit; } @@ -437,13 +471,22 @@ EOF sub stab { - next unless /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun + next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun s/"// || next; s/",([x\d]+),([x\d]+),([x\d]+),.*// || next; next if /^\s*$/; $size = $3 if $3; + $_ = $continued . $_ if length($continued); + if (s/\\\\$//) { + # if last 2 chars of string are '\\' then stab is continued + # in next stab entry + chop; + $continued = $_; + next; + } + $continued = ''; $line = $_; @@ -518,7 +561,7 @@ sub stab { $type[$typeno] = $2; print STDERR "intrinsic $2 in new type $typeno\n" if $debug; } - elsif (s/^=e//) { # blessed by thy compiler; mine won't do this + elsif (s/^=e//) { # blessed be thy compiler; mine won't do this &edecl; } else { @@ -583,8 +626,8 @@ sub pstruct { } } - $template = &fetch_template($type) x - ($count ? &scripts2count($count) : 1); + $template = &fetch_template($type); + &repeat_template($template,$count); if (! $finished_template{$sname}) { $template{$sname} .= $template; @@ -610,16 +653,21 @@ sub pstruct { ($bits = $length % 8) ? ".$bits": "" if !$perl || $verbose; + if ($perl) { + $template = &fetch_template($type); + &repeat_template($template,$count); + } if ($perl && $nesting == 1) { - $template = &scrunch(&fetch_template($type) x - ($count ? &scripts2count($count) : 1)); + push(@sizeof, int($length/8) .",\t# $fieldname"); push(@offsetof, int($offset/8) .",\t# $fieldname"); - push(@typedef, "'$template', \t# $fieldname"); + local($little) = &scrunch($template); + push(@typedef, "'$little', \t# $fieldname"); $type =~ s/(struct|union) //; - push(@typeof, "'$type" . ($count ? $count : '') . + push(@typeof, "'$mytype" . ($count ? $count : '') . "',\t# $fieldname"); + push(@fieldnames, "'$fieldname',"); } print ' ', ' ' x $indent x $nesting, $template @@ -705,8 +753,10 @@ sub adecl { # global $typeno, @type local($_, $typedef) = @_; - while (s/^((\d+)=)?ar(\d+);//) { + while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) { ($arraytype, $unknown) = ($2, $3); + $arraytype = &typeno($arraytype); + $unknown = &typeno($unknown); if (s/^(\d+);(\d+);//) { ($lower, $upper) = ($1, $2); $scripts .= '[' . ($upper+1) . ']'; @@ -714,14 +764,14 @@ sub adecl { warn "can't find array bounds: $_"; } } - if (s/^([\d*f=]*),(\d+),(\d+);//) { + if (s/^([(,)\d*f=]*),(\d+),(\d+);//) { ($start, $length) = ($2, $3); - local($whatis) = $1; - if ($whatis =~ /^(\d+)=/) { - $typeno = $1; + $whatis = $1; + if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) { + $typeno = &typeno($1); &pdecl($whatis); } else { - $typeno = $whatis; + $typeno = &typeno($whatis); } } elsif (s/^(\d+)(=[*suf]\d*)//) { local($whatis) = $2; @@ -798,10 +848,15 @@ SFIELD: #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); } - if (/^\d+=ar/) { + if (/^(\d+|\(\d+,\d+\))=ar/) { $_ = &adecl($_); } elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) { + ($start, $length) = ($2, $3); + &panic("no length?") unless $length; + $typeno = &typeno($1) if $1; + } + elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) { ($start, $length) = ($2, $3); &panic("no length?") unless $length; $typeno = &typeno($1) if $1; @@ -901,6 +956,8 @@ sub psou { sub scrunch { local($_) = @_; + return '' if $_ eq ''; + study; s/\$//g; @@ -920,7 +977,7 @@ sub scrunch { sub buildscrunchlist { $scrunch_code = "sub quick_scrunch {\n"; for (values %intrinsics) { - $scrunch_code .= "\ts/($_{2,})/'$_' . length(\$1)/ge;\n"; + $scrunch_code .= "\ts/($_\{2,})/'$_' . length(\$1)/ge;\n"; } $scrunch_code .= "}\n"; print "$scrunch_code" if $debug; @@ -977,7 +1034,7 @@ main() { EOF for $type (@intrinsics) { - next if $type eq 'void'; + next if !type || $type eq 'void' || $type =~ /complex/; # sun stuff print <<"EOF"; printf(mask,sizeof($type), "$type"); EOF @@ -1096,7 +1153,17 @@ sub squishseq { $string .= $last if $inseq && $last != -e18; $string; } -!NO!SUBS! -$eunicefix c2ph -rm -f pstruct -ln c2ph pstruct + +sub repeat_template { + # local($template, $scripts) = @_; have to change caller's values + + if ( $_[1] ) { + local($ncount) = &scripts2count($_[1]); + if ($_[0] =~ /^\s*c\s*$/i) { + $_[0] = "A$ncount "; + $_[1] = ''; + } else { + $_[0] = $template x $ncount; + } + } +} @@ -14,7 +14,7 @@ * $Id: Config_h.U,v 3.0.1.3 1995/01/30 14:25:39 ram Exp $ */ -/* Configuration time: Tue Jun 6 12:34:26 EDT 1995 +/* Configuration time: Tue Jul 25 15:36:03 EDT 1995 * Configured by: andy * Target system: crystal crystal 3.2 2 i386 */ diff --git a/config_h.SH b/config_h.SH index 02b6030d9e..f76b0446ed 100755 --- a/config_h.SH +++ b/config_h.SH @@ -54,12 +54,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define BIN "$bin" /**/ -/* BYTEORDER: - * This symbol hold the hexadecimal constant defined in byteorder, - * i.e. 0x1234 or 0x4321, etc... - */ -#define BYTEORDER 0x$byteorder /* large digits for MSB */ - /* CAT2: * This macro catenates 2 tokens together. */ @@ -301,23 +295,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_fsetpos HAS_FSETPOS /**/ -/* Gconvert: - * This preprocessor macro is defined to convert a floating point - * number to a string without a trailing decimal point. This - * emulates the behavior of sprintf("%g"), but is sometimes much more - * efficient. If gconvert() is not available, but gcvt() drops the - * trailing decimal point, then gcvt() is used. If all else fails, - * a macro using sprintf("%g") is used. Arguments for the Gconvert - * macro are: value, number of digits, whether trailing zeros should - * be retained, and the output buffer. - * Possible values are: - * d_Gconvert='gconvert((x),(n),(t),(b))' - * d_Gconvert='gcvt((x),(n),(b))' - * d_Gconvert='sprintf((b),"%.*g",(n),(x))' - * The last two assume trailing zeros should not be kept. - */ -#define Gconvert(x,n,t,b) $d_Gconvert - /* HAS_GETGROUPS: * This symbol, if defined, indicates that the getgroups() routine is * available to get the list of process groups. If unavailable, multiple @@ -538,6 +515,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_pipe HAS_PIPE /**/ +/* HAS_POLL: + * This symbol, if defined, indicates that the poll routine is + * available to poll active file descriptors. + */ +#$d_poll HAS_POLL /**/ + /* HAS_READDIR: * This symbol, if defined, indicates that the readdir routine is * available to read directory entries. You may have to include @@ -1274,12 +1257,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$i_vfork I_VFORK /**/ -/* INTSIZE: - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#define INTSIZE $intsize /**/ - /* Off_t: * This symbol holds the type used to declare offsets in the kernel. * It can be int, long, off_t, etc... It may be necessary to include @@ -1295,6 +1272,33 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define Mode_t $modetype /* file mode parameter for system calls */ +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK $o_nonblock +#define VAL_EAGAIN $eagain +#define RD_NODATA $rd_nodata +#$d_eofnblk EOF_NONBLOCK + /* PRIVLIB_EXP: * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. @@ -1341,16 +1345,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define Select_fd_set_t $selecttype /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - */ -#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`" /**/ - /* Size_t: * This symbol holds the type used to declare length parameters * for string functions. It is usually size_t, but may be @@ -1382,31 +1376,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define Uid_t $uidtype /* UID type */ -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. - */ -#ifndef VOIDUSED -#define VOIDUSED $defvoidused -#endif -#define VOIDFLAGS $voidflags -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - /* VMS: * This symbol, if defined, indicates that the program is running under * VMS. It is currently only set in conjunction with the EUNICE symbol. @@ -1418,6 +1387,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define LOC_SED "$full_sed" /**/ +/* BYTEORDER: + * This symbol hold the hexadecimal constant defined in byteorder, + * i.e. 0x1234 or 0x4321, etc... + */ +#define BYTEORDER 0x$byteorder /* large digits for MSB */ + /* CSH: * This symbol, if defined, indicates that the C-shell exists. * If defined, contains the full pathname of csh. @@ -1432,18 +1407,52 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_dlsymun DLSYM_NEEDS_UNDERSCORE /* */ +/* Gconvert: + * This preprocessor macro is defined to convert a floating point + * number to a string without a trailing decimal point. This + * emulates the behavior of sprintf("%g"), but is sometimes much more + * efficient. If gconvert() is not available, but gcvt() drops the + * trailing decimal point, then gcvt() is used. If all else fails, + * a macro using sprintf("%g") is used. Arguments for the Gconvert + * macro are: value, number of digits, whether trailing zeros should + * be retained, and the output buffer. + * Possible values are: + * d_Gconvert='gconvert((x),(n),(t),(b))' + * d_Gconvert='gcvt((x),(n),(b))' + * d_Gconvert='sprintf((b),"%.*g",(n),(x))' + * The last two assume trailing zeros should not be kept. + */ +#define Gconvert(x,n,t,b) $d_Gconvert + /* USE_DYNAMIC_LOADING: * This symbol, if defined, indicates that dynamic loading of * some sort is available. */ #$usedl USE_DYNAMIC_LOADING /**/ +/* I_DBM: + * This symbol, if defined, indicates that <dbm.h> exists and should + * be included. + */ +/* I_RPCSVC_DBM: + * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and + * should be included. + */ +#$i_dbm I_DBM /**/ +#$i_rpcsvcdbm I_RPCSVC_DBM /**/ + /* I_SYS_STAT: * This symbol, if defined, indicates to the C program that it should * include <sys/stat.h>. */ #$i_sysstat I_SYS_STAT /**/ +/* INTSIZE: + * This symbol contains the size of an int, so that the C preprocessor + * can make decisions based on it. + */ +#define INTSIZE $intsize /**/ + /* Free_t: * This variable contains the return type of free(). It is usually * void, but occasionally int. @@ -1459,11 +1468,65 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_mymalloc MYMALLOC /**/ +/* SIG_NAME: + * This symbol contains a list of signal names in order. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". Duplicates are allowed. + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + * See SIG_NUM and SIG_MAX. + */ +#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`",0 /**/ + +/* SIG_NUM: + * This symbol contains a list of signal number, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. Duplicates are allowed, so you can't assume + * sig_num[i] == i. Instead, the signal number corresponding to + * sig_name[i] is sig_number[i]. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define SIG_NUM `echo $sig_num 0 | sed 's/ /,/g'` /**/ + /* SITELIB_EXP: * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ #$d_sitelib SITELIB_EXP "$sitelibexp" /**/ +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. + */ +#ifndef VOIDUSED +#define VOIDUSED $defvoidused +#endif +#define VOIDFLAGS $voidflags +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif + #endif !GROK!THIS! @@ -176,6 +176,7 @@ sub STORE { &readonly } sub DELETE{ &readonly } sub CLEAR { &readonly } +sub config_sh { $config_sh } 1; ENDOFEND @@ -1,65 +1,108 @@ #! /bin/sh +# +# $Id: configure,v 3.0.1.1 1995/07/25 14:16:21 ram Exp $ +# # GNU configure-like front end to metaconfig's Configure. # -# Written by Andy Dougherty (doughera@lafcol.lafayette.edu) -# and matthew green (mrg@mame.mu.oz.au) +# Written by Andy Dougherty <doughera@lafcol.lafayette.edu> +# and Matthew Green <mrg@mame.mu.oz.au>. +# +# Reformatted and modified for inclusion in the dist-3.0 package by +# Raphael Manfredi <ram@hptnos02.grenoble.hp.com>. +# +# This script belongs to the public domain and may be freely redistributed. +# +# The remaining of this leading shell comment may be removed if you +# include this script in your own package. +# +# $Log: configure,v $ +# Revision 3.0.1.1 1995/07/25 14:16:21 ram +# patch56: created # -# public domain. +(exit $?0) || exec sh $0 $argv:q opts='' -for f in $* -do - case $f in +verbose='' +create='-e' +while test $# -gt 0; do + case $1 in --help) - echo This is GNU configure-like front end for a MetaConfig Configure. - echo It understands the follow GNU configure options: - echo " --prefix=PREFIX" - echo " --help" - echo "" - echo And these environment variables: - echo " CFLAGS" - echo " CC" - echo " DEFS" - echo 0 - ;; - --prefix=*) - shift - arg=`echo $f | sed 's/--prefix=/-Dprefix=/'` - opts="$opts $arg" - ;; - --*) - opt=`echo $f | sed 's/=.*//'` - echo This GNU configure front end does not understand $opt - exit 1 - ;; - *) - shift - opts="$opts $f" - ;; - esac + cat <<EOM +Usage: configure [options] +This is GNU configure-like front end for a metaconfig-generated Configure. +It emulates the following GNU configure options (must be fully spelled out): + --help + --no-create + --prefix=PREFIX + --quiet + --silent + --verbose + --version + +And it honours these environment variables: CC, CFLAGS and DEFS. +EOM + exit 0 + ;; + --no-create) + create='-E' + shift + ;; + --prefix=*) + arg=`echo $1 | sed 's/--prefix=/-Dprefix=/'` + opts="$opts $arg" + shift + ;; + --quiet|--silent) + exec >/dev/null 2>&1 + shift + ;; + --verbose) + verbose=true + shift + ;; + --version) + copt="$copt -V" + shift + ;; + --*) + opt=`echo $1 | sed 's/=.*//'` + echo "This GNU configure front end does not understand $opt" + exit 1 + ;; + *) + opts="$opts $1" + shift + ;; + esac done case "$CC" in - '') ;; - *) opts="$opts -Dcc='$CC'" ;; +'') ;; +*) opts="$opts -Dcc='$CC'";; esac -# join DEFS and CFLAGS together. - +# Join DEFS and CFLAGS together. ccflags='' -if test "x$DEFS" != x -then - ccflags=$DEFS -fi -if test "x$CFLAGS" != x -then - ccflags="$ccflags $CFLAGS" -fi +case "$DEFS" in +'') ;; +*) ccflags=$DEFS;; +esac +case "$CFLAGS" in +'') ;; +*) ccflags="$ccflags $CFLAGS";; +esac +case "$ccflags" in +'') ;; +*) opts="$opts -Dccflags='$ccflags'";; +esac -if test "x$ccflags" != x -then - opts="$opts -Dccflags='$ccflags'" -fi +# Don't use -s if they want verbose mode +case "$verbose" in +'') copt="$copt -ds";; +*) copt="$copt -d";; +esac -echo ./Configure "$opts" -des -./Configure "$opts" -des +set X ./Configure $copt $create $opts +shift +echo "$@" +exec "$@" @@ -196,6 +196,7 @@ #define sge_amg Perl_sge_amg #define sgt_amg Perl_sgt_amg #define sig_name Perl_sig_name +#define sig_num Perl_sig_num #define siggv Perl_siggv #define sighandler Perl_sighandler #define simple Perl_simple @@ -974,6 +975,7 @@ #define warn Perl_warn #define watch Perl_watch #define whichsig Perl_whichsig +#define whichsigname Perl_whichsigname #define xiv_arenaroot Perl_xiv_arenaroot #define xiv_root Perl_xiv_root #define xnv_root Perl_xnv_root diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index 5b9fba7765..0491d6bb42 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,251 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) -# last modified 19th May 1995 -# version 0.2 +# last modified 7th October 1995 +# version 1.0 + +package DB_File::HASHINFO ; +use Carp; + +sub TIEHASH +{ + bless {} ; +} + +%elements = ( 'bsize' => 0, + 'ffactor' => 0, + 'nelem' => 0, + 'cachesize' => 0, + 'hash' => 0, + 'lorder' => 0 + ) ; + +sub FETCH +{ + return $_[0]{$_[1]} if defined $elements{$_[1]} ; + + croak "DB_File::HASHINFO::FETCH - Unknown element '$_[1]'" ; +} + + +sub STORE +{ + if ( defined $elements{$_[1]} ) + { + $_[0]{$_[1]} = $_[2] ; + return ; + } + + croak "DB_File::HASHINFO::STORE - Unknown element '$_[1]'" ; +} + +sub DELETE +{ + if ( defined $elements{$_[1]} ) + { + delete ${$_[0]}{$_[1]} ; + return ; + } + + croak "DB_File::HASHINFO::DELETE - Unknown element '$_[1]'" ; +} + + +sub DESTROY {undef %{$_[0]} } +sub FIRSTKEY { croak "DB_File::HASHINFO::FIRSTKEY is not implemented" } +sub NEXTKEY { croak "DB_File::HASHINFO::NEXTKEY is not implemented" } +sub EXISTS { croak "DB_File::HASHINFO::EXISTS is not implemented" } +sub CLEAR { croak "DB_File::HASHINFO::CLEAR is not implemented" } + +package DB_File::BTREEINFO ; +use Carp; + +sub TIEHASH +{ + bless {} ; +} + +%elements = ( 'flags' => 0, + 'cachesize' => 0, + 'maxkeypage' => 0, + 'minkeypage' => 0, + 'psize' => 0, + 'compare' => 0, + 'prefix' => 0, + 'lorder' => 0 + ) ; + +sub FETCH +{ + return $_[0]{$_[1]} if defined $elements{$_[1]} ; + + croak "DB_File::BTREEINFO::FETCH - Unknown element '$_[1]'" ; +} + + +sub STORE +{ + if ( defined $elements{$_[1]} ) + { + $_[0]{$_[1]} = $_[2] ; + return ; + } + + croak "DB_File::BTREEINFO::STORE - Unknown element '$_[1]'" ; +} + +sub DELETE +{ + if ( defined $elements{$_[1]} ) + { + delete ${$_[0]}{$_[1]} ; + return ; + } + + croak "DB_File::BTREEINFO::DELETE - Unknown element '$_[1]'" ; +} + + +sub DESTROY {undef %{$_[0]} } +sub FIRSTKEY { croak "DB_File::BTREEINFO::FIRSTKEY is not implemented" } +sub NEXTKEY { croak "DB_File::BTREEINFO::NEXTKEY is not implemented" } +sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" } +sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" } + +package DB_File::RECNOINFO ; +use Carp; + +sub TIEHASH +{ + bless {} ; +} + +%elements = ( 'bval' => 0, + 'cachesize' => 0, + 'psize' => 0, + 'flags' => 0, + 'lorder' => 0, + 'reclen' => 0, + 'bfname' => 0 + ) ; +sub FETCH +{ + return $_[0]{$_[1]} if defined $elements{$_[1]} ; + + croak "DB_File::RECNOINFO::FETCH - Unknown element '$_[1]'" ; +} + + +sub STORE +{ + if ( defined $elements{$_[1]} ) + { + $_[0]{$_[1]} = $_[2] ; + return ; + } + + croak "DB_File::RECNOINFO::STORE - Unknown element '$_[1]'" ; +} + +sub DELETE +{ + if ( defined $elements{$_[1]} ) + { + delete ${$_[0]}{$_[1]} ; + return ; + } + + croak "DB_File::RECNOINFO::DELETE - Unknown element '$_[1]'" ; +} + + +sub DESTROY {undef %{$_[0]} } +sub FIRSTKEY { croak "DB_File::RECNOINFO::FIRSTKEY is not implemented" } +sub NEXTKEY { croak "DB_File::RECNOINFO::NEXTKEY is not implemented" } +sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" } +sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" } + + + +package DB_File ; +use Carp; + +$VERSION = 1.0 ; + +#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; +$DB_BTREE = TIEHASH DB_File::BTREEINFO ; +$DB_HASH = TIEHASH DB_File::HASHINFO ; +$DB_RECNO = TIEHASH DB_File::RECNOINFO ; + +require TieHash; +require Exporter; +use AutoLoader; +require DynaLoader; +@ISA = qw(TieHash Exporter DynaLoader); +@EXPORT = qw( + $DB_BTREE $DB_HASH $DB_RECNO + BTREEMAGIC + BTREEVERSION + DB_LOCK + DB_SHMEM + DB_TXN + HASHMAGIC + HASHVERSION + MAX_PAGE_NUMBER + MAX_PAGE_OFFSET + MAX_REC_NUMBER + RET_ERROR + RET_SPECIAL + RET_SUCCESS + R_CURSOR + R_DUP + R_FIRST + R_FIXEDLEN + R_IAFTER + R_IBEFORE + R_LAST + R_NEXT + R_NOKEY + R_NOOVERWRITE + R_PREV + R_RECNOSYNC + R_SETCURSOR + R_SNAPSHOT + __R_UNUSED +); + +sub AUTOLOAD { + local($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + ($pack,$file,$line) = caller; + croak "Your vendor has not defined DB macro $constname, used at $file line $line. +"; + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + +@liblist = (); +@liblist = split ' ', $Config::Config{"DB_File_loadlibs"} + if defined $Config::Config{"DB_File_loadlibs"}; + +bootstrap DB_File @liblist; + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. + +1; +__END__ + +=cut =head1 NAME @@ -28,16 +271,15 @@ DB_File - Perl5 access to Berkeley DB =head1 DESCRIPTION -B<DB_File> is a module which allows Perl programs to make use of -the facilities provided by Berkeley DB. If you intend to use this -module you should really have a copy of the Berkeley DB manual -page at hand. The interface defined here -mirrors the Berkeley DB interface closely. +B<DB_File> is a module which allows Perl programs to make use of the +facilities provided by Berkeley DB. If you intend to use this +module you should really have a copy of the Berkeley DB manualpage at +hand. The interface defined here mirrors the Berkeley DB interface +closely. -Berkeley DB is a C library which provides a consistent interface to a number of -database formats. -B<DB_File> provides an interface to all three of the database types currently -supported by Berkeley DB. +Berkeley DB is a C library which provides a consistent interface to a +number of database formats. B<DB_File> provides an interface to all +three of the database types currently supported by Berkeley DB. The file types are: @@ -45,50 +287,50 @@ The file types are: =item DB_HASH -This database type allows arbitrary key/data pairs to be stored in data files. -This is equivalent to the functionality provided by -other hashing packages like DBM, NDBM, ODBM, GDBM, and SDBM. -Remember though, the files created using DB_HASH are -not compatible with any of the other packages mentioned. +This database type allows arbitrary key/data pairs to be stored in data +files. This is equivalent to the functionality provided by other +hashing packages like DBM, NDBM, ODBM, GDBM, and SDBM. Remember though, +the files created using DB_HASH are not compatible with any of the +other packages mentioned. -A default hashing algorithm, which will be adequate for most applications, -is built into Berkeley DB. -If you do need to use your own hashing algorithm it is possible to write your -own in Perl and have B<DB_File> use it instead. +A default hashing algorithm, which will be adequate for most +applications, is built into Berkeley DB. If you do need to use your own +hashing algorithm it is possible to write your own in Perl and have +B<DB_File> use it instead. =item DB_BTREE -The btree format allows arbitrary key/data pairs to be stored in a sorted, -balanced binary tree. +The btree format allows arbitrary key/data pairs to be stored in a +sorted, balanced binary tree. -As with the DB_HASH format, it is possible to provide a user defined Perl routine -to perform the comparison of keys. By default, though, the keys are stored -in lexical order. +As with the DB_HASH format, it is possible to provide a user defined +Perl routine to perform the comparison of keys. By default, though, the +keys are stored in lexical order. =item DB_RECNO -DB_RECNO allows both fixed-length and variable-length flat text files to be -manipulated using -the same key/value pair interface as in DB_HASH and DB_BTREE. -In this case the key will consist of a record (line) number. +DB_RECNO allows both fixed-length and variable-length flat text files +to be manipulated using the same key/value pair interface as in DB_HASH +and DB_BTREE. In this case the key will consist of a record (line) +number. =back =head2 How does DB_File interface to Berkeley DB? B<DB_File> allows access to Berkeley DB files using the tie() mechanism -in Perl 5 (for full details, see L<perlfunc/tie()>). -This facility allows B<DB_File> to access Berkeley DB files using -either an associative array (for DB_HASH & DB_BTREE file types) or an -ordinary array (for the DB_RECNO file type). +in Perl 5 (for full details, see L<perlfunc/tie()>). This facility +allows B<DB_File> to access Berkeley DB files using either an +associative array (for DB_HASH & DB_BTREE file types) or an ordinary +array (for the DB_RECNO file type). -In addition to the tie() interface, it is also possible to use most of the -functions provided in the Berkeley DB API. +In addition to the tie() interface, it is also possible to use most of +the functions provided in the Berkeley DB API. =head2 Differences with Berkeley DB -Berkeley DB uses the function dbopen() to open or create a -database. Below is the C prototype for dbopen(). +Berkeley DB uses the function dbopen() to open or create a database. +Below is the C prototype for dbopen(). DB* dbopen (const char * file, int flags, int mode, @@ -100,25 +342,24 @@ Depending on which of these is actually chosen, the final parameter, I<openinfo> points to a data structure which allows tailoring of the specific interface method. -This interface is handled -slightly differently in B<DB_File>. Here is an equivalent call using -B<DB_File>. +This interface is handled slightly differently in B<DB_File>. Here is +an equivalent call using B<DB_File>. tie %array, DB_File, $filename, $flags, $mode, $DB_HASH ; -The C<filename>, C<flags> and C<mode> parameters are the direct equivalent -of their dbopen() counterparts. The final parameter $DB_HASH -performs the function of both the C<type> and C<openinfo> -parameters in dbopen(). +The C<filename>, C<flags> and C<mode> parameters are the direct +equivalent of their dbopen() counterparts. The final parameter $DB_HASH +performs the function of both the C<type> and C<openinfo> parameters in +dbopen(). -In the example above $DB_HASH is actually a reference to a hash object. -B<DB_File> has three of these pre-defined references. -Apart from $DB_HASH, there is also $DB_BTREE and $DB_RECNO. +In the example above $DB_HASH is actually a reference to a hash +object. B<DB_File> has three of these pre-defined references. Apart +from $DB_HASH, there is also $DB_BTREE and $DB_RECNO. -The keys allowed in each of these pre-defined references is limited to the names -used in the equivalent C structure. -So, for example, the $DB_HASH reference will only allow keys called C<bsize>, -C<cachesize>, C<ffactor>, C<hash>, C<lorder> and C<nelem>. +The keys allowed in each of these pre-defined references is limited to +the names used in the equivalent C structure. So, for example, the +$DB_HASH reference will only allow keys called C<bsize>, C<cachesize>, +C<ffactor>, C<hash>, C<lorder> and C<nelem>. To change one of these elements, just assign to it like this @@ -134,33 +375,33 @@ RECNO arrays begins at 0 rather than 1 as in Berkeley DB. =head2 In Memory Databases -Berkeley DB allows the creation of in-memory databases by using NULL (that is, a -C<(char *)0 in C) in -place of the filename. -B<DB_File> uses C<undef> instead of NULL to provide this functionality. +Berkeley DB allows the creation of in-memory databases by using NULL +(that is, a C<(char *)0 in C) in place of the filename. B<DB_File> +uses C<undef> instead of NULL to provide this functionality. =head2 Using the Berkeley DB Interface Directly As well as accessing Berkeley DB using a tied hash or array, it is also -possible to make direct use of most of the functions defined in the Berkeley DB -documentation. +possible to make direct use of most of the functions defined in the +Berkeley DB documentation. To do this you need to remember the return value from the tie. $db = tie %hash, DB_File, "filename" -Once you have done that, you can access the Berkeley DB API functions directly. +Once you have done that, you can access the Berkeley DB API functions +directly. $db->put($key, $value, R_NOOVERWRITE) ; -All the functions defined in L<dbx(3X)> are available except -for close() and dbopen() itself. -The B<DB_File> interface to these functions have been implemented to mirror -the the way Berkeley DB works. In particular note that all the functions return -only a status value. Whenever a Berkeley DB function returns data via one of -its parameters, the B<DB_File> equivalent does exactly the same. +All the functions defined in L<dbx(3X)> are available except for +close() and dbopen() itself. The B<DB_File> interface to these +functions have been implemented to mirror the the way Berkeley DB +works. In particular note that all the functions return only a status +value. Whenever a Berkeley DB function returns data via one of its +parameters, the B<DB_File> equivalent does exactly the same. All the constants defined in L<dbopen> are also available. @@ -170,17 +411,16 @@ Below is a list of the functions available. =item get -Same as in C<recno> except that the flags parameter is optional. -Remember the value -associated with the key you request is returned in the $value parameter. +Same as in C<recno> except that the flags parameter is optional. +Remember the value associated with the key you request is returned in +the $value parameter. =item put As usual the flags parameter is optional. -If you use either the R_IAFTER or -R_IBEFORE flags, the key parameter will have the record number of the inserted -key/value pair set. +If you use either the R_IAFTER or R_IBEFORE flags, the key parameter +will have the record number of the inserted key/value pair set. =item del @@ -204,15 +444,15 @@ The flags parameter is optional. =head1 EXAMPLES -It is always a lot easier to understand something when you see a real example. -So here are a few. +It is always a lot easier to understand something when you see a real +example. So here are a few. =head2 Using HASH use DB_File ; use Fcntl ; - tie %h, DB_File, "hashed", O_RDWR|O_CREAT, 0640, $DB_HASH ; + tie %h, "DB_File", "hashed", O_RDWR|O_CREAT, 0640, $DB_HASH ; # Add a key/value pair to the file $h{"apple"} = "orange" ; @@ -227,9 +467,10 @@ So here are a few. =head2 Using BTREE -Here is sample of code which used BTREE. Just to make life more interesting -the default comparision function will not be used. Instead a Perl sub, C<Compare()>, -will be used to do a case insensitive comparison. +Here is sample of code which used BTREE. Just to make life more +interesting the default comparision function will not be used. Instead +a Perl sub, C<Compare()>, will be used to do a case insensitive +comparison. use DB_File ; use Fcntl ; @@ -243,7 +484,7 @@ will be used to do a case insensitive comparison. $DB_BTREE->{compare} = 'Compare' ; - tie %h, DB_File, "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE ; + tie %h, 'DB_File', "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE ; # Add a key/value pair to the file $h{'Wall'} = 'Larry' ; @@ -301,23 +542,37 @@ process if I<dbopen> returned an error. This allows file protection errors to be caught at run time. Thanks to Judith Grass <grass@cybercash.com> for spotting the bug. +=head2 0.3 + +Added prototype support for multiple btree compare callbacks. + +=head 1.0 + +B<DB_File> has been in use for over a year. To reflect that, the +version number has been incremented to 1.0. + +Added complete support for multiple concurrent callbacks. + +Using the I<push> method on an empty list didn't work properly. This +has been fixed. + =head1 WARNINGS -If you happen find any other functions defined in the source for this module -that have not been mentioned in this document -- beware. -I may drop them at a moments notice. +If you happen find any other functions defined in the source for this +module that have not been mentioned in this document -- beware. I may +drop them at a moments notice. -If you cannot find any, then either you didn't look very hard or the moment has -passed and I have dropped them. +If you cannot find any, then either you didn't look very hard or the +moment has passed and I have dropped them. =head1 BUGS -Some older versions of Berkeley DB had problems with fixed length records -using the RECNO file format. The newest version at the time of writing -was 1.85 - this seems to have fixed the problems with RECNO. +Some older versions of Berkeley DB had problems with fixed length +records using the RECNO file format. The newest version at the time of +writing was 1.85 - this seems to have fixed the problems with RECNO. -I am sure there are bugs in the code. If you do find any, or can suggest any -enhancements, I would welcome your comments. +I am sure there are bugs in the code. If you do find any, or can +suggest any enhancements, I would welcome your comments. =head1 AVAILABILITY @@ -328,252 +583,14 @@ directory C</ucb/4bsd/db.tar.gz>. It is I<not> under the GPL. L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)> -Berkeley DB is available from F<ftp.cs.berkeley.edu> in the directory F</ucb/4bsd>. +Berkeley DB is available from F<ftp.cs.berkeley.edu> in the directory +F</ucb/4bsd>. =head1 AUTHOR -The DB_File interface was written by -Paul Marquess <pmarquess@bfsec.bt.co.uk>. -Questions about the DB system itself may be addressed to -Keith Bostic <bostic@cs.berkeley.edu>. +The DB_File interface was written by Paul Marquess +<pmarquess@bfsec.bt.co.uk>. +Questions about the DB system itself may be addressed to Keith Bostic +<bostic@cs.berkeley.edu>. =cut - -package DB_File::HASHINFO ; -use Carp; - -sub TIEHASH -{ - bless {} ; -} - -%elements = ( 'bsize' => 0, - 'ffactor' => 0, - 'nelem' => 0, - 'cachesize' => 0, - 'hash' => 0, - 'lorder' => 0 - ) ; - -sub FETCH -{ - return $_[0]{$_[1]} if defined $elements{$_[1]} ; - - croak "DB_File::HASHINFO::FETCH - Unknown element '$_[1]'" ; -} - - -sub STORE -{ - if ( defined $elements{$_[1]} ) - { - $_[0]{$_[1]} = $_[2] ; - return ; - } - - croak "DB_File::HASHINFO::STORE - Unknown element '$_[1]'" ; -} - -sub DELETE -{ - if ( defined $elements{$_[1]} ) - { - delete ${$_[0]}{$_[1]} ; - return ; - } - - croak "DB_File::HASHINFO::DELETE - Unknown element '$_[1]'" ; -} - - -sub DESTROY {undef %{$_[0]} } -sub FIRSTKEY { croak "DB_File::HASHINFO::FIRSTKEY is not implemented" } -sub NEXTKEY { croak "DB_File::HASHINFO::NEXTKEY is not implemented" } -sub EXISTS { croak "DB_File::HASHINFO::EXISTS is not implemented" } -sub CLEAR { croak "DB_File::HASHINFO::CLEAR is not implemented" } - -package DB_File::BTREEINFO ; -use Carp; - -sub TIEHASH -{ - bless {} ; -} - -%elements = ( 'flags' => 0, - 'cachesize' => 0, - 'maxkeypage' => 0, - 'minkeypage' => 0, - 'psize' => 0, - 'compare' => 0, - 'prefix' => 0, - 'lorder' => 0 - ) ; - -sub FETCH -{ - return $_[0]{$_[1]} if defined $elements{$_[1]} ; - - croak "DB_File::BTREEINFO::FETCH - Unknown element '$_[1]'" ; -} - - -sub STORE -{ - if ( defined $elements{$_[1]} ) - { - $_[0]{$_[1]} = $_[2] ; - return ; - } - - croak "DB_File::BTREEINFO::STORE - Unknown element '$_[1]'" ; -} - -sub DELETE -{ - if ( defined $elements{$_[1]} ) - { - delete ${$_[0]}{$_[1]} ; - return ; - } - - croak "DB_File::BTREEINFO::DELETE - Unknown element '$_[1]'" ; -} - - -sub DESTROY {undef %{$_[0]} } -sub FIRSTKEY { croak "DB_File::BTREEINFO::FIRSTKEY is not implemented" } -sub NEXTKEY { croak "DB_File::BTREEINFO::NEXTKEY is not implemented" } -sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" } -sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" } - -package DB_File::RECNOINFO ; -use Carp; - -sub TIEHASH -{ - bless {} ; -} - -%elements = ( 'bval' => 0, - 'cachesize' => 0, - 'psize' => 0, - 'flags' => 0, - 'lorder' => 0, - 'reclen' => 0, - 'bfname' => 0 - ) ; -sub FETCH -{ - return $_[0]{$_[1]} if defined $elements{$_[1]} ; - - croak "DB_File::RECNOINFO::FETCH - Unknown element '$_[1]'" ; -} - - -sub STORE -{ - if ( defined $elements{$_[1]} ) - { - $_[0]{$_[1]} = $_[2] ; - return ; - } - - croak "DB_File::RECNOINFO::STORE - Unknown element '$_[1]'" ; -} - -sub DELETE -{ - if ( defined $elements{$_[1]} ) - { - delete ${$_[0]}{$_[1]} ; - return ; - } - - croak "DB_File::RECNOINFO::DELETE - Unknown element '$_[1]'" ; -} - - -sub DESTROY {undef %{$_[0]} } -sub FIRSTKEY { croak "DB_File::RECNOINFO::FIRSTKEY is not implemented" } -sub NEXTKEY { croak "DB_File::RECNOINFO::NEXTKEY is not implemented" } -sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" } -sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" } - - - -package DB_File ; -use Carp; - -#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; -$DB_BTREE = TIEHASH DB_File::BTREEINFO ; -$DB_HASH = TIEHASH DB_File::HASHINFO ; -$DB_RECNO = TIEHASH DB_File::RECNOINFO ; - -require TieHash; -require Exporter; -use AutoLoader; -require DynaLoader; -@ISA = qw(TieHash Exporter DynaLoader); -@EXPORT = qw( - $DB_BTREE $DB_HASH $DB_RECNO - BTREEMAGIC - BTREEVERSION - DB_LOCK - DB_SHMEM - DB_TXN - HASHMAGIC - HASHVERSION - MAX_PAGE_NUMBER - MAX_PAGE_OFFSET - MAX_REC_NUMBER - RET_ERROR - RET_SPECIAL - RET_SUCCESS - R_CURSOR - R_DUP - R_FIRST - R_FIXEDLEN - R_IAFTER - R_IBEFORE - R_LAST - R_NEXT - R_NOKEY - R_NOOVERWRITE - R_PREV - R_RECNOSYNC - R_SETCURSOR - R_SNAPSHOT - __R_UNUSED -); - -sub AUTOLOAD { - local($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - $val = constant($constname, @_ ? $_[0] : 0); - if ($! != 0) { - if ($! =~ /Invalid/) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD; - } - else { - ($pack,$file,$line) = caller; - croak "Your vendor has not defined DB macro $constname, used at $file line $line. -"; - } - } - eval "sub $AUTOLOAD { $val }"; - goto &$AUTOLOAD; -} - -@liblist = (); -@liblist = split ' ', $Config::Config{"DB_File_loadlibs"} - if defined $Config::Config{"DB_File_loadlibs"}; - -bootstrap DB_File @liblist; - -# Preloaded methods go here. Autoload methods go after __END__, and are -# processed by the autosplit program. - -1; -__END__ diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 0541668e24..8abb230da1 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,14 +3,17 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 19th May 1995 - version 0.2 + last modified 7th October 1995 + version 1.0 All comments/suggestions/problems are welcome Changes: 0.1 - Initial Release 0.2 - No longer bombs out if dbopen returns an error. + 0.3 - Added some support for multiple btree compares + 1.0 - Complete support for multiple callbacks added. + Fixed a problem with pushing a value onto an empty list. */ #include "EXTERN.h" @@ -21,7 +24,15 @@ #include <fcntl.h> -typedef DB * DB_File; +typedef struct { + DBTYPE type ; + DB * dbp ; + SV * compare ; + SV * prefix ; + SV * hash ; + } DB_File_type; + +typedef DB_File_type * DB_File ; typedef DBT DBTKEY ; union INFO { @@ -30,25 +41,21 @@ union INFO { BTREEINFO btree ; } ; -typedef struct { - SV * sub ; - } CallBackInfo ; - /* #define TRACE */ -#define db_DESTROY(db) (db->close)(db) -#define db_DELETE(db, key, flags) (db->del)(db, &key, flags) -#define db_STORE(db, key, value, flags) (db->put)(db, &key, &value, flags) -#define db_FETCH(db, key, flags) (db->get)(db, &key, &value, flags) +#define db_DESTROY(db) (db->dbp->close)(db->dbp) +#define db_DELETE(db, key, flags) (db->dbp->del)(db->dbp, &key, flags) +#define db_STORE(db, key, value, flags) (db->dbp->put)(db->dbp, &key, &value, flags) +#define db_FETCH(db, key, flags) (db->dbp->get)(db->dbp, &key, &value, flags) -#define db_close(db) (db->close)(db) -#define db_del(db, key, flags) (db->del)(db, &key, flags) -#define db_fd(db) (db->fd)(db) -#define db_put(db, key, value, flags) (db->put)(db, &key, &value, flags) -#define db_get(db, key, value, flags) (db->get)(db, &key, &value, flags) -#define db_seq(db, key, value, flags) (db->seq)(db, &key, &value, flags) -#define db_sync(db, flags) (db->sync)(db, flags) +#define db_close(db) (db->dbp->close)(db->dbp) +#define db_del(db, key, flags) (db->dbp->del)(db->dbp, &key, flags) +#define db_fd(db) (db->dbp->fd)(db->dbp) +#define db_put(db, key, value, flags) (db->dbp->put)(db->dbp, &key, &value, flags) +#define db_get(db, key, value, flags) (db->dbp->get)(db->dbp, &key, &value, flags) +#define db_seq(db, key, value, flags) (db->dbp->seq)(db->dbp, &key, &value, flags) +#define db_sync(db, flags) (db->dbp->sync)(db->dbp, flags) #define OutputValue(arg, name) \ @@ -57,7 +64,7 @@ typedef struct { #define OutputKey(arg, name) \ { if (RETVAL == 0) \ { \ - if (db->close != DB_recno_close) \ + if (db->type != DB_RECNO) \ sv_setpvn(arg, name.data, name.size); \ else \ sv_setiv(arg, (I32)*(I32*)name.data - 1); \ @@ -65,13 +72,10 @@ typedef struct { } /* Internal Global Data */ - -static recno_t Value ; -static int (*DB_recno_close)() = NULL ; - -static CallBackInfo hash_callback = { 0 } ; -static CallBackInfo compare_callback = { 0 } ; -static CallBackInfo prefix_callback = { 0 } ; +static recno_t Value ; +static DB_File CurrentDB ; +static recno_t zero = 0 ; +static DBTKEY empty = { &zero, sizeof(recno_t) } ; static int @@ -105,7 +109,7 @@ const DBT * key2 ; PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; - count = perl_call_sv(compare_callback.sub, G_SCALAR); + count = perl_call_sv(CurrentDB->compare, G_SCALAR); SPAGAIN ; @@ -152,7 +156,7 @@ const DBT * key2 ; PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; - count = perl_call_sv(prefix_callback.sub, G_SCALAR); + count = perl_call_sv(CurrentDB->prefix, G_SCALAR); SPAGAIN ; @@ -184,7 +188,7 @@ size_t size ; XPUSHs(sv_2mortal(newSVpv((char*)data,size))); PUTBACK ; - count = perl_call_sv(hash_callback.sub, G_SCALAR); + count = perl_call_sv(CurrentDB->hash, G_SCALAR); SPAGAIN ; @@ -256,7 +260,7 @@ BTREEINFO btree ; static I32 GetArrayLength(db) -DB_File db ; +DB * db ; { DBT key ; DBT value ; @@ -282,10 +286,12 @@ char * string ; SV ** svp; HV * action ; union INFO info ; - DB_File RETVAL ; + DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; void * openinfo = NULL ; - DBTYPE type = DB_HASH ; + /* DBTYPE type = DB_HASH ; */ + RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ; + RETVAL->type = DB_HASH ; if (sv) { @@ -295,7 +301,7 @@ char * string ; action = (HV*)SvRV(sv); if (sv_isa(sv, "DB_File::HASHINFO")) { - type = DB_HASH ; + RETVAL->type = DB_HASH ; openinfo = (void*)&info ; svp = hv_fetch(action, "hash", 4, FALSE); @@ -303,7 +309,7 @@ char * string ; if (svp && SvOK(*svp)) { info.hash.hash = hash_cb ; - hash_callback.sub = *svp ; + RETVAL->hash = newSVsv(*svp) ; } else info.hash.hash = NULL ; @@ -327,14 +333,14 @@ char * string ; } else if (sv_isa(sv, "DB_File::BTREEINFO")) { - type = DB_BTREE ; + RETVAL->type = DB_BTREE ; openinfo = (void*)&info ; svp = hv_fetch(action, "compare", 7, FALSE); if (svp && SvOK(*svp)) { info.btree.compare = btree_compare ; - compare_callback.sub = *svp ; + RETVAL->compare = newSVsv(*svp) ; } else info.btree.compare = NULL ; @@ -343,7 +349,7 @@ char * string ; if (svp && SvOK(*svp)) { info.btree.prefix = btree_prefix ; - prefix_callback.sub = *svp ; + RETVAL->prefix = newSVsv(*svp) ; } else info.btree.prefix = NULL ; @@ -371,7 +377,7 @@ char * string ; } else if (sv_isa(sv, "DB_File::RECNOINFO")) { - type = DB_RECNO ; + RETVAL->type = DB_RECNO ; openinfo = (void *)&info ; svp = hv_fetch(action, "flags", 5, FALSE); @@ -415,14 +421,16 @@ char * string ; } - RETVAL = dbopen(name, flags, mode, type, openinfo) ; + RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; +#if 0 /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE so remember a DB_RECNO by saving the address of one of it's internal routines */ - if (RETVAL && type == DB_RECNO) - DB_recno_close = RETVAL->close ; + if (RETVAL->dbp && type == DB_RECNO) + DB_recno_close = RETVAL->dbp->close ; +#endif return (RETVAL) ; @@ -710,6 +718,16 @@ BOOT: int db_DESTROY(db) DB_File db + INIT: + CurrentDB = db ; + CLEANUP: + if (db->hash) + SvREFCNT_dec(db->hash) ; + if (db->compare) + SvREFCNT_dec(db->compare) ; + if (db->prefix) + SvREFCNT_dec(db->prefix) ; + Safefree(db) ; int @@ -717,6 +735,8 @@ db_DELETE(db, key, flags=0) DB_File db DBTKEY key u_int flags + INIT: + CurrentDB = db ; int db_FETCH(db, key, flags=0) @@ -727,7 +747,8 @@ db_FETCH(db, key, flags=0) { DBT value ; - RETVAL = (db->get)(db, &key, &value, flags) ; + CurrentDB = db ; + RETVAL = (db->dbp->get)(db->dbp, &key, &value, flags) ; ST(0) = sv_newmortal(); if (RETVAL == 0) sv_setpvn(ST(0), value.data, value.size); @@ -739,6 +760,8 @@ db_STORE(db, key, value, flags=0) DBTKEY key DBT value u_int flags + INIT: + CurrentDB = db ; int @@ -749,11 +772,12 @@ db_FIRSTKEY(db) DBTKEY key ; DBT value ; - RETVAL = (db->seq)(db, &key, &value, R_FIRST) ; + CurrentDB = db ; + RETVAL = (db->dbp->seq)(db->dbp, &key, &value, R_FIRST) ; ST(0) = sv_newmortal(); if (RETVAL == 0) { - if (db->type != DB_RECNO) + if (db->dbp->type != DB_RECNO) sv_setpvn(ST(0), key.data, key.size); else sv_setiv(ST(0), (I32)*(I32*)key.data - 1); @@ -768,11 +792,12 @@ db_NEXTKEY(db, key) { DBT value ; - RETVAL = (db->seq)(db, &key, &value, R_NEXT) ; + CurrentDB = db ; + RETVAL = (db->dbp->seq)(db->dbp, &key, &value, R_NEXT) ; ST(0) = sv_newmortal(); if (RETVAL == 0) { - if (db->type != DB_RECNO) + if (db->dbp->type != DB_RECNO) sv_setpvn(ST(0), key.data, key.size); else sv_setiv(ST(0), (I32)*(I32*)key.data - 1); @@ -793,6 +818,7 @@ unshift(db, ...) int i ; int One ; + CurrentDB = db ; RETVAL = -1 ; for (i = items-1 ; i > 0 ; --i) { @@ -801,7 +827,7 @@ unshift(db, ...) One = 1 ; key.data = &One ; key.size = sizeof(int) ; - RETVAL = (db->put)(db, &key, &value, R_IBEFORE) ; + RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ; if (RETVAL != 0) break; } @@ -817,13 +843,14 @@ pop(db) DBTKEY key ; DBT value ; + CurrentDB = db ; /* First get the final value */ - RETVAL = (db->seq)(db, &key, &value, R_LAST) ; + RETVAL = (db->dbp->seq)(db->dbp, &key, &value, R_LAST) ; ST(0) = sv_newmortal(); /* Now delete it */ if (RETVAL == 0) { - RETVAL = (db->del)(db, &key, R_CURSOR) ; + RETVAL = (db->dbp->del)(db->dbp, &key, R_CURSOR) ; if (RETVAL == 0) sv_setpvn(ST(0), value.data, value.size); } @@ -837,13 +864,14 @@ shift(db) DBTKEY key ; DBT value ; + CurrentDB = db ; /* get the first value */ - RETVAL = (db->seq)(db, &key, &value, R_FIRST) ; + RETVAL = (db->dbp->seq)(db->dbp, &key, &value, R_FIRST) ; ST(0) = sv_newmortal(); /* Now delete it */ if (RETVAL == 0) { - RETVAL = (db->del)(db, &key, R_CURSOR) ; + RETVAL = (db->dbp->del)(db->dbp, &key, R_CURSOR) ; if (RETVAL == 0) sv_setpvn(ST(0), value.data, value.size); } @@ -856,22 +884,25 @@ push(db, ...) CODE: { DBTKEY key ; + DBTKEY * keyptr = &key ; DBT value ; int i ; + CurrentDB = db ; /* Set the Cursor to the Last element */ - RETVAL = (db->seq)(db, &key, &value, R_LAST) ; - if (RETVAL == 0) + RETVAL = (db->dbp->seq)(db->dbp, &key, &value, R_LAST) ; + if (RETVAL >= 0) { - /* for (i = 1 ; i < items ; ++i) */ - for (i = items - 1 ; i > 0 ; --i) - { - value.data = SvPV(ST(i), na) ; - value.size = na ; - RETVAL = (db->put)(db, &key, &value, R_IAFTER) ; - if (RETVAL != 0) - break; - } + if (RETVAL == 1) + keyptr = &empty ; + for (i = items - 1 ; i > 0 ; --i) + { + value.data = SvPV(ST(i), na) ; + value.size = na ; + RETVAL = (db->dbp->put)(db->dbp, keyptr, &value, R_IAFTER) ; + if (RETVAL != 0) + break; + } } } OUTPUT: @@ -882,7 +913,8 @@ I32 length(db) DB_File db CODE: - RETVAL = GetArrayLength(db) ; + CurrentDB = db ; + RETVAL = GetArrayLength(db->dbp) ; OUTPUT: RETVAL @@ -896,6 +928,8 @@ db_del(db, key, flags=0) DB_File db DBTKEY key u_int flags + INIT: + CurrentDB = db ; int @@ -904,6 +938,8 @@ db_get(db, key, value, flags=0) DBTKEY key DBT value u_int flags + INIT: + CurrentDB = db ; OUTPUT: value @@ -913,17 +949,23 @@ db_put(db, key, value, flags=0) DBTKEY key DBT value u_int flags + INIT: + CurrentDB = db ; OUTPUT: key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key); int db_fd(db) DB_File db + INIT: + CurrentDB = db ; int db_sync(db, flags=0) DB_File db u_int flags + INIT: + CurrentDB = db ; int @@ -932,6 +974,8 @@ db_seq(db, key, value, flags) DBTKEY key DBT value u_int flags + INIT: + CurrentDB = db ; OUTPUT: key value diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL index c300d8569f..3ad8015d95 100644 --- a/ext/DB_File/Makefile.PL +++ b/ext/DB_File/Makefile.PL @@ -1,2 +1,9 @@ use ExtUtils::MakeMaker; -WriteMakefile(LIBS => ["-L/usr/local/lib -ldb"]); + +WriteMakefile( + NAME => 'DB_File', + LIBS => ["-L/usr/local/lib -ldb"], + #INC => '-I/usr/local/include', + VERSION => 1.0, + ); + diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap index 242fa041d2..4acc65e078 100644 --- a/ext/DB_File/typemap +++ b/ext/DB_File/typemap @@ -15,7 +15,7 @@ DBTKEY T_dbtkeydatum INPUT T_dbtkeydatum - if (db->close != DB_recno_close) + if (db->type != DB_RECNO) { $var.data = SvPV($arg, na); $var.size = (int)na; diff --git a/ext/Devel/DProf/DProf.pm b/ext/Devel/DProf/DProf.pm new file mode 100644 index 0000000000..8ec82d04f2 --- /dev/null +++ b/ext/Devel/DProf/DProf.pm @@ -0,0 +1,106 @@ +# Devel::DProf - a Perl code profiler +# 5apr95 +# Dean Roehrich +# +# changes/bugs fixed since 01mar95 version: +# - record $pwd and build pathname for tmon.out +# (so the profile doesn't get lost if the process chdir's) +# changes/bugs fixed since 03feb95 version: +# - fixed some doc bugs +# - added require 5.000 +# - added -w note to bugs section of pod +# changes/bugs fixed since 31dec94 version: +# - podified +# + +require 5.000; + +=head1 NAME + +Devel::DProf - a Perl code profiler + +=head1 SYNOPSIS + + PERL5DB="use Devel::DProf;" + export PERL5DB + + perl5 -d test.pl + +=head1 DESCRIPTION + +The Devel::DProf package is a Perl code profiler. This will collect +information on the execution time of a Perl script and of the subs in that +script. This information can be used to determine which subroutines are +using the most time and which subroutines are being called most often. This +information can also be used to create an execution graph of the script, +showing subroutine relationships. + +To use this package the PERL5DB environment variable must be set to the +following value: + + PERL5DB="use Devel::DProf;" + export PERL5DB + +To profile a Perl script run the perl interpreter with the B<-d> debugging +switch. The profiler uses the debugging hooks. So to profile script +"test.pl" the following command should be used: + + perl5 -d test.pl + +When the script terminates the profiler will dump the profile information +to a file called I<tmon.out>. The supplied I<dprofpp> tool can be used to +interpret the information which is in that profile. The following command +will print the top 15 subroutines which used the most time: + + dprofpp + +To print an execution graph of the subroutines in the script use the +following command: + + dprofpp -T + +Consult the "dprofpp" manpage for other options. + +=head1 BUGS + +If perl5 is invoked with the B<-w> (warnings) flag then Devel::DProf will +cause a large quantity of warnings to be printed. + +=head1 SEE ALSO + +L<perl>, L<dprofpp>, times(2) + +=cut + +package DB; + +# So Devel::DProf knows where to drop tmon.out. +chop($pwd = `pwd`); +$tmon = "$pwd/tmon.out"; + +# This sub is replaced by an XS version after the profiler is bootstrapped. +sub sub { +# print "nonXS DBsub($sub)\n"; + $single = 0; # disable DB single-stepping + if( wantarray ){ + @a = &$sub; + @a; + } + else{ + $a = &$sub; + $a; + } +} + +# This sub is needed during startup. +sub DB { +# print "nonXS DBDB\n"; +} + + +require DynaLoader; +@Devel::DProf::ISA = qw(DynaLoader); + +bootstrap Devel::DProf; + +1; diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs new file mode 100644 index 0000000000..8670481a35 --- /dev/null +++ b/ext/Devel/DProf/DProf.xs @@ -0,0 +1,247 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* +# Devel::DProf - a Perl code profiler +# 5apr95 +# Dean Roehrich +# +# changes/bugs fixed since 2apr95 version: +# -now mallocing an extra byte for the \0 :) +# changes/bugs fixed since 01mar95 version: +# -stringified code ref is used for name of anonymous sub. +# -include stash name with stringified code ref. +# -use perl.c's DBsingle and DBsub. +# -now using croak() and warn(). +# -print "timer is on" before turning timer on. +# -use safefree() instead of free(). +# -rely on PM to provide full path name to tmon.out. +# -print errno if unable to write tmon.out. +# changes/bugs fixed since 03feb95 version: +# -comments +# changes/bugs fixed since 31dec94 version: +# -added patches from Andy. +# +*/ + +/*#define DBG_SUB 1 /* */ +/*#define DBG_TIMER 1 /* */ + +#ifdef DBG_SUB +# define DBG_SUB_NOTIFY(A,B) warn( A, B ) +#else +# define DBG_SUB_NOTIFY(A,B) /* nothing */ +#endif + +#ifdef DBG_TIMER +# define DBG_TIMER_NOTIFY(A) warn( A ) +#else +# define DBG_TIMER_NOTIFY(A) /* nothing */ +#endif + +/* HZ == clock ticks per second */ +#ifndef HZ +#define HZ 60 +#endif + +static SV * Sub; /* pointer to $DB::sub */ +static char *Tmon; /* name of tmon.out */ + +/* Everything is built on times(2). See its manpage for a description + * of the timings. + */ + +static +struct tms prof_start, + prof_end; + +static +clock_t rprof_start, /* elapsed real time, in ticks */ + rprof_end; + +union prof_any { + clock_t tms_utime; /* cpu time spent in user space */ + clock_t tms_stime; /* cpu time spent in system */ + clock_t realtime; /* elapsed real time, in ticks */ + char *name; + opcode ptype; +}; + +typedef union prof_any PROFANY; + +static PROFANY *profstack; +static int profstack_max = 128; +static int profstack_ix = 0; + + +static void +prof_mark( ptype ) +opcode ptype; +{ + struct tms t; + clock_t realtime; + char *name, *pv; + char *hvname; + STRLEN len; + SV *sv; + + if( profstack_ix + 5 > profstack_max ){ + profstack_max = profstack_max * 3 / 2; + Renew( profstack, profstack_max, PROFANY ); + } + + realtime = times(&t); + pv = SvPV( Sub, len ); + + if( SvROK(Sub) ){ + /* Attempt to make CODE refs identifiable by + * including their package name. + */ + sv = (SV*)SvRV(Sub); + if( sv && SvTYPE(sv) == SVt_PVCV ){ + hvname = HvNAME(CvSTASH(sv)); + len += strlen( hvname ) + 2; /* +2 for more ::'s */ + + } + else { + croak( "DProf prof_mark() lost on supposed CODE ref %s.\n", pv ); + } + name = (char *)safemalloc( len * sizeof(char) + 1 ); + strcpy( name, hvname ); + strcat( name, "::" ); + strcat( name, pv ); + } + else{ + name = (char *)safemalloc( len * sizeof(char) + 1 ); + strcpy( name, pv ); + } + + profstack[profstack_ix++].ptype = ptype; + profstack[profstack_ix++].tms_utime = t.tms_utime; + profstack[profstack_ix++].tms_stime = t.tms_stime; + profstack[profstack_ix++].realtime = realtime; + profstack[profstack_ix++].name = name; +} + +static void +prof_record(){ + FILE *fp; + char *name; + int base = 0; + opcode ptype; + clock_t tms_utime; + clock_t tms_stime; + clock_t realtime; + + if( (fp = fopen( Tmon, "w" )) == NULL ){ + warn("DProf: unable to write %s, errno = %d\n", Tmon, errno ); + return; + } + + fprintf(fp, "#fOrTyTwO\n" ); + fprintf(fp, "$hz=%d;\n", HZ ); + fprintf(fp, "# All values are given in HZ\n" ); + fprintf(fp, "$rrun_utime=%ld; $rrun_stime=%ld; $rrun_rtime=%ld\n", + prof_end.tms_utime - prof_start.tms_utime, + prof_end.tms_stime - prof_start.tms_stime, + rprof_end - rprof_start ); + fprintf(fp, "PART2\n" ); + + while( base < profstack_ix ){ + ptype = profstack[base++].ptype; + tms_utime = profstack[base++].tms_utime; + tms_stime = profstack[base++].tms_stime; + realtime = profstack[base++].realtime; + name = profstack[base++].name; + + switch( ptype ){ + case OP_LEAVESUB: + fprintf(fp,"- %ld %ld %ld %s\n", + tms_utime, tms_stime, realtime, name ); + break; + case OP_ENTERSUB: + fprintf(fp,"+ %ld %ld %ld %s\n", + tms_utime, tms_stime, realtime, name ); + break; + default: + fprintf(fp,"Profiler unknown prof code %d\n", ptype); + } + } + fclose( fp ); +} + +#define for_real +#ifdef for_real + +XS(XS_DB_sub) +{ + dXSARGS; + dORIGMARK; + SP -= items; + + DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) ); + + sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */ + + prof_mark( OP_ENTERSUB ); + PUSHMARK( ORIGMARK ); + + perl_call_sv( Sub, GIMME ); + + prof_mark( OP_LEAVESUB ); + SPAGAIN; + PUTBACK; + return; +} + +#endif /* for_real */ + +#ifdef testing + + MODULE = Devel::DProf PACKAGE = DB + + void + sub(...) + PPCODE: + + dORIGMARK; + /* SP -= items; added by xsubpp */ + DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) ); + + sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */ + + prof_mark( OP_ENTERSUB ); + PUSHMARK( ORIGMARK ); + + perl_call_sv( Sub, GIMME ); + + prof_mark( OP_LEAVESUB ); + SPAGAIN; + /* PUTBACK; added by xsubpp */ + +#endif /* testing */ + + +MODULE = Devel::DProf PACKAGE = Devel::DProf + +void +END() + PPCODE: + rprof_end = times(&prof_end); + DBG_TIMER_NOTIFY("Profiler timer is off.\n"); + prof_record(); + +BOOT: + newXS("DB::sub", XS_DB_sub, file); + Sub = GvSV(DBsub); /* name of current sub */ + sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */ + { /* obtain name of tmon.out file */ + SV *sv; + sv = perl_get_sv( "DB::tmon", FALSE ); + Tmon = (char *)safemalloc( SvCUR(sv) * sizeof(char) ); + strcpy( Tmon, SvPVX(sv) ); + } + New( 0, profstack, profstack_max, PROFANY ); + DBG_TIMER_NOTIFY("Profiler timer is on.\n"); + rprof_start = times(&prof_start); diff --git a/ext/Devel/DProf/Makefile.PL b/ext/Devel/DProf/Makefile.PL new file mode 100644 index 0000000000..a1d7b0774d --- /dev/null +++ b/ext/Devel/DProf/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + 'NAME' => 'Devel::DProf', + 'VERSION' => 'Apr5,1995', + 'clean' => {'FILES' => "tmon.out"}, + 'EXE_FILES' => ['dprofpp'], + +); diff --git a/ext/Devel/DProf/README b/ext/Devel/DProf/README new file mode 100644 index 0000000000..970e26b46e --- /dev/null +++ b/ext/Devel/DProf/README @@ -0,0 +1,3 @@ +Please consult the pod in DProf.pm. + +Dean Roehrich diff --git a/ext/Devel/DProf/dprofpp b/ext/Devel/DProf/dprofpp new file mode 100644 index 0000000000..6b6c0e70f2 --- /dev/null +++ b/ext/Devel/DProf/dprofpp @@ -0,0 +1,394 @@ +#!/usr/local/bin/perl + +require 5.000; + + +# dprofpp - display perl profile data +# 5apr95 +# Dean Roehrich +# +# changes/bugs fixed since 10feb95 version: +# - summary info is printed by default, opt_c is gone. +# - fixed some doc bugs +# - changed name to dprofpp +# changes/bugs fixed since 03feb95 version: +# - fixed division by zero. +# - replace many local()s with my(). +# - now prints user+system times by default +# now -u prints user time, -U prints unsorted. +# - fixed documentation +# - fixed output, to clarify that times are given in seconds. +# - can now fake exit timestamps if the profile is garbled. +# changes/bugs fixed since 17jun94 version: +# - podified. +# - correct old documentation flaws. +# - added Andy's patches. +# + + +=head1 NAME + +dprofpp - display perl profile data + +=head1 SYNOPSIS + +dprofpp [B<-a|-t|-l|-v|-U|-T>] [B<-s|-r|-u>] [B<-q>] [B<-F>] [B<-O cnt>] [profile] + +=head1 DESCRIPTION + +The I<dprofpp> command interprets a profile file produced by the Devel::DProf +profiler. By default dprofpp will read the file I<tmon.out> and will display +the 15 subroutines which are using the most time. + +=head1 OPTIONS + +=over 5 + +=item B<-a> + +Sort alphabetically by subroutine names. + +=item B<-t> + +(default) Sort by amount of user+system time used. The first few lines +should show you which subroutines are using the most time. + +=item B<-l> + +Sort by number of calls to the subroutines. This may help identify +candidates for inlining. + +=item B<-v> + +Sort by average time spent in subroutines during each call. This may help +identify candidates for inlining. + +=item B<-U> + +Do not sort. Display in the order found in the raw profile. + +=item B<-F> + +Force the generation of fake exit timestamps if dprofpp reports that the +profile is garbled. This is only useful if dprofpp determines that the +profile is garbled due to missing exit timestamps. You're on your own if +you do this. Consult the BUGS section. + +=item B<-T> + +Display subroutine call tree to stdout. Subroutine statistics are +not displayed. + +=item B<-q> + +Do not display column headers. Does nothing if B<-T> is used. + +=item B<-O cnt> + +Show only I<cnt> subroutines. The default is 15. Does nothing if B<-T> +is used. + +=item B<-r> + +Display elapsed real times rather than user+system times. + +=item B<-s> + +Display system times rather than user+system times. + +=item B<-u> + +Display user times rather than user+system times. + +=back + +=head1 BUGS + +Applications which call I<die> from within an eval for exception handling +(catch/throw) or for setjmp/longjmp may not generate a readable profile. + +Applications which call I<exit> from within a subroutine will leave an +incomplete profile. + +=head1 FILES + + dprofpp - profile processor + tmon.out - raw profile + +=head1 SEE ALSO + +L<perl>, L<Devel::DProf>, times(2) + +=cut + +use Getopt::Std 'getopts'; + +Setup: { + getopts('O:ltavuTqrsUF'); + +# -O cnt Specifies maximum number of subroutines to display. +# -a Sort by alphabetic name of subroutines. +# -t Sort by user+system time spent in subroutines. (default) +# -l Sort by number of calls to subroutines. +# -v Sort by average amount of time spent in subroutines. +# -T Show call tree. +# -q Do not print column headers. +# -u Use user time rather than user+system time. +# -s Use system time rather than user+system time. +# -r Use real elapsed time rather than user+system time. +# -U Do not sort subroutines. + + $cnt = $opt_O || 15; + $sort = 'by_time'; + $sort = 'by_calls' if defined $opt_l; + $sort = 'by_alpha' if defined $opt_a; + $sort = 'by_avgcpu' if defined $opt_v; + $whichtime = "User+System"; + $whichtime = "System" if defined $opt_s; + $whichtime = "Real" if defined $opt_r; + $whichtime = "User" if defined $opt_u; +} + +Main: { + my $monout = shift || "tmon.out"; + my $fh = "main::fh"; + local $names = {}; + local $times = {}; # times in hz + local $calls = {}; + local $persecs = {}; # times in seconds + local $idkeys = []; + local $runtime; # runtime in seconds + my @a = (); + my $a; + local $rrun_utime = 0; # user time in hz + local $rrun_stime = 0; # system time in hz + local $rrun_rtime = 0; # elapsed run time in hz + local $rrun_ustime = 0; # user+system time in hz + local $hz = 0; + + open( $fh, "<$monout" ) || die "Unable to open $monout\n"; + + header($fh); + + $rrun_ustime = $rrun_utime + $rrun_stime; + + settime( \$runtime, $hz ); + + $~ = 'STAT'; + if( ! $opt_q ){ + $^ = 'CSTAT_top'; + } + + parsestack( $fh, $names, $calls, $times, $idkeys ); + + exit(0) if $opt_T; + + if( $opt_v ){ + percalc( $calls, $times, $persecs, $idkeys ); + } + if( ! $opt_U ){ + @a = sort $sort @$idkeys; + $a = \@a; + } + else { + $a = $idkeys; + } + display( $runtime, $hz, $names, $calls, $times, $cnt, $a ); +} + + +# Sets $runtime to user, system, real, or user+system time. The +# result is given in seconds. +# +sub settime { + my( $runtime, $hz ) = @_; + + if( $opt_r ){ + $$runtime = $rrun_rtime/$hz; + } + elsif( $opt_s ){ + $$runtime = $rrun_stime/$hz; + } + elsif( $opt_u ){ + $$runtime = $rrun_utime/$hz; + } + else{ + $$runtime = $rrun_ustime/$hz; + } +} + + +# Report the times in seconds. +sub display { + my( $runtime, $hz, $names, $calls , $times, $cnt, $idkeys ) = @_; + my( $x, $key, $s ); + #format: $ncalls, $name, $secs, $percall, $pcnt + + for( $x = 0; $x < @$idkeys; ++$x ){ + $key = $idkeys->[$x]; + $ncalls = $calls->{$key}; + $name = $names->{$key}; + $s = $times->{$key}/$hz; + $secs = sprintf("%.3f", $s ); + $percall = sprintf("%.4f", $s/$ncalls ); + $pcnt = sprintf("%.2f", + $runtime ? + (($secs / $runtime) * 100.0) : + 0 ); + write; + $pcnt = $secs = $ncalls = $percall = ""; + write while( length $name ); + last unless --$cnt; + } +} + + +sub parsestack { + my( $fh, $names, $calls, $times, $idkeys ) = @_; + my( $dir, $name ); + my( $t, $syst, $realt, $usert ); + my( $x, $z, $c ); + my @stack = (); + my @tstack = (); + my $tab = 3; + my $in = 0; + + while(<$fh>){ + next if /^#/o; + last if /^PART/o; + chop; + ($dir, $usert, $syst, $realt, $name) = split; + + if ( $opt_u ) { $t = $usert } + elsif( $opt_s ) { $t = $syst } + elsif( $opt_r ) { $t = $realt } + else { $t = $usert + $syst } + + if( $dir eq '+' ){ + if( $opt_T ){ + print " " x $in, "$name\n"; + $in += $tab; + } + if(! defined $names->{$name} ){ + $names->{$name} = $name; + $times->{$name} = 0; + push( @$idkeys, $name ); + } + $calls->{$name}++; + $x = [ $name, $t ]; + push( @stack, $x ); + + # my children will put their time here + push( @tstack, 0 ); + + next; + } + if( $dir eq '-' ){ + exitstamp( \@stack, \@tstack, $t, $times, + $name, \$in, $tab ); + next; + } + die "Bad profile: $_"; + } + if( @stack ){ + my @astack; + + warn "Garbled profile is missing some exit time stamps:\n"; + foreach (@stack) { + printf "${$_}[0]\n"; + push( @astack, @stack ); + } + if( ! $opt_F ){ + die "Garbled profile"; + } + else{ + warn( "Faking " . scalar( @astack ) . " exit timestamp(s) . . .\n"); + + foreach $x ( @astack ){ + $name = $x->[0]; + exitstamp( \@stack, \@tstack, $t, $times, + $name, \$in, $tab ); + } + } + } +} + +sub exitstamp { + my( $stack, $tstack, $t, $times, $name, $in, $tab ) = @_; + + my( $x, $c, $z ); + + $x = pop( @$stack ); + if( ! defined $x ){ + die "Garbled profile, missing an enter time stamp"; + } + if( $x->[0] ne $name ){ + die "Garbled profile, unexpected exit time stamp"; + } + if( $opt_T ){ + $$in -= $tab; + } + # collect childtime + $c = pop( @$tstack ); + # total time this func has been active + $z = $t - $x->[1]; + # less time spent in child funcs. + # prepare to accept that the children may account + # for all my time. + $times->{$name} += ($z > $c)? $z - $c: $c - $z; + + # pass my time to my parent + if( @$tstack ){ + $c = pop( @$tstack ); + push( @$tstack, $c + $z ); + } +} + + +sub header { + my $fh = shift; + chop($_ = <$fh>); + if( ! /^#fOrTyTwO$/ ){ + die "Not a perl profile"; + } + while(<$fh>){ + next if /^#/o; + last if /^PART/o; + eval; + } +} + + +# Report avg time-per-function in seconds +sub percalc { + my( $calls, $times, $persecs, $idkeys ) = @_; + my( $x, $t, $n, $key ); + + for( $x = 0; $x < @$idkeys; ++$x ){ + $key = $idkeys->[$x]; + $n = $calls->{$key}; + $t = $times->{$key} / $hz; + $persecs->{$key} = $t ? $t / $n : 0; + } +} + + +sub by_time { $times->{$b} <=> $times->{$a} } +sub by_calls { $calls->{$b} <=> $calls->{$a} } +sub by_alpha { $names->{$a} cmp $names->{$b} } +sub by_avgcpu { $persecs->{$b} <=> $persecs->{$a} } + + +format CSTAT_top = +Total Elapsed Time = @>>>>>> Seconds +($rrun_rtime / $hz) + @>>>>>>>>>> Time = @>>>>>> Seconds +$whichtime, $runtime +%Time Seconds #Calls sec/call Name +. + +format STAT = + ^>>> ^>>>> ^>>>>>>>>> ^>>>>> ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +$pcnt, $secs, $ncalls, $percall, $name +. + diff --git a/ext/Devel/DProf/test.pl b/ext/Devel/DProf/test.pl new file mode 100644 index 0000000000..8fa0f41043 --- /dev/null +++ b/ext/Devel/DProf/test.pl @@ -0,0 +1,20 @@ +#!./perl + +sub foo { + print "in sub foo\n"; + bar(); +} + +sub bar { + print "in sub bar\n"; +} + +sub baz { + print "in sub baz\n"; + bar(); + foo(); +} + +bar(); +baz(); +foo(); diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm index 00466c3f2a..05053b849e 100644 --- a/ext/DynaLoader/DynaLoader.pm +++ b/ext/DynaLoader/DynaLoader.pm @@ -1,5 +1,264 @@ package DynaLoader; +# And Gandalf said: 'Many folk like to know beforehand what is to +# be set on the table; but those who have laboured to prepare the +# feast like to keep their secret; for wonder makes the words of +# praise louder.' + +# (Quote from Tolkien sugested by Anno Siegel.) +# +# See pod text at end of file for documentation. +# See also ext/DynaLoader/README in source tree for other information. +# +# Tim.Bunce@ig.co.uk, August 1994 + +require Carp; +require Config; +require AutoLoader; + +@ISA=qw(AutoLoader); + + +sub import { } # override import inherited from AutoLoader + +# enable debug/trace messages from DynaLoader perl code +$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; + +($dl_dlext, $dlsrc, $osname) + = @Config::Config{'dlext', 'dlsrc', 'osname'}; + +# Some systems need special handling to expand file specifications +# (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>) +# See dl_expandspec() for more details. Should be harmless but +# inefficient to define on systems that don't need it. +$do_expand = ($osname eq 'VMS'); + +@dl_require_symbols = (); # names of symbols we need +@dl_resolve_using = (); # names of files to link with +@dl_library_path = (); # path to look for files + +# This is a fix to support DLD's unfortunate desire to relink -lc +@dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs"; + +# Initialise @dl_library_path with the 'standard' library path +# for this platform as determined by Configure +push(@dl_library_path, split(' ',$Config::Config{'libpth'})); + +# Add to @dl_library_path any extra directories we can gather from +# environment variables. So far LD_LIBRARY_PATH is the only known +# variable used for this purpose. Others may be added later. +push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH})) + if $ENV{LD_LIBRARY_PATH}; + + +# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. +boot_DynaLoader() if defined(&boot_DynaLoader); + + +if ($dl_debug) { + print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n"; + print STDERR "DynaLoader not linked into this perl\n" + unless defined(&boot_DynaLoader); +} + +1; # End of main code + + +# The bootstrap function cannot be autoloaded (without complications) +# so we define it here: + +sub bootstrap { + # use local vars to enable $module.bs script to edit values + local(@args) = @_; + local($module) = $args[0]; + local(@dirs, $file); + + Carp::confess "Usage: DynaLoader::bootstrap(module)" unless $module; + + # A common error on platforms which don't support dynamic loading. + # Since it's fatal and potentially confusing we give a detailed message. + Carp::croak("Can't load module $module, dynamic loading not available in this perl.\n". + " (You may need to build a new perl executable which either supports\n". + " dynamic loading or has the $module module statically linked into it.)\n") + unless defined(&dl_load_file); + + my @modparts = split(/::/,$module); + my $modfname = $modparts[-1]; + + # Some systems have restrictions on files names for DLL's etc. + # mod2fname returns appropriate file base name (typically truncated) + # It may also edit @modparts if required. + $modfname = &mod2fname(\@modparts) if defined &mod2fname; + + my $modpname = join('/',@modparts); + + print STDERR "DynaLoader::bootstrap for $module ", + "(auto/$modpname/$modfname.$dl_dlext)\n" if $dl_debug; + + foreach (@INC) { + my $dir = "$_/auto/$modpname"; + next unless -d $dir; # skip over uninteresting directories + + # check for common cases to avoid autoload of dl_findfile + last if ($file=_check_file("$dir/$modfname.$dl_dlext")); + + # no luck here, save dir for possible later dl_findfile search + push(@dirs, "-L$dir"); + } + # last resort, let dl_findfile have a go in all known locations + $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file; + + Carp::croak "Can't find loadable object for module $module in \@INC (@INC)" + unless $file; + + my $bootname = "boot_$module"; + $bootname =~ s/\W/_/g; + @dl_require_symbols = ($bootname); + + # Execute optional '.bootstrap' perl script for this module. + # The .bs file can be used to configure @dl_resolve_using etc to + # match the needs of the individual module on this architecture. + my $bs = $file; + $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library + if (-s $bs) { # only read file if it's not empty + print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug; + eval { do $bs; }; + warn "$bs: $@\n" if $@; + } + + # Many dynamic extension loading problems will appear to come from + # this section of code: XYZ failed at line 123 of DynaLoader.pm. + # Often these errors are actually occurring in the initialisation + # C code of the extension XS file. Perl reports the error as being + # in this perl code simply because this was the last perl code + # it executed. + + my $libref = dl_load_file($file) or + Carp::croak "Can't load '$file' for module $module: ".dl_error()."\n"; + + my @unresolved = dl_undef_symbols(); + Carp::carp "Undefined symbols present after loading $file: @unresolved\n" + if @unresolved; + + my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or + Carp::croak "Can't find '$bootname' symbol in $file\n"; + + my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); + + # See comment block above + &$xs(@args); +} + + +sub _check_file { # private utility to handle dl_expandspec vs -f tests + my($file) = @_; + return $file if (!$do_expand && -f $file); # the common case + return $file if ( $do_expand && ($file=dl_expandspec($file))); + return undef; +} + + +# Let autosplit and the autoloader deal with these functions: +__END__ + + +sub dl_findfile { + # Read ext/DynaLoader/DynaLoader.doc for detailed information. + # This function does not automatically consider the architecture + # or the perl library auto directories. + my (@args) = @_; + my (@dirs, $dir); # which directories to search + my (@found); # full paths to real files we have found + my $vms = ($osname eq 'VMS'); + my $dl_so = $Config::Config{'so'}; # suffix for shared libraries + + print STDERR "dl_findfile(@args)\n" if $dl_debug; + + # accumulate directories but process files as they appear + arg: foreach(@args) { + # Special fast case: full filepath requires no search + if (m:/: && -f $_ && !$do_expand) { + push(@found,$_); + last arg unless wantarray; + next; + } + + # Deal with directories first: + # Using a -L prefix is the preferred option (faster and more robust) + if (m:^-L:) { s/^-L//; push(@dirs, $_); next; } + + # Otherwise we try to try to spot directories by a heuristic + # (this is a more complicated issue than it first appears) + if (m:/: && -d $_) { push(@dirs, $_); next; } + + # VMS: we may be using native VMS directry syntax instead of + # Unix emulation, so check this as well + if ($vms && /[:>\]]/ && -d $_) { push(@dirs, $_); next; } + + # Only files should get this far... + my(@names, $name); # what filenames to look for + if (m:-l: ) { # convert -lname to appropriate library name + s/-l//; + push(@names,"lib$_.$dl_so"); + push(@names,"lib$_.a"); + } else { # Umm, a bare name. Try various alternatives: + # these should be ordered with the most likely first + push(@names,"$_.$dl_so") unless m/\.$dl_so$/o; + push(@names,"lib$_.$dl_so") unless m:/:; + push(@names,"$_.o") unless m/\.(o|$dl_so)$/o; + push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs"; + push(@names, $_); + } + foreach $dir (@dirs, @dl_library_path) { + next unless -d $dir; + foreach $name (@names) { + my($file) = "$dir/$name"; + print STDERR " checking in $dir for $name\n" if $dl_debug; + $file = _check_file($file); + if ($file) { + push(@found, $file); + next arg; # no need to look any further + } + } + } + } + if ($dl_debug) { + foreach(@dirs) { + print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_; + } + print STDERR "dl_findfile found: @found\n"; + } + return $found[0] unless wantarray; + @found; +} + + +sub dl_expandspec { + my($spec) = @_; + # Optional function invoked if DynaLoader.pm sets $do_expand. + # Most systems do not require or use this function. + # Some systems may implement it in the dl_*.xs file in which case + # this autoload version will not be called but is harmless. + + # This function is designed to deal with systems which treat some + # 'filenames' in a special way. For example VMS 'Logical Names' + # (something like unix environment variables - but different). + # This function should recognise such names and expand them into + # full file paths. + # Must return undef if $spec is invalid or file does not exist. + + my $file = $spec; # default output to input + + if ($osname eq 'VMS') { # dl_expandspec should be defined in dl_vms.xs + Carp::croak "dl_expandspec: should be defined in XS file!\n"; + } else { + return undef unless -f $file; + } + print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug; + $file; +} + + =head1 NAME DynaLoader - Dynamically load C libraries into Perl code @@ -8,8 +267,10 @@ dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl =head1 SYNOPSIS + package YourPackage; require DynaLoader; @ISA = qw(... DynaLoader ...); + bootstrap YourPackage; =head1 DESCRIPTION @@ -300,7 +561,8 @@ calls dl_install_xsub() to install it as "${module}::bootstrap" =item * -calls &{"${module}::bootstrap"} to bootstrap the module +calls &{"${module}::bootstrap"} to bootstrap the module (actually +it uses the function reference returned by dl_install_xsub for speed) =back @@ -319,255 +581,3 @@ Larry Wall designed the elegant inherited bootstrap mechanism and implemented the first Perl 5 dynamic loader using it. =cut - -# -# And Gandalf said: 'Many folk like to know beforehand what is to -# be set on the table; but those who have laboured to prepare the -# feast like to keep their secret; for wonder makes the words of -# praise louder.' -# - -# Quote from Tolkien sugested by Anno Siegel. -# -# Read ext/DynaLoader/README for detailed information. -# -# Tim.Bunce@ig.co.uk, August 1994 - -use Config; -use Carp; -use AutoLoader; - -@ISA=qw(AutoLoader); - - -# enable messages from DynaLoader perl code -$dl_debug = 0 unless $dl_debug; -$dl_debug = $ENV{'PERL_DL_DEBUG'} if $ENV{'PERL_DL_DEBUG'}; - -$dl_so = $dl_dlext = ""; # avoid typo warnings -$dl_so = $Config{'so'}; # suffix for shared libraries -$dl_dlext = $Config{'dlext'}; # suffix for dynamic modules - -# Some systems need special handling to expand file specifications -# (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>) -# See dl_expandspec() for more details. Should be harmless but -# inefficient to define on systems that don't need it. -$do_expand = ($Config{'osname'} eq 'VMS'); - -@dl_require_symbols = (); # names of symbols we need -@dl_resolve_using = (); # names of files to link with -@dl_library_path = (); # path to look for files - -# This is a fix to support DLD's unfortunate desire to relink -lc -@dl_resolve_using = dl_findfile('-lc') if $Config{'dlsrc'} eq "dl_dld.xs"; - -# Initialise @dl_library_path with the 'standard' library path -# for this platform as determined by Configure -push(@dl_library_path, split(' ',$Config{'libpth'})); - -# Add to @dl_library_path any extra directories we can gather from -# environment variables. So far LD_LIBRARY_PATH is the only known -# variable used for this purpose. Others may be added later. -push(@dl_library_path, split(/:/, $ENV{'LD_LIBRARY_PATH'})) - if $ENV{'LD_LIBRARY_PATH'}; - - -# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. -boot_DynaLoader() if defined(&boot_DynaLoader); - - -if ($dl_debug){ - print STDERR "DynaLoader.pm loaded (@dl_library_path)\n"; - print STDERR "DynaLoader not linked into this perl\n" - unless defined(&boot_DynaLoader); -} - -1; # End of main code - - -# The bootstrap function cannot be autoloaded (without complications) -# so we define it here: - -sub bootstrap { - # use local vars to enable $module.bs script to edit values - local(@args) = @_; - local($module) = $args[0]; - local(@dirs, $file); - - confess "Usage: DynaLoader::bootstrap(module)" unless $module; - - # A common error on platforms which don't support dynamic loading. - # Since it's fatal and potentially confusing we give a detailed message. - croak("Can't load module $module, dynamic loading not available in this perl.\n". - " (You may need to build a new perl executable which either supports\n". - " dynamic loading or has the $module module statically linked into it.)\n") - unless defined(&dl_load_file); - - print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug; - - my(@modparts) = split(/::/,$module); - my($modfname) = $modparts[-1]; - my($modpname) = join('/',@modparts); - foreach (@INC) { - my $dir = "$_/auto/$modpname"; - next unless -d $dir; # skip over uninteresting directories - - # check for common cases to avoid autoload of dl_findfile - last if ($file=_check_file("$dir/$modfname.$dl_dlext")); - - # no luck here, save dir for possible later dl_findfile search - push(@dirs, "-L$dir"); - } - # last resort, let dl_findfile have a go in all known locations - $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file; - - croak "Can't find loadable object for module $module in \@INC" - unless $file; - - my($bootname) = "boot_$module"; - $bootname =~ s/\W/_/g; - @dl_require_symbols = ($bootname); - - # Execute optional '.bootstrap' perl script for this module. - # The .bs file can be used to configure @dl_resolve_using etc to - # match the needs of the individual module on this architecture. - my $bs = $file; - $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library - if (-s $bs) { # only read file if it's not empty - local($osname, $dlsrc) = @Config{'osname','dlsrc'}; - print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug; - eval { do $bs; }; - warn "$bs: $@\n" if $@; - } - - # Many dynamic extension loading problems will appear to come from - # this section of code: XYZ failed at line 123 of DynaLoader.pm. - # Often these errors are actually occurring in the initialisation - # C code of the extension XS file. Perl reports the error as being - # in this perl code simply because this was the last perl code - # it executed. - - my $libref = dl_load_file($file) or - croak "Can't load '$file' for module $module: ".dl_error()."\n"; - - my(@unresolved) = dl_undef_symbols(); - carp "Undefined symbols present after loading $file: @unresolved\n" - if (@unresolved); - - my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or - croak "Can't find '$bootname' symbol in $file\n"; - - dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); - - # See comment block above - &{"${module}::bootstrap"}(@args); -} - - -sub _check_file{ # private utility to handle dl_expandspec vs -f tests - my($file) = @_; - return $file if (!$do_expand && -f $file); # the common case - return $file if ( $do_expand && ($file=dl_expandspec($file))); - return undef; -} - - -# Let autosplit and the autoloader deal with these functions: -__END__ - - -sub dl_findfile { - # Read ext/DynaLoader/DynaLoader.doc for detailed information. - # This function does not automatically consider the architecture - # or the perl library auto directories. - my (@args) = @_; - my (@dirs, $dir); # which directories to search - my (@found); # full paths to real files we have found - my ($vms) = ($Config{'osname'} eq 'VMS'); - - print STDERR "dl_findfile(@args)\n" if $dl_debug; - - # accumulate directories but process files as they appear - arg: foreach(@args) { - # Special fast case: full filepath requires no search - if (m:/: && -f $_ && !$do_expand){ - push(@found,$_); - last arg unless wantarray; - next; - } - - # Deal with directories first: - # Using a -L prefix is the preferred option (faster and more robust) - if (m:^-L:){ s/^-L//; push(@dirs, $_); next; } - - # Otherwise we try to try to spot directories by a heuristic - # (this is a more complicated issue than it first appears) - if (m:/: && -d $_){ push(@dirs, $_); next; } - - # VMS: we may be using native VMS directry syntax instead of - # Unix emulation, so check this as well - if ($vms && /[:>\]]/ && -d $_){ push(@dirs, $_); next; } - - # Only files should get this far... - my(@names, $name); # what filenames to look for - if (m:-l: ){ # convert -lname to appropriate library name - s/-l//; - push(@names,"lib$_.$dl_so"); - push(@names,"lib$_.a"); - }else{ # Umm, a bare name. Try various alternatives: - # these should be ordered with the most likely first - push(@names,"$_.$dl_so") unless m/\.$dl_so$/o; - push(@names,"lib$_.$dl_so") unless m:/:; - push(@names,"$_.o") unless m/\.(o|$dl_so)$/o; - push(@names,"$_.a") unless m/\.a$/; - push(@names, $_); - } - foreach $dir (@dirs, @dl_library_path) { - next unless -d $dir; - foreach $name (@names) { - my($file) = "$dir/$name"; - print STDERR " checking in $dir for $name\n" if $dl_debug; - $file = _check_file($file); - if ($file){ - push(@found, $file); - next arg; # no need to look any further - } - } - } - } - if ($dl_debug) { - foreach(@dirs) { - print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_; - } - print STDERR "dl_findfile found: @found\n"; - } - return $found[0] unless wantarray; - @found; -} - - -sub dl_expandspec{ - my($spec) = @_; - # Optional function invoked if DynaLoader.pm sets $do_expand. - # Most systems do not require or use this function. - # Some systems may implement it in the dl_*.xs file in which case - # this autoload version will not be called but is harmless. - - # This function is designed to deal with systems which treat some - # 'filenames' in a special way. For example VMS 'Logical Names' - # (something like unix environment variables - but different). - # This function should recognise such names and expand them into - # full file paths. - # Must return undef if $spec is invalid or file does not exist. - - my($file) = $spec; # default output to input - my($osname) = $Config{'osname'}; - - if ($osname eq 'VMS'){ # dl_expandspec should be defined in dl_vms.xs - croak "dl_expandspec: should be defined in XS file!\n"; - }else{ - return undef unless -f $file; - } - print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug; - $file; -} diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index 31f625a26d..a0028a1f7a 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -44,11 +44,16 @@ #include "dlutils.c" /* for SaveError() etc */ +static AV *dl_resolve_using = Nullav; +static AV *dl_require_symbols = Nullav; + static void dl_private_init() { int dlderr; dl_generic_private_init(); + dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4); + dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4); #ifdef __linux__ dlderr = dld_init("/proc/self/exe"); if (dlderr) { @@ -77,39 +82,33 @@ dl_load_file(filename) CODE: int dlderr,x,max; GV *gv; - AV *av; RETVAL = filename; DLDEBUG(1,fprintf(stderr,"dl_load_file(%s)\n", filename)); - gv = gv_fetchpv("DynaLoader::dl_require_symbols", FALSE, SVt_PVAV); - if (gv) { - av = GvAV(gv); - max = AvFILL(av); - for (x = 0; x <= max; x++) { - char *sym = SvPVX(*av_fetch(av, x, 0)); - DLDEBUG(1,fprintf(stderr, "dld_create_ref(%s)\n", sym)); - if (dlderr = dld_create_reference(sym)) { - SaveError("dld_create_reference(%s): %s", sym, - dld_strerror(dlderr)); - goto haverror; - } + + max = AvFILL(dl_require_symbols); + for (x = 0; x <= max; x++) { + char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); + DLDEBUG(1,fprintf(stderr, "dld_create_ref(%s)\n", sym)); + if (dlderr = dld_create_reference(sym)) { + SaveError("dld_create_reference(%s): %s", sym, + dld_strerror(dlderr)); + goto haverror; } } + DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", filename)); if (dlderr = dld_link(filename)) { SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr)); goto haverror; } - gv = gv_fetchpv("DynaLoader::dl_resolve_using", FALSE, SVt_PVAV); - if (gv) { - av = GvAV(gv); - max = AvFILL(av); - for (x = 0; x <= max; x++) { - char *sym = SvPVX(*av_fetch(av, x, 0)); - DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", sym)); - if (dlderr = dld_link(sym)) { - SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr)); - goto haverror; - } + + max = AvFILL(dl_resolve_using); + for (x = 0; x <= max; x++) { + char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); + DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", sym)); + if (dlderr = dld_link(sym)) { + SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr)); + goto haverror; } } DLDEBUG(2,fprintf(stderr,"libref=%s\n", RETVAL)); diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 0cba08729e..9a6f0597ec 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -34,7 +34,7 @@ error. The mode parameter must be set to 1 for Solaris 1 and to - RTLD_LAZY on Solaris 2. + RTLD_LAZY (==2) on Solaris 2. dlsym @@ -114,6 +114,10 @@ #include <link.h> #endif +#ifndef RTLD_LAZY +# define RTLD_LAZY 1 /* Solaris 1 */ +#endif + #ifndef HAS_DLERROR # ifdef __NetBSD__ # define dlerror() strerror(errno) @@ -142,9 +146,10 @@ void * dl_load_file(filename) char * filename CODE: - int mode = 1; /* Solaris 1 */ -#ifdef RTLD_LAZY - mode = RTLD_LAZY; /* Solaris 2 */ + int mode = RTLD_LAZY; +#ifdef RTLD_NOW + if (dl_nonlazy) + mode = RTLD_NOW; #endif DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); RETVAL = dlopen(filename, mode) ; diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index d2c405ecdc..0e146830ef 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -21,11 +21,14 @@ #include "dlutils.c" /* for SaveError() etc */ +static AV *dl_resolve_using = Nullav; + static void dl_private_init() { (void)dl_generic_private_init(); + dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4); } MODULE = DynaLoader PACKAGE = DynaLoader @@ -39,29 +42,25 @@ dl_load_file(filename) char * filename CODE: shl_t obj = NULL; - int i, max; - GV *gv; - AV *av; - - gv = gv_fetchpv("DynaLoader::dl_resolve_using", FALSE, SVt_PVAV); - if (gv) { - av = GvAV(gv); - max = AvFILL(av); - for (i = 0; i <= max; i++) { - char *sym = SvPVX(*av_fetch(av, i, 0)); - DLDEBUG(1,fprintf(stderr, "dl_load_file(%s) (dependent)\n", sym)); - obj = shl_load(sym, - BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE, - 0L); - if (obj == NULL) { - goto end; - } + int i, max, bind_type; + + if (dl_nonlazy) + bind_type = BIND_IMMEDIATE; + else + bind_type = BIND_DEFERRED; + + max = AvFILL(dl_resolve_using); + for (i = 0; i <= max; i++) { + char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); + DLDEBUG(1,fprintf(stderr, "dl_load_file(%s) (dependent)\n", sym)); + obj = shl_load(sym, bind_type | BIND_NOSTART, 0L); + if (obj == NULL) { + goto end; } } DLDEBUG(1,fprintf(stderr,"dl_load_file(%s): ", filename)); - obj = shl_load(filename, - BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE, 0L); + obj = shl_load(filename, bind_type | BIND_NOSTART, 0L); DLDEBUG(2,fprintf(stderr," libref=%x\n", obj)); end: @@ -86,27 +85,25 @@ dl_find_symbol(libhandle, symbolname) #endif DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); + ST(0) = sv_newmortal() ; + errno = 0; + status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr); DLDEBUG(2,fprintf(stderr," symbolref(PROCEDURE) = %x\n", symaddr)); - ST(0) = sv_newmortal() ; + + if (status == -1 && errno == 0) { /* try TYPE_DATA instead */ + status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr); + DLDEBUG(2,fprintf(stderr," symbolref(DATA) = %x\n", symaddr)); + } + if (status == -1) { - if (errno == 0) { - status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr); - DLDEBUG(2,fprintf(stderr," symbolref(DATA) = %x\n", symaddr)); - if (status == -1) { - SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ; - } else { - sv_setiv( ST(0), (IV)symaddr); - } - } else { - SaveError("%s", Strerror(errno)); - } + SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ; } else { sv_setiv( ST(0), (IV)symaddr); } -int +void dl_undef_symbols() PPCODE: diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 9bc5cd81c2..33a41003ef 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -31,17 +31,21 @@ Anno Siegel */ +/* include these before perl headers */ +#include <mach-o/rld.h> +#include <streams/streams.h> + #include "EXTERN.h" #include "perl.h" #include "XSUB.h" -#include "dlutils.c" /* SaveError() etc */ +#define DL_LOADONCEONLY +#include "dlutils.c" /* SaveError() etc */ -#include <mach-o/rld.h> -#include <streams/streams.h> static char * dl_last_error = (char *) 0; +static AV *dl_resolve_using = Nullav; NXStream * OpenError() @@ -84,19 +88,21 @@ char * path; int mode; /* mode is ignored */ { int rld_success; - NXStream *nxerr = OpenError(); - AV * av_resolve; + NXStream *nxerr; I32 i, psize; char *result; char **p; + + /* Do not load what is already loaded into this process */ + if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) + return path; - av_resolve = GvAVn(gv_fetchpv( - "DynaLoader::dl_resolve_using", FALSE, SVt_PVAV)); - psize = AvFILL(av_resolve) + 3; + nxerr = OpenError(); + psize = AvFILL(dl_resolve_using) + 3; p = (char **) safemalloc(psize * sizeof(char*)); p[0] = path; for(i=1; i<psize-1; i++) { - p[i] = SvPVx(*av_fetch(av_resolve, i-1, TRUE), na); + p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na); } p[psize-1] = 0; rld_success = rld_load(nxerr, (struct mach_header **)0, p, @@ -104,6 +110,8 @@ int mode; /* mode is ignored */ safefree((char*) p); if (rld_success) { result = path; + /* prevent multiple loads of same file into same process */ + hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0); } else { TransferError(nxerr); result = (char*) 0; @@ -144,6 +152,7 @@ static void dl_private_init() { (void)dl_generic_private_init(); + dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4); } MODULE = DynaLoader PACKAGE = DynaLoader diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index c6e58fb33c..a49e5eb939 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -50,6 +50,9 @@ #include "XSUB.h" #include "dlutils.c" /* dl_debug, LastError; SaveError not used */ + +static AV *dl_require_symbols = Nullav; + /* N.B.: * dl_debug and LastError are static vars; you'll need to deal * with them appropriately if you need context independence @@ -117,6 +120,7 @@ static void dl_private_init() { dl_generic_private_init(); + dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4); /* Set up the static control blocks for dl_expand_filespec() */ dlfab = cc$rms_fab; dlnam = cc$rms_nam; @@ -195,7 +199,6 @@ dl_load_file(filespec) char * filespec CODE: char vmsspec[NAM$C_MAXRSS]; - AV *reqAV; SV *reqSV, **reqSVhndl; STRLEN deflen; struct dsc$descriptor_s @@ -239,9 +242,7 @@ dl_load_file(filespec) dlptr->name.dsc$a_pointer, dlptr->defspec.dsc$w_length, dlptr->defspec.dsc$a_pointer)); - if (!(reqAV = GvAV(gv_fetchpv("DynaLoader::dl_require_symbols", - FALSE,SVt_PVAV))) - || !(reqSVhndl = av_fetch(reqAV,0,FALSE)) || !(reqSV = *reqSVhndl)) { + if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) { DLDEBUG(2,fprintf(stderr,"\t@dl_require_symbols empty, returning untested libref\n")); } else { diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 0ce082182c..67dea787cc 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -9,12 +9,17 @@ /* pointer to allocated memory for last error message */ static char *LastError = (char*)NULL; +/* flag for immediate rather than lazy linking (spots unresolved symbol) */ +static int dl_nonlazy = 0; + +#ifdef DL_LOADONCEONLY +static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */ +#endif #ifdef DEBUGGING -/* currently not connected to $DynaLoader::dl_error but should be */ -static int dl_debug = 0; -#define DLDEBUG(level,code) if(dl_debug>=level){ code; } +static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */ +#define DLDEBUG(level,code) if (dl_debug>=level) { code; } #else #define DLDEBUG(level,code) #endif @@ -23,10 +28,17 @@ static int dl_debug = 0; static void dl_generic_private_init() /* called by dl_*.xs dl_private_init() */ { + char *perl_dl_nonlazy; #ifdef DEBUGGING - char *perl_dl_debug = getenv("PERL_DL_DEBUG"); - if (perl_dl_debug) - dl_debug = atoi(perl_dl_debug); + dl_debug = SvIV( perl_get_sv("DynaLoader::dl_debug", 0x04) ); +#endif + if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL ) + dl_nonlazy = atoi(perl_dl_nonlazy); + if (dl_nonlazy) + DLDEBUG(1,fprintf(stderr,"DynaLoader bind mode is 'non-lazy'\n")); +#ifdef DL_LOADONCEONLY + if (!dl_loaded_files) + dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ #endif } @@ -47,8 +59,7 @@ SaveError(pat, va_alist) char *message; int len; - /* This code is based on croak/warn but I'm not sure where mess() */ - /* gets its buffer space from! */ + /* This code is based on croak/warn, see mess() in util.c */ #ifdef I_STDARG va_start(args, pat); diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs index 308e9dda2c..b505239629 100644 --- a/ext/Fcntl/Fcntl.xs +++ b/ext/Fcntl/Fcntl.xs @@ -4,6 +4,20 @@ #include <fcntl.h> +/* This comment is a kludge to get metaconfig to see the symbols + VAL_O_NONBLOCK + VAL_EAGAIN + RD_NODATA + EOF_NONBLOCK + and include the appropriate metaconfig unit + so that Configure will test how to turn on non-blocking I/O + for a file descriptor. See config.h for how to use these + in your extension. + + While I'm at it, I'll have metaconfig look for HAS_POLL too. + --AD October 16, 1995 +*/ + static int not_here(s) char *s; diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs index 2272474dcc..c1b405ff89 100644 --- a/ext/ODBM_File/ODBM_File.xs +++ b/ext/ODBM_File/ODBM_File.xs @@ -5,7 +5,13 @@ #ifdef NULL #undef NULL #endif -#include <dbm.h> +#ifdef I_DBM +# include <dbm.h> +#else +# ifdef I_RPCSVC_DBM +# include <rpcsvc/dbm.h> +# endif +#endif #include <fcntl.h> diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 3d68d91b03..2a1338200d 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -2753,8 +2753,8 @@ sigaction(sig, action, oldaction = 0) POSIX__SigSet sigset; SV** svp; SV** sigsvp = hv_fetch(GvHVn(siggv), - sig_name[sig], - strlen(sig_name[sig]), + whichsigname(sig), + strlen(whichsigname(sig)), TRUE); /* Remember old handler name if desired. */ diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm index 86cc86c6b7..5a4b486a22 100644 --- a/ext/Socket/Socket.pm +++ b/ext/Socket/Socket.pm @@ -2,14 +2,19 @@ package Socket; =head1 NAME -Socket - load the C socket.h defines +Socket - load the C socket.h defines and structure manipulators =head1 SYNOPSIS use Socket; $proto = (getprotobyname('udp'))[2]; - socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto); + socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto); + $sockaddr_in = pack_sockaddr_in(AF_INET,7,inet_aton("localhost")); + $sockaddr_in = pack_sockaddr_in(AF_INET,7,INADDR_LOOPBACK); + connect(Socket_Handle,$sockaddr_in); + $peer = inet_ntoa((unpack_sockaddr_in(getpeername(Socket_Handle)))[2]); + =head1 DESCRIPTION @@ -19,10 +24,62 @@ file, this uses the B<h2xs> program (see the Perl source distribution) and your native C compiler. This means that it has a far more likely chance of getting the numbers right. -=head1 NOTE +In addition, some structure manipulation functions are available: + +=item inet_aton HOSTNAME + +Takes a string giving the name of a host, and translates that +to the 4-byte string (structure). Takes arguments of both +the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name +cannot be resolved, returns undef. + +=item inet_ntoa IP_ADDRESS + +Takes a four byte ip address (as returned by inet_aton()) +and translates it into a string of the form 'd.d.d.d' +where the 'd's are numbers less than 256 (the normal +readable four dotted number notation for internet addresses). + +=item INADDR_ANY + +Note - does not return a number. + +Returns the 4-byte wildcard ip address which specifies any +of the hosts ip addresses. (A particular machine can have +more than one ip address, each address corresponding to +a particular network interface. This wildcard address +allows you to bind to all of them simultaneously.) +Normally equivalent to inet_aton('0.0.0.0'). + +=item INADDR_LOOPBACK + +Note - does not return a number. + +Returns the 4-byte loopback address. Normally equivalent +to inet_aton('localhost'). -Only C<#define> symbols get translated; you must still correctly -pack up your own arguments to pass to bind(), etc. +=item INADDR_NONE + +Note - does not return a number. + +Returns the 4-byte invalid ip address. Normally equivalent +to inet_aton('255.255.255.255'). + +=item pack_sockaddr_in FAMILY, PORT, IP_ADDRESS + +Takes three arguments, an address family (normally AF_INET), +a port number, and a 4 byte IP_ADDRESS (as returned by +inet_aton()). Returns the sockaddr_in structure with those +arguments packed in. For internet domain sockets, this structure +is normally what you need for the arguments in bind(), connect(), +and send(), and is also returned by getpeername(), getsockname() +and recv(). + +=item unpack_sockaddr_in SOCKADDR_IN + +Takes a sockaddr_in structure (as returned by pack_sockaddr_in()) +and returns an array of three elements: the address family, +the port, and the 4-byte ip-address. =cut @@ -33,6 +90,8 @@ use AutoLoader; require DynaLoader; @ISA = qw(Exporter DynaLoader); @EXPORT = qw( + inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in + INADDR_ANY INADDR_LOOPBACK INADDR_NONE AF_802 AF_APPLETALK AF_CCITT @@ -130,16 +189,6 @@ sub AUTOLOAD { goto &$AUTOLOAD; } - -# pack a sockaddr_in structure for use in bind() calls. -# (here to hide the 'S n C4 x8' magic from applications) -sub sockaddr_in{ - my($af, $port, @quad) = @_; - my $pack = 'S n C4 x8'; # lookup $pack from hash using $af? - pack($pack, $af, $port, @quad); -} - - bootstrap Socket; # Preloaded methods go here. Autoload methods go after __END__, and are diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs index 7a0bf465b2..1f32dab79c 100644 --- a/ext/Socket/Socket.xs +++ b/ext/Socket/Socket.xs @@ -2,7 +2,19 @@ #include "perl.h" #include "XSUB.h" +#ifndef VMS +# ifdef I_SYS_TYPES +# include <sys/types.h> +# endif #include <sys/socket.h> +# ifdef I_NETINET_IN +# include <netinet/in.h> +# endif +#include <netdb.h> +#include <arpa/inet.h> +#else +#include "sockadapt.h" +#endif #ifndef AF_NBS #undef PF_NBS @@ -12,6 +24,14 @@ #undef PF_X25 #endif +#ifndef INADDR_NONE +#define INADDR_NONE 0xffffffff +#endif /* INADDR_NONE */ +#ifndef INADDR_LOOPBACK +#define INADDR_LOOPBACK 0x7F000001 +#endif /* INADDR_LOOPBACK */ + + static int not_here(s) char *s; @@ -556,6 +576,7 @@ not_there: return 0; } + MODULE = Socket PACKAGE = Socket double @@ -563,3 +584,116 @@ constant(name,arg) char * name int arg + +void +inet_aton(host) + char * host + CODE: + { + struct in_addr ip_address; + struct hostent * phe; + + if (phe = gethostbyname(host)) { + Copy( phe->h_addr, &ip_address, phe->h_length, char ); + } else { + ip_address.s_addr = inet_addr(host); + } + + ST(0) = sv_newmortal(); + if(ip_address.s_addr != INADDR_NONE) { + sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address ); + } + } + +void +inet_ntoa(ip_address_sv) + SV * ip_address_sv + CODE: + { + STRLEN addrlen; + struct in_addr addr; + char * addr_str; + char * ip_address = SvPV(ip_address_sv,addrlen); + if (addrlen != sizeof(addr)) { + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::inet_ntoa", + addrlen, sizeof(addr)); + } + + Copy( ip_address, &addr, sizeof addr, char ); + addr_str = inet_ntoa(addr); + + ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str))); + } + +void +pack_sockaddr_in(family,port,ip_address) + short family + short port + char * ip_address + CODE: + { + struct sockaddr_in sin; + + Zero( &sin, sizeof sin, char ); + sin.sin_family = family; + sin.sin_port = htons(port); + Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char ); + + ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin)); + } + +void +unpack_sockaddr_in(sin_sv) + SV * sin_sv + PPCODE: + { + STRLEN sockaddrlen; + struct sockaddr_in addr; + short family; + short port; + struct in_addr ip_address; + char * sin = SvPV(sin_sv,sockaddrlen); + if (sockaddrlen != sizeof(addr)) { + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::unpack_sockaddr_in", + sockaddrlen, sizeof(addr)); + } + + Copy( sin, &addr,sizeof addr, char ); + family = addr.sin_family; + port = ntohs(addr.sin_port); + ip_address = addr.sin_addr; + + EXTEND(sp, 3); + PUSHs(sv_2mortal(newSViv(family))); + PUSHs(sv_2mortal(newSViv(port))); + PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address))); + } + +void +INADDR_ANY() + CODE: + { + struct in_addr ip_address; + ip_address.s_addr = htonl(INADDR_ANY); + ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address )); + } + +void +INADDR_LOOPBACK() + CODE: + { + struct in_addr ip_address; + ip_address.s_addr = htonl(INADDR_LOOPBACK); + ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + } + +void +INADDR_NONE() + CODE: + { + struct in_addr ip_address; + ip_address.s_addr = htonl(INADDR_NONE); + ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + } diff --git a/global.sym b/global.sym index ec0181aa93..304db489f9 100644 --- a/global.sym +++ b/global.sym @@ -193,6 +193,7 @@ seq_amg sge_amg sgt_amg sig_name +sig_num siggv sighandler simple @@ -862,10 +863,10 @@ push_scope q ref refkids -regcomp +pregcomp regdump -regexec -regfree +pregexec +pregfree regnext regprop repeatcpy @@ -974,6 +975,7 @@ wait4pid warn watch whichsig +whichsigname xiv_arenaroot xiv_root xnv_root @@ -186,7 +186,7 @@ $module = $opt_n || do { $name; }; -chdir 'ext' if -d 'ext'; +(chdir 'ext', $ext = 'ext/') if -d 'ext'; if( $module =~ /::/ ){ $nested = 1; @@ -201,17 +201,17 @@ else { } -die "Won't overwrite existing ext/$modpname\n" if -e $modpname; +die "Won't overwrite existing $ext$modpname\n" if -e $modpname; # quick hack, should really loop over @modparts mkdir($modparts[0], 0777) if $nested; mkdir($modpname, 0777); -chdir($modpname) || die "Can't chdir ext/$modpname: $!\n"; +chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; -open(XS, ">$modfname.xs") || die "Can't create ext/$modpname/$modfname.xs: $!\n"; -open(PM, ">$modfname.pm") || die "Can't create ext/$modpname/$modfname.pm: $!\n"; +open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; +open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"; $" = "\n\t"; -warn "Writing ext/$modpname/$modfname.pm\n"; +warn "Writing $ext$modpname/$modfname.pm\n"; print PM <<"END"; package $module; @@ -291,7 +291,7 @@ END close PM; -warn "Writing ext/$modpname/$modfname.xs\n"; +warn "Writing $ext$modpname/$modfname.xs\n"; print XS <<"END"; #include "EXTERN.h" @@ -390,8 +390,8 @@ END close XS; -warn "Writing ext/$modpname/Makefile.PL\n"; -open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n"; +warn "Writing $ext$modpname/Makefile.PL\n"; +open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; print PL <<'END'; use ExtUtils::MakeMaker; diff --git a/hints/aix.sh b/hints/aix.sh index 1e8b3124c4..bca6eb7022 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -32,10 +32,14 @@ case "$osvers" in d_setreuid='undef' ccflags='-D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE' nm_opt='-B' - scope_cflags='optimize=" "' ;; esac +# The optimizer in 4.1.1 apparently generates bad code for scope.c. +# Configure doesn't offer an easy way to propagate extra variables +# only for certain cases, so the following contortion is required: +scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac' + # Changes for dynamic linking by Wayne Scott <wscott@ichips.intel.com> # # Tell perl which symbols to export for dynamic linking. diff --git a/hints/hpux.sh b/hints/hpux.sh new file mode 100644 index 0000000000..27513ce196 --- /dev/null +++ b/hints/hpux.sh @@ -0,0 +1,83 @@ +# hints/hpux.sh +# Perl Configure hints file for Hewlett Packard HP/UX 9.x and 10.x +# This file is based on +# hints/hpux_9.sh, Perl Configure hints file for Hewlett Packard HP/UX 9.x +# Use Configure -Dcc=gcc to use gcc. +# From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> +# Date: Thu, 28 Sep 95 11:06:07 PDT +# and +# hints/hpux_10.sh, Perl Configure hints file for Hewlett Packard HP/UX 10.x +# From: Giles Lean <giles@nemeton.com.au> +# Date: Tue, 27 Jun 1995 08:17:45 +1000 + +# Use Configure -Dcc=gcc to use gcc. +# Use Configure -Dprefix=/usr/local to install in /usr/local. + +# Turn on the _HPUX_SOURCE flag to get many of the HP add-ons +ccflags="$ccflags -D_HPUX_SOURCE" +ldflags="$ldflags" + +# Check if you're using the bundled C compiler. This compiler doesn't support +# ANSI C (the -Aa flag) nor can it produce shared libraries. Thus we have +# to turn off dynamic loading. +case "$cc" in +'') if cc $ccflags -Aa 2>&1 | $contains 'Unknown option "A"' >/dev/null + then + case "$usedl" in + '') usedl="$undef" + cat <<'EOM' + +The bundled C compiler can not produce shared libraries, so you will +not be able to use dynamic loading. + +EOM + ;; + esac + else + ccflags="$ccflags -Aa" # The add-on compiler supports ANSI C + fi + optimize='-O' + ;; +esac + +# Remove bad libraries that will cause problems +# (This doesn't remove libraries that don't actually exist) +# -lld is unneeded (and I can't figure out what it's used for anyway) +# -ldbm is obsolete and should not be used +# -lBSD contains BSD-style duplicates of SVR4 routines that cause confusion +# -lPW is obsolete and should not be used +# Although -lndbm should be included, it will make perl blow up if you should +# copy the binary to a system without libndbm.sl. +# The libraries crypt, malloc, ndir, and net are empty. +set `echo " $libswanted " | sed -e 's@ ndbm @ @' -e 's@ ld @ @' -e 's@ dbm @ @' -e 's@ BSD @ @' -e 's@ PW @ @'` +libswanted="$*" + +# If you copy the perl binaries to other systems and the dynamic loader +# complains about missing libraries, you can either copy the shared libraries +# or switch the comments to recompile perl to use archive libraries +# ccdlflags="-Wl,-E -Wl,-a,archive $ccdlflags" +ccdlflags="-Wl,-E $ccdlflags" + +usemymalloc='y' +alignbytes=8 +selecttype='int *' + +# There are some lingering issues about whether g/setpgrp should be a part +# of the perl core. This setting should cause perl to conform to the Principle +# of Least Astonishment. The best thing is to use the g/setpgrp in the POSIX +# module. +d_bsdpgrp='define' + +# If your compile complains about FLT_MIN, uncomment the next line +# POSIX_cflags='ccflags="$ccflags -DFLT_MIN=1.17549435E-38"' + +# Comment these out if you don't want to follow the SVR4 filesystem layout +# that HP-UX 10.0 uses +case "$prefix" in +'') prefix='/opt/perl5' + privlib='/opt/perl5/lib' + archlib='/opt/perl5/lib/hpux' + man3dir='/opt/perl5/man/man3' + ;; +esac + diff --git a/hints/hpux_9.sh b/hints/hpux_9.sh deleted file mode 100644 index fe5c2c7517..0000000000 --- a/hints/hpux_9.sh +++ /dev/null @@ -1,29 +0,0 @@ -# hints/hpux_9.sh, Perl Configure hints file for Hewlett Packard HP/UX 9.x -# Use Configure -Dcc=gcc to use gcc. -ccflags="$ccflags -D_POSIX_SOURCE -D_HPUX_SOURCE" -case "$cc" in -'') if cc $ccflags -Aa 2>&1 | $contains 'Unknown option "A"' >/dev/null - then # The bundled (limited) compiler doesn't - case "$usedl" in # support -Aa for "ANSI C mode". - '') usedl="$undef";; # Nor can it produce shared libraries. - esac - else - ccflags="$ccflags -Aa" # The add-on compiler supports ANSI C - fi - optimize='+O1' - ;; -esac -libswanted='m dld' -# ccdlflags="-Wl,-E -Wl,-a,shared $ccdlflags" # Force all shared? -ccdlflags="-Wl,-E $ccdlflags" -usemymalloc='y' -alignbytes=8 -selecttype='int *' -POSIX_cflags='ccflags="$ccflags -DFLT_MIN=1.17549435E-38"' - -case "$prefix" in -'') prefix='/opt/perl5' ;; -esac -case "$archname" in -'') archname='hpux' ;; -esac diff --git a/hints/isc.sh b/hints/isc.sh index 0ecdb7ddc9..df745a9b25 100644 --- a/hints/isc.sh +++ b/hints/isc.sh @@ -33,5 +33,3 @@ esac # compilation "redefinition" warnings, but they appear harmless. # ccflags="$ccflags -D_SYSV3" -# Pick up dbm.h in <rpcsvc/dbm.h> -ccflags="$ccflags -I/usr/include/rpcsvc" diff --git a/hints/isc_2.sh b/hints/isc_2.sh index 95b61ba773..c73908cbc6 100644 --- a/hints/isc_2.sh +++ b/hints/isc_2.sh @@ -17,8 +17,6 @@ case "$cc" in ldflags="$ldflags -Xp" ;; esac -# Pick up dbm.h in <rpcsvc/dbm.h> -ccflags="$ccflags -I/usr/include/rpcsvc" # Compensate for conflicts in <net/errno.h> doio_cflags='ccflags="$ccflags -DENOTSOCK=103"' pp_sys_cflags='ccflags="$ccflags -DENOTSOCK=103"' diff --git a/hints/ncr_tower.sh b/hints/ncr_tower.sh index 799ee9375c..7ddb9230e9 100644 --- a/hints/ncr_tower.sh +++ b/hints/ncr_tower.sh @@ -1,4 +1,16 @@ +# For SysV release 2, there are no directory functions defined. To +# prevent compile errors, acquire the functions written by Doug Gwynn. +# They are contained in dirent.tar.gz and can be accessed from gnu +# repositories, as well as other places. +# +# The following hints have been verified to work with PERL5 (001m) on +# SysVr2 with the following caveat(s): +# 1. Maximum User program space (MAXSPACE) must be at least 2MB. +# 2. The directory functions mentioned above have been installed. +# optimize='-O0' -ccflags="$ccflags -W2,-Sl,2000" +ccflags="$ccflags -W2,-Sl,1500 -W0,-Sp,350,-Ss,2500 -Wp,-Sd,30" d_mkdir=$undef usemymalloc='y' +useposix='false' +so='none' diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index b940663d35..0193bd4a1c 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -1,5 +1,14 @@ +# hints/solaris_2.sh +# Last modified: 27 September 1995 by +# Andy Dougherty <doughera@lafcol.lafayette.edu> +# Based on input from lots of folks, especially +# Dean Roehrich <roehrich@ironwood-fddi.cray.com> +# +# See man vfork. usevfork=false +# d_suidsafe=define +# Avoid all libraries in /usr/ucblib. set `echo $glibpth | sed -e 's@/usr/ucblib@@'` glibpth="$*" # Remove bad libraries. -lucb contains incompatible routines. @@ -29,11 +38,311 @@ case "$archname" in *) ;; esac +# See below for excerpts from the Solaris FAQ. + +# From roehrich@ironwood-fddi.cray.com Wed Sep 27 12:51:46 1995 +# Date: Thu, 7 Sep 1995 16:31:40 -0500 +# From: Dean Roehrich <roehrich@ironwood-fddi.cray.com> +# To: perl5-porters@africa.nicoh.com +# Subject: Re: On perl5/solaris/gcc + +# Here's another draft of the perl5/solaris/gcc sanity-checker. + case $PATH in -*/usr/ucb*:/usr/bin:*) cat <<END +*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END + NOTE: Some people have reported problems with /usr/ucb/cc. Remove /usr/ucb from your PATH if you have difficulties. + +END +;; +esac + + +# Check that /dev/fd is mounted. If it is not mounted, let the +# user know that suid scripts may not work. +/usr/bin/df /dev/fd 2>&1 > /dev/null +case $? in +0) ;; +*) + cat <<END + +NOTE: Your system does not have /dev/fd mounted. If you want to +be able to use set-uid scripts you must ask your system administrator +to mount /dev/fd. + +END + ;; +esac + + +# See if libucb can be found in /usr/lib. If it is, warn the user +# that this may cause problems while building Perl extensions. +/usr/bin/ls /usr/lib/libucb* >/dev/null 2>&1 +case $? in +0) + cat <<END + +NOTE: libucb has been found in /usr/lib. libucb should reside in +/usr/ucblib. You may have trouble while building Perl extensions. + END ;; esac + +# See if make(1) is GNU make(1). +# If it is, make sure the setgid bit is not set. +make -v > make.vers 2>&1 +if grep GNU make.vers > /dev/null 2>&1; then + tmp=`/usr/bin/which make` + case "`/usr/bin/ls -l $tmp`" in + ??????s*) + cat <<END + +NOTE: Your PATH points to GNU make, and your GNU make has the set-group-id +bit set. You must either rearrange your PATH to put /usr/ccs/bin before the +GNU utilities or you must ask your system administrator to disable the +set-group-id bit on GNU make. + +END + ;; + esac +fi +rm -f make.vers + +# If the C compiler is gcc: +# - check the fixed-includes +# - check as(1) and ld(1), they should not be GNU +# If the C compiler is not gcc: +# - check as(1) and ld(1), they should not be GNU +# +# Watch out in case they have not set $cc. +case "`${cc:-cc} -v 2>&1`" in +*gcc*) + # + # Using gcc. + # + #echo Using gcc + + # Get gcc to share its secrets. + echo 'main() { return 0; }' > try.c + verbose=`${cc:-cc} -v -o try try.c 2>&1` + tmp=`echo "$verbose" | grep '^Reading' | + awk '{print $NF}' | sed 's/specs$/include/'` + + # Determine if the fixed-includes look like they'll work. + sed 1q $tmp/stdarg.h 2>&1 | grep 'stdarg.h for GNU' 2>&1 >/dev/null + case $? in + 0) ;; + *) + cat <<END + +NOTE: The fixincludes or just-fixinc script for gcc was not run +properly. Your gcc may not be able to compile Perl. Inform your system +administrator that ${cc:-cc} is not properly installed. + +END + ;; + esac + + # See if as(1) is GNU as(1). GNU as(1) won't work for this job. + case $verbose in + */usr/ccs/bin/as*) ;; + *) + cat <<END + +NOTE: You are using GNU as(1). GNU as(1) will not build Perl. +You must arrange to use /usr/ccs/bin/as, perhaps by setting +GCC_EXEC_PREFIX. + +END + ;; + esac + + # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. + case $verbose in + */usr/ccs/bin/ld*) ;; + *) + cat <<END + +NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. +You must arrange to use /usr/ccs/bin/ld, perhaps by setting +GCC_EXEC_PREFIX. + +END + ;; + esac + + ;; #using gcc +*) + # + # Not using gcc. + # + #echo Not using gcc + + # See if as(1) is GNU as(1). GNU as(1) won't work for this job. + case `as --version < /dev/null 2>&1` in + *GNU*) + cat <<END + +NOTE: You are using GNU as(1). GNU as(1) will not build Perl. +You must arrange to use /usr/ccs/bin, perhaps by adding it to the +beginning of your PATH. + +END + ;; + esac + + # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. + case `ld --version < /dev/null 2>&1` in + *GNU*) + cat <<END + +NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. +You must arrange to use /usr/ccs/bin, perhaps by adding it to the +beginning of your PATH + +END + ;; + esac + + ;; #not using gcc +esac + +# as --version or ld --version might dump core. +rm -f core + +# This is just a trick to include some useful notes. +cat > /dev/null <<'End_of_Solaris_Notes' + +Here are some notes kindly contributed by Dean Roehrich. + +----- +Generic notes about building Perl5 on Solaris: +- Use /usr/ccs/bin/make. +- If you use GNU make, remove its setgid bit. +- Remove all instances of *ucb* from your path. +- Make sure libucb is not in /usr/lib (it should be in /usr/ucblib). +- Do not use GNU as or GNU ld, or any of GNU binutils or GNU libc. +- Do not use /usr/ucb/cc. +- Do not change Configure's default answers, except for the path names. +- Do not use -lmalloc. +- Do not build on SunOS 4 and expect it to work properly on SunOS 5. +- /dev/fd must be mounted if you want set-uid scripts to work. + + +Here are the gcc-related questions and answers from the Solaris 2 FAQ. Note +the themes: + - run fixincludes + - run fixincludes correctly + - don't use GNU as or GNU ld + +Question 5.7 covers the __builtin_va_alist problem people are always seeing. +Question 6.1.3 covers the GNU as and GNU ld issues which are always biting +people. +Question 6.9 is for those who are still trying to compile Perl4. + +The latest Solaris 2 FAQ can be found in the following locations: + rtfm.mit.edu:/pub/usenet-by-group/comp.sys.sun.admin + ftp.fwi.uva.nl:/pub/solaris + +Perl5 comes with a script in the top-level directory called "myconfig" which +will print a summary of the configuration in your config.sh. My summary for +Solaris 2.4 and gcc 2.6.3 follows. I have also built with gcc 2.7.0 and the +results are identical. This configuration was generated with Configure's -d +option (take all defaults, don't bother prompting me). All tests pass for +Perl5.001, patch.1m. + +Summary of my perl5 (patchlevel 1) configuration: + Platform: + osname=solaris, osver=2.4, archname=sun4-solaris + uname='sunos poplar 5.4 generic_101945-27 sun4d sparc ' + hint=recommended + Compiler: + cc='gcc', optimize='-O', ld='gcc' + cppflags='' + ccflags ='' + ldflags ='' + stdchar='unsigned char', d_stdstdio=define, usevfork=false + voidflags=15, castflags=0, d_casti32=define, d_castneg=define + intsize=4, alignbytes=8, usemymalloc=y, randbits=15 + Libraries: + so=so + libpth=/lib /usr/lib /usr/ccs/lib /usr/local/lib + libs=-lsocket -lnsl -ldl -lm -lc -lcrypt + libc=/usr/lib/libc.so + Dynamic Linking: + dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef + cccdlflags='-fpic', ccdlflags=' ', lddlflags='-G' + + +Dean +roehrich@cray.com +9/7/95 + +----------- + +From: Casper.Dik@Holland.Sun.COM (Casper H.S. Dik - Network Security Engineer) +Subject: Solaris 2 Frequently Asked Questions (FAQ) 1.48 +Date: 25 Jul 1995 12:20:18 GMT + +5.7) Why do I get __builtin_va_alist or __builtin_va_arg_incr undefined? + + You're using gcc without properly installing the gcc fixed + include files. Or you ran fixincludes after installing gcc + w/o moving the gcc supplied varargs.h and stdarg.h files + out of the way and moving them back again later. This often + happens when people install gcc from a binary distribution. + If there's a tmp directory in gcc's include directory, fixincludes + didn't complete. You should have run "just-fixinc" instead. + + Another possible cause is using ``gcc -I/usr/include.'' + +6.1) Where is the C compiler or where can I get one? + + [...] + + 3) Gcc. + + Gcc is available from the GNU archives in source and binary + form. Look in a directory called sparc-sun-solaris2 for + binaries. You need gcc 2.3.3 or later. You should not use + GNU as or GNU ld. Make sure you run just-fixinc if you use + a binary distribution. Better is to get a binary version and + use that to bootstrap gcc from source. + + [...] + + When you install gcc, don't make the mistake of installing + GNU binutils or GNU libc, they are not as capable as their + counterparts you get with Solaris 2.x. + +6.9) I can't get perl 4.036 to compile or run. + + Run Configure, and use the solaris_2_0 hints, *don't* use + the solaris_2_1 hints and don't use the config.sh you may + already have. First you must make sure Configure and make + don't find /usr/ucb/cc. (It must use gcc or the native C + compiler: /opt/SUNWspro/bin/cc) + + Some questions need a special answer. + + Are your system (especially dbm) libraries compiled with gcc? [y] y + + yes: gcc 2.3.3 or later uses the standard calling + conventions, same as Sun's C. + + Any additional cc flags? [ -traditional -Dvolatile=__volatile__ + -I/usr/ucbinclude] -traditional -Dvolatile=__volatile__ + Remove /usr/ucbinclude. + + Any additional libraries? [-lsocket -lnsl -ldbm -lmalloc -lm + -lucb] -lsocket -lnsl -lm + + Don't include -ldbm, -lmalloc and -lucb. + + Perl 5 compiled out of the box. + +End_of_Solaris_Notes + diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh index f0369c0be7..3f96a668e1 100644 --- a/hints/ultrix_4.sh +++ b/hints/ultrix_4.sh @@ -24,6 +24,8 @@ case "$cc" in case "$osvers" in *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 2900" ;; *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 2900" + # Prototypes sometimes cause compilation errors in 4.2. + prototype=undef case "$myuname" in *risc*) d_volatile=undef ;; esac diff --git a/hints/unicos.sh b/hints/unicos.sh index 6c431293c6..272cb9b5d6 100644 --- a/hints/unicos.sh +++ b/hints/unicos.sh @@ -7,7 +7,3 @@ libswanted=m d_setregid='undef' d_setreuid='undef' -# Pick up dbm.h in <rpcsvc/dbm.h> -if test -f /usr/include/rpcsvc/dbm.h; then - ccflags="$ccflags -I/usr/include/rpcsvc" -fi diff --git a/hints/utekv.sh b/hints/utekv.sh index 0d30fd66ab..ebc7809c60 100644 --- a/hints/utekv.sh +++ b/hints/utekv.sh @@ -6,9 +6,6 @@ ccflags="$ccflags -X18" usemymalloc='y' -# /usr/include/rpcsvc is for finding dbm.h -inclwanted="$inclwanted /usr/include/rpcsvc" - echo " " echo "NOTE: You may have to take out makefile dependencies on the files in" echo "/usr/include (i.e. /usr/include/ctype.h) or the make will fail. A" @@ -481,7 +481,8 @@ HV *hv; } if (!xhv->xhv_array) - Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); + entry = Null(HE*); + else do { if (entry) entry = entry->hent_next; diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index da98d20be2..7672f5ef31 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -1,5 +1,4 @@ package ExtUtils::Liblist; -require ExtUtils::MakeMaker; # currently for MM_Unix::lsdir # Broken out of MakeMaker from version 4.11 @@ -10,7 +9,7 @@ use Cwd; sub ext { my($potential_libs, $Verbose) = @_; return ("", "", "") unless $potential_libs; - print STDOUT "Potential libraries are '$potential_libs':" if $Verbose; + print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose; my($so) = $Config{'so'}; my($libs) = $Config{'libs'}; @@ -62,7 +61,7 @@ sub ext { # For gcc-2.6.2 on linux (March 1995), DLD can not load # .sa libraries, with the exception of libm.sa, so we # deliberately skip them. - if (@fullname = MM_Unix::lsdir($thispth,"^lib$thislib\.$so\.[0-9]+")){ + if (@fullname = lsdir($thispth,"^lib$thislib\.$so\.[0-9]+")){ # Take care that libfoo.so.10 wins against libfoo.so.9. # Compare two libraries to find the most recent version # number. E.g. if you have libfoo.so.9.0.7 and @@ -96,10 +95,10 @@ sub ext { } elsif (-f ($fullname="$thispth/lib$thislib.a")){ } elsif (-f ($fullname="$thispth/Slib$thislib.a")){ } else { - print STDOUT "$thislib not found in $thispth" if $Verbose; + print STDOUT "$thislib not found in $thispth\n" if $Verbose; next; } - print STDOUT "'-l$thislib' found at $fullname" if $Verbose; + print STDOUT "'-l$thislib' found at $fullname\n" if $Verbose; $found++; $found_lib++; @@ -140,12 +139,22 @@ sub ext { } last; # found one here so don't bother looking further } - print STDOUT "Warning (non-fatal): No library found for -l$thislib" + print STDOUT "Warning (non-fatal): No library found for -l$thislib\n" unless $found_lib>0; } return ('','','') unless $found; ("@extralibs", "@bsloadlibs", "@ldloadlibs"); } +sub lsdir { #yes, duplicate code seems less hassle than having an + #extra file with only lsdir + my($dir, $regex) = @_; + local(*DIR, @ls); + opendir(DIR, $dir || ".") or return (); + @ls = readdir(DIR); + closedir(DIR); + @ls = grep(/$regex/, @ls) if $regex; + @ls; +} 1; diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index b073ffc99a..a03e4b8a60 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -1,460 +1,380 @@ -package ExtUtils::MakeMaker; - -$Version = 4.16; # Last edited $Date: 1995/06/18 16:04:00 $ by Tim Bunce +package ExtUtils::MakeMaker::TieAtt; +# this package will go away again, when we don't have modules around +# anymore that import %att It ties an empty %att and records in which +# object this %att was tied. FETCH and STORE return/store-to the +# appropriate value from %$self -$Version_OK = 4.13; # Makefiles older than $Version_OK will die - # (Will be checked from MakeMaker version 4.13 onwards) +# the warndirectuse method warns if somebody calls MM->something. It +# has nothing to do with the tie'd %att. -# $Id: MakeMaker.pm,v 1.21 1995/06/06 06:14:16 k Exp k $ +$Enough_limit = 5; -use Config; -use Carp; -use Cwd; - -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(&WriteMakefile $Verbose &prompt); -@EXPORT_OK = qw($Version &Version_check %att %skip %Recognized_Att_Keys - @MM_Sections %MM_Sections - &help &neatvalue &mkbootstrap &mksymlists); - -$Is_VMS = $Config{'osname'} eq 'VMS'; -require ExtUtils::MM_VMS if $Is_VMS; - -use strict qw(refs); - -$Version = $Version;# avoid typo warning -$Verbose = 0; -$^W=1; - -sub prompt { - my($mess,$def)=@_; - local $\=""; - local $/="\n"; - local $|=1; - die "prompt function called without an argument" unless defined $mess; - $def = "" unless defined $def; - my $dispdef = "[$def] "; - print "$mess $dispdef"; - chop(my $ans = <STDIN>); - $ans || $def; +sub TIEHASH { + bless { SECRETHASH => $_[1]}; } -sub check_hints { - # We allow extension-specific hints files. - - # First we look for the best hintsfile we have - my(@goodhints); - my($hint)="$Config{'osname'}_$Config{'osvers'}"; - $hint =~ s/\./_/g; - $hint =~ s/_$//; - local(*DIR); - opendir DIR, "hints"; - while (defined ($_ = readdir DIR)) { - next if /^\./; - next unless s/\.pl$//; - next unless /^$Config{'osname'}/; - # Don't trust a hintfile for a later OS version: - next if $_ gt $hint; - push @goodhints, $_; - if ($_ eq $hint){ - @goodhints=$_; - last; - } - } - closedir DIR; - return unless @goodhints; # There was no hintsfile - # the last one in lexical ordering is our choice: - $hint=(sort @goodhints)[-1]; - - # execute the hintsfile: - open HINTS, "hints/$hint.pl"; - @goodhints = <HINTS>; - close HINTS; - print STDOUT "Processing hints file hints/$hint.pl"; - eval join('',@goodhints); - print STDOUT $@ if $@; +sub FETCH { + print "Warning (non-fatal): Importing of %att is depreciated [$_[1]] + use \$self instead\n" unless ++$Enough>$Enough_limit; + print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n" if $Enough==$Enough_limit; + $_[0]->{SECRETHASH}->{$_[1]}; } -# Setup dummy package: -# MY exists for overriding methods to be defined within -unshift(@MY::ISA, qw(MM)); - -# Dummy package MM inherits actual methods from OS-specific -# default packages. We use this intermediate package so -# MY->func() can call MM->func() and get the proper -# default routine without having to know under what OS -# it's running. -unshift(@MM::ISA, $Is_VMS ? qw(ExtUtils::MM_VMS MM_Unix) : qw(MM_Unix)); - -$Attrib_Help = <<'END'; - NAME: Perl module name for this extension (DBD::Oracle) - This will default to the directory name but should - be explicitly defined in the Makefile.PL. - - DISTNAME: Your name for distributing the package (by tar file) - This defaults to NAME above. +sub STORE { + print "Warning (non-fatal): Importing of %att is depreciated [$_[1]][$_[2]] + use \$self instead\n" unless ++$Enough>$Enough_limit; + print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n" if $Enough==$Enough_limit; + $_[0]->{SECRETHASH}->{$_[1]} = $_[2]; +} - VERSION: Your version number for distributing the package. - This defaults to 0.1. +sub FIRSTKEY { + print "Warning (non-fatal): Importing of %att is depreciated [FIRSTKEY] + use \$self instead\n" unless ++$Enough>$Enough_limit; + print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n" if $Enough==$Enough_limit; + each %{$_[0]->{SECRETHASH}}; +} - INST_LIB: Perl library directory to directly install - into during 'make'. +sub NEXTKEY { + each %{$_[0]->{SECRETHASH}}; +} - INSTALLPRIVLIB:Used by 'make install', which sets INST_LIB to this value. +sub DESTROY { +} - INST_ARCHLIB: Perl architecture-dependent library to directly install - into during 'make'. +sub warndirectuse { + my($caller) = @_; + return if $Enough>$Enough_limit; + print STDOUT "Warning (non-fatal): Direct use of class methods depreciated; use\n"; + my($method) = $caller =~ /.*:(\w+)$/; + print STDOUT +' my $self = shift; + local *', $method, '; + $self->MM::', $method, "(); + instead\n"; + print "Further ExtUtils::MakeMaker::TieAtt warnings suppressed\n" + if ++$Enough==$Enough_limit; +} - INSTALLARCHLIB:Used by 'make install', which sets INST_ARCHLIB to this value. +package ExtUtils::MakeMaker::TieVersion; +sub TIESCALAR { my $x = "5.00"; bless \$x } +sub FETCH { ${$_[0]} } +sub STORE { warn "You just tried to alter \$ExtUtils::MakeMaker::Version. +Please check your Makefile.PL"; $_[1]; } +sub DESTROY {} - INST_EXE: Directory, where executable scripts should be installed during - 'make'. Defaults to "./blib", just to have a dummy location - during testing. C<make install> will set INST_EXE to INSTALLBIN. +package ExtUtils::MakeMaker; - INSTALLBIN: Used by 'make install' which sets INST_EXE to this value. +# Last edited $Date: 1995/10/26 16:24:47 $ by Andreas Koenig - PERL_LIB: Directory containing the Perl library to use. +# The tie will go away again inlater versions +$ExtUtils::MakeMaker::Version = $ExtUtils::MakeMaker::VERSION; +tie $ExtUtils::MakeMaker::Version, ExtUtils::MakeMaker::TieVersion; +tie $ExtUtils::MakeMaker::VERSION, ExtUtils::MakeMaker::TieVersion; - PERL_ARCHLIB: Architectur dependent directory containing the Perl library to use. +$ExtUtils::MakeMaker::Version_OK = 4.13; # Makefiles older than $Version_OK will die + # (Will be checked from MakeMaker version 4.13 onwards) - PERL_SRC: Directory containing the Perl source code - (use of this should be avoided, it may be undefined) +# $Id: MakeMaker.pm,v 1.93 1995/10/26 16:24:47 k Exp $ - INC: Include file dirs eg: '-I/usr/5include -I/path/to/inc' +use Config; +use Carp; +use Cwd; +require Exporter; +require ExtUtils::Manifest; +require ExtUtils::Liblist; +#use strict qw(refs); - DEFINE: something like "-DHAVE_UNISTD_H" +eval {require DynaLoader;}; # Get mod2fname, if defined. Will fail + # with miniperl. - OBJECT: List of object files, defaults to '$(BASEEXT).o', - but can be a long string containing all object files, - e.g. "tkpBind.o tkpButton.o tkpCanvas.o" +# print join "**\n**", "", %INC, ""; +%NORMAL_INC = %INC; - MYEXTLIB: If the extension links to a library that it builds - set this to the name of the library (see SDBM_File) - LIBS: An anonymous array of alternative library specifications - to be searched for (in order) until at least one library - is found. - 'LIBS' => [ "-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs" ] - Mind, that any element of the array contains a complete - set of arguments for the ld command. So do not specify - 'LIBS' => ["-ltcl", "-ltk", "-lX11" ], #wrong - See ODBM_File/Makefile.PL for an example, where an - array is needed. If you specify a scalar as in - 'LIBS' => "-ltcl -ltk -lX11" - MakeMaker will turn it into an array with one element. - LDFROM: defaults to "$(OBJECT)" and is used in the ld command - to specify what files to link/load from - (also see dynamic_lib below for how to specify ld flags) +@ISA = qw(Exporter); +@EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt); +@EXPORT_OK = qw($Version $VERSION &Version_check + &help &neatvalue &mkbootstrap &mksymlists + %att ## Import of %att is depreciated, please use OO features! +); - DIR: Ref to array of subdirectories containing Makefile.PLs - e.g. [ 'sdbm' ] in ext/SDBM_File +$Is_VMS = $Config::Config{osname} eq 'VMS'; +require ExtUtils::MM_VMS if $Is_VMS; +$Is_OS2 = $Config::Config{'osname'} =~ m|^os/?2$|i ; +$ENV{EMXSHELL} = 'sh' if $Is_OS2; # to run `commands` - PMLIBDIRS: Ref to array of subdirectories containing library files. - Defaults to [ 'lib', $(BASEEXT) ]. The directories will - be scanned and any files they contain will - be installed in the corresponding location in the library. - A MY::libscan() function can be used to alter the behaviour. - Defining PM in the Makefile.PL will override PMLIBDIRS. +$ExtUtils::MakeMaker::Verbose = 0; +$^W=1; +#$SIG{__DIE__} = sub { print @_, Carp::longmess(); die; }; +####$SIG{__WARN__} = sub { print Carp::longmess(); warn @_; }; +$SIG{__WARN__} = sub { $_[0] =~ /^Use of uninitialized value/ && return; }; - PM: Hashref of .pm files and *.pl files to be installed. - e.g. { 'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm' } - By default this will include *.pm and *.pl. If a lib directory - exists and is not listed in DIR (above) then any *.pm and - *.pl files it contains will also be included by default. - Defining PM in the Makefile.PL will override PMLIBDIRS. +# Setup dummy package: +# MY exists for overriding methods to be defined within +unshift(@MY::ISA, qw(MM)); - XS: Hashref of .xs files. MakeMaker will default this. - e.g. { 'name_of_file.xs' => 'name_of_file.c' } - The .c files will automatically be included in the list - of files deleted by a make clean. +# Dummy package MM inherits actual methods from OS-specific +# default packages. We use this intermediate package so +# MY::XYZ->func() can call MM->func() and get the proper +# default routine without having to know under what OS +# it's running. +#unshift(@MM::ISA, $Is_VMS ? qw(ExtUtils::MM_VMS MM_Unix) : qw(MM_Unix)); +unshift @MM::ISA, 'MM_Unix'; +unshift @MM::ISA, 'ExtUtils::MM_VMS' if $Is_VMS; +unshift @MM::ISA, 'ExtUtils::MM_OS2' if $Is_OS2; +push @MM::ISA, qw[ExtUtils::MakeMaker]; + + +@ExtUtils::MakeMaker::MM_Sections_spec = ( + post_initialize => {}, + const_config => {}, + constants => {}, + const_loadlibs => {}, + const_cccmd => {}, # the last but one addition here (CONST_CCCMD) + tool_autosplit => {}, + tool_xsubpp => {}, + tools_other => {}, + dist => {}, + macro => {}, + post_constants => {}, + pasthru => {}, + c_o => {}, + xs_c => {}, + xs_o => {}, + top_targets => {}, # currently the last section that adds a key to $self (DIR_TARGET) + linkext => {}, + dlsyms => {}, + dynamic => {}, + dynamic_bs => {}, + dynamic_lib => {}, + static => {}, + static_lib => {}, + installpm => {}, + manifypods => {}, + processPL => {}, + installbin => {}, + subdirs => {}, + clean => {}, + realclean => {}, + dist_basics => {}, + dist_core => {}, + dist_dir => {}, + dist_test => {}, + dist_ci => {}, + install => {}, + force => {}, + perldepend => {}, + makefile => {}, + staticmake => {}, # Sadly this defines more macros + test => {}, + postamble => {}, # should always be last the user has hands on + selfdocument => {}, # well, he may override it, but he won't do it +); +# looses section ordering +%ExtUtils::MakeMaker::MM_Sections = @ExtUtils::MakeMaker::MM_Sections_spec; +# keeps order +@ExtUtils::MakeMaker::MM_Sections = grep(!ref, @ExtUtils::MakeMaker::MM_Sections_spec); - C: Ref to array of *.c file names. Initialised from a directory scan - and the values portion of the XS attribute hash. This is not - currently used by MakeMaker but may be handy in Makefile.PLs. +%ExtUtils::MakeMaker::Recognized_Att_Keys = %ExtUtils::MakeMaker::MM_Sections; # All sections are valid keys. +foreach(split(/\n/,attrib_help())){ + next unless m/^=item\s+(\w+)\s*$/; + $ExtUtils::MakeMaker::Recognized_Att_Keys{$1} = $2; + print "Attribute '$1' => '$2'\n" if ($ExtUtils::MakeMaker::Verbose >= 2); +} - H: Ref to array of *.h file names. Similar to C: above. +%ExtUtils::MakeMaker::Prepend_dot_dot = qw( +INST_LIB 1 INST_ARCHLIB 1 INST_EXE 1 MAP_TARGET 1 INST_MAN1DIR 1 INST_MAN3DIR 1 +); +$PACKNAME = "PACK000"; - PL_FILES: Ref to hash of files to be processed as perl programs. MakeMaker - will default to any found C<*.PL> file (except C<Makefile.PL>) being - keys and the basename of the file being the value. E.g. - C<{ 'foobar.PL' => 'foobar' }>. The C<*.PL> files are expected to - produce output to the target files themselves. +sub writeMakefile { + die <<END; - EXE_FILES: Ref to array of executable files. The files will be copied to - the INST_EXE directory. Make realclean will delete them from - there again. +The extension you are trying to build apparently is rather old and +most probably outdated. We detect that from the fact, that a +subroutine "writeMakefile" is called, and this subroutine is not +supported anymore since about October 1994. - LINKTYPE: =>'static' or 'dynamic' (default unless usedl=undef in config.sh) - Should only be used to force static linking (also see linkext below). +Please contact the author or ask archie for a more recent version of +the extension. If you're really desperate, you can try to change the +subroutine name from writeMakefile to WriteMakefile and rerun 'perl +akefile.PL', but you're most probably left alone, when you do so. - DL_FUNCS: Hashref of symbol names for routines to be made available as - universal symbols. Each key/value pair consists of the package - name and an array of routine names in that package. Used only - under AIX (export lists) and VMS (linker options) at present. - The routine names supplied will be expanded in the same way - as XSUB names are expanded by the XS() macro. - Defaults to { "$(NAME)" => [ "boot_$(NAME)" ] }. - (e.g. { "RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )], - "NetconfigPtr" => [ 'DESTROY'] } ) +The MakeMaker team - DL_VARS: Array of symbol names for variables to be made available as - universal symbols. Used only under AIX (export lists) and VMS - (linker options) at present. Defaults to []. - (e.g. [ qw( Foo_version Foo_numstreams Foo_tree ) ]) - - CONFIG: =>[qw(archname manext)] defines ARCHNAME & MANEXT from config.sh - - SKIP: =>[qw(name1 name2)] skip (do not write) sections of the Makefile - - MAP_TARGET: If it is intended, that a new perl binary be produced, this variable - may hold a name for that binary. Defaults to C<perl> - - LIBPERL_A: The filename of the perllibrary that will be used together - with this extension. Defaults to C<libperl.a>. - - PERL: - FULLPERL: - -Additional lowercase attributes can be used to pass parameters to the -methods which implement that part of the Makefile. These are not -normally required: - - macro: {ANY_MACRO => ANY_VALUE, ...} - installpm: {SPLITLIB => '$(INST_LIB)' (default) or '$(INST_ARCHLIB)'} - linkext: {LINKTYPE => 'static', 'dynamic' or ''} - dynamic_lib: {ARMAYBE => 'ar', OTHERLDFLAGS => '...'} - clean: {FILES => "*.xyz foo"} - realclean: {FILES => '$(INST_ARCHAUTODIR)/*.xyz'} - dist: {TARFLAGS=>'cvfF', COMPRESS=>'gzip', SUFFIX=>'gz', SHAR=>'shar -m'} - tool_autosplit: {MAXLEN => 8} END +} -sub help {print $Attrib_Help;} - -@MM_Sections_spec = ( - 'post_initialize' => {}, - 'const_config' => {}, - 'constants' => {}, - 'const_loadlibs' => {}, - 'const_cccmd' => {}, - 'tool_autosplit' => {}, - 'tool_xsubpp' => {}, - 'tools_other' => {}, - 'macro' => {}, - 'post_constants' => {}, - 'pasthru' => {}, - 'c_o' => {}, - 'xs_c' => {}, - 'xs_o' => {}, - 'top_targets' => {}, - 'linkext' => {}, - 'dlsyms' => {}, - 'dynamic' => {}, - 'dynamic_bs' => {}, - 'dynamic_lib' => {}, - 'static' => {}, - 'static_lib' => {}, - 'installpm' => {}, - 'processPL' => {}, - 'installbin' => {}, - 'subdirs' => {}, - 'clean' => {}, - 'realclean' => {}, - 'dist' => {}, - 'install' => {}, - 'force' => {}, - 'perldepend' => {}, - 'makefile' => {}, - 'staticmake' => {}, # Sadly this defines more macros - 'test' => {}, - 'postamble' => {}, # should always be last -); -%MM_Sections = @MM_Sections_spec; # looses section ordering -@MM_Sections = grep(!ref, @MM_Sections_spec); # keeps order - -%Recognized_Att_Keys = %MM_Sections; # All sections are valid keys. -foreach(split(/\n/,$Attrib_Help)){ - chomp; - next unless m/^\s*(\w+):\s*(.*)/; - $Recognized_Att_Keys{$1} = $2; - print "Attribute '$1' => '$2'\n" if ($Verbose >= 2); +sub WriteMakefile { + Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; + my %att = @_; + MM->new(\%att)->flush; } -%att = (); -%skip = (); +sub new { + my($class,$self) = @_; + my($key); -sub skipcheck{ - my($section) = @_; - if ($section eq 'dynamic') { - print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets " - . "in skipped section 'dynamic_bs'\n" - if $skip{'dynamic_bs'} && $Verbose; - print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets " - . "in skipped section 'dynamic_lib'\n" - if $skip{'dynamic_lib'} && $Verbose; + print STDOUT "MakeMaker (v$ExtUtils::MakeMaker::VERSION)\n" if $ExtUtils::MakeMaker::Verbose; + if (-f "MANIFEST" && ! -f "Makefile"){ + check_manifest(); } - if ($section eq 'dynamic_lib') { - print STDOUT "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on " - . "targets in skipped section 'dynamic_bs'\n" - if $skip{'dynamic_bs'} && $Verbose; - } - if ($section eq 'static') { - print STDOUT "Warning (non-fatal): Target 'static' depends on targets " - . "in skipped section 'static_lib'\n" - if $skip{'static_lib'} && $Verbose; - } - return 'skipped' if $skip{$section}; - return ''; -} + check_hints(); -sub WriteMakefile { - %att = @_; - local($\)="\n"; + $self = {} unless (defined $self); - print STDOUT "MakeMaker (v$Version)" if $Verbose; + my(%initial_att) = %$self; # record initial attributes - if ( Carp::longmess("") =~ "runsubdirpl" ){ - $Correct_relativ_directories++; - } else { - $Correct_relativ_directories=0; - } - - if (-f "MANIFEST"){ - eval {require ExtUtils::Manifest}; - if ($@){ - print STDOUT "Warning: you have not installed the ExtUtils::Manifest - module -- skipping check of the MANIFEST file"; + if (defined $self->{CONFIGURE}) { + if (ref $self->{CONFIGURE} eq 'CODE') { + $self = { %$self, %{&{$self->{CONFIGURE}}}}; } else { - print STDOUT "Checking if your kit is complete..."; - $ExtUtils::Manifest::Quiet=$ExtUtils::Manifest::Quiet=1; #avoid warning - my(@missed)=ExtUtils::Manifest::manicheck(); - if (@missed){ - print STDOUT "Warning: the following files are missing in your kit:"; - print "\t", join "\n\t", @missed; - print STDOUT "Please inform the author.\n"; - } else { - print STDOUT "Looks good"; - } + croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n"; } } - parse_args(\%att, @ARGV); - my(%initial_att) = %att; # record initial attributes + # This is for old Makefiles written pre 5.00, will go away + if ( Carp::longmess("") =~ /runsubdirpl/s ){ + $self->{Correct_relativ_directories}++; + } else { + $self->{Correct_relativ_directories}=0; + } - check_hints(); + my $class = ++$PACKNAME; + { +# no strict; + print "Blessing Object into class [$class]\n" if $ExtUtils::MakeMaker::Verbose; + mv_all_methods("MY",$class); + bless $self, $class; +######## tie %::att, ExtUtils::MakeMaker::TieAtt, $self; + push @ExtUtils::MakeMaker::Parent, $self; + @{"$class\:\:ISA"} = 'MM'; + } - my($key); + if (defined $ExtUtils::MakeMaker::Parent[-2]){ + $self->{PARENT} = $ExtUtils::MakeMaker::Parent[-2]; + my $key; + for $key (keys %ExtUtils::MakeMaker::Prepend_dot_dot) { + $self->{$key} = $self->{PARENT}{$key}; + $self->{$key} = $self->catdir("..",$self->{$key}) + unless $self->{$key} =~ m!^/!; + } + $self->{PARENT}->{CHILDREN}->{$class} = $self if $self->{PARENT}; + } else { + parse_args($self,@ARGV); + } + + $self->{NAME} ||= $self->guess_name; - MY->init_main(); + ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g; - print STDOUT "Writing Makefile for $att{NAME}"; + $self->init_main(); - if (! $att{PERL_SRC} && - $INC{'Config.pm'} ne "$Config{'archlib'}/Config.pm"){ + if (! $self->{PERL_SRC} && + $INC{'Config.pm'} ne $self->catdir($Config::Config{archlibexp},'Config.pm')){ (my $pthinks = $INC{'Config.pm'}) =~ s!/Config\.pm$!!; $pthinks =~ s!.*/!!; print STDOUT <<END; Your perl and your Config.pm seem to have different ideas about the architecture they are running on. -Perl thinks: $pthinks -Config says: $Config{"archname"} +Perl thinks: [$pthinks] +Config says: [$Config::Config{archname}] This may or may not cause problems. Please check your installation of perl if you have problems building this extension. END } - MY->init_dirscan(); - MY->init_others(); + $self->init_dirscan(); + $self->init_others(); - unlink("Makefile", "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ''); - open MAKE, ">MakeMaker.tmp" or die "Unable to open MakeMaker.tmp: $!"; - select MAKE; $|=1; select STDOUT; + push @{$self->{RESULT}}, <<END; +# This Makefile is for the $self->{NAME} extension to perl. +# +# It was generated automatically by MakeMaker version $ExtUtils::MakeMaker::VERSION from the contents +# of Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker Parameters: +END - print MAKE "# This Makefile is for the $att{NAME} extension to perl.\n#"; - print MAKE "# It was generated automatically by MakeMaker version $Version from the contents"; - print MAKE "# of Makefile.PL. Don't edit this file, edit Makefile.PL instead."; - print MAKE "#\n# ANY CHANGES MADE HERE WILL BE LOST! \n#"; - print MAKE "# MakeMaker Parameters: "; foreach $key (sort keys %initial_att){ my($v) = neatvalue($initial_att{$key}); + $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; $v =~ tr/\n/ /s; - print MAKE "# $key => $v"; + push @{$self->{RESULT}}, "# $key => $v"; } - # build hash for SKIP to make testing easy - %skip = map( ($_,1), @{$att{'SKIP'} || []}); + # turn the SKIP array into a SKIPHASH hash + my (%skip,$skip); + for $skip (@{$self->{SKIP} || []}) { + $self->{SKIPHASH}{$skip} = 1; + } - my $section; - foreach $section ( @MM_Sections ){ - print "Processing Makefile '$section' section" if ($Verbose >= 2); - my($skipit) = skipcheck($section); - if ($skipit){ - print MAKE "\n# --- MakeMaker $section section $skipit."; - } else { - my(%a) = %{$att{$section} || {}}; - print MAKE "\n# --- MakeMaker $section section:"; - print MAKE "# ", join ", ", %a if $Verbose; - print(MAKE MY->nicetext(MY->$section( %a ))); + # We run all the subdirectories now. They don't have much to query + # from the parent, but the parent has to query them: if they need linking! + my($dir); + unless ($self->{NORECURS}) { + foreach $dir (@{$self->{DIR}}){ + chdir $dir; + local *FH; + open FH, "Makefile.PL"; + eval join "", <FH>; + close FH; + chdir ".."; } } - if ($Verbose){ - print MAKE "\n# Full list of MakeMaker attribute values:"; - foreach $key (sort keys %att){ - my($v) = neatvalue($att{$key}); - $v =~ tr/\n/ /s; - print MAKE "# $key => $v"; + tie %::att, ExtUtils::MakeMaker::TieAtt, $self; + my $section; + foreach $section ( @ExtUtils::MakeMaker::MM_Sections ){ + print "Processing Makefile '$section' section\n" if ($ExtUtils::MakeMaker::Verbose >= 2); + my($skipit) = $self->skipcheck($section); + if ($skipit){ + push @{$self->{RESULT}}, "\n# --- MakeMaker $section section $skipit."; + } else { # MEMO: b 329 print "$self->{NAME}**$section**\n" and $section eq 'postamble' + my(%a) = %{$self->{$section} || {}}; + push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:"; + push @{$self->{RESULT}}, "# " . join ", ", %a if $ExtUtils::MakeMaker::Verbose && %a; + push @{$self->{RESULT}}, $self->nicetext($self->$section( %a )); } } - print MAKE "\n# End."; - close MAKE; - my($finalname) = $Is_VMS ? "Descrip.MMS" : "Makefile"; - rename("MakeMaker.tmp", $finalname); - - chmod 0644, $finalname; - system("$Config{'eunicefix'} $finalname") unless $Config{'eunicefix'} eq ":"; - - 1; -} - -sub Version_check { - my($checkversion) = @_; - die "Your Makefile was built with ExtUtils::MakeMaker v $checkversion. -Current Version is $Version. There have been considerable changes in the meantime. -Please rerun 'perl Makefile.PL' to regenerate the Makefile.\n" if $checkversion < $Version_OK; - print STDOUT "Makefile built with ExtUtils::MakeMaker v $checkversion. Current Version is $Version." unless $checkversion == $Version; -} + push @{$self->{RESULT}}, "\n# End."; +######## untie %::att; + pop @ExtUtils::MakeMaker::Parent; -sub mksymlists{ - %att = @_; - parse_args(\%att, @ARGV); - MY->mksymlists(@_); + $self; } -# The following mkbootstrap() is only for installations that are calling -# the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker -# write Makefiles, that use ExtUtils::Mkbootstrap directly. -sub mkbootstrap{ - parse_args(\%att, @ARGV); - MY->init_main() unless defined $att{BASEEXT}; - eval {require ExtUtils::Mkbootstrap}; +sub check_manifest { + eval {require ExtUtils::Manifest}; if ($@){ - # Very difficult to arrive here, I suppose - carp "Error: $@\nVersion mismatch: This MakeMaker (v$Version) needs the ExtUtils::Mkbootstrap package. Please check your installation."; + print STDOUT "Warning: you have not installed the ExtUtils::Manifest + module -- skipping check of the MANIFEST file\n"; + } else { + print STDOUT "Checking if your kit is complete...\n"; + $ExtUtils::Manifest::Quiet=$ExtUtils::Manifest::Quiet=1; #avoid warning + my(@missed)=ExtUtils::Manifest::manicheck(); + if (@missed){ + print STDOUT "Warning: the following files are missing in your kit:\n"; + print "\t", join "\n\t", @missed; + print STDOUT "\n"; + print STDOUT "Please inform the author.\n"; + } else { + print STDOUT "Looks good\n"; + } } - ExtUtils::Mkbootstrap::Mkbootstrap($att{BASEEXT},@_); } sub parse_args{ - my($attr, @args) = @_; + my($self, @args) = @_; foreach (@args){ unless (m/(.*?)=(.*)/){ help(),exit 1 if m/^help$/; - ++$Verbose if m/^verb/; + ++$ExtUtils::MakeMaker::Verbose if m/^verb/; next; } my($name, $value) = ($1, $2); @@ -465,64 +385,278 @@ sub parse_args{ (getpwuid($>))[7] ]ex; } - if ($Correct_relativ_directories){ - # This is experimental, so we don't care for efficiency - my @dirs = qw(INST_LIB INST_ARCHLIB INST_EXE); - my %dirs; - @dirs{@dirs}=@dirs; - if ($dirs{$name} && $value !~ m!^/!){ # a relativ directory - $value = "../$value"; - } + # This will go away: + if ($self->{Correct_relativ_directories}){ + $value = $self->catdir("..",$value) + if $ExtUtils::MakeMaker::Prepend_dot_dot{$name} &&! $value =~ m!^/!; } - - $$attr{$name} = $value; + $self->{$name} = $value; } + delete $self->{Correct_relativ_directories}; + # catch old-style 'potential_libs' and inform user how to 'upgrade' - if (defined $$attr{'potential_libs'}){ - my($msg)="'potential_libs' => '$$attr{potential_libs}' should be"; - if ($$attr{'potential_libs'}){ - print STDOUT "$msg changed to:\n\t'LIBS' => ['$$attr{potential_libs}']\n"; + if (defined $self->{potential_libs}){ + my($msg)="'potential_libs' => '$self->{potential_libs}' should be"; + if ($self->{potential_libs}){ + print STDOUT "$msg changed to:\n\t'LIBS' => ['$self->{potential_libs}']\n"; } else { print STDOUT "$msg deleted.\n"; } - $$attr{LIBS} = [$$attr{'potential_libs'}]; - delete $$attr{'potential_libs'}; + $self->{LIBS} = [$self->{potential_libs}]; + delete $self->{potential_libs}; } # catch old-style 'ARMAYBE' and inform user how to 'upgrade' - if (defined $$attr{'ARMAYBE'}){ - my($armaybe) = $$attr{'ARMAYBE'}; + if (defined $self->{ARMAYBE}){ + my($armaybe) = $self->{ARMAYBE}; print STDOUT "ARMAYBE => '$armaybe' should be changed to:\n", "\t'dynamic_lib' => {ARMAYBE => '$armaybe'}\n"; - my(%dl) = %{$$attr{'dynamic_lib'} || {}}; - $$attr{'dynamic_lib'} = { %dl, ARMAYBE => $armaybe}; - delete $$attr{'ARMAYBE'}; + my(%dl) = %{$self->{dynamic_lib} || {}}; + $self->{dynamic_lib} = { %dl, ARMAYBE => $armaybe}; + delete $self->{ARMAYBE}; } - if (defined $$attr{'LDTARGET'}){ + if (defined $self->{LDTARGET}){ print STDOUT "LDTARGET should be changed to LDFROM\n"; - $$attr{'LDFROM'} = $$attr{'LDTARGET'}; - delete $$attr{'LDTARGET'}; + $self->{LDFROM} = $self->{LDTARGET}; + delete $self->{LDTARGET}; + } + my $mmkey; + foreach $mmkey (sort keys %$self){ + print STDOUT " $mmkey => ", neatvalue($self->{$mmkey}), "\n" if $ExtUtils::MakeMaker::Verbose; + print STDOUT "'$mmkey' is not a known MakeMaker parameter name.\n" + unless exists $ExtUtils::MakeMaker::Recognized_Att_Keys{$mmkey}; + } +} + +sub check_hints { + my($self) = @_; + # We allow extension-specific hints files. + + return unless -d "hints"; + + # First we look for the best hintsfile we have + my(@goodhints); + my($hint)="$Config::Config{osname}_$Config::Config{osvers}"; + $hint =~ s/\./_/g; + $hint =~ s/_$//; + return unless $hint; + + # Also try without trailing minor version numbers. + while (1) { + last if -f "hints/$hint.pl"; # found + } continue { + last unless $hint =~ s/_[^_]*$//; # nothing to cut off } - foreach(sort keys %{$attr}){ - print STDOUT " $_ => ".neatvalue($$attr{$_}) if ($Verbose); - print STDOUT "'$_' is not a known MakeMaker parameter name.\n" - unless exists $Recognized_Att_Keys{$_}; + return unless -f "hints/$hint.pl"; # really there + + # execute the hintsfile: + open HINTS, "hints/$hint.pl"; + @goodhints = <HINTS>; + close HINTS; + print STDOUT "Processing hints file hints/$hint.pl\n"; + eval join('',@goodhints); + print STDOUT $@ if $@; +} + +sub mv_all_methods { + my($from,$to) = @_; + my($method); +# no strict; + + foreach $method (@ExtUtils::MakeMaker::MM_Sections, qw[ dir_target exescan extliblist +fileparse fileparse_set_fstype init_dirscan init_main init_others +installpm_x libscan makeaperl mksymlists needs_linking runsubdirpl +subdir_x test_via_harness test_via_script writedoc ]) { + + # We cannot say "next" here. Nick might call MY->makeaperl + # which isn't defined right now + + # next unless defined &{"${from}::$method"}; + + *{"${to}::$method"} = \&{"${from}::$method"}; + my $symtab = \%{"${from}::"}; + + # delete would do, if we were sure, nobody ever called + # MY->makeaperl directly + + # delete $symtab->{$method}; + + # If we delete a method, then it will be undefined and cannot + # be called. But as long as we have Makefile.PLs that rely on + # %MY:: being intact, we have to fill the hole with an + # inheriting method: + + eval "package MY; sub $method {local *$method; shift->MY::$method(\@_); }"; + + } + + # We have to clean out %INC also, because the current directory is + # changed frequently and Graham Barr prefers to get his version + # out of a History.pl file which is "required" so woudn't get + # loaded again in another extension requiring a History.pl + + my $inc; + foreach $inc (keys %INC) { + next if $ExtUtils::MakeMaker::NORMAL_INC{$inc}; + #warn "***$inc*** deleted"; + delete $INC{$inc}; + } + +} + +sub prompt { + my($mess,$def)=@_; + local $|=1; + die "prompt function called without an argument" unless defined $mess; + $def = "" unless defined $def; + my $dispdef = "[$def] "; + print "$mess $dispdef"; + chop(my $ans = <STDIN>); + $ans || $def; +} + +sub attrib_help { + return $Attrib_Help if $Attrib_Help; + my $switch = 0; + my $help; + my $line; + local *POD; +#### local $/ = ""; # bug in 5.001m + open POD, $INC{"ExtUtils/MakeMaker.pm"} + or die "Open $INC{'ExtUtils/MakeMaker.pm'}: $!"; + while ($line = <POD>) { + $switch ||= $line =~ /^=item NAME\s*$/; + next unless $switch; + last if $line =~ /^=cut/; + $help .= $line; + } + close POD; + $Attrib_Help = $help; +} + +sub help {print &attrib_help, "\n";} + +sub skipcheck{ + my($self) = shift; + my($section) = @_; + if ($section eq 'dynamic') { + print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ", + "in skipped section 'dynamic_bs'\n" + if $self->{SKIPHASH}{dynamic_bs} && $ExtUtils::MakeMaker::Verbose; + print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ", + "in skipped section 'dynamic_lib'\n" + if $self->{SKIPHASH}{dynamic_lib} && $ExtUtils::MakeMaker::Verbose; + } + if ($section eq 'dynamic_lib') { + print STDOUT "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on ", + "targets in skipped section 'dynamic_bs'\n" + if $self->{SKIPHASH}{dynamic_bs} && $ExtUtils::MakeMaker::Verbose; + } + if ($section eq 'static') { + print STDOUT "Warning (non-fatal): Target 'static' depends on targets ", + "in skipped section 'static_lib'\n" + if $self->{SKIPHASH}{static_lib} && $ExtUtils::MakeMaker::Verbose; + } + return 'skipped' if $self->{SKIPHASH}{$section}; + return ''; +} + +sub flush { + my $self = shift; + my($chunk); + local *MAKE; + print STDOUT "Writing $self->{MAKEFILE} for $self->{NAME}\n"; + + unlink($self->{MAKEFILE}, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ''); + open MAKE, ">MakeMaker.tmp" or die "Unable to open MakeMaker.tmp: $!"; + + for $chunk (@{$self->{RESULT}}) { + print MAKE "$chunk\n"; } + + close MAKE; + my($finalname) = $Is_VMS ? "Descrip.MMS" : $self->{MAKEFILE}; + rename("MakeMaker.tmp", $finalname); + chmod 0644, $finalname; + system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":"; } +sub Version_check { + my($checkversion) = @_; + die "Your Makefile was built with ExtUtils::MakeMaker v $checkversion. +Current Version is $ExtUtils::MakeMaker::VERSION. There have been considerable +changes in the meantime. +Please rerun 'perl Makefile.PL' to regenerate the Makefile.\n" + if $checkversion < $ExtUtils::MakeMaker::Version_OK; + printf STDOUT "%s %.2f %s %.2f.\n", "Makefile built with ExtUtils::MakeMaker v", + $checkversion, "Current Version is", $ExtUtils::MakeMaker::VERSION + unless $checkversion == $ExtUtils::MakeMaker::VERSION; +} + +sub mksymlists { + my $class = shift; + my $self = shift; + bless $self, $class; + tie %att, ExtUtils::MakeMaker::TieAtt, $self; + $self->parse_args(@ARGV); + $self->mksymlists(@_); +} + +# The following mkbootstrap() is only for installations that are calling +# the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker +# writes Makefiles, that use ExtUtils::Mkbootstrap directly. +sub mkbootstrap { + die <<END; +!!! Your Makefile has been built such a long time ago, !!! +!!! that is unlikely to work with current MakeMaker. !!! +!!! Please rebuild your Makefile !!! +END +} -sub neatvalue{ +sub neatvalue { my($v) = @_; return "undef" unless defined $v; my($t) = ref $v; return "'$v'" unless $t; - return "[ ".join(', ',map("'$_'",@$v))." ]" if ($t eq 'ARRAY'); + if ($t eq 'ARRAY') { + my(@m, $elem, @neat); + push @m, "["; + foreach $elem (@$v) { + push @neat, "'$elem'"; + } + push @m, join ", ", @neat; + push @m, "]"; + return join "", @m; + } return "$v" unless $t eq 'HASH'; my(@m, $key, $val); push(@m,"$key=>".neatvalue($val)) while (($key,$val) = each %$v); return "{ ".join(', ',@m)." }"; } -# ------ Define the MakeMaker default methods in package MM_Unix ------ +sub selfdocument { + my($self) = @_; + my(@m); + if ($ExtUtils::MakeMaker::Verbose){ + push @m, "\n# Full list of MakeMaker attribute values:"; + foreach $key (sort keys %$self){ + next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/; + my($v) = neatvalue($self->{$key}); + $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; + $v =~ tr/\n/ /s; + push @m, "# $key => $v"; + } + } + join "\n", @m; +} + + + # # # # # # + ## ## ## ## # # # # # # # + # # # # # # # # # # ## # # # # + # # # # # # # # # # # # ## + # # # # # # # # # # ## + # # # # # # # ## # # # + # # # # ####### ##### # # # # # package MM_Unix; @@ -532,42 +666,77 @@ use File::Basename; require Exporter; Exporter::import('ExtUtils::MakeMaker', - qw(%att %skip %Recognized_Att_Keys $Verbose)); + qw( $Verbose)); # These attributes cannot be overridden externally @Other_Att_Keys{qw(EXTRALIBS BSLOADLIBS LDLOADLIBS)} = (1) x 3; -if ($Is_VMS = $Config{'osname'} eq 'VMS') { +if ($Is_VMS = $Config::Config{osname} eq 'VMS') { require VMS::Filespec; import VMS::Filespec 'vmsify'; } +$Is_OS2 = $ExtUtils::MakeMaker::Is_OS2; + +sub guess_name { # Charles! That's something for MM_VMS + my($self) = @_; + my $name = fastcwd(); + if ($Is_VMS) { + $name =~ s:.*?([^.\]]+)\]:$1: unless ($name =~ s:.*[.\[]ext\.(.*)\]:$1:i); + $name =~ s#[.\]]#::#g; + } else { + $name =~ s:.*/:: unless ($name =~ s:^.*/ext/::); + $name =~ s#/#::#g; + $name =~ s#\-\d+\.\d+$##; # this is new with MM 5.00 + } + $name; +} sub init_main { my($self) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } - # Find out directory name. This may contain the extension name. - my($pwd) = fastcwd(); # from Cwd.pm # --- Initialize Module Name and Paths # NAME = The perl module name for this extension (eg DBD::Oracle). # FULLEXT = Pathname for extension directory (eg DBD/Oracle). # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. # ROOTEXT = Directory part of FULLEXT with leading /. - unless($att{NAME}){ # we have to guess our name - my($name) = $pwd; - if ($Is_VMS) { - $name =~ s:.*?([^.\]]+)\]:$1: unless ($name =~ s:.*[.\[]ext\.(.*)\]:$1:i); - ($att{NAME}=$name) =~ s#[.\]]#::#g; - } else { - $name =~ s:.*/:: unless ($name =~ s:^.*/ext/::); - ($att{NAME} =$name) =~ s#/#::#g; - } + ($self->{FULLEXT} = + $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket + + # Copied from DynaLoader: + + my(@modparts) = split(/::/,$self->{NAME}); + my($modfname) = $modparts[-1]; + + # Some systems have restrictions on files names for DLL's etc. + # mod2fname returns appropriate file base name (typically truncated) + # It may also edit @modparts if required. + if (defined &DynaLoader::mod2fname) { + $modfname = &DynaLoader::mod2fname(\@modparts); + } elsif ($Is_OS2) { # Need manual correction if run with miniperl:-( + $modfname = substr($modfname, 0, 7) . '_'; } - ($att{FULLEXT} =$att{NAME}) =~ s#::#/#g ; #eg. BSD/Foo/Socket - ($att{BASEEXT} =$att{NAME}) =~ s#.*::##; #eg. Socket - ($att{ROOTEXT} =$att{FULLEXT}) =~ s#/?\Q$att{BASEEXT}\E$## ; # eg. /BSD/Foo - $att{ROOTEXT} = ($Is_VMS ? '' : '/') . $att{ROOTEXT} if $att{ROOTEXT}; + + + ($self->{BASEEXT} = + $self->{NAME}) =~ s!.*::!! ; #eg. Socket + + if (defined &DynaLoader::mod2fname or $Is_OS2) { + # As of 5.001m, dl_os2 appends '_' + $self->{DLBASE} = $modfname; #eg. Socket_ + } else { + $self->{DLBASE} = '$(BASEEXT)'; + } + + ($self->{ROOTEXT} = + $self->{FULLEXT}) =~ s#/?\Q$self->{BASEEXT}\E$## ; #eg. /BSD/Foo + + $self->{ROOTEXT} = ($Is_VMS ? '' : '/') . $self->{ROOTEXT} if $self->{ROOTEXT}; # --- Initialize PERL_LIB, INST_LIB, PERL_SRC @@ -587,24 +756,43 @@ sub init_main { # INST Macro: For standard for any other # modules module # INST_LIB ../../lib ./blib - # INST_ARCHLIB ../../lib ./blib - - unless ($att{PERL_SRC}){ - foreach (qw(../.. ../../.. ../../../..)){ - if ( -f "$_/config.sh" - && -f "$_/perl.h" - && -f "$_/lib/Exporter.pm") { - $att{PERL_SRC}=$_ ; + # INST_ARCHLIB ../../lib ./blib/<archname> + + unless ($self->{PERL_SRC}){ + my($dir); + foreach $dir (qw(../.. ../../.. ../../../..)){ + if ( -f "$dir/config.sh" + && -f "$dir/perl.h" + && -f "$dir/lib/Exporter.pm") { + $self->{PERL_SRC}=$dir ; last; } } } - unless ($att{PERL_SRC}){ + if ($self->{PERL_SRC}){ + $self->{PERL_LIB} ||= $self->catdir("$self->{PERL_SRC}","lib"); + $self->{PERL_ARCHLIB} = $self->{PERL_LIB}; + $self->{PERL_INC} = $self->{PERL_SRC}; + # catch an situation that has occurred a few times in the past: + warn <<EOM unless -s "$self->{PERL_SRC}/cflags"; +You cannot build extensions below the perl source tree after executing +a 'make clean' in the perl source tree. + +To rebuild extensions distributed with the perl source you should +simply Configure (to include those extensions) and then build perl as +normal. After installing perl the source tree can be deleted. It is not +needed for building extensions. + +It is recommended that you unpack and build additional extensions away +from the perl source tree. +EOM + } else { # we should also consider $ENV{PERL5LIB} here - $att{PERL_LIB} = $Config{'privlib'} unless $att{PERL_LIB}; - $att{PERL_ARCHLIB} = $Config{'archlib'} unless $att{PERL_ARCHLIB}; - $att{PERL_INC} = "$att{PERL_ARCHLIB}/CORE"; # wild guess for now - die <<EOM unless (-f "$att{PERL_INC}/perl.h"); + $self->{PERL_LIB} = $Config::Config{privlibexp} unless $self->{PERL_LIB}; + $self->{PERL_ARCHLIB} = $Config::Config{archlibexp} unless $self->{PERL_ARCHLIB}; + $self->{PERL_INC} = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now + my $perl_h; + die <<EOM unless (-f ($perl_h = $self->catfile("$self->{PERL_INC}","perl.h"))); Error: Unable to locate installed Perl libraries or Perl source code. It is recommended that you install perl in a standard location before @@ -614,117 +802,96 @@ building extensions. You can say: if you have not yet installed perl but still want to build this extension now. +(You get this message, because MakeMaker could not find "$perl_h") EOM - print STDOUT "Using header files found in $att{PERL_INC}" if $Verbose && $self->needs_linking; - - } else { # PERL_SRC is defined here... - - $att{PERL_LIB} = "$att{PERL_SRC}/lib" unless $att{PERL_LIB}; - $att{PERL_ARCHLIB} = $att{PERL_LIB}; - $att{PERL_INC} = $att{PERL_SRC}; - # catch an situation that has occurred a few times in the past: - warn <<EOM unless -s "$att{PERL_SRC}/cflags"; -You cannot build extensions below the perl source tree after executing -a 'make clean' in the perl source tree. - -To rebuild extensions distributed with the perl source you should -simply Configure (to include those extensions) and then build perl as -normal. After installing perl the source tree can be deleted. It is not -needed for building extensions. +# print STDOUT "Using header files found in $self->{PERL_INC}\n" +# if $Verbose && $self->needs_linking(); -It is recommended that you unpack and build additional extensions away -from the perl source tree. -EOM } # INST_LIB typically pre-set if building an extension after # perl has been built and installed. Setting INST_LIB allows - # you to build directly into, say $Config{'privlib'}. - unless ($att{INST_LIB}){ - if (defined $att{PERL_SRC}) { -# require ExtUtils::Manifest; -# my $file; - my $standard = 0; -# my $mani = ExtUtils::Manifest::maniread("$att{PERL_SRC}/MANIFEST"); -# foreach $file (keys %$mani){ -# if ($file =~ m!^ext/\Q$att{FULLEXT}!){ -# $standard++; -# last; -# } -# } - -#### Temporary solution for perl5.001f: -$standard = 1; -#### This is just the same as was MakeMaker 4.094, but everything's prepared to -#### switch to a different behaviour after 5.001f - - if ($standard){ - $att{INST_LIB} = $att{PERL_LIB}; - } else { - $att{INST_LIB} = "./blib"; - print STDOUT <<END; -Warning: The $att{NAME} extension will not be installed by 'make install' in the -perl source directory. Please install it with 'make install' from the - $pwd -directory. -END - } + # you to build directly into, say $Config::Config{privlibexp}. + unless ($self->{INST_LIB}){ + if (defined $self->{PERL_SRC}) { + $self->{INST_LIB} = $self->{PERL_LIB}; } else { - $att{INST_LIB} = "./blib"; + $self->{INST_LIB} = $self->catdir(".","blib"); } } # Try to work out what INST_ARCHLIB should be if not set: - unless ($att{INST_ARCHLIB}){ + unless ($self->{INST_ARCHLIB}){ my(%archmap) = ( - "./blib" => "./blib", # our private build lib - $att{PERL_LIB} => $att{PERL_ARCHLIB}, - $Config{'privlib'} => $Config{'archlib'}, + $self->catdir(".","blib") => $self->catdir(".","blib",$Config::Config{archname}), # our private build lib + $self->{PERL_LIB} => $self->{PERL_ARCHLIB}, + $Config::Config{privlibexp} => $Config::Config{archlibexp}, $inc_carp_dir => $inc_config_dir, ); - $att{INST_ARCHLIB} = $archmap{$att{INST_LIB}}; - unless($att{INST_ARCHLIB}){ + $self->{INST_ARCHLIB} = $archmap{$self->{INST_LIB}}; + unless($self->{INST_ARCHLIB}){ # Oh dear, we'll have to default it and warn the user - my($archname) = $Config{'archname'}; - if (-d "$att{INST_LIB}/$archname"){ - $att{INST_ARCHLIB} = "$att{INST_LIB}/$archname"; - print STDOUT "Defaulting INST_ARCHLIB to INST_LIB/$archname\n"; + my($archname) = $Config::Config{archname}; + if (-d "$self->{INST_LIB}/$archname"){ + $self->{INST_ARCHLIB} = $self->catdir("$self->{INST_LIB}","$archname"); + print STDOUT "Defaulting INST_ARCHLIB to $self->{INST_ARCHLIB}\n"; } else { - $att{INST_ARCHLIB} = $att{INST_LIB}; - print STDOUT "Warning: Defaulting INST_ARCHLIB to INST_LIB ", - "(not architecture independent).\n"; + $self->{INST_ARCHLIB} = $self->{INST_LIB}; } } } - $att{INST_EXE} = "./blib" unless $att{INST_EXE}; + $self->{INST_EXE} ||= $self->catdir('.','blib',$Config::Config{archname}); + + if ($self->{PREFIX}){ + $self->{INSTALLPRIVLIB} = $self->catdir($self->{PREFIX},"lib","perl5"); + $self->{INSTALLBIN} = $self->catdir($self->{PREFIX},"bin"); + $self->{INSTALLMAN1DIR} = $self->catdir($self->{PREFIX},"perl5","man","man1"); + $self->{INSTALLMAN3DIR} = $self->catdir($self->{PREFIX},"perl5","man","man3"); + } - if( $att{INSTALLPRIVLIB} && ! $att{INSTALLARCHLIB} ){ - my($archname) = $Config{'archname'}; - if (-d "$att{INSTALLPRIVLIB}/$archname"){ - $att{INSTALLARCHLIB} = "$att{INSTALLPRIVLIB}/$archname"; - print STDOUT "Defaulting INSTALLARCHLIB to INSTALLPRIVLIB/$archname\n"; + if( $self->{INSTALLPRIVLIB} && ! $self->{INSTALLARCHLIB} ){ + my($archname) = $Config::Config{archname}; + if (-d $self->catdir($self->{INSTALLPRIVLIB},$archname)){ + $self->{INSTALLARCHLIB} = $self->catdir($self->{INSTALLPRIVLIB},$archname); + print STDOUT "Defaulting INSTALLARCHLIB to $self->{INSTALLARCHLIB}\n"; } else { - $att{INSTALLARCHLIB} = $att{INSTALLPRIVLIB}; - print STDOUT "Warning: Defaulting INSTALLARCHLIB to INSTALLPRIVLIB ", - "(not architecture independent).\n"; + $self->{INSTALLARCHLIB} = $self->{INSTALLPRIVLIB}; } } - $att{INSTALLPRIVLIB} ||= $Config{'installprivlib'}; - $att{INSTALLARCHLIB} ||= $Config{'installarchlib'}; - $att{INSTALLBIN} ||= $Config{'installbin'}; + $self->{INSTALLPRIVLIB} ||= $Config::Config{installprivlib}; + $self->{INSTALLARCHLIB} ||= $Config::Config{installarchlib}; + $self->{INSTALLBIN} ||= $Config::Config{installbin}; + + $self->{INST_MAN1DIR} ||= $self->catdir('.','blib','man','man1'); + $self->{INSTALLMAN1DIR} ||= $Config::Config{installman1dir}; + $self->{MAN1EXT} ||= $Config::Config{man1ext}; + + $self->{INST_MAN3DIR} ||= $self->catdir('.','blib','man','man3'); + $self->{INSTALLMAN3DIR} ||= $Config::Config{installman3dir}; + $self->{MAN3EXT} ||= $Config::Config{man3ext}; + + $self->{MAP_TARGET} = "perl" unless $self->{MAP_TARGET}; - $att{MAP_TARGET} = "perl" unless $att{MAP_TARGET}; - $att{LIBPERL_A} = $Is_VMS ? 'libperl.olb' : 'libperl.a' - unless $att{LIBPERL_A}; + $self->{LIB_EXT} = $Config::Config{lib_ext} || "a"; + $self->{OBJ_EXT} = $Config::Config{obj_ext} || "o"; + $self->{AR} = $Config::Config{ar} || "ar"; + + unless ($self->{LIBPERL_A}){ + if ($Is_VMS) { + $self->{LIBPERL_A} = 'libperl.olb'; + } else { + $self->{LIBPERL_A} = "libperl.$self->{LIB_EXT}"; + } + } # make a few simple checks - warn "Warning: PERL_LIB ($att{PERL_LIB}) seems not to be a perl library directory + warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory (Exporter.pm not found)" - unless (-f "$att{PERL_LIB}/Exporter.pm"); + unless (-f $self->catfile("$self->{PERL_LIB}","Exporter.pm")); - ($att{DISTNAME}=$att{NAME}) =~ s#(::)#-#g unless $att{DISTNAME}; - $att{VERSION} = "0.1" unless $att{VERSION}; - ($att{VERSION_SYM} = $att{VERSION}) =~ s/\W/_/g; + ($self->{DISTNAME}=$self->{NAME}) =~ s#(::)#-#g unless $self->{DISTNAME}; + $self->{VERSION} = "0.10" unless $self->{VERSION}; + ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g; # --- Initialize Perl Binary Locations @@ -732,31 +899,36 @@ END # Find Perl 5. The only contract here is that both 'PERL' and 'FULLPERL' # will be working versions of perl 5. miniperl has priority over perl # for PERL to ensure that $(PERL) is usable while building ./ext/* - $att{'PERL'} = - MY->find_perl(5.0, ['miniperl','perl','perl5',"perl$]" ], - [ grep defined $_, $att{PERL_SRC}, split(":", $ENV{PATH}), - $Config{'bin'} ], $Verbose ) - unless ($att{'PERL'}); # don't check, if perl is executable, maybe they - # they have decided to supply switches with perl + my $path_sep = $Is_OS2 ? ";" : $Is_VMS ? "/" : ":"; + my $path = $ENV{PATH}; + $path =~ s:\\:/:g if $Is_OS2; + my @path = split $path_sep, $path; + my ($component,@defpath); + foreach $component ($self->{PERL_SRC}, @path, $Config::Config{binexp}) { + push @defpath, $component if defined $component; + } + $self->{PERL} = + $self->find_perl(5.0, [ $^X, 'miniperl','perl','perl5',"perl$]" ], + \@defpath, $ExtUtils::MakeMaker::Verbose ) unless ($self->{PERL}); +# don't check, if perl is executable, maybe they +# have decided to supply switches with perl # Define 'FULLPERL' to be a non-miniperl (used in test: target) - ($att{'FULLPERL'} = $att{'PERL'}) =~ s/miniperl/perl/ - unless ($att{'FULLPERL'} && -x $att{'FULLPERL'}); - - if ($Is_VMS) { - $att{'PERL'} = 'MCR ' . vmsify($att{'PERL'}); - $att{'FULLPERL'} = 'MCR ' . vmsify($att{'FULLPERL'}); - } + ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/perl/i + unless ($self->{FULLPERL}); } - sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) - - my($name, %dir, %xs, %c, %h, %ignore, %pl_files); + my($self) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods); local(%pm); #the sub in find() has to see this hash $ignore{'test.pl'} = 1; $ignore{'makefile.pl'} = 1 if $Is_VMS; - foreach $name (lsdir(".")){ + foreach $name ($self->lsdir(".")){ next if ($name =~ /^\./ or $ignore{$name}); if (-d $name){ $dir{$name} = $name if (-f "$name/Makefile.PL"); @@ -770,7 +942,7 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) } elsif ($name =~ /\.h$/){ $h{$name} = 1; } elsif ($name =~ /\.(p[ml]|pod)$/){ - $pm{$name} = "\$(INST_LIBDIR)/$name"; + $pm{$name} = $self->catfile('$(INST_LIBDIR)',"$name"); } elsif ($name =~ /\.PL$/ && $name ne "Makefile.PL") { ($pl_files{$name} = $name) =~ s/\.PL$// ; } @@ -781,17 +953,17 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) # The attribute PMLIBDIRS holds an array reference which lists # subdirectories which we should search for library files to - # install. PMLIBDIRS defaults to [ 'lib', $att{BASEEXT} ]. + # install. PMLIBDIRS defaults to [ 'lib', $self->{BASEEXT} ]. # We recursively search through the named directories (skipping # any which don't exist or contain Makefile.PL files). - # For each *.pm or *.pl file found MY->libscan() is called with - # the default installation path in $_. The return value of libscan - # defines the actual installation location. - # The default libscan function simply returns $_. - # The file is skipped if libscan returns false. + # For each *.pm or *.pl file found $self->libscan() is called with + # the default installation path in $_[1]. The return value of + # libscan defines the actual installation location. The default + # libscan function simply returns the path. The file is skipped + # if libscan returns false. - # The default installation location passed to libscan in $_ is: + # The default installation location passed to libscan in $_[1] is: # # ./*.pm => $(INST_LIBDIR)/*.pm # ./xyz/... => $(INST_LIBDIR)/xyz/... @@ -802,156 +974,232 @@ sub init_dirscan { # --- File and Directory Lists (.xs .pm .pod etc) # (which includes ROOTEXT). This is a subtle distinction but one # that's important for nested modules. - $att{PMLIBDIRS} = [ 'lib', $att{BASEEXT} ] unless $att{PMLIBDIRS}; + $self->{PMLIBDIRS} = [ 'lib', $self->{BASEEXT} ] unless $self->{PMLIBDIRS}; #only existing directories that aren't in $dir are allowed - @{$att{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$att{PMLIBDIRS}}; - if (@{$att{PMLIBDIRS}}){ - print "Searching PMLIBDIRS: @{$att{PMLIBDIRS}}" - if ($Verbose >= 2); + # Avoid $_ wherever possible: + # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}}; + my (@pmlibdirs) = @{$self->{PMLIBDIRS}}; + my ($pmlibdir); + @{$self->{PMLIBDIRS}} = (); + foreach $pmlibdir (@pmlibdirs) { + -d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir; + } + + if (@{$self->{PMLIBDIRS}}){ + print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n" + if ($ExtUtils::MakeMaker::Verbose >= 2); use File::Find; # try changing to require ! File::Find::find(sub { -# We now allow any file in PMLIBDIRS to be installed. nTk needs that, and -# we should allow it. -# return unless m/\.p[ml]$/; - return if -d $_; # anything else that Can't be copied? - my($path, $prefix) = ($File::Find::name, '$(INST_LIBDIR)'); - my $striplibpath; - $prefix = '$(INST_LIB)' if (($striplibpath = $path) =~ s:^lib/::); - local($_) = "$prefix/$striplibpath"; - my($inst) = MY->libscan(); - print "libscan($path) => '$inst'" if ($Verbose >= 2); - return unless $inst; - $pm{$path} = $inst; - }, @{$att{PMLIBDIRS}}); - } - - $att{DIR} = [sort keys %dir] unless $att{DIRS}; - $att{XS} = \%xs unless $att{XS}; - $att{PM} = \%pm unless $att{PM}; - $att{C} = [sort keys %c] unless $att{C}; - my(@o_files) = @{$att{C}}; - my($sufx) = $Is_VMS ? '.obj' : '.o'; - $att{O_FILES} = [grep s/\.c$/$sufx/, @o_files] ; - $att{H} = [sort keys %h] unless $att{H}; - $att{PL_FILES} = \%pl_files unless $att{PL_FILES}; + if (-d $_){ + if ($_ eq "CVS" || $_ eq "RCS"){ + $File::Find::prune = 1; + } + return; + } + my($path, $prefix) = ($File::Find::name, '$(INST_LIBDIR)'); + my $striplibpath; + $prefix = '$(INST_LIB)' if (($striplibpath = $path) =~ s:^lib/::); + my($inst) = $self->catdir($prefix,$striplibpath); + local($_) = $inst; # for backwards compatibility + $inst = $self->libscan($inst); + print "libscan($path) => '$inst'\n" if ($ExtUtils::MakeMaker::Verbose >= 2); + return unless $inst; + $pm{$path} = $inst; + }, @{$self->{PMLIBDIRS}}); + } + + $self->{DIR} = [sort keys %dir] unless $self->{DIR}; + $self->{XS} = \%xs unless $self->{XS}; + $self->{PM} = \%pm unless $self->{PM}; + $self->{C} = [sort keys %c] unless $self->{C}; + my(@o_files) = @{$self->{C}}; + $self->{O_FILES} = [grep s/\.c$/\.$self->{OBJ_EXT}/, @o_files] ; + $self->{H} = [sort keys %h] unless $self->{H}; + $self->{PL_FILES} = \%pl_files unless $self->{PL_FILES}; + + # Set up names of manual pages to generate from pods + # Configure overrides anything else + if ($self->{MANPODS}) { + } elsif ( $self->{INST_MAN3DIR} =~ /^(none|\s*)$/ ) { + $self->{MANPODS} = {}; + } else { + my %manifypods = (); # we collect the keys first, i.e. the files + # we have to convert to pod + foreach $name (keys %{$self->{PM}}) { + if ($name =~ /\.pod$/ ) { + $manifypods{$name} = $self->{PM}{$name}; + } elsif ($name =~ /\.p[ml]$/ ) { + local(*TESTPOD); + my($ispod)=0; + open(TESTPOD,"<$name"); + my $testpodline; + while ($testpodline = <TESTPOD>) { + if($testpodline =~ /^=head/) { + $ispod=1; + last; + } + #Speculation on the future (K.A., not A.K. :) + #if(/^=don't\S+install/) { $ispod=0; last} + } + close(TESTPOD); + + if( $ispod ) { + $manifypods{$name} = $self->{PM}{$name}; + } + } + } + + # Remove "Configure.pm" and similar, if it's not the only pod listed + # To force inclusion, just name it "Configure.pod", or override MANPODS + foreach $name (keys %manifypods) { + if ($name =~ /(config|install|setup).*\.pm/i) { + delete $manifypods{$name}; + next; + } + my($manpagename) = $name; + unless ($manpagename =~ s!^lib/!!) { + $manpagename = join("/",$self->{ROOTEXT},$manpagename); + } + $manpagename =~ s/\.p(od|m|l)$//; + # Strip leading slashes + $manpagename =~ s!^/+!!; + # Turn other slashes into colons +# $manpagename =~ s,/+,::,g; + $manpagename = $self->replace_manpage_seperator($manpagename); + $manifypods{$name} = "\$(INST_MAN3DIR)/$manpagename.\$(MAN3EXT)"; + } + $self->{MANPODS} = \%manifypods; + } } +sub lsdir { + my($self) = shift; + my($dir, $regex) = @_; + local(*DIR, @ls); + opendir(DIR, $dir || ".") or return (); + @ls = readdir(DIR); + closedir(DIR); + @ls = grep(/$regex/, @ls) if $regex; + @ls; +} + +sub replace_manpage_seperator { + my($self,$man) = @_; + $man =~ s,/+,::,g; + $man; +} sub libscan { - return '' if m:/RCS/: ; # return undef triggered warnings with $Verbose>=2 - $_; + my($self,$path) = @_; + return '' if $path =~ m:/RCS/: ; + $path; } sub init_others { # --- Initialize Other Attributes - my($key); - for $key (keys(%Recognized_Att_Keys), keys(%Other_Att_Keys)){ - # avoid warnings for uninitialized vars - next if exists $att{$key}; - $att{$key} = ""; + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; } - # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $att{'LIBS'} - # Lets look at $att{LIBS} carefully: It may be an anon array, a string or + # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS} + # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or # undefined. In any case we turn it into an anon array: - $att{LIBS}=[] unless $att{LIBS}; - $att{LIBS}=[$att{LIBS}] if ref \$att{LIBS} eq SCALAR; - $att{LD_RUN_PATH} = ""; - foreach ( @{$att{'LIBS'}} ){ - s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace - my(@libs) = MY->extliblist($_); + $self->{LIBS}=[] unless $self->{LIBS}; + $self->{LIBS}=[$self->{LIBS}] if ref \$self->{LIBS} eq SCALAR; + $self->{LD_RUN_PATH} = ""; + my($libs); + foreach $libs ( @{$self->{LIBS}} ){ + $libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace + my(@libs) = $self->extliblist($libs); if ($libs[0] or $libs[1] or $libs[2]){ - @att{EXTRALIBS, BSLOADLIBS, LDLOADLIBS} = @libs; + ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, $self->{LDLOADLIBS}) = @libs; if ($libs[2]) { - $att{LD_RUN_PATH} = join(":",grep($_=~s/^-L//,split(" ", $libs[2]))); + my @splitted = split(" ", $libs[2]); + my $splitted; + foreach $splitted (@splitted) { + $splitted =~ s/^-L//; + } + $self->{LD_RUN_PATH} = join ":", @splitted; } last; } } print STDOUT "CONFIG must be an array ref\n" - if ($att{CONFIG} and ref $att{CONFIG} ne 'ARRAY'); - $att{CONFIG} = [] unless (ref $att{CONFIG}); - push(@{$att{CONFIG}}, + if ($self->{CONFIG} and ref $self->{CONFIG} ne 'ARRAY'); + $self->{CONFIG} = [] unless (ref $self->{CONFIG}); + push(@{$self->{CONFIG}}, qw(cc libc ldflags lddlflags ccdlflags cccdlflags ranlib so dlext dlsrc )); - push(@{$att{CONFIG}}, 'shellflags') if $Config{'shellflags'}; + push(@{$self->{CONFIG}}, 'shellflags') if $Config::Config{shellflags}; - if ($Is_VMS) { - $att{OBJECT} = '$(BASEEXT).obj' unless $att{OBJECT}; - $att{OBJECT} =~ s/[^,\s]\s+/, /g; - $att{OBJECT} =~ s/\n+/, /g; - $att{OBJECT} =~ s#\.o,#\.obj,#; - } else { - $att{OBJECT} = '$(BASEEXT).o' unless $att{OBJECT}; - $att{OBJECT} =~ s/\n+/ \\\n\t/g; + unless ( $self->{OBJECT} ){ + # init_dirscan should have found out, if we have C files + $self->{OBJECT} = '$(BASEEXT).$(OBJ_EXT)' if @{$self->{C}||[]}; } - $att{BOOTDEP} = (-f "$att{BASEEXT}_BS") ? "$att{BASEEXT}_BS" : ""; - $att{LD} = ($Config{'ld'} || 'ld') unless $att{LD}; - $att{LDFROM} = '$(OBJECT)' unless $att{LDFROM}; + $self->{OBJECT} =~ s/\n+/ \\\n\t/g; + $self->{BOOTDEP} = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : ""; + $self->{LD} = ($Config::Config{ld} || 'ld') unless $self->{LD}; + $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM}; + # Sanity check: don't define LINKTYPE = dynamic if we're skipping # the 'dynamic' section of MM. We don't have this problem with # 'static', since we either must use it (%Config says we can't # use dynamic loading) or the caller asked for it explicitly. - if (!$att{LINKTYPE}) { - $att{LINKTYPE} = grep(/dynamic/,@{$att{SKIP} || []}) + if (!$self->{LINKTYPE}) { + $self->{LINKTYPE} = grep(/dynamic/,@{$self->{SKIP} || []}) ? 'static' - : ($Config{'usedl'} ? 'dynamic' : 'static'); + : ($Config::Config{usedl} ? 'dynamic' : 'static'); }; # These get overridden for VMS and maybe some other systems - $att{NOOP} = ""; - $att{MAKEFILE} = "Makefile"; - $att{RM_F} = "rm -f"; - $att{RM_RF} = "rm -rf"; - $att{TOUCH} = "touch"; - $att{CP} = "cp"; - $att{MV} = "mv"; - $att{CHMOD} = "chmod"; -} - - -sub lsdir{ - my($dir, $regex) = @_; - local(*DIR, @ls); - opendir(DIR, $_[0] || ".") or die "opendir: $!"; - @ls = readdir(DIR); - closedir(DIR); - @ls = grep(/$regex/, @ls) if $regex; - @ls; + $self->{NOOP} = ""; + $self->{MAKEFILE} ||= "Makefile"; + $self->{RM_F} = "rm -f"; + $self->{RM_RF} = "rm -rf"; + $self->{TOUCH} = "touch"; + $self->{CP} = "cp"; + $self->{MV} = "mv"; + $self->{CHMOD} = "chmod"; + $self->{UMASK_NULL} = "umask 0"; } - sub find_perl{ my($self, $ver, $names, $dirs, $trace) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my($name, $dir); if ($trace >= 2){ - print "Looking for perl $ver by these names: "; - print "@$names, "; - print "in these dirs:"; - print "@$dirs"; + print "Looking for perl $ver by these names: +@$names +in these dirs: +@$dirs +"; } foreach $dir (@$dirs){ - next unless defined $dir; # $att{PERL_SRC} may be undefined + next unless defined $dir; # $self->{PERL_SRC} may be undefined foreach $name (@$names){ - print "Checking $dir/$name " if ($trace >= 2); - if ($Is_VMS) { - $name .= ".exe" unless -x "$dir/$name"; - } - next unless -x "$dir/$name"; - print "Executing $dir/$name" if ($trace >= 2); - my($out); - if ($Is_VMS) { - my($vmscmd) = 'MCR ' . vmsify("$dir/$name"); - $out = `$vmscmd -e "require $ver; print ""VER_OK\n"""`; + my $abs; + if ($name =~ m|^/|) { + $abs = $name; } else { - $out = `$dir/$name -e 'require $ver; print "VER_OK\n" ' 2>&1`; + $abs = $self->catfile($dir, $name); + } + print "Checking $abs\n" if ($trace >= 2); + if ($Is_OS2) { + $abs .= ".exe" unless -x $abs; } - if ($out =~ /VER_OK/) { - print "Using PERL=$dir/$name" if $trace; - return "$dir/$name"; + next unless -x "$abs"; + print "Executing $abs\n" if ($trace >= 2); + if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) { + print "Using PERL=$abs\n" if $trace; + return $abs; } } } @@ -959,106 +1207,140 @@ sub find_perl{ 0; # false and not empty } - -sub post_initialize{ +sub post_initialize { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } ""; } -sub needs_linking { # Does this module need linking? - return 1 if $att{OBJECT} or @{$att{C} || []} or $att{MYEXTLIB}; - return 0; +# --- Constants Sections --- + +sub const_config { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@m,$m); + push(@m,"\n# These definitions are from config.sh (via $INC{'Config.pm'})\n"); + my(%once_only); + foreach $m (@{$self->{CONFIG}}){ + next if $once_only{$m}; + print STDOUT "CONFIG key '$m' does not exist in Config.pm\n" + unless exists $Config::Config{$m}; + push @m, "\U$m\E = $Config::Config{$m}\n"; + $once_only{$m} = 1; + } + join('', @m); } sub constants { my($self) = @_; - my(@m); + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@m,$tmp); push @m, " -NAME = $att{NAME} -DISTNAME = $att{DISTNAME} -VERSION = $att{VERSION} -VERSION_SYM = $att{VERSION_SYM} +NAME = $self->{NAME} +DISTNAME = $self->{DISTNAME} +NAME_SYM = $self->{NAME_SYM} +VERSION = $self->{VERSION} +VERSION_SYM = $self->{VERSION_SYM} +VERSION_MACRO = VERSION +DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\" # In which directory should we put this extension during 'make'? # This is typically ./blib. # (also see INST_LIBDIR and relationship to ROOTEXT) -INST_LIB = $att{INST_LIB} -INST_ARCHLIB = $att{INST_ARCHLIB} -INST_EXE = $att{INST_EXE} +INST_LIB = $self->{INST_LIB} +INST_ARCHLIB = $self->{INST_ARCHLIB} +INST_EXE = $self->{INST_EXE} # AFS users will want to set the installation directories for # the final 'make install' early without setting INST_LIB, # INST_ARCHLIB, and INST_EXE for the testing phase -INSTALLPRIVLIB = $att{INSTALLPRIVLIB} -INSTALLARCHLIB = $att{INSTALLARCHLIB} -INSTALLBIN = $att{INSTALLBIN} +INSTALLPRIVLIB = $self->{INSTALLPRIVLIB} +INSTALLARCHLIB = $self->{INSTALLARCHLIB} +INSTALLBIN = $self->{INSTALLBIN} # Perl library to use when building the extension -PERL_LIB = $att{PERL_LIB} -PERL_ARCHLIB = $att{PERL_ARCHLIB} -LIBPERL_A = $att{LIBPERL_A} +PERL_LIB = $self->{PERL_LIB} +PERL_ARCHLIB = $self->{PERL_ARCHLIB} +LIBPERL_A = $self->{LIBPERL_A} MAKEMAKER = \$(PERL_LIB)/ExtUtils/MakeMaker.pm -MM_VERSION = $ExtUtils::MakeMaker::Version -"; - - # Define I_PERL_LIBS to include the required -Ipaths - # To be cute we only include PERL_ARCHLIB if different - - #### Deprecated from Version 4.11: We want to avoid different - #### behavior for variables with make(1) and perl(1) +MM_VERSION = $ExtUtils::MakeMaker::VERSION - # To be portable we add quotes for VMS - my(@i_perl_libs) = qw{-I$(PERL_ARCHLIB) -I$(PERL_LIB)}; - shift(@i_perl_libs) if ($att{PERL_ARCHLIB} eq $att{PERL_LIB}); - if ($Is_VMS){ - push @m, "I_PERL_LIBS = \"".join('" "',@i_perl_libs)."\"\n"; - } else { - push @m, "I_PERL_LIBS = ".join(' ',@i_perl_libs)."\n"; - } +OBJ_EXT = $self->{OBJ_EXT} +LIB_EXT = $self->{LIB_EXT} +AR = $self->{AR} +"; push @m, " # Where is the perl source code located? -PERL_SRC = $att{PERL_SRC}\n" if $att{PERL_SRC}; +PERL_SRC = $self->{PERL_SRC}\n" if $self->{PERL_SRC}; push @m, " # Perl header files (will eventually be under PERL_LIB) -PERL_INC = $att{PERL_INC} +PERL_INC = $self->{PERL_INC} # Perl binaries -PERL = $att{'PERL'} -FULLPERL = $att{'FULLPERL'} +PERL = $self->{PERL} +FULLPERL = $self->{FULLPERL} "; push @m, " # FULLEXT = Pathname for extension directory (eg DBD/Oracle). # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. # ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) -FULLEXT = $att{FULLEXT} -BASEEXT = $att{BASEEXT} -ROOTEXT = $att{ROOTEXT} +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = $self->{FULLEXT} +BASEEXT = $self->{BASEEXT} +ROOTEXT = $self->{ROOTEXT} +DLBASE = $self->{DLBASE} "; push @m, " -INC = $att{INC} -DEFINE = $att{DEFINE} -OBJECT = $att{OBJECT} -LDFROM = $att{LDFROM} -LINKTYPE = $att{LINKTYPE} +INC = $self->{INC} +DEFINE = $self->{DEFINE} +OBJECT = $self->{OBJECT} +LDFROM = $self->{LDFROM} +LINKTYPE = $self->{LINKTYPE} # Handy lists of source code files: -XS_FILES= ".join(" \\\n\t", sort keys %{$att{XS}})." -C_FILES = ".join(" \\\n\t", @{$att{C}})." -O_FILES = ".join(" \\\n\t", @{$att{O_FILES}})." -H_FILES = ".join(" \\\n\t", @{$att{H}})." +XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})." +C_FILES = ".join(" \\\n\t", @{$self->{C}})." +O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})." +H_FILES = ".join(" \\\n\t", @{$self->{H}})." +MANPODS = ".join(" \\\n\t", sort keys %{$self->{MANPODS}})." -.SUFFIXES: .xs +# Man installation stuff: +INST_MAN1DIR = $self->{INST_MAN1DIR} +INSTALLMAN1DIR = $self->{INSTALLMAN1DIR} +MAN1EXT = $self->{MAN1EXT} -.PRECIOUS: Makefile +INST_MAN3DIR = $self->{INST_MAN3DIR} +INSTALLMAN3DIR = $self->{INSTALLMAN3DIR} +MAN3EXT = $self->{MAN3EXT} -.NO_PARALLEL: + +# work around a famous dec-osf make(1) feature(?): +makemakerdflt: all + +.SUFFIXES: .xs .c .\$(OBJ_EXT) + +.PRECIOUS: Makefile .PHONY: all config static dynamic test linkext # This extension may link to it's own library (see SDBM_File) -MYEXTLIB = $att{MYEXTLIB} +MYEXTLIB = $self->{MYEXTLIB} # Where is the Config information that we are using/depend on CONFIGDEP = \$(PERL_ARCHLIB)/Config.pm \$(PERL_INC)/config.h @@ -1073,10 +1355,10 @@ INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) '; - if ($self->needs_linking) { + if ($self->has_link_code()) { push @m, ' -INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT).a -INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(BASEEXT).$(DLEXT) +INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT).$(LIB_EXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT) INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs '; } else { @@ -1087,32 +1369,99 @@ INST_BOOT = '; } + if ($Is_OS2) { + $tmp = "$self->{BASEEXT}.def"; + } else { + $tmp = ""; + } + push @m, " +EXPORT_LIST = $tmp +"; + + if ($Is_OS2) { + $tmp = "\$(PERL_INC)/libperl.lib"; + } else { + $tmp = ""; + } + push @m, " +PERL_ARCHIVE = $tmp +"; + push @m, ' -INST_PM = '.join(" \\\n\t", sort values %{$att{PM}}).' +INST_PM = '.join(" \\\n\t", sort values %{$self->{PM}}).' '; join('',@m); } -$Const_cccmd=0; # package global +sub const_loadlibs { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return "" unless $self->needs_linking; + " +# $self->{NAME} might depend on some other libraries: +# (These comments may need revising:) +# +# Dependent libraries can be linked in one of three ways: +# +# 1. (For static extensions) by the ld command when the perl binary +# is linked with the extension library. See EXTRALIBS below. +# +# 2. (For dynamic extensions) by the ld command when the shared +# object is built/linked. See LDLOADLIBS below. +# +# 3. (For dynamic extensions) by the DynaLoader when the shared +# object is loaded. See BSLOADLIBS below. +# +# EXTRALIBS = List of libraries that need to be linked with when +# linking a perl binary which includes this extension +# Only those libraries that actually exist are included. +# These are written to a file and used when linking perl. +# +# LDLOADLIBS = List of those libraries which can or must be linked into +# the shared library when created using ld. These may be +# static or dynamic libraries. +# LD_RUN_PATH is a colon separated list of the directories +# in LDLOADLIBS. It is passed as an environment variable to +# the process that links the shared library. +# +# BSLOADLIBS = List of those libraries that are needed but can be +# linked in dynamically at run time on this platform. +# SunOS/Solaris does not need this because ld records +# the information (from LDLOADLIBS) into the object file. +# This list is used to create a .bs (bootstrap) file. +# +EXTRALIBS = $self->{EXTRALIBS} +LDLOADLIBS = $self->{LDLOADLIBS} +BSLOADLIBS = $self->{BSLOADLIBS} +LD_RUN_PATH= $self->{LD_RUN_PATH} +"; +} -sub const_cccmd{ +sub const_cccmd { my($self,$libperl)=@_; - $libperl or $libperl = $att{LIBPERL_A} || "libperl.a" ; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; + return '' unless $self->needs_linking(); + $libperl or $libperl = $self->{LIBPERL_A} || "libperl.$self->{LIB_EXT}" ; + $libperl =~ s/\.\$\(A\)$/.$self->{LIB_EXT}/; # This is implemented in the same manner as extliblist, # e.g., do both and compare results during the transition period. my($cc,$ccflags,$optimize,$large,$split, $shflags) = @Config{qw(cc ccflags optimize large split shellflags)}; - my($optdebug)=""; + my($optdebug) = ""; $shflags = '' unless $shflags; my($prog, $old, $uc, $perltype); - unless ($Const_cccmd++){ - chop($old = `cd $att{PERL_SRC}; sh $shflags ./cflags $libperl $att{BASEEXT}.c`) - if $att{PERL_SRC}; - $Const_cccmd++; # shut up typo warning - } + chop($old = `cd $self->{PERL_SRC}; sh $shflags ./cflags $libperl $self->{BASEEXT}.c`) + if $self->{PERL_SRC}; my(%map) = ( D => '-DDEBUGGING', @@ -1122,7 +1471,7 @@ sub const_cccmd{ DM => '-DDEBUGGING -DEMBED -DMULTIPLICITY', ); - if ($libperl =~ /libperl(\w*)\.a/){ + if ($libperl =~ /libperl(\w*)\.$self->{LIB_EXT}/){ $uc = uc($1); } else { $uc = ""; # avoid warning @@ -1135,10 +1484,10 @@ sub const_cccmd{ my($name); - ( $name = $att{NAME} . "_cflags" ) =~ s/:/_/g ; - if ($prog = $Config{$name}) { + ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ; + if ($prog = $Config::Config{$name}) { # Expand hints for this extension via the shell - print STDOUT "Processing $name hint:\n" if $Verbose; + print STDOUT "Processing $name hint:\n" if $ExtUtils::MakeMaker::Verbose; my(@o)=`cc=\"$cc\" ccflags=\"$ccflags\" optimize=\"$optimize\" @@ -1160,7 +1509,7 @@ sub const_cccmd{ chomp $line; if ($line =~ /(.*?)=\s*(.*)\s*$/){ $cflags{$1} = $2; - print STDOUT " $1 = $2" if $Verbose; + print STDOUT " $1 = $2\n" if $ExtUtils::MakeMaker::Verbose; } else { print STDOUT "Unrecognised result from hint: '$line'\n"; } @@ -1178,86 +1527,30 @@ sub const_cccmd{ if (defined($old)){ $old =~ s/^\s+//; $old =~ s/\s+/ /g; $old =~ s/\s+$//; if ($new ne $old) { - print STDOUT "Warning (non-fatal): cflags evaluation in " - ."MakeMaker ($ExtUtils::MakeMaker::Version) " - ."differs from shell output\n" - ." package: $att{NAME}\n" - ." old: $old\n" - ." new: $new\n" - ." Using 'old' set.\n" - . Config::myconfig() - ."\nPlease send these details to perl5-porters\@nicoh.com\n"; + print STDOUT "Warning (non-fatal): cflags evaluation in ", + "MakeMaker ($ExtUtils::MakeMaker::VERSION) ", + "differs from shell output\n", + " package: $self->{NAME}\n", + " old: $old\n", + " new: $new\n", + " Using 'old' set.\n", + Config::myconfig(), "\n"; } } my($cccmd)=($old) ? $old : $new; - $cccmd =~ s/^\s*\Q$Config{'cc'}\E\s/\$(CC) /; - "CCCMD = $cccmd\n"; -} - - -# --- Constants Sections --- - -sub const_config{ - my(@m,$m); - push(@m,"\n# These definitions are from config.sh (via $INC{'Config.pm'})\n"); - my(%once_only); - foreach $m (@{$att{'CONFIG'}}){ - next if $once_only{$m}; - print STDOUT "CONFIG key '$m' does not exist in Config.pm\n" - unless exists $Config{$m}; - push @m, "\U$m\E = $Config{$m}\n"; - $once_only{$m} = 1; - } - join('', @m); + $cccmd =~ s/^\s*\Q$Config::Config{cc}\E\s/\$(CC) /; + $cccmd .= " \$(DEFINE_VERSION)"; + $self->{CONST_CCCMD} = "CCCMD = $cccmd\n"; } - -sub const_loadlibs{ - " -# $att{NAME} might depend on some other libraries: -# (These comments may need revising:) -# -# Dependent libraries can be linked in one of three ways: -# -# 1. (For static extensions) by the ld command when the perl binary -# is linked with the extension library. See EXTRALIBS below. -# -# 2. (For dynamic extensions) by the ld command when the shared -# object is built/linked. See LDLOADLIBS below. -# -# 3. (For dynamic extensions) by the DynaLoader when the shared -# object is loaded. See BSLOADLIBS below. -# -# EXTRALIBS = List of libraries that need to be linked with when -# linking a perl binary which includes this extension -# Only those libraries that actually exist are included. -# These are written to a file and used when linking perl. -# -# LDLOADLIBS = List of those libraries which can or must be linked into -# the shared library when created using ld. These may be -# static or dynamic libraries. -# LD_RUN_PATH is a colon separated list of the directories -# in LDLOADLIBS. It is passed as an environment variable to -# the process that links the shared library. -# -# BSLOADLIBS = List of those libraries that are needed but can be -# linked in dynamically at run time on this platform. -# SunOS/Solaris does not need this because ld records -# the information (from LDLOADLIBS) into the object file. -# This list is used to create a .bs (bootstrap) file. -# -EXTRALIBS = $att{'EXTRALIBS'} -LDLOADLIBS = $att{'LDLOADLIBS'} -BSLOADLIBS = $att{'BSLOADLIBS'} -LD_RUN_PATH= $att{'LD_RUN_PATH'} -"; -} - - # --- Tool Sections --- -sub tool_autosplit{ +sub tool_autosplit { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my($asl) = ""; $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN}; q{ @@ -1266,12 +1559,27 @@ AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;}. }; } - -sub tool_xsubpp{ +sub tool_xsubpp { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my($xsdir) = '$(PERL_LIB)/ExtUtils'; # drop back to old location if xsubpp is not in new location yet - $xsdir = '$(PERL_SRC)/ext' unless (-f "$att{PERL_LIB}/ExtUtils/xsubpp"); + $xsdir = '$(PERL_SRC)/ext' unless (-f "$self->{PERL_LIB}/ExtUtils/xsubpp"); my(@tmdeps) = ('$(XSUBPPDIR)/typemap'); + if( $self->{TYPEMAPS} ){ + my $typemap; + foreach $typemap (@{$self->{TYPEMAPS}}){ + if( ! -f $typemap ){ + warn "Typemap $typemap not found.\n"; + } + else{ + push(@tmdeps, $typemap); + } + } + } push(@tmdeps, "typemap") if -f "typemap"; my(@tmargs) = map("-typemap $_", @tmdeps); " @@ -1282,30 +1590,76 @@ XSUBPPARGS = @tmargs "; }; - -sub tools_other{ +sub tools_other { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } " SHELL = /bin/sh -LD = $att{LD} -TOUCH = $att{TOUCH} -CP = $att{CP} -MV = $att{MV} -RM_F = $att{RM_F} -RM_RF = $att{RM_RF} -CHMOD = $att{CHMOD} +LD = $self->{LD} +TOUCH = $self->{TOUCH} +CP = $self->{CP} +MV = $self->{MV} +RM_F = $self->{RM_F} +RM_RF = $self->{RM_RF} +CHMOD = $self->{CHMOD} +UMASK_NULL = $self->{UMASK_NULL} ".q{ # The following is a portable way to say mkdir -p -MKPATH = $(PERL) -wle '$$"="/"; foreach $$p (@ARGV){ next if -d $$p; my(@p); foreach(split(/\//,$$p)){ push(@p,$$_); next if -d "@p/"; print "mkdir @p"; mkdir("@p",0777)||die $$! }} exit 0;' +# To see which directories are created, change the if 0 to if 1 +MKPATH = $(PERL) -wle '$$"="/"; foreach $$p (@ARGV){' \\ +-e 'next if -d $$p; my(@p); foreach(split(/\//,$$p)){' \\ +-e 'push(@p,$$_); next if -d "@p/"; print "mkdir @p" if 0;' \\ +-e 'mkdir("@p",0777)||die $$! } } exit 0;' }; } +sub dist { + my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@m); + # VERSION should be sanitised before use as a file name + my($name) = $attribs{NAME} || '$(DISTVNAME)'; + my($tar) = $attribs{TAR} || 'tar'; # eg /usr/bin/gnutar + my($tarflags) = $attribs{TARFLAGS} || 'cvf'; + my($compress) = $attribs{COMPRESS} || 'compress'; # eg gzip + my($suffix) = $attribs{SUFFIX} || 'Z'; # eg gz + my($shar) = $attribs{SHAR} || 'shar'; # eg "shar --gzip" + my($preop) = $attribs{PREOP} || '@ true'; # eg update MANIFEST + my($postop) = $attribs{POSTOP} || '@ true'; # eg remove the distdir + my($ci) = $attribs{CI} || 'ci -u'; + my($rcs_label)= $attribs{RCS_LABEL}|| 'rcs -Nv$(VERSION_SYM): -q'; + my($dist_cp) = $attribs{DIST_CP} || 'cp'; + my($dist_default) = $attribs{DIST_DEFAULT} || 'tardist'; -sub post_constants{ - ""; + push @m, " +DISTVNAME = \$(DISTNAME)-\$(VERSION) +TAR = $tar +TARFLAGS = $tarflags +COMPRESS = $compress +SUFFIX = $suffix +SHAR = $shar +PREOP = $preop +POSTOP = $postop +CI = $ci +RCS_LABEL = $rcs_label +DIST_CP = $dist_cp +DIST_DEFAULT = $dist_default +"; + join "", @m; } sub macro { my($self,%attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my(@m,$key,$val); while (($key,$val) = each %attribs){ push @m, "$key = $val\n"; @@ -1313,49 +1667,58 @@ sub macro { join "", @m; } +sub post_constants{ + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + ""; +} + sub pasthru { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my(@m,$key); - # It has to be considered carefully, which variables are apt - # to be passed through, e.g. ALL RELATIV DIRECTORIES are - # not suited for PASTHRU to subdirectories. - # Moreover: No directories at all have a chance, because we - # don't know yet, if the directories are absolute or relativ - - # PASTHRU2 is a conservative approach, that hardly changed - # MakeMaker between version 4.086 and 4.09. - - # PASTHRU1 is a revolutionary approach :), it cares for having - # a prepended "../" whenever runsubdirpl is called, but only - # for the three crucial INST_* directories. - my(@pasthru1,@pasthru2); # 1 for runsubdirpl, 2 for the rest + my(@pasthru); # 1 was for runsubdirpl, 2 for normal make in subdirectories - foreach $key (qw(INST_LIB INST_ARCHLIB INST_EXE)){ - push @pasthru1, "$key=\"\$($key)\""; + foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN + INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A LINKTYPE)){ + push @pasthru, "$key=\"\$($key)\""; } - foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN LIBPERL_A LINKTYPE)){ - push @pasthru1, "$key=\"\$($key)\""; - push @pasthru2, "$key=\"\$($key)\""; - } - - push @m, "\nPASTHRU1 = ", join ("\\\n\t", @pasthru1), "\n"; - push @m, "\nPASTHRU2 = ", join ("\\\n\t", @pasthru2), "\n"; + push @m, "\nPASTHRU = ", join ("\\\n\t", @pasthru), "\n"; join "", @m; } # --- Translation Sections --- sub c_o { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return '' unless $self->needs_linking(); my(@m); push @m, ' -.c.o: +.c.$(OBJ_EXT): $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $(INC) $*.c '; join "", @m; } sub xs_c { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return '' unless $self->needs_linking(); ' .xs.c: $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSUBPPARGS) $*.xs >$*.tc && mv $*.tc $@ @@ -1363,39 +1726,82 @@ sub xs_c { } sub xs_o { # many makes are too dumb to use xs_c then c_o + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return '' unless $self->needs_linking(); ' -.xs.o: +.xs.$(OBJ_EXT): $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSUBPPARGS) $*.xs >xstmp.c && mv xstmp.c $*.c $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $(INC) $*.c '; } - # --- Target Sections --- -sub top_targets{ +sub top_targets { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my(@m); push @m, ' -all :: config linkext $(INST_PM) -'.$att{NOOP}.' +all :: config $(INST_PM) subdirs linkext manifypods + +subdirs :: $(MYEXTLIB) + +'.$self->{NOOP}.' + +config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)/.exists + +config :: $(INST_ARCHAUTODIR)/.exists Version_check -config :: '.$att{MAKEFILE}.' $(INST_LIBDIR)/.exists $(INST_ARCHAUTODIR)/.exists Version_check +config :: $(INST_AUTODIR)/.exists + +config :: $(INST_MAN1DIR)/.exists + +config :: $(INST_MAN3DIR)/.exists '; - push @m, MM->dir_target('$(INST_LIBDIR)', '$(INST_ARCHAUTODIR)', '$(INST_EXE)'); + + +#postamble ist einfach leer! + + # 5.00 breaks with the incomplete rules set up by Tk-b8. We + # introduce the following dependency for Tk-b8: + if ($self->{NAME} eq 'Tk' && $self->{VERSION} eq 'b8') { +# push @m, " +#$(MYEXTLIB) :: +# cd pTk"; + } + + + + + + push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR) + $(INST_MAN1DIR) $(INST_MAN3DIR)]); push @m, ' $(O_FILES): $(H_FILES) -' if @{$att{O_FILES} || []} && @{$att{H} || []}; +' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; push @m, q{ help: - $(PERL) -I$(PERL_LIB) -e 'use ExtUtils::MakeMaker "&help"; &help;' + perldoc ExtUtils::MakeMaker }; push @m, q{ Version_check: - @$(PERL) -I$(PERL_LIB) -e 'use ExtUtils::MakeMaker qw($$Version &Version_check);' \ + @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + -e 'use ExtUtils::MakeMaker qw($$Version &Version_check);' \ -e '&Version_check($(MM_VERSION))' }; @@ -1404,40 +1810,48 @@ Version_check: sub linkext { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } # LINKTYPE => static or dynamic or '' my($linktype) = defined $attribs{LINKTYPE} ? $attribs{LINKTYPE} : '$(LINKTYPE)'; " linkext :: $linktype -$att{NOOP} +$self->{NOOP} "; } sub dlsyms { my($self,%attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } - return '' if ($Config{'osname'} ne 'aix'); + return '' if ($Config::Config{osname} ne 'aix'); - my($funcs) = $attribs{DL_FUNCS} || $att{DL_FUNCS} || {}; - my($vars) = $attribs{DL_VARS} || $att{DL_VARS} || []; + my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; + my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; my(@m); push(@m," -dynamic :: $att{BASEEXT}.exp +dynamic :: $self->{BASEEXT}.exp -") unless $skip{'dynamic'}; +") unless $self->{SKIPHASH}{dynamic}; push(@m," -static :: $att{BASEEXT}.exp +static :: $self->{BASEEXT}.exp -") unless $skip{'static'}; +") unless $self->{SKIPHASH}{static}; push(@m," -$att{BASEEXT}.exp: Makefile.PL +$self->{BASEEXT}.exp: Makefile.PL ",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::MakeMaker qw(&mksymlists); \\ &mksymlists(DL_FUNCS => ', %$funcs ? neatvalue($funcs) : '""',', DL_VARS => ', - @$vars ? neatvalue($vars) : '""', ", NAME => \"$att{NAME}\")' + @$vars ? neatvalue($vars) : '""', ", NAME => \"$self->{NAME}\")' "); join('',@m); @@ -1446,24 +1860,33 @@ $att{BASEEXT}.exp: Makefile.PL # --- Dynamic Loading Sections --- sub dynamic { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } ' # $(INST_PM) has been moved to the all: target. # It remains here for awhile to allow for old usage: "make dynamic" -dynamic :: '.$att{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM) -'.$att{NOOP}.' +dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM) +'.$self->{NOOP}.' '; } sub dynamic_bs { my($self, %attribs) = @_; - return '' unless $self->needs_linking; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return '' unless $self->needs_linking(); ' -BOOTSTRAP = '."$att{BASEEXT}.bs".' +BOOTSTRAP = '."$self->{BASEEXT}.bs".' # As Mkbootstrap might not write a file (if none is required) # we use touch to prevent make continually trying to remake it. # The DynaLoader only reads a non-empty file. -$(BOOTSTRAP): '."$att{MAKEFILE} $att{BOOTDEP}".' +$(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' @ echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" @ $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ -e \'use ExtUtils::Mkbootstrap;\' \ @@ -1473,21 +1896,29 @@ $(BOOTSTRAP): '."$att{MAKEFILE} $att{BOOTDEP}".' @echo $@ >> $(INST_ARCHAUTODIR)/.packlist $(INST_BOOT): $(BOOTSTRAP) - @ '.$att{RM_RF}.' $(INST_BOOT) - -'.$att{CP}.' $(BOOTSTRAP) $(INST_BOOT) + @ '.$self->{RM_RF}.' $(INST_BOOT) + -'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT) $(CHMOD) 644 $@ @echo $@ >> $(INST_ARCHAUTODIR)/.packlist '; } - sub dynamic_lib { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return '' unless $self->needs_linking(); #might be because of a subdir + + return ' +$(INST_DYNAMIC): +' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}); + my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; - my($armaybe) = $attribs{ARMAYBE} || $att{ARMAYBE} || ":"; + my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":"; my($ldfrom) = '$(LDFROM)'; - return '' unless $self->needs_linking; - my($osname) = $Config{'osname'}; + my($osname) = $Config::Config{osname}; $armaybe = 'ar' if ($osname eq 'dec_osf' and $armaybe eq ':'); my(@m); push(@m,' @@ -1496,50 +1927,63 @@ sub dynamic_lib { ARMAYBE = '.$armaybe.' OTHERLDFLAGS = '.$otherldflags.' -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) '); if ($armaybe ne ':'){ - $ldfrom = "tmp.a"; + $ldfrom = "tmp.$(LIB_EXT)"; push(@m,' $(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n"); push(@m,' $(RANLIB) '."$ldfrom\n"); } $ldfrom = "-all $ldfrom -none" if ($osname eq 'dec_osf'); push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ $(LDDLFLAGS) '.$ldfrom. - ' $(OTHERLDFLAGS) $(MYEXTLIB) $(LDLOADLIBS)'); + ' $(OTHERLDFLAGS) $(MYEXTLIB) $(LDLOADLIBS) $(EXPORT_LIST) $(PERL_ARCHIVE)'); push @m, ' $(CHMOD) 755 $@ @echo $@ >> $(INST_ARCHAUTODIR)/.packlist '; - push @m, MM->dir_target('$(INST_ARCHAUTODIR)'); + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('',@m); } - # --- Static Loading Sections --- sub static { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } ' # $(INST_PM) has been moved to the all: target. # It remains here for awhile to allow for old usage: "make static" -static :: '.$att{MAKEFILE}.' $(INST_STATIC) $(INST_PM) -'.$att{NOOP}.' +static :: '.$self->{MAKEFILE}.' $(INST_STATIC) $(INST_PM) +'.$self->{NOOP}.' '; } -sub static_lib{ +sub static_lib { my($self) = @_; - return '' unless $self->needs_linking; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return '' unless $self->needs_linking(); #might be because of a subdir + + return ' +$(INST_DYNAMIC): +' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}); + my(@m); push(@m, <<'END'); $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists END # If this extension has it's own library (eg SDBM_File) # then copy that to $(INST_STATIC) and add $(OBJECT) into it. - push(@m, " $att{CP} \$(MYEXTLIB) \$\@\n") if $att{MYEXTLIB}; + push(@m, " $self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB}; push(@m, <<'END'); - ar cr $@ $(OBJECT) && $(RANLIB) $@ + $(AR) cr $@ $(OBJECT) && $(RANLIB) $@ @echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld $(CHMOD) 755 $@ @echo $@ >> $(INST_ARCHAUTODIR)/.packlist @@ -1547,17 +1991,20 @@ END # Old mechanism - still available: - push(@m, <<'END') if $att{PERL_SRC}; + push(@m, <<'END') if $self->{PERL_SRC}; @ echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs END - push @m, MM->dir_target('$(INST_ARCHAUTODIR)'); + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('', "\n",@m); } - sub installpm { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } # By default .pm files are split into the architecture independent # library. This is a good thing. If a specific module requires that # it's .pm files are split into the architecture specific library @@ -1567,10 +2014,11 @@ sub installpm { my($splitlib) = '$(INST_LIB)'; # NOT arch specific by default $splitlib = $attribs{SPLITLIB} if exists $attribs{SPLITLIB}; my(@m, $dist); - foreach $dist (sort keys %{$att{PM}}){ - my($inst) = $att{PM}->{$dist}; + push @m, "inst_pm :: \$(INST_PM)\n\n"; + foreach $dist (sort keys %{$self->{PM}}){ + my($inst) = $self->{PM}->{$dist}; push(@m, "\n# installpm: $dist => $inst, splitlib=$splitlib\n"); - push(@m, MY->installpm_x($dist, $inst, $splitlib)); + push(@m, $self->installpm_x($dist, $inst, $splitlib)); push(@m, "\n"); } join('', @m); @@ -1578,32 +2026,65 @@ sub installpm { sub installpm_x { # called by installpm per file my($self, $dist, $inst, $splitlib) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } warn "Warning: Most probably 'make' will have problems processing this file: $inst\n" if $inst =~ m![:#]!; my($instdir) = $inst =~ m|(.*)/|; my(@m); push(@m," -$inst: $dist $att{MAKEFILE} $instdir/.exists -".' @ '.$att{RM_F}.' $@ - '."$att{CP} $dist".' $@ - $(CHMOD) 644 $@ - @echo $@ >> $(INST_ARCHAUTODIR)/.packlist +$inst: $dist $self->{MAKEFILE} $instdir/.exists +".' @ '.$self->{RM_F}.' $@ + $(UMASK_NULL) && '."$self->{CP} $dist".' $@ + @ echo $@ >> $(INST_ARCHAUTODIR)/.packlist '); push(@m, "\t\@\$(AUTOSPLITFILE) \$@ $splitlib/auto\n") if ($splitlib and $inst =~ m/\.pm$/); - push @m, MM->dir_target($instdir); + push @m, $self->dir_target($instdir); + join('', @m); +} + +sub manifypods { + my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my($dist); + my(@m); + push @m, +q[POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \\ +-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M "].$self->{MAKEFILE}.q[";' \\ +-e 'print "Installing $$m{$$_}\n";' \\ +-e 'system("pod2man $$_>$$m{$$_}")==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\ +-e 'chmod 0644, $$m{$$_} or warn "chmod 644 $$m{$$_}: $$!\n";}' +]; + push @m, "\nmanifypods :"; + + push(@m,"\n"); + if (%{$self->{MANPODS}}) { + push @m, "\t\@\$(POD2MAN) \\\t"; + push @m, join " \\\n\t", %{$self->{MANPODS}}; + } join('', @m); } sub processPL { - return "" unless $att{PL_FILES}; + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + return "" unless $self->{PL_FILES}; my(@m, $plfile); - foreach $plfile (sort keys %{$att{PL_FILES}}) { + foreach $plfile (sort keys %{$self->{PL_FILES}}) { push @m, " -all :: $att{PL_FILES}->{$plfile} +all :: $self->{PL_FILES}->{$plfile} -$att{PL_FILES}->{$plfile} :: $plfile +$self->{PL_FILES}->{$plfile} :: $plfile \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile "; } @@ -1611,56 +2092,62 @@ $att{PL_FILES}->{$plfile} :: $plfile } sub installbin { - return "" unless $att{EXE_FILES} && ref $att{EXE_FILES} eq "ARRAY"; + my($self) = shift; + return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY"; my(@m, $from, $to, %fromto, @to); - for $from (@{$att{EXE_FILES}}) { - local($_)= '$(INST_EXE)/' . basename($from); - $to = MY->exescan(); - print "exescan($from) => '$to'" if ($Verbose >=2); + push @m, $self->dir_target(qw[$(INST_EXE)]); + for $from (@{$self->{EXE_FILES}}) { + my($path)= '$(INST_EXE)/' . basename($from); + local($_) = $path; # for backwards compatibility + $to = $self->exescan($path); + print "exescan($from) => '$to'\n" if ($ExtUtils::MakeMaker::Verbose >=2); $fromto{$from}=$to; } @to = values %fromto; push(@m, " -EXE_FILES = @{$att{EXE_FILES}} +EXE_FILES = @{$self->{EXE_FILES}} all :: @to realclean :: - $att{RM_F} @to + $self->{RM_F} @to "); while (($from,$to) = each %fromto) { my $todir = dirname($to); push @m, " -$to: $from $att{MAKEFILE} $todir/.exists - $att{CP} $from $to +$to: $from $self->{MAKEFILE} $todir/.exists + $self->{CP} $from $to "; } join "", @m; } sub exescan { - $_; + my($self,$path) = @_; + $path; } # --- Sub-directory Sections --- sub subdirs { - my(@m); + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@m,$dir); # This method provides a mechanism to automatically deal with # subdirectories containing further Makefile.PL scripts. # It calls the subdir_x() method for each subdirectory. - foreach(grep -d, &lsdir()){ - next if /^\./; - next unless -f "$_/Makefile\.PL" ; - print "Including $_ subdirectory" if ($Verbose); - push(@m, MY->subdir_x($_)); + foreach $dir (@{$self->{DIR}}){ + push(@m, $self->subdir_x($dir)); + print "Including $dir subdirectory\n" if $ExtUtils::MakeMaker::Verbose; } if (@m){ unshift(@m, " # The default clean, realclean and test targets in this Makefile # have automatically been given entries for each subdir. -all :: subdirs "); } else { push(@m, "\n# none") @@ -1670,44 +2157,40 @@ all :: subdirs sub runsubdirpl{ # Experimental! See subdir_x section my($self,$subdir) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } chdir($subdir) or die "chdir($subdir): $!"; - ExtUtils::MakeMaker::check_hints(); + #ExtUtils::MakeMaker::check_hints(); package main; require "Makefile.PL"; } sub subdir_x { my($self, $subdir) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my(@m); - # The intention is that the calling Makefile.PL should define the - # $(SUBDIR_MAKEFILE_PL_ARGS) make macro to contain whatever - # information needs to be passed down to the other Makefile.PL scripts. - # If this does not suit your needs you'll need to write your own - # MY::subdir_x() method to override this one. qq{ -config :: $subdir/$att{MAKEFILE} - cd $subdir && \$(MAKE) config \$(PASTHRU2) \$(SUBDIR_MAKEFILE_PL_ARGS) - -$subdir/$att{MAKEFILE}: $subdir/Makefile.PL \$(CONFIGDEP) -}.' @echo "Rebuilding $@ ..." - @$(PERL) -I"$(PERL_ARCHLIB)" -I"$(PERL_LIB)" \\ - -e "use ExtUtils::MakeMaker; MM->runsubdirpl(qw('.$subdir.'))" \\ - $(PASTHRU1) $(SUBDIR_MAKEFILE_PL_ARGS) - @echo "Rebuild of $@ complete." -'.qq{ subdirs :: - cd $subdir && \$(MAKE) all \$(PASTHRU2) + \@ -cd $subdir && \$(MAKE) all \$(PASTHRU) }; } - # --- Cleanup and Distribution Sections --- sub clean { my($self, %attribs) = @_; - my(@m); + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@m,$dir); push(@m, ' # Delete temporary files but do not touch installed files. We don\'t delete # the Makefile here so a later make realclean still has a makefile to use. @@ -1715,20 +2198,33 @@ sub clean { clean :: '); # clean subdirectories first - push(@m, map("\t-cd $_ && test -f $att{MAKEFILE} && \$(MAKE) clean\n",@{$att{DIR}})); - my(@otherfiles) = values %{$att{XS}}; # .c files from *.xs files + for $dir (@{$self->{DIR}}) { + push @m, "\t-cd $dir && test -f $self->{MAKEFILE} && \$(MAKE) clean\n"; + } + + my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; - push(@otherfiles, "./blib"); - push(@m, " -$att{RM_RF} *~ t/*~ *.o *.a mon.out core so_locations " - ."\$(BOOTSTRAP) \$(BASEEXT).bso \$(BASEEXT).exp @otherfiles\n"); + push(@otherfiles, qw[./blib Makeaperlfile $(INST_ARCHAUTODIR)/extralibs.all + perlmain.c mon.out core so_locations + *~ */*~ */*/*~ + *.$(OBJ_EXT) *.$(LIB_EXT) + perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp + ]); + push @m, "\t-$self->{RM_RF} @otherfiles\n"; # See realclean and ext/utils/make_ext for usage of Makefile.old - push(@m, " -$att{MV} $att{MAKEFILE} $att{MAKEFILE}.old 2>/dev/null\n"); - push(@m, " $attribs{POSTOP}\n") if $attribs{POSTOP}; + push(@m, + "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old 2>/dev/null\n"); + push(@m, + "\t$attribs{POSTOP}\n") if $attribs{POSTOP}; join("", @m); } sub realclean { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my(@m); push(@m,' # Delete temporary files (via clean) and also delete installed files @@ -1736,156 +2232,140 @@ realclean purge :: clean '); # realclean subdirectories first (already cleaned) my $sub = "\t-cd %s && test -f %s && \$(MAKE) %s realclean\n"; - foreach(@{$att{DIR}}){ - push(@m, sprintf($sub,$_,"$att{MAKEFILE}.old","-f $att{MAKEFILE}.old")); - push(@m, sprintf($sub,$_,"$att{MAKEFILE}",'')); - } - push(@m, " $att{RM_RF} \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n"); - push(@m, " $att{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n"); - push(@m, " $att{RM_F} \$(INST_STATIC) \$(INST_PM)\n"); - my(@otherfiles) = ($att{MAKEFILE}, - "$att{MAKEFILE}.old"); # Makefiles last + foreach(@{$self->{DIR}}){ + push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old")); + push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",'')); + } + push(@m, " $self->{RM_RF} \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n"); + push(@m, " $self->{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n"); + push(@m, " $self->{RM_F} \$(INST_STATIC) \$(INST_PM)\n"); + my(@otherfiles) = ($self->{MAKEFILE}, + "$self->{MAKEFILE}.old"); # Makefiles last push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; - push(@m, " $att{RM_RF} @otherfiles\n") if @otherfiles; + push(@m, " $self->{RM_RF} @otherfiles\n") if @otherfiles; push(@m, " $attribs{POSTOP}\n") if $attribs{POSTOP}; join("", @m); } - -sub dist { - my($self, %attribs) = @_; - my(@m); - # VERSION should be sanitised before use as a file name - if ($attribs{TARNAME}){ - print STDOUT "Error (fatal): Attribute TARNAME for target dist is deprecated -Please use DISTNAME and VERSION"; +sub dist_basics { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; } - my($name) = $attribs{NAME} || '$(DISTNAME)-$(VERSION)'; - my($tar) = $attribs{TAR} || 'tar'; # eg /usr/bin/gnutar - my($tarflags) = $attribs{TARFLAGS} || 'cvf'; - my($compress) = $attribs{COMPRESS} || 'compress'; # eg gzip - my($suffix) = $attribs{SUFFIX} || 'Z'; # eg gz - my($shar) = $attribs{SHAR} || 'shar'; # eg "shar --gzip" - my($preop) = $attribs{PREOP} || '@ :'; # eg update MANIFEST - my($postop) = $attribs{POSTOP} || '@ :'; # eg remove the distdir - my($ci) = $attribs{CI} || 'ci -u'; - my($rcs) = $attribs{RCS} || 'rcs -Nv$(VERSION_SYM):'; - my($dist_default) = $attribs{DIST_DEFAULT} || 'tardist'; - - push @m, " -TAR = $tar -TARFLAGS = $tarflags -COMPRESS = $compress -SUFFIX = $suffix -SHAR = $shar -PREOP = $preop -POSTOP = $postop -CI = $ci -RCS = $rcs -DIST_DEFAULT = $dist_default -"; - + my @m; push @m, q{ distclean :: realclean distcheck +}; + push @m, q{ distcheck : - $(PERL) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&fullcheck";' \\ + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&fullcheck";' \\ -e 'fullcheck();' +}; + push @m, q{ manifest : - $(PERL) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&mkmanifest";' \\ + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&mkmanifest";' \\ -e 'mkmanifest();' +}; + join "", @m; +} +sub dist_core { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my @m; + push @m, q{ dist : $(DIST_DEFAULT) -tardist : $(DISTNAME)-$(VERSION).tar.$(SUFFIX) +tardist : $(DISTVNAME).tar.$(SUFFIX) -$(DISTNAME)-$(VERSION).tar.$(SUFFIX) : distdir +$(DISTVNAME).tar.$(SUFFIX) : distdir $(PREOP) - $(TAR) $(TARFLAGS) $(DISTNAME)-$(VERSION).tar $(DISTNAME)-$(VERSION) - $(COMPRESS) $(DISTNAME)-$(VERSION).tar - $(RM_RF) $(DISTNAME)-$(VERSION) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar $(POSTOP) -uutardist : $(DISTNAME)-$(VERSION).tar.$(SUFFIX) - uuencode $(DISTNAME)-$(VERSION).tar.$(SUFFIX) \\ - $(DISTNAME)-$(VERSION).tar.$(SUFFIX) > \\ - $(DISTNAME)-$(VERSION).tar.$(SUFFIX).uu +uutardist : $(DISTVNAME).tar.$(SUFFIX) + uuencode $(DISTVNAME).tar.$(SUFFIX) \\ + $(DISTVNAME).tar.$(SUFFIX) > \\ + $(DISTVNAME).tar.$(SUFFIX).uu shdist : distdir $(PREOP) - $(SHAR) $(DISTNAME)-$(VERSION) > $(DISTNAME)-$(VERSION).shar - $(RM_RF) $(DISTNAME)-$(VERSION) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) $(POSTOP) - -distdir : - $(RM_RF) $(DISTNAME)-$(VERSION) - $(PERL) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "/mani/";' \\ - -e 'manicopy(maniread(),"$(DISTNAME)-$(VERSION)");' - - -ci : - $(PERL) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&maniread";' \\ - -e '@all = keys %{maniread()};' \\ - -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\ - -e 'print("Executing $(RCS) ...\n"); system("$(RCS) @all");' - }; join "", @m; } - -# --- Test and Installation Sections --- - -sub test { - my($self, %attribs) = @_; - my($tests) = $attribs{TESTS} || (-d "t" ? "t/*.t" : ""); - my(@m); - push(@m," -TEST_VERBOSE=0 -TEST_TYPE=test_$att{LINKTYPE} - -test :: \$(TEST_TYPE) -"); - push(@m, map("\tcd $_ && test -f $att{MAKEFILE} && \$(MAKE) test \$(PASTHRU2)\n", - @{$att{DIR}})); - push(@m, "\t\@echo 'No tests defined for \$(NAME) extension.'\n") - unless $tests or -f "test.pl" or @{$att{DIR}}; - push(@m, "\n"); - - push(@m, "test_dynamic :: all\n"); - push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests; - push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl"; - push(@m, "\n"); - - push(@m, "test_static :: all \$(MAP_TARGET)\n"); - push(@m, $self->test_via_harness('./$(MAP_TARGET)', $tests)) if $tests; - push(@m, $self->test_via_script('./$(MAP_TARGET)', 'test.pl')) if -f "test.pl"; - push(@m, "\n"); - - join("", @m); +sub dist_dir { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my @m; + push @m, q{ +distdir : + $(RM_RF) $(DISTVNAME) + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "/mani/";' \\ + -e 'manicopy(maniread(),"$(DISTVNAME)", "$(DIST_CP)");' +}; + join "", @m; } -sub test_via_harness { - my($self, $perl, $tests) = @_; - "\t$perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n"; +sub dist_test { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my @m; + push @m, q{ +disttest : distdir + cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL + cd $(DISTVNAME) && $(MAKE) + cd $(DISTVNAME) && $(MAKE) test +}; + join "", @m; } -sub test_via_script { - my($self, $perl, $script) = @_; - "\t$perl".' -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) test.pl -'; +sub dist_ci { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my @m; + push @m, q{ +ci : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&maniread";' \\ + -e '@all = keys %{ maniread() };' \\ + -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\ + -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");' +}; + join "", @m; } - sub install { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my(@m); push @m, q{ doc_install :: @ echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod @ $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \\ - -e "use ExtUtils::MakeMaker; MM->writedoc('Module', '$(NAME)', \\ + -e "use ExtUtils::MakeMaker; MY->new({})->writedoc('Module', '$(NAME)', \\ 'LINKTYPE=$(LINKTYPE)', 'VERSION=$(VERSION)', \\ 'EXE_FILES=$(EXE_FILES)')" >> $(INSTALLARCHLIB)/perllocal.pod }; @@ -1896,15 +2376,16 @@ install :: pure_install doc_install pure_install :: "); # install subdirectories first - push(@m, map("\tcd $_ && test -f $att{MAKEFILE} && \$(MAKE) install\n", - @{$att{DIR}})); - - push(@m, "\t\@\$(PERL) -e 'foreach (\@ARGV){die qq{You do not have permissions to install into \$\$_\\n} unless -w \$\$_}' \$(INSTALLPRIVLIB) \$(INSTALLARCHLIB) - : perl5.000 and MM pre 3.8 autosplit into INST_ARCHLIB, we delete these old files here - $att{RM_F} \$(INSTALLARCHLIB)/auto/\$(FULLEXT)/*.al - $att{RM_F} \$(INSTALLARCHLIB)/auto/\$(FULLEXT)/*.ix - \$(MAKE) INST_LIB=\$(INSTALLPRIVLIB) INST_ARCHLIB=\$(INSTALLARCHLIB) INST_EXE=\$(INSTALLBIN) - \@\$(PERL) -i.bak -lne 'print unless \$\$seen{\$\$_}++' \$(INSTALLARCHLIB)/auto/\$(FULLEXT)/.packlist + push(@m, map("\tcd $_ && test -f $self->{MAKEFILE} && \$(MAKE) install\n", + @{$self->{DIR}})); + + push(@m, "\t\@\$(PERL) \"-I\$(PERL_ARCHLIB)\" \"-I\$(PERL_LIB)\" -e 'require File::Path;' \\ + -e '\$\$message = q[ You do not have permissions to install into];' \\ + -e 'File::Path::mkpath(\@ARGV);' \\ + -e 'foreach (\@ARGV){ die qq{ \$\$message \$\$_\\n} unless -w \$\$_}' \\ + \$(INSTALLPRIVLIB) \$(INSTALLARCHLIB) + \$(MAKE) INST_LIB=\$(INSTALLPRIVLIB) INST_ARCHLIB=\$(INSTALLARCHLIB) INST_EXE=\$(INSTALLBIN) INST_MAN1DIR=\$(INSTALLMAN1DIR) INST_MAN3DIR=\$(INSTALLMAN3DIR) all + \@\$(PERL) -i.bak -lne 'print unless \$\$seen{ \$\$_ }++' \$(INSTALLARCHLIB)/auto/\$(FULLEXT)/.packlist "); push @m, ' @@ -1912,15 +2393,21 @@ pure_install :: uninstall :: '; - push(@m, map("\tcd $_ && test -f $att{MAKEFILE} && \$(MAKE) uninstall\n", - @{$att{DIR}})); + push(@m, map("\tcd $_ && test -f $self->{MAKEFILE} && \$(MAKE) uninstall\n", + @{$self->{DIR}})); push @m, "\t".'$(RM_RF) `cat $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist` '; join("",@m); } + sub force { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } '# Phony target to force checking subdirectories. FORCE: '; @@ -1928,6 +2415,11 @@ FORCE: sub perldepend { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my(@m); push(@m,' PERL_HDRS = $(PERL_INC)/EXTERN.h $(PERL_INC)/INTERN.h \ @@ -1945,7 +2437,7 @@ PERL_HDRS = $(PERL_INC)/EXTERN.h $(PERL_INC)/INTERN.h \ push @m, ' $(OBJECT) : $(PERL_HDRS) -' if $att{OBJECT}; +' if $self->{OBJECT}; push(@m,' # Check for unpropogated config.sh changes. Should never happen. @@ -1957,97 +2449,186 @@ $(PERL_INC)/config.h: $(PERL_SRC)/config.sh $(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh @echo "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh" cd $(PERL_SRC) && $(MAKE) lib/Config.pm -') if $att{PERL_SRC}; +') if $self->{PERL_SRC}; - push(@m, join(" ", values %{$att{XS}})." : \$(XSUBPPDEPS)\n") - if %{$att{XS}}; + push(@m, join(" ", values %{$self->{XS}})." : \$(XSUBPPDEPS)\n") + if %{$self->{XS}}; join("\n",@m); } - sub makefile { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my @m; # We do not know what target was originally specified so we # must force a manual rerun to be sure. But as it should only # happen very rarely it is not a significant problem. push @m, ' -$(OBJECT) : '.$att{MAKEFILE}.' +$(OBJECT) : '.$self->{MAKEFILE}.' +' if $self->{OBJECT}; + push @m, ' # We take a very conservative approach here, but it\'s worth it. # We move Makefile to Makefile.old here to avoid gnu make looping. -'.$att{MAKEFILE}.' : Makefile.PL $(CONFIGDEP) +'.$self->{MAKEFILE}.' : Makefile.PL $(CONFIGDEP) @echo "Makefile out-of-date with respect to $?" @echo "Cleaning current config before rebuilding Makefile..." - -@mv '."$att{MAKEFILE} $att{MAKEFILE}.old".' - -$(MAKE) -f '.$att{MAKEFILE}.'.old clean >/dev/null 2>&1 || true + -@mv '."$self->{MAKEFILE} $self->{MAKEFILE}.old".' + -$(MAKE) -f '.$self->{MAKEFILE}.'.old clean >/dev/null 2>&1 || true $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL '."@ARGV".' - @echo "Now you must rerun make."; false + @echo ">>> Your Makefile has been rebuilt. <<<" + @echo ">>> Please rerun the make command. <<<"; false '; join "", @m; } -sub postamble{ - ""; -} +sub staticmake { + my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@static); -# --- Make-Directories section (internal method) --- -# dir_target(@array) returns a Makefile entry for the file .exists in each -# named directory. Returns nothing, if the entry has already been processed. -# We're helpless though, if the same directory comes as $(FOO) _and_ as "bar". -# Both of them get an entry, that's why we use "::". I chose '$(PERL)' as the -# prerequisite, because there has to be one, something that doesn't change -# too often :) -%Dir_Target = (); # package global + my(%searchdirs)=($self->{PERL_ARCHLIB} => 1, $self->{INST_ARCHLIB} => 1); + my(@searchdirs)=keys %searchdirs; -sub dir_target { - my($self,@dirs) = @_; - my(@m,$dir); - foreach $dir (@dirs) { - next if $Dir_Target{$dir}; - push @m, " -$dir/.exists :: \$(PERL) - \@ \$(MKPATH) $dir - \@ \$(TOUCH) $dir/.exists -"; - $Dir_Target{$dir}++; + # And as it's not yet built, we add the current extension + # but only if it has some C code (or XS code, which implies C code) + if (@{$self->{C}}) { + @static="$self->{INST_ARCHLIB}/auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{LIB_EXT}"; } - join "", @m; + + # Either we determine now, which libraries we will produce in the + # subdirectories or we do it at runtime of the make. + + # We could ask all subdir objects, but I cannot imagine, why it + # would be necessary. + + # Instead we determine all libraries for the new perl at + # runtime. + my(@perlinc) = ($self->{INST_ARCHLIB}, $self->{INST_LIB}, $self->{PERL_ARCHLIB}, $self->{PERL_LIB}); + + $self->makeaperl(MAKE => $self->{MAKEFILE}, + DIRS => \@searchdirs, + STAT => \@static, + INCL => \@perlinc, + TARGET => $self->{MAP_TARGET}, + TMP => "", + LIBPERL => $self->{LIBPERL_A} + ); } -# --- Make-A-Perl section --- +# --- Test and Installation Sections --- -sub staticmake { +sub test { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my($tests) = $attribs{TESTS} || (-d "t" ? "t/*.t" : ""); + my(@m); + push(@m," +TEST_VERBOSE=0 +TEST_TYPE=test_\$(LINKTYPE) - my(%searchdirs)=($att{PERL_ARCHLIB} => 1, $att{INST_ARCHLIB} => 1); - my(@searchdirs)=keys %searchdirs; - # And as it's not yet built, we add the current extension - my(@static)="$att{INST_ARCHLIB}/auto/$att{FULLEXT}/$att{BASEEXT}.a"; - my(@perlinc) = ($att{INST_ARCHLIB}, $att{INST_LIB}, $att{PERL_ARCHLIB}, $att{PERL_LIB}); - MY->makeaperl('MAKE' => $att{MAKEFILE}, - 'DIRS' => \@searchdirs, - 'STAT' => \@static, - 'INCL' => \@perlinc, - 'TARGET' => $att{MAP_TARGET}, - 'TMP' => "", - 'LIBPERL' => $att{LIBPERL_A} - ); +test :: \$(TEST_TYPE) +"); + push(@m, map("\t\@cd $_ && test -f $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n", + @{$self->{DIR}})); + push(@m, "\t\@echo 'No tests defined for \$(NAME) extension.'\n") + unless $tests or -f "test.pl" or @{$self->{DIR}}; + push(@m, "\n"); + + push(@m, "test_dynamic :: all\n"); + push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests; + push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl"; + push(@m, "\n"); + + # Occasionally we may face this degenerated target: + push @m, "test_ : test_dynamic\n\n"; + + if ($self->needs_linking()) { + push(@m, "test_static :: all \$(MAP_TARGET)\n"); + push(@m, $self->test_via_harness('./$(MAP_TARGET)', $tests)) if $tests; + push(@m, $self->test_via_script('./$(MAP_TARGET)', 'test.pl')) if -f "test.pl"; + push(@m, "\n"); + } else { + push @m, "test_static :: test_dynamic\n"; + } + join("", @m); +} + +sub test_via_harness { + my($self, $perl, $tests) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + "\tPERL_DL_NONLAZY=1 $perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n"; +} + +sub test_via_script { + my($self, $perl, $script) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + "\tPERL_DL_NONLAZY=1 $perl".' -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) test.pl +'; +} + + +sub postamble { + my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + ""; } sub makeaperl { my($self, %attribs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = - @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; + @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; my(@m); - my($cccmd, $linkcmd); + push @m, " +# --- MakeMaker makeaperl section --- +MAP_TARGET = $target +FULLPERL = $self->{FULLPERL} +"; + return join '', @m if $self->{PARENT}; + + unless ($self->{MAKEAPERL}) { + push @m, ' +$(MAP_TARGET) :: + $(MAKE) LINKTYPE=static all + $(PERL) Makefile.PL MAKEFILE=Makefile.aperl LINKTYPE=static MAKEAPERL=1 NORECURS=1 + $(MAKE) -f Makefile.aperl $(MAP_TARGET) +'; + return join '', @m; + } + + + + my($cccmd, $linkcmd, $lperl); + - # This emulates cflags to get the compiler invocation... - $cccmd = MY->const_cccmd($libperl); + $cccmd = $self->const_cccmd($libperl); $cccmd =~ s/^CCCMD\s*=\s*//; - chomp $cccmd; - $cccmd =~ s/\s/ -I$att{PERL_INC} /; - $cccmd .= " $Config{'cccdlflags'}" if ($Config{'d_shrplib'}); + $cccmd =~ s/\s/ -I$self->{PERL_INC} /; + $cccmd .= " $Config::Config{cccdlflags}" if ($Config::Config{d_shrplib}); + $cccmd =~ s/\n/ /g; # yes I've seen "\n", don't ask me where it came from. A.K. # The front matter of the linkcommand... $linkcmd = join ' ', "\$(CC)", @@ -2057,10 +2638,16 @@ sub makeaperl { # Which *.a files could we make use of... local(%static); File::Find::find(sub { - return unless m/\.a$/; + return unless m/\.$self->{LIB_EXT}$/; return if m/^libperl/; - # don't include the installed version of this extension - return if $File::Find::name =~ m:auto/$att{FULLEXT}/$att{BASEEXT}.a$:; + # don't include the installed version of this extension. I + # leave this line here, although it is not necessary anymore: + # I patched minimod.PL instead, so that Miniperl.pm won't + # enclude duplicates + + # Once the patch to minimod.PL is in the distribution, I can + # drop it + return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{LIB_EXT}$:; $static{fastcwd() . "/" . $_}++; }, grep( -d $_, @{$searchdirs || []}) ); @@ -2070,33 +2657,41 @@ sub makeaperl { $extra = [] unless $extra && ref $extra eq 'ARRAY'; for (sort keys %static) { - next unless /\.a$/; + next unless /\.$self->{LIB_EXT}$/; $_ = dirname($_) . "/extralibs.ld"; push @$extra, $_; } - grep(s/^/-I/, @$perlinc); + grep(s/^/-I/, @{$perlinc || []}); $target = "perl" unless $target; $tmp = "." unless $tmp; +# MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we +# regenerate the Makefiles, MAP_STATIC and the dependencies for +# extralibs.all are computed correctly push @m, " -# --- MakeMaker makeaperl section --- -MAP_TARGET = $target -FULLPERL = $att{'FULLPERL'} MAP_LINKCMD = $linkcmd -MAP_PERLINC = @{$perlinc} +MAP_PERLINC = @{$perlinc || []} MAP_STATIC = ", -join(" ", sort keys %static), " -MAP_PRELIBS = $Config{'libs'} $Config{'cryptlib'} +join(" \\\n\t", sort keys %static), " + +MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} "; - unless ($libperl && -f $libperl) { - my $dir = $att{PERL_SRC} || "$att{PERL_ARCHLIB}/CORE"; - $libperl ||= "libperl.a"; - $libperl = "$dir/$libperl"; - print STDOUT "Warning: $libperl not found" - unless (-f $libperl || defined($att{PERL_SRC})); + if (defined $libperl) { + ($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/; + } + unless ($libperl && -f $lperl) { # Could quite follow your idea her, Ilya + my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE"; + $libperl ||= "libperl.$self->{LIB_EXT}"; + $libperl = "$dir/$libperl"; + $lperl ||= "libperl.$self->{LIB_EXT}"; + $lperl = "$dir/$lperl"; + print STDOUT "Warning: $libperl not found + If you're going to build a static perl binary, make sure perl is installed + otherwise ignore this warning\n" + unless (-f $lperl || defined($self->{PERL_SRC})); } push @m, " @@ -2104,24 +2699,25 @@ MAP_LIBPERL = $libperl "; push @m, " -extralibs.ld: @$extra - \@ $att{RM_F} \$\@ +\$(INST_ARCHAUTODIR)/extralibs.all: \$(INST_ARCHAUTODIR)/.exists ".join(" \\\n\t", @$extra)." + \@ $self->{RM_F} \$\@ \@ \$(TOUCH) \$\@ "; - foreach (@$extra){ - push @m, "\tcat $_ >> \$\@\n"; + my $catfile; + foreach $catfile (@$extra){ + push @m, "\tcat $catfile >> \$\@\n"; } push @m, " -\$(MAP_TARGET): $tmp/perlmain.o \$(MAP_LIBPERL) \$(MAP_STATIC) extralibs.ld - \$(MAP_LINKCMD) -o \$\@ $tmp/perlmain.o \$(MAP_LIBPERL) \$(MAP_STATIC) `cat extralibs.ld` \$(MAP_PRELIBS) +\$(MAP_TARGET) :: $tmp/perlmain.\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all + \$(MAP_LINKCMD) -o \$\@ $tmp/perlmain.\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS) @ echo 'To install the new \"\$(MAP_TARGET)\" binary, call' @ echo ' make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)' @ echo 'To remove the intermediate files say' @ echo ' make -f $makefilename map_clean' -$tmp/perlmain.o: $tmp/perlmain.c +$tmp/perlmain.\$(OBJ_EXT): $tmp/perlmain.c "; push @m, "\tcd $tmp && $cccmd perlmain.c\n"; @@ -2137,22 +2733,22 @@ $tmp/perlmain.c: $makefilename}, q{ push @m, q{ doc_inst_perl: @ echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod - @ $(FULLPERL) -e 'use ExtUtils::MakeMaker; MM->writedoc("Perl binary",' \\ + @ $(FULLPERL) -e 'use ExtUtils::MakeMaker; MY->new->writedoc("Perl binary",' \\ -e '"$(MAP_TARGET)", "MAP_STATIC=$(MAP_STATIC)",' \\ -e '"MAP_EXTRA=@ARGV", "MAP_LIBPERL=$(MAP_LIBPERL)")' \\ - -- `cat extralibs.ld` >> $(INSTALLARCHLIB)/perllocal.pod + -- `cat $(INST_ARCHAUTODIR)/extralibs.all` >> $(INSTALLARCHLIB)/perllocal.pod }; push @m, qq{ inst_perl: pure_inst_perl doc_inst_perl pure_inst_perl: \$(MAP_TARGET) - $att{CP} \$(MAP_TARGET) \$(INSTALLBIN)/\$(MAP_TARGET) + $self->{CP} \$(MAP_TARGET) \$(INSTALLBIN)/\$(MAP_TARGET) clean :: map_clean map_clean : - $att{RM_F} $tmp/perlmain.o $tmp/perlmain.c \$(MAP_TARGET) extralibs.ld + $self->{RM_F} $tmp/perlmain.\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all }; join '', @m; @@ -2160,32 +2756,40 @@ map_clean : sub extliblist { my($self,$libs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } require ExtUtils::Liblist; - ExtUtils::Liblist::ext($libs, $Verbose); + ExtUtils::Liblist::ext($libs, $ExtUtils::MakeMaker::Verbose); } sub mksymlists { my($self) = shift; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my($pkg); # only AIX requires a symbol list at this point # (so does VMS, but that's handled by the MM_VMS package) - return '' unless $Config{'osname'} eq 'aix'; + return '' unless $Config::Config{osname} eq 'aix'; - init_main(@ARGV) unless defined $att{'BASEEXT'}; - if (! $att{DL_FUNCS}) { + $self->init_main(@ARGV) unless defined $self->{BASEEXT}; + if (! $self->{DL_FUNCS}) { my($bootfunc); - ($bootfunc = $att{NAME}) =~ s/\W/_/g; - $att{DL_FUNCS} = {$att{BASEEXT} => ["boot_$bootfunc"]}; + ($bootfunc = $self->{NAME}) =~ s/\W/_/g; + $self->{DL_FUNCS} = {$self->{BASEEXT} => ["boot_$bootfunc"]}; } - rename "$att{BASEEXT}.exp", "$att{BASEEXT}.exp_old"; + rename "$self->{BASEEXT}.exp", "$self->{BASEEXT}.exp_old"; - open(EXP,">$att{BASEEXT}.exp") or die $!; - print EXP join("\n",@{$att{DL_VARS}}) if $att{DL_VARS}; - foreach $pkg (keys %{$att{DL_FUNCS}}) { + open(EXP,">$self->{BASEEXT}.exp") or die $!; + print EXP join("\n",@{$self->{DL_VARS}}, "\n") if $self->{DL_VARS}; + foreach $pkg (keys %{$self->{DL_FUNCS}}) { (my($prefix) = $pkg) =~ s/\W/_/g; my $func; - foreach $func (@{$att{DL_FUNCS}->{$pkg}}) { + foreach $func (@{$self->{DL_FUNCS}->{$pkg}}) { $func = "XS_${prefix}_$func" unless $func =~ /^boot_/; print EXP "$func\n"; } @@ -2193,46 +2797,141 @@ sub mksymlists { close EXP; } +# --- Make-Directories section (internal method) --- +# dir_target(@array) returns a Makefile entry for the file .exists in each +# named directory. Returns nothing, if the entry has already been processed. +# We're helpless though, if the same directory comes as $(FOO) _and_ as "bar". +# Both of them get an entry, that's why we use "::". I chose '$(PERL)' as the +# prerequisite, because there has to be one, something that doesn't change +# too often :) + +sub dir_target { + my($self,@dirs) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + my(@m,$dir); + foreach $dir (@dirs) { + next if $self->{DIR_TARGET}{$self}{$dir}++; + push @m, " +$dir/.exists :: \$(PERL) + \@ \$(MKPATH) $dir + \@ \$(TOUCH) $dir/.exists + \@-\$(CHMOD) 755 $dir +"; + } + join "", @m; +} + # --- Output postprocessing section --- -#nicetext is included to make VMS support easier +# nicetext is included to make VMS support easier sub nicetext { # Just return the input - no action needed my($self,$text) = @_; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } $text; } +sub needs_linking { # Does this module need linking? Looks into + # subdirectory objects (see also has_link_code() + my($self) = shift; + my($child,$caller); + $caller = (caller(0))[3]; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse($caller); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } + Carp::confess("Needs_linking called too early") if $caller =~ /^ExtUtils::MakeMaker::/; + return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING}; +# print "DEBUG:\n"; +# print Carp::longmess(); +# print "EO_DEBUG\n"; + if ($self->has_link_code){ + $self->{NEEDS_LINKING} = 1; + return 1; + } + foreach $child (keys %{$self->{CHILDREN}}) { + if ($self->{CHILDREN}->{$child}->needs_linking) { + $self->{NEEDS_LINKING} = 1; + return 1; + } + } + return $self->{NEEDS_LINKING} = 0; +} + +sub has_link_code { + my($self) = shift; + return $self->{HAS_LINK_CODE} if defined $self->{HAS_LINK_CODE}; + if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB} or $self->{MAKEAPERL}){ + $self->{HAS_LINK_CODE} = 1; + return 1; + } + return $self->{HAS_LINK_CODE} = 0; +} + # --- perllocal.pod section --- sub writedoc { my($self,$what,$name,@attribs)=@_; -# the following would have to move to a ExtUtils::Perllocal.pm, if we want it -# it's dangerous wrt AFS, and it's against the philosophy that MakeMaker -# should never write to files. We write to stdout and append to the file -# during make install, but we cannot rely on '-f $Config{"installarchlib"}, -# as there is a time window between the WriteMakefile and the make. -# -w $Config{'installarchlib'} or die "No write permission to $Config{'installarchlib'}"; -# my($localpod) = "$Config{'installarchlib'}/perllocal.pod"; + unless (ref $self){ + ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]); + $self = $ExtUtils::MakeMaker::Parent[-1]; + } my($time); -# if (-f $localpod) { -# print "Appending installation info to $localpod\n"; -# open POD, ">>$localpod" or die "Couldn't open $localpod"; -# } else { -# print "Writing new file $localpod\n"; -# open POD, ">$localpod" or die "Couldn't open $localpod"; -# print POD "=head1 NAME -# -#perllocal - locally installed modules and perl binaries -#\n=head1 HISTORY OF LOCAL INSTALLATIONS -# -#"; -# } require "ctime.pl"; chop($time = ctime(time)); print "=head2 $time: $what C<$name>\n\n=over 4\n\n=item *\n\n"; print join "\n\n=item *\n\n", map("C<$_>",@attribs); print "\n\n=back\n\n"; -# close POD; } +sub catdir { shift; join('/',@_); } +sub catfile { shift; join('/',@_); } + +package ExtUtils::MM_OS2; + +#use Config; +#use Cwd; +#use File::Basename; +require Exporter; + +Exporter::import('ExtUtils::MakeMaker', + qw( $Verbose)); + +sub dlsyms { + my($self,%attribs) = @_; + + my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; + my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my(@m); + (my $boot = $self->{NAME}) =~ s/:/_/g; + + if (not $self->{SKIPHASH}{'dynamic'}) { + push(@m," +$self->{BASEEXT}.def: Makefile.PL" + . ' + echo "LIBRARY ' . "'$self->{DLBASE}'" . ' INITINSTANCE TERMINSTANCE" > $@ ; \\ + echo "CODE LOADONCALL" >> $@ ; \\ + echo "DATA LOADONCALL NONSHARED MULTIPLE" >> $@ ; \\ + echo "EXPORTS" >> $@ ; \\ + echo " ' . "boot_$boot" . '" >> $@'); + foreach $sym (keys %$funcs, @$vars) { + push(@m, " ; \\ + echo \" $sym\" >> \$@"); + } + push(@m,"\n"); + } + join('',@m); +} + +sub replace_manpage_seperator { + my($self,$man) = @_; + $man =~ s,/+,.,g; + $man; +} # the following keeps AutoSplit happy package ExtUtils::MakeMaker; @@ -2250,6 +2949,10 @@ C<use ExtUtils::MakeMaker;> C<WriteMakefile( ATTRIBUTE =E<gt> VALUE [, ...] );> +which is really + +C<MM-E<gt>new(\%att)-E<gt>flush;> + =head1 DESCRIPTION This utility is designed to write a Makefile for an extension module @@ -2261,15 +2964,90 @@ that can be individually overridden. Each subroutine returns the text it wishes to have written to the Makefile. MakeMaker.pm uses the architecture specific information from -Config.pm. In addition the extension may contribute to the C<%Config> -hash table of Config.pm by supplying hints files in a C<hints/> -directory. The hints files are expected to be named like their -counterparts in C<PERL_SRC/hints>, but with an C<.pl> file name -extension (eg. C<next_3_2.pl>). They are simply C<eval>ed by MakeMaker -within the WriteMakefile() subroutine, and can be used to execute -commands as well as to include special variables. If there is no -hintsfile for the actual system, but for some previous releases of the -same operating system, the latest one of those is used. +Config.pm. In addition it evaluates architecture specific hints files +in a C<hints/> directory. The hints files are expected to be named +like their counterparts in C<PERL_SRC/hints>, but with an C<.pl> file +name extension (eg. C<next_3_2.pl>). They are simply C<eval>ed by +MakeMaker within the WriteMakefile() subroutine, and can be used to +execute commands as well as to include special variables. The rules +which hintsfile is chosen are the same as in Configure. + +=head2 What's new in version 5 of MakeMaker + +MakeMaker 5 is pure object oriented. This allows us to write an +unlimited number of Makefiles with a single perl process. 'perl +Makefile.PL' with MakeMaker 5 goes through all subdirectories +immediately and evaluates any Makefile.PL found in the next level +subdirectories. The benefit of this approach comes in useful for both +single and multi directories extensions. + +Multi directory extensions have an immediately visible speed +advantage, because there's no startup penalty for any single +subdirectory Makefile. + +Single directory packages benefit from the much improved +needs_linking() method. As the main Makefile knows everything about +the subdirectories, a needs_linking() method can now query all +subdirectories if there is any linking involved down in the tree. The +speedup for PM-only Makefiles seems to be around 1 second on my +Indy 100 MHz. + +=head2 Incompatibilities between MakeMaker 5.00 and 4.23 + +There are no incompatibilities in the short term, as all changes are +accompanied by short-term workarounds that guarantee full backwards +compatibility. + +You are likely to face a few warnings that expose depreciations which +will result in incompatibilities in the long run: + +You should not use %att directly anymore. Instead any subroutine you +override in the MY package will be called by the object method, so you +can access all object attributes directly via the object in $_[0]. + +You should not call the class methos MM->something anymore. Instead +you should call the superclass. Something like + + sub MY::constants { + my $self = shift; + local *constants; + $self->MM::constants(); + } + +Especially the libscan() and exescan() methods should be altered +towards OO programming, that means do not expect that $_ to contain +the path but rather $_[1]. + +You should program with more care. Watch out for any MakeMaker +variables. Do not try to alter them, somebody else might depend on +them. E.g. do not overwrite the ExtUtils::MakeMaker::VERSION variable +(this happens if you import it and then set it to the version number +of your package), do not expect that the INST_LIB variable will be +./blib (do not 'unshift @INC, "./blib" and do not use +"blib/FindBin.pm"). Do not croak in your Makefile.PL, let it fail with +a warning instead. + +Try to build several extensions simultanously to debug your +Makefile.PL. You can unpack a bunch of distributed packages, so your +directory looks like + + Alias-1.00/ Net-FTP-1.01a/ Set-Scalar-0.001/ + ExtUtils-Peek-0.4/ Net-Ping-1.00/ SetDualVar-1.0/ + Filter-1.06/ NetTools-1.01a/ Storable-0.1/ + GD-1.00/ Religion-1.04/ Sys-Domain-1.05/ + MailTools-1.03/ SNMP-1.5b/ Term-ReadLine-0.7/ + +and write a dummy Makefile.PL that contains nothing but + + use ExtUtils::MakeMaker; + WriteMakefile(); + +That's actually fun to watch :) + +Final suggestion: Try to delete all of your MY:: subroutines and +watch, if you really still need them. MakeMaker might already do what +you want without them. That's all about it. + =head2 Default Makefile Behaviour @@ -2278,29 +3056,30 @@ to invoke perl Makefile.PL # optionally "perl Makefile.PL verbose" make - make test # optionally set TEST_VERBOSE=1 - make install # See below + make test # optionally set TEST_VERBOSE=1 + make install # See below The Makefile to be produced may be altered by adding arguments of the form C<KEY=VALUE>. If the user wants to work with a different perl -than the default, this is achieved by specifying +than the default, this can be achieved with perl Makefile.PL PERL=/tmp/myperl5 Other interesting targets in the generated Makefile are make config # to check if the Makefile is up-to-date - make clean # delete local temporary files (Makefile gets renamed) - make realclean # delete all derived files (including installed files) + make clean # delete local temp files (Makefile gets renamed) + make realclean # delete derived files (including ./blib) make dist # see below the Distribution Support section -=head2 Special case C<make install> +=head2 Special case make install -C<make> alone puts all relevant files into directories that are named -by the macros INST_LIB, INST_ARCHLIB, and INST_EXE. All three default -to ./blib if you are I<not> building below the perl source directory. If -you I<are> building below the perl source, INST_LIB and INST_ARCHLIB -default to ../../lib, and INST_EXE is not defined. +make alone puts all relevant files into directories that are named by +the macros INST_LIB, INST_ARCHLIB, INST_EXE, INST_MAN1DIR, and +INST_MAN3DIR. All these default to ./blib or something below blib if +you are I<not> building below the perl source directory. If you I<are> +building below the perl source, INST_LIB and INST_ARCHLIB default to +../../lib, and INST_EXE is not defined. The I<install> target of the generated Makefile is a recursive call to make which sets @@ -2308,15 +3087,17 @@ make which sets INST_LIB to INSTALLPRIVLIB INST_ARCHLIB to INSTALLARCHLIB INST_EXE to INSTALLBIN + INST_MAN1DIR to INSTALLMAN1DIR + INST_MAN3DIR to INSTALLMAN3DIR -The three INSTALL... macros in turn default to -$Config{installprivlib}, $Config{installarchlib}, and -$Config{installbin} respectively. +The INSTALL... macros in turn default to their %Config +($Config{installprivlib}, $Config{installarchlib}, etc.) counterparts. The recommended way to proceed is to set only the INSTALL* macros, not the INST_* targets. In doing so, you give room to the compilation -process without affecting important directories. Usually a 'make test' -will succeed after the make, and a 'make install' can finish the game. +process without affecting important directories. Usually a make +test will succeed after the make, and a make install can finish +the game. MakeMaker gives you much more freedom than needed to configure internal variables and get different results. It is worth to mention, @@ -2327,40 +3108,27 @@ recommends it. The usual relationship between INSTALLPRIVLIB and INSTALLARCHLIB is that the latter is a subdirectory of the former with the name -C<$Config{'archname'}>, MakeMaker supports the user who sets +C<$Config{archname}>, MakeMaker supports the user who sets INSTALLPRIVLIB. If INSTALLPRIVLIB is set, but INSTALLARCHLIB not, then MakeMaker defaults the latter to be INSTALLPRIVLIB/ARCHNAME if that directory exists, otherwise it defaults to INSTALLPRIVLIB. -Previous versions of MakeMaker suggested to use the INST_* macros. For -backwards compatibility, these are still supported but deprecated in -favor of the INSTALL* macros. -Here is the description, what they are used for: If the user specifies -the final destination for the INST_... macros, then there is no need -to call 'make install', because 'make' will already put all files in -place. +=head2 PREFIX attribute -If there is a need to first build everything in the C<./blib> -directory and test the product, then it's appropriate to use the -INSTALL... macros. So the users have the choice to either say +The PREFIX attribute can be used to set the INSTALL* +attributes in one go. This is the quickest way to install a module in +a non-standard place. - # case: trust the module - perl Makefile.PL INST_LIB=~/perllib INST_EXE=~/bin - make - make test + perl Makefile.PL PREFIX=~ -or +This is identical to - perl Makefile.PL INSTALLPRIVLIB=~/foo \ - INSTALLARCHLIB=~/foo/bar INSTALLBIN=~/bin - make - make test - make install + perl Makefile.PL INSTALLPRIVLIB=~/perl5/lib INSTALLBIN=~/bin \ + INSTAMAN1DIR=~/perl5/man/man1 INSTALLMAN3DIR=~/perl5/man/man3 Note, that the tilde expansion is done by MakeMaker, not by perl by -default, nor by make. So be careful to use the tilde only with the -C<perl Makefile.PL> call. +default, nor by make. It is important to know, that the INSTALL* macros should be absolute paths, never relativ ones. Packages with multiple Makefile.PLs in @@ -2370,20 +3138,35 @@ relativ paths, but not the INSTALL* macros.) If the user has superuser privileges, and is not working on AFS (Andrew File System) or relatives, then the defaults for -INSTALLPRIVLIB, INSTALLARCHLIB, and INSTALLBIN will be appropriate, +INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLBIN, etc. will be appropriate, and this incantation will be the best: perl Makefile.PL; make; make test make install -(I<make test> is not necessarily supported for all modules.) +make install per default writes some documentation of what has been +done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This is +an experimental feature. It can be bypassed by calling make +pure_install. -C<make install> per default writes some documentation of what has been -done into the file C<$Config{'installarchlib'}/perllocal.pod>. This is -an experimental feature. It can be bypassed by calling C<make -pure_install>. +=head2 AFS users -=head2 Support to Link a new Perl Binary (eg dynamic loading not available) +will have to specify the installation directories as these most +probably have changed since perl itself has been installed. They will +have to do this by calling + + perl Makefile.PL INSTALLPRIVLIB=/afs/here/today \ + INSTALLBIN=/afs/there/now INSTALLMAN3DIR=/afs/for/manpages + make + +In nested extensions with many subdirectories, the INSTALL* arguments +will get propagated to the subdirectories. Be careful to repeat this +procedure every time you recompile an extension, unless you are sure +the AFS istallation directories are still valid. + + + +=head2 Static Linking of a new Perl Binary An extension that is built with the above steps is ready to use on systems supporting dynamic loading. On systems that do not support @@ -2395,8 +3178,8 @@ is built. You can invoke the corresponding section of the makefile with make perl That produces a new perl binary in the current directory with all -extensions linked in that can be found in INST_ARCHLIB (usually -C<./blib>) and PERL_ARCHLIB. +extensions linked in that can be found in INST_ARCHLIB (which usually +is C<./blib>) and PERL_ARCHLIB. The binary can be installed into the directory where perl normally resides on your machine with @@ -2422,13 +3205,23 @@ Note, that there is a C<makeaperl> scipt in the perl distribution, that supports the linking of a new perl binary in a similar fashion, but with more options. -C<make inst_perl> per default writes some documentation of what has been -done into the file C<$Config{'installarchlib'}/perllocal.pod>. This -can be bypassed by calling C<make pure_inst_perl>. +make inst_perl per default writes some documentation of what has been +done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This +can be bypassed by calling make pure_inst_perl. Warning: the inst_perl: target is rather mighty and will probably overwrite your existing perl binary. Use with care! +Sometimes you might want to build a statically linked perl although +your system supports dynamic loading. In this case you may explicitly +set the linktype with the invocation of the Makefile.PL or make: + + perl Makefile.PL LINKTYPE=static # recommended + +or + + make LINKTYPE=static # works on most systems + =head2 Determination of Perl Library and Installation Locations MakeMaker needs to know, or to guess, where certain things are @@ -2457,7 +3250,7 @@ of the perl library. The other variables default to the following: PERL_LIB = $privlib PERL_ARCHLIB = $archlib INST_LIB = ./blib - INST_ARCHLIB = ./blib + INST_ARCHLIB = ./blib/<archname> If perl has not yet been installed then PERL_SRC can be defined on the command line as shown in the previous section. @@ -2470,48 +3263,375 @@ BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) -PERL_LIB = Directory where we read the perl library files - -PERL_ARCHLIB = Same as above for architecture dependent files - -INST_LIB = Directory where we put library files of this extension -while building it. If we are building below PERL_SRC/ext -we default to PERL_SRC/lib, else we default to ./blib. - -INST_ARCHLIB = Same as above for architecture dependent files - INST_LIBDIR = C<$(INST_LIB)$(ROOTEXT)> INST_AUTODIR = C<$(INST_LIB)/auto/$(FULLEXT)> INST_ARCHAUTODIR = C<$(INST_ARCHLIB)/auto/$(FULLEXT)> -=head2 Customizing The Generated Makefile - -If the Makefile generated does not fit your purpose you can change it -using the mechanisms described below. - =head2 Using Attributes (and Parameters) The following attributes can be specified as arguments to WriteMakefile() or as NAME=VALUE pairs on the command line: -This description is not yet documented; you can get at the description -with one of the commands +=cut -=over 4 +# The following "=item NAME" is used by the attrib_help routine +# likewise the "=back" below. So be careful when changing it! + +=over 2 + +=item NAME + +Perl module name for this extension (DBD::Oracle). This will default +to the directory name but should be explicitly defined in the +Makefile.PL. + +=item DISTNAME + +Your name for distributing the package (by tar file) This defaults to +NAME above. + +=item VERSION + +Your version number for distributing the package. This defaults to +0.1. + +=item CONFIGURE + +CODE reference. Extension writers are requested to do all their +initializing within that subroutine. The subroutine +should return a hash reference. The hash may contain +further attributes, e.g. {LIBS => ...}, that have to +be determined by some evaluation method. + +=item NEEDS_LINKING + +MakeMaker will figure out, if an extension contains linkable code +anywhere down the directory tree, but you can speed him up a little +bit, if you define this boolean variable yourself. Extensions that do +not need linking will be given a reduced Makefile yielding a +considerable speedadvantage. + +=item INST_LIB + +Directory where we put library files of this extension while building +it. + +=item INSTALLPRIVLIB + +Used by 'make install', which sets INST_LIB to this value. + +=item INST_ARCHLIB + +Same as INST_LIB for architecture dependent files. + +=item INSTALLARCHLIB + +Used by 'make install', which sets INST_ARCHLIB to this value. + +=item INST_EXE + +Directory, where executable scripts should be installed during +'make'. Defaults to "./blib/ARCHNAME", just to have a dummy +location during testing. make install will set +INST_EXE to INSTALLBIN. + +=item INSTALLBIN + +Used by 'make install' which sets INST_EXE to this value. + +=item INST_MAN1DIR + +=item INST_MAN3DIR + +These directories get the man pages at 'make' time + +=item INSTALLMAN1DIR + +=item INSTALLMAN3DIR + +These directories get the man pages at 'make install' time + +=item PREFIX + +Can be used to set the three INSTALL* attributes above in one go. +They will have PREFIX as a common directory node and +will branch from that node into lib/, lib/ARCHNAME, +and bin/ unless you override one of them. + +=item PERL_LIB + +Directory containing the Perl library to use. + +=item PERL_ARCHLIB + +Same as above for architecture dependent files + +=item PERL_SRC + +Directory containing the Perl source code (use of this should be +avoided, it may be undefined) + +=item INC + +Include file dirs eg: C<"-I/usr/5include -I/path/to/inc"> + +=item DEFINE + +Something like C<"-DHAVE_UNISTD_H"> + +=item OBJECT + +List of object files, defaults to '$(BASEEXT).$(OBJ_EXT)', but can be a long +string containing all object files, e.g. "tkpBind.o +tkpButton.o tkpCanvas.o" + +=item MYEXTLIB + +If the extension links to a library that it builds set this to the +name of the library (see SDBM_File) + +=item LIBS + +An anonymous array of alternative library +specifications to be searched for (in order) until +at least one library is found. E.g. + + 'LIBS' => ["-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs"] + +Mind, that any element of the array +contains a complete set of arguments for the ld +command. So do not specify + + 'LIBS' => ["-ltcl", "-ltk", "-lX11"] + +See ODBM_File/Makefile.PL for an example, where an array is needed. If +you specify a scalar as in + + 'LIBS' => "-ltcl -ltk -lX11" + +MakeMaker will turn it into an array with one element. + +=item LDFROM + +defaults to "$(OBJECT)" and is used in the ld command to specify +what files to link/load from (also see dynamic_lib below for how to +specify ld flags) + +=item DIR + +Ref to array of subdirectories containing Makefile.PLs e.g. [ 'sdbm' +] in ext/SDBM_File + +=item PMLIBDIRS + +Ref to array of subdirectories containing library files. Defaults to +[ 'lib', $(BASEEXT) ]. The directories will be scanned and any files +they contain will be installed in the corresponding location in the +library. A libscan() method can be used to alter the behaviour. +Defining PM in the Makefile.PL will override PMLIBDIRS. + +=item PM + +Hashref of .pm files and *.pl files to be installed. e.g. + + {'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'} + +By default this will include *.pm and *.pl. If a lib directory +exists and is not listed in DIR (above) then any *.pm and *.pl files +it contains will also be included by default. Defining PM in the +Makefile.PL will override PMLIBDIRS. + +=item XS + +Hashref of .xs files. MakeMaker will default this. e.g. + + {'name_of_file.xs' => 'name_of_file.c'} + +The .c files will automatically be included in the list of files +deleted by a make clean. + +=item C + +Ref to array of *.c file names. Initialised from a directory scan +and the values portion of the XS attribute hash. This is not +currently used by MakeMaker but may be handy in Makefile.PLs. + +=item H + +Ref to array of *.h file names. Similar to C above. + +=item TYPEMAPS + +Ref to array of typemap file names. Use this when the typemaps are +in some directory other than the current directory or when they are +not named B<typemap>. The last typemap in the list takes +precedence. A typemap in the current directory has highest +precedence, even if it isn't listed in TYPEMAPS. The default system +typemap has lowest precedence. -=item C<perl Makefile.PL help> -(if you already have a basic Makefile.PL) +=item PL_FILES -=item C<make help> -(if you already have a Makefile) +Ref to hash of files to be processed as perl programs. MakeMaker +will default to any found *.PL file (except Makefile.PL) being keys +and the basename of the file being the value. E.g. -=item C<perl -e 'use ExtUtils::MakeMaker "&help"; &help;'> -(if you have neither nor) + {'foobar.PL' => 'foobar'} + +The *.PL files are expected to produce output to the target files +themselves. + +=item EXE_FILES + +Ref to array of executable files. The files will be copied to the +INST_EXE directory. Make realclean will delete them from there +again. + +=item LINKTYPE + +'static' or 'dynamic' (default unless usedl=undef in config.sh) Should +only be used to force static linking (also see +linkext below). + +=item DL_FUNCS + +Hashref of symbol names for routines to be made available as +universal symbols. Each key/value pair consists of the package name +and an array of routine names in that package. Used only under AIX +(export lists) and VMS (linker options) at present. The routine +names supplied will be expanded in the same way as XSUB names are +expanded by the XS() macro. Defaults to + + {"$(NAME)" => ["boot_$(NAME)" ] } + +e.g. + + {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )], + "NetconfigPtr" => [ 'DESTROY'] } + +=item DL_VARS + +Array of symbol names for variables to be made available as +universal symbols. Used only under AIX (export lists) and VMS +(linker options) at present. Defaults to []. (e.g. [ qw( +Foo_version Foo_numstreams Foo_tree ) ]) + +=item CONFIG + +Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from +config.sh + +=item SKIP + +Arryref. E.g. [qw(name1 name2)] skip (do not write) sections of the +Makefile + +=item MAP_TARGET + +If it is intended, that a new perl binary be produced, this variable +may hold a name for that binary. Defaults to perl + +=item LIBPERL_A + +The filename of the perllibrary that will be used together with this +extension. Defaults to libperl.a. + +=item PERL + +Perl binary for tasks that can be done by miniperl + +=item FULLPERL + +Perl binary able to run this extension. + +=item PREREQ + +Hashref. Names of modules that need to be available to run this +extension (e.g. Fcntl for SDBM_File) are the keys of the hash and +the desired version is the value. (Not yet implemented!) + +=item NORECURS + +Boolean. Experimental attribute to inhibit descending into +subdirectories. + +=item MANPODS + +Hashref of .pm and .pod files. MakeMaker will default this to all +.pod and any .pm files that include POD directives. The files listed +here will be converted to man pages and installed as was requested +at Configure time. + +=item MAKEAPERL + +Boolean which tells MakeMaker, that it should include the rules to +make a perl. This is handled automatically as a switch by +MakeMaker. The user normally does not need it. + +=item MAKEFILE + +The name of the Makefile to be produced. =back +=head2 Additional lowercase attributes + +can be used to pass parameters to the methods which implement that +part of the Makefile. These are not normally required: + +=over 2 + +=item macro + + {ANY_MACRO => ANY_VALUE, ...} + +=item installpm + + {SPLITLIB => '$(INST_LIB)' (default) or '$(INST_ARCHLIB)'} + +=item linkext + + {LINKTYPE => 'static', 'dynamic' or ''} + +NB: Extensions that have nothing but *.pm files or have the role of +holding together several subdirectories specify + + {LINKTYPE => ''} + +=item dynamic_lib + + {ARMAYBE => 'ar', OTHERLDFLAGS => '...'} + +=item clean + + {FILES => "*.xyz foo"} + +=item realclean + + {FILES => '$(INST_ARCHAUTODIR)/*.xyz'} + +=item dist + + {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => 'gz', + SHAR => 'shar -m', DIST_CP => 'ln'} + +If you specify COMPRESS, then SUFFIX should also be altered, as it +is needed to tell make the target file of the compression. DIST_CP +can be useful, if you need to preserve the timestamps on your files. + +=item tool_autosplit + + {MAXLEN =E<gt> 8} + +=back + +=cut + +# bug in pod2html, so leave the =back + +# Don't delete this cut, MM depends on it! + =head2 Overriding MakeMaker Methods If you cannot achieve the desired Makefile behaviour by specifying @@ -2524,11 +3644,20 @@ either say: or you can edit the default by saying something like: - sub MY::c_o { $_=MM->c_o; s/old text/new text/; $_ } + sub MY::c_o { + my $self = shift; + local *c_o; + $_=$self->MM::c_o; + s/old text/new text/; + $_; + } + +Both methods above are available for backwards compatibility with +older Makefile.PLs. If you still need a different solution, try to develop another subroutine, that fits your needs and submit the diffs to -F<perl5-porters@nicoh.com> or F<comp.lang.perl> as appropriate. +F<perl5-porters@nicoh.com> or F<comp.lang.perl.misc> as appropriate. =head2 Distribution Support @@ -2539,37 +3668,50 @@ where additional documentation can be found. =over 4 =item make distcheck + reports which files are below the build directory but not in the MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for details) =item make distclean + does a realclean first and then the distcheck. Note that this is not needed to build a new distribution as long as you are sure, that the MANIFEST file is ok. =item make manifest + rewrites the MANIFEST file, adding all remaining files found (See ExtUtils::Manifest::mkmanifest() for details) =item make distdir + Copies all the files that are in the MANIFEST file to a newly created directory with the name C<$(DISTNAME)-$(VERSION)>. If that directory exists, it will be removed first. +=item make disttest + +Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and +a make install in that directory. + =item make tardist + First does a command $(PREOP) which defaults to a null command. Does a distdir next and runs C<tar> on that directory into a tarfile. Then deletes the distdir. Finishes with a command $(POSTOP) which defaults to a null command. =item make dist + Defaults to $(DIST_DEFAULT) which in turn defaults to tardist. =item make uutardist + Runs a tardist first and uuencodes the tarfile. =item make shdist + First does a command $(PREOP) which defaults to a null command. Does a distdir next and runs C<shar> on that directory into a sharfile. Then deletes the distdir. Finishes with a command $(POSTOP) which defaults @@ -2577,270 +3719,46 @@ to a null command. Note: For shdist to work properly a C<shar> program that can handle directories is mandatory. =item make ci -Does a $(CI) (defaults to C<ci -u>) and a $(RCS) (C<rcs -q --Nv$(VERSION_SYM):>) on all files in the MANIFEST file + +Does a $(CI) and a $(RCS_LABEL) on all files in the MANIFEST file. + +=back Customization of the dist targets can be done by specifying a hash reference to the dist attribute of the WriteMakefile call. The following parameters are recognized: - TAR ('tar') - TARFLAGS ('cvf') + CI ('ci -u') COMPRESS ('compress') - SUFFIX ('Z') - SHAR ('shar') - PREOP ('@ :') POSTOP ('@ :') + PREOP ('@ :') + RCS_LABEL ('rcs -q -Nv$(VERSION_SYM):') + SHAR ('shar') + SUFFIX ('Z') + TAR ('tar') + TARFLAGS ('cvf') An example: WriteMakefile( 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" }) -=back =head1 AUTHORS Andy Dougherty F<E<lt>doughera@lafcol.lafayette.eduE<gt>>, Andreas -Koenig F<E<lt>k@franz.ww.TU-Berlin.DEE<gt>>, Tim Bunce +KE<ouml>nig F<E<lt>A.Koenig@franz.ww.TU-Berlin.DEE<gt>>, Tim Bunce F<E<lt>Tim.Bunce@ig.co.ukE<gt>>. VMS support by Charles Bailey F<E<lt>bailey@HMIVAX.HUMGEN.UPENN.EDUE<gt>>. Contact the makemaker -mailing list L<mailto:makemaker@franz.ww.tu-berlin.de>, if you have any +mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if you have any questions. =head1 MODIFICATION HISTORY -v1, August 1994; by Andreas Koenig. Based on Andy Dougherty's Makefile.SH. -v2, September 1994 by Tim Bunce. -v3.0 October 1994 by Tim Bunce. -v3.1 November 11th 1994 by Tim Bunce. -v3.2 November 18th 1994 by Tim Bunce. -v3.3 November 27th 1994 by Andreas Koenig. -v3.4 December 7th 1994 by Andreas Koenig and Tim Bunce. -v3.5 December 15th 1994 by Tim Bunce. -v3.6 December 15th 1994 by Tim Bunce. -v3.7 December 30th 1994 By Tim Bunce -v3.8 January 17th 1995 By Andreas Koenig and Tim Bunce -v3.9 January 19th 1995 By Tim Bunce -v3.10 January 23rd 1995 By Tim Bunce -v3.11 January 24th 1995 By Andreas Koenig -v4.00 January 24th 1995 By Tim Bunce -v4.01 January 25th 1995 By Tim Bunce -v4.02 January 29th 1995 By Andreas Koenig -v4.03 January 30th 1995 By Andreas Koenig -v4.04 Februeary 5th 1995 By Andreas Koenig -v4.05 February 8th 1995 By Andreas Koenig -v4.06 February 10th 1995 By Andreas Koenig -v4.061 February 12th 1995 By Andreas Koenig -v4.08 - 4.085 February 14th-21st 1995 by Andreas Koenig -v4.086 March 9 1995 by Andy Dougherty -v4.09 March 31 1995 by Andreas Koenig -v4.091 April 3 1995 by Andy Dougherty -v4.092 April 11 1995 by Andreas Koenig -v4.093 April 12 1995 by Andy Dougherty -v4.094 April 12 1995 by Andy Dougherty - -v4.100 May 10 1995 by Andreas Koenig - -Broken out Mkbootstrap to make the file smaller and easier to manage, -and to speed up the build process. - -Added ExtUtils::Manifest as an extra module that is used to streamline -distributions. (See pod section I<distribution support>). - -Added a VERSION_SYM macro, that is derived from VERSION but all C<\W> -characters replaced by an underscore. - -Moved the whole documentation below __END__ for easier maintanance. - -linkext =E<gt> { LINKTYPE =E<gt> '' } should work now as expected. - -Rechecked the use of INST_LIB, INST_ARCHLIB, and INST_EXE from the -perspective of an AFS user (thanks to Rudolph T Maceyko for the -hint). With full backward compatiblity it is now possible, to set -INSTALLPRIVLIB, INSTALLARCHLIB, and INSTALLBIN either with 'perl -Makefile.PL' or with 'make install'. A bare 'make' ignores these -settings. The effect of this change is that it is no longer -recommended to set the INST_* attributes directly, although it doesn't -hurt, if they do so. The PASTHRU variables (now PASTHRU1 and PASTHRU2) -are fully aware of their duty: the INST_* attributes are only -propagated to runsubdirpl, not to 'cd subdir && make config' and 'cd -subdir && make all'. - -Included Tim's "Unable to locate Perl library" patch. - -Eliminated any excess of spaces in the $old/$new comparison in -const_cccmd(). - -Added a prompt function with usage $answer = prompt $message, $default. - -Included Tim's patch that searches for perl5 and perl$] as well as -perl and miniperl. - -Added .NO_PARALLEL for the time until I have a multiple cpu machine -myself :) - -Introduced a macro() subroutine. WriteMakefile("macro" =E<gt> { FOO -=E<gt> BAR }) defines the macro FOO = BAR in the generated Makefile. - -Rolled in Tim's patch for needs_linking. - -writedoc now tries to be less clever. It was trying to determine, if a -perllocal.pod had to be created or appended to. As we have now the -possibility, that INSTALLARCHLIB is determined at make's runtime, we -cannot do this anymore. We append to that file in any case. - -Added Kenneth's pod installation patch. - -v4.110 May 19 1995 by Andreas Koenig - -=head1 NEW in 4.11 - -MANIFEST.SKIP now contains only regular expressions. RCS directories -are no longer skipped by default, as this may be configured in the -SKIP file. - -The manifest target now does no realclean anymore. - -I_PERL_LIBS depreciated (no longer used). (unless you speak up, of -course) - -I could not justify that we rebuild the Makefile when MakeMaker has -changed (as Kenneth suggested). If this is really a strong desire, -please convince me. But a minor change of the MakeMaker should not -trigger a 60 minutes rebuild of Tk, IMO. - -Broken out extliblist into the new module ExtUtils::Liblist. Should -help extension writers for their own Configure scripts. The breaking -into pieces should be done now, I suppose. - -Added an (experimenta!!) uninstall target that works with a -packlist. AutoSplit files are not yet in the packlist. This needs a -patch to AutoSplit, doesn't it? The packlist file is installed in -INST_ARCHAUTODIR/.packlist. It doesn't have means to decide, if a file -is architecture dependent or not, we just collect as much as we can -get. make -n recommended before actually executing. (I leave this -target undocumented in the pod section). Suggestions welcome! - -Added basic chmod support. Nothing spectacular. *.so and *.a files get -permission 755, because I seem to recall, that some systems need -execute permissions in some weird constellations. The rest becomes -644. What else do we need to make this flexible? - -Then I took Tim's word serious: no bloat. No turning all packages into -perl scripts. Leaving shar, tar, uu be what they are... Sorry, -Kenneth, we still have to convince Larry that a growing MakeMaker -makes sense :) - -Added an extra check whenever they install below the perl source tree: -is this extension a standard extension? If it is, everything behaves -as we are used to. If it is not, the three INST_ macros are set to -./blib, and they get a warning that this extension has to be -installed manually with 'make install'. - -Added a warning for targets that have a colon or a hashmark within -their names, because most make(1)s will not be able to process them. - -Applied Hallvard's patch to ~user evaluation for cases where user does -not exist. - -Added a ci target that checks in all files from the MANIFEST into rcs. - -=head1 new in 4.12/4.13 - -"Please notify perl5-porters" message is now accompanied by -Config::myconfig(). - -(Manifest.pm) Change delimiter for the evaluation of the regexes from -MANIFEST.SKIP to from "!" to "/". I had overlooked the fact, that ! no -has a meaning in regular expressions. - -Disabled the new logic that prevents non-standard extensions from -writing to PERL_SRC/lib to give Andy room for 5.001f. - -Added a Version_check target that calls MakeMaker for a simple Version -control function on every invocation of 'make' in the future. Doesn't -have an effect currently. - -Target dist is still defaulting to tardist, but the level of -indirection has changed. The Makefile macro DIST_DEFAULT takes it's -place. This allows me to make dist dependent from whatever I intend as -my standard distribution. - -Made sure that INST_EXE is created for extensions that need it. - -4.13 is just a cleanup/documentation patch. And it adds a MakeMaker FAQ :) - -=head v4.14 June 5, 1995, by Andreas Koenig - -Reintroduces the LD_RUN_PATH macro. LD_RUN_PATH is passed as an -environment variable to the ld run. It is needed on Sun OS, and does -no harm on other systems. It is a colon seperated list of the -directories in LDLOADLIBS. - -=head v4.15 June 6, 1995, by Andreas Koenig - -Add -I$(PERL_ARCHLIB) -I$(PERL_LIB) to calls to xsubpp. - -=head v4.16 June 18, 1995, by Tim Bunce - -Split test: target into test_static: and test_dynamic: with automatic -selection based on LINKTYPE. The test_static: target automatically -builds a local ./perl binary containing the extension and executes the -tests using that binary. This fixes problems that users were having -dealing with building and testing static extensions. It also simplifies -the process down to the standard: make + make test. - -MakeMaker no longer incorrectly considers a perlmain.c file to be part -of an extensions source files. The map_clean target is now invoked by -clean not realclean and now deletes MAP_TARGET but does not delete -Makefile (since that's done properly elsewhere). - -Since the staticmake section defines macros that the test target now -needs the test section is written into the makefile after the -staticmake section. The postamble section has been made last again, as -it should be. +For a more complete documentation see the file Changes in the +MakeMaker distribution package. =head1 TODO -Needs more complete documentation. - -Add a C<html:> target when there has been found a general solution to -installing html files. - -Add a FLAVOR variable that makes it easier to build debugging, -embedded or multiplicity perls. Currently the easiest way to produce a -debugging perl seems to be (after haveing built perl): - make clobber - ./Configure -D"archname=IP22-irix-d" -des - make perllib=libperld.a - make test perllib=libperld.a - mv /usr/local/bin/perl /usr/local/bin/perl/O_perl5.001e - make install perllib=libperld.a - cp /usr/local/bin/perl/O_perl5.001e /usr/local/bin/perl -It would be nice, if the Configure step could be dropped. Also nice, but -maybe expensive, if 'make clobber' wouldn't be needed. - -The uninstall target has to be completed, it's just a sketch. - -Reconsider Makefile macros. The output of macro() should be the last -before PASTHRU and none should come after that -- tough work. - -Think about Nick's desire, that the pTk subdirectory needs a special -treatment. - -Find a way to have multiple MYEXTLIB archive files combined into -one. Actually I need some scenario, where this problem can be -illustrated. I currently don't see the problem. - -Test if .NOPARALLEL can be omitted. - -Don't let extensions write to PERL_SRC/lib anymore, build perl from -the extensions found below ext, run 'make test' and 'make install' on -each extension (giving room for letting them fail). Move some of the -tests from t/lib/* to the libraries. - -Streamline the production of a new perl binary on systems that DO have -dynamic loading (especially make test needs further support, as test -most probably needs the new binary). +See the file Todo in the MakeMaker distribution package. =cut diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index a76006e321..027ead5e1b 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -18,7 +18,7 @@ C<ExtUtils::Manifest::fullcheck;> C<ExtUtils::Manifest::maniread($file);> -C<ExtUtils::Manifest::manicopy($read,$target);> +C<ExtUtils::Manifest::manicopy($read,$target,$how);> =head1 DESCRIPTION @@ -49,11 +49,13 @@ Maniread($file) reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current directory) and returns a HASH reference with files being the keys and comments being the values of the HASH. -I<Manicopy($read,$target)> copies the files that are the keys in the -HASH I<%$read> to the named target directory. The HASH reference +I<Manicopy($read,$target,$how)> copies the files that are the keys in +the HASH I<%$read> to the named target directory. The HASH reference I<$read> is typically returned by the maniread() function. This function is useful for producing a directory tree identical to the -intended distribution tree. +intended distribution tree. The third parameter $how can be used to +specify a different system call to do the copying (eg. C<ln> instead +of C<cp>, which is the default). =head1 MANIFEST.SKIP @@ -80,20 +82,24 @@ C<&maniread>, and C<&manicopy> are exportable. All diagnostic output is sent to C<STDERR>. =over - + =item C<Not in MANIFEST:> I<file> + is reported if a file is found, that is missing in the C<MANIFEST> file which is excluded by a regular expression in the file C<MANIFEST.SKIP>. =item C<No such file:> I<file> + is reported if a file mentioned in a C<MANIFEST> file does not exist. =item C<MANIFEST:> I<$!> + is reported if C<MANIFEST> could not be opened. =item C<Added to MANIFEST:> I<file> + is reported by mkmanifest() if $Verbose is set and a file is added to MANIFEST. $Verbose is set to 1 by default. @@ -108,15 +114,17 @@ Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>> require Exporter; @ISA=('Exporter'); @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', - 'maniread', 'manicopy'); + 'skipcheck', 'maniread', 'manicopy'); +use Config; use File::Find; use Carp; $Debug = 0; $Verbose = 1; +$Is_VMS = $Config{'osname'} eq 'VMS'; -($Version) = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/); +($Version) = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/); $Version = $Version; #avoid warning $Quiet = 0; @@ -137,19 +145,22 @@ sub mkmanifest { if ($Verbose){ warn "Added to MANIFEST: $file\n" unless exists $read->{$file}; } + my $text = $all{$file}; + ($file,$text) = split(/\s+/,$text,2) if $Is_VMS; my $tabs = (5 - (length($file)+1)/8); $tabs = 1 if $tabs < 1; - $tabs = 0 unless $all{$file}; - print M $file, "\t" x $tabs, $all{$file}, "\n"; + $tabs = 0 unless $text; + print M $file, "\t" x $tabs, $text, "\n"; } close M; } sub manifind { local $found = {}; - find(sub {return if -d $_; + find(sub {return if -d $File::Find::name; (my $name = $File::Find::name) =~ s|./||; warn "Debug: diskfile $name\n" if $Debug; + $name =~ s#(.*)\.$#\L$1# if $Is_VMS; $found->{$name} = "";}, "."); $found; } @@ -166,6 +177,10 @@ sub filecheck { return @{(_manicheck(2))[1]}; } +sub skipcheck { + _manicheck(6); +} + sub _manicheck { my($arg) = @_; my $read = maniread(); @@ -176,8 +191,8 @@ sub _manicheck { foreach $file (sort keys %$read){ warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug; unless ( exists $found->{$file} ) { - warn "No such file: $file\n" unless $Quiet; - push @missfile, $file; + warn "No such file: $file\n" unless $Quiet; + push @missfile, $file; } } } @@ -185,12 +200,16 @@ sub _manicheck { $read ||= {}; my $matches = _maniskip(); my $found = manifind(); + my $skipwarn = $arg & 4; foreach $file (sort keys %$found){ - next if &$matches($file); + if (&$matches($file)){ + warn "Skipping $file\n" if $skipwarn; + next; + } warn "Debug: manicheck checking from disk $file\n" if $Debug; unless ( exists $read->{$file} ) { - warn "Not in MANIFEST: $file\n" unless $Quiet; - push @missentry, $file; + warn "Not in MANIFEST: $file\n" unless $Quiet; + push @missentry, $file; } } } @@ -208,7 +227,8 @@ sub maniread { } while (<M>){ chomp; - /^(\S+)\s*(.*)/ and $read->{$1}=$2; + if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; } + else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; } } close M; $read; @@ -229,9 +249,10 @@ sub _maniskip { push @skip, $_; } close M; + my $opts = $Is_VMS ? 'oi ' : 'o '; my $sub = "\$matches = " . "sub { my(\$arg)=\@_; return 1 if " - . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/o "} @skip), 0) + . join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0) . " }"; eval $sub; print "Debug: $sub\n" if $Debug; @@ -239,26 +260,83 @@ sub _maniskip { } sub manicopy { - my($read,$target)=@_; + my($read,$target,$how)=@_; croak "manicopy() called without target argument" unless defined $target; + $how = 'cp' unless defined $how && $how; require File::Path; require File::Basename; my(%dirs,$file); + $target = VMS::Filespec::unixify($target) if $Is_VMS; + umask 0; foreach $file (keys %$read){ + $file = VMS::Filespec::unixify($file) if $Is_VMS; my $dir = File::Basename::dirname($file); - File::Path::mkpath("$target/$dir"); - cp_if_diff($file, "$target/$file"); + File::Path::mkpath(["$target/$dir"],1,0755); + if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); } + else { cp_if_diff($file, "$target/$file", $how); } } } sub cp_if_diff { - my($from,$to)=@_; + my($from,$to, $how)=@_; -f $from || carp "$0: $from not found"; - system "cmp", "-s", $from, $to; - if ($?) { - unlink($to); # In case we don't have write permissions. - (system 'cp', $from, $to) == 0 or confess "system 'cp': $!"; + my($diff) = 0; + local(*F,*T); + open(F,$from) or croak "Can't read $from: $!\n"; + if (open(T,$to)) { + while (<F>) { $diff++,last if $_ ne <T>; } + $diff++ unless eof(T); + close T; + } + else { $diff++; } + close F; + if ($diff) { + if (-e $to) { + unlink($to) or confess "unlink $to: $!"; + } + &$how($from, $to); + } +} + +# Do the comparisons here rather than spawning off another process +sub vms_cp_if_diff { + my($from,$to) = @_; + my($diff) = 0; + local(*F,*T); + open(F,$from) or croak "Can't read $from: $!\n"; + if (open(T,$to)) { + while (<F>) { $diff++,last if $_ ne <T>; } + $diff++ unless eof(T); + close T; + } + else { $diff++; } + close F; + if ($diff) { + system('copy',vmsify($from),vmsify($to)) & 1 + or confess "Copy failed: $!"; } } +sub cp { + my ($srcFile, $dstFile) = @_; + my $buf; + open (IN,"<$srcFile") or die "Can't open input $srcFile: $!\n"; + open (OUT,">$dstFile") or die "Can't open output $dstFile: $!\n"; + my ($perm,$access,$mod) = (stat IN)[2,8,9]; + syswrite(OUT, $buf, $len) while $len = sysread(IN, $buf, 8192); + close IN; + close OUT; + utime $access, $mod, $dstFile; + # chmod a+rX-w,go-w + chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ); +} + +sub ln { + my ($srcFile, $dstFile) = @_; + link($srcFile, $dstFile); + local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x) + my $mode= 0444 | (stat)[2] & 0700; + chmod( $mode | ( $mode & 0100 ? 0111 : 0 ), $_ ); +} + 1; diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index dbfb352ee5..44a3bf191b 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code =head1 SYNOPSIS -B<xsubpp> [B<-C++>] [B<-except>] [B<-typemap typemap>]... file.xs +B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-typemap typemap>]... file.xs =head1 DESCRIPTION @@ -40,6 +40,10 @@ Indicates that a user-supplied typemap should take precedence over the default typemaps. This option may be used multiple times, with the last typemap having the highest precedence. +=item B<-v> + +Prints the I<xsubpp> version number to standard output, then exits. + =back =head1 ENVIRONMENT @@ -52,149 +56,7 @@ Larry Wall =head1 MODIFICATION HISTORY -=head2 1.0 - -I<xsubpp> as released with Perl 5.000 - -=head2 1.1 - -I<xsubpp> as released with Perl 5.001 - -=head2 1.2 - -Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 22 May 1995. - -=over 5 - -=item 1. - -Added I<xsubpp> version number for the first time. As previous releases -of I<xsubpp> did not have a formal version number, a numbering scheme -has been applied retrospectively. - -=item 2. - -If OUTPUT: is being used to specify output parameters and RETVAL is -also to be returned, it is now no longer necessary for the user to -ensure that RETVAL is specified last. - -=item 3. - -The I<xsubpp> version number, the .xs filename and a time stamp are -written to the generated .c file as a comment. - -=item 4. - -When I<xsubpp> is parsing the definition of both the input parameters -and the OUTPUT parameters, any duplicate definitions will be noted and -ignored. - -=item 5. - -I<xsubpp> is slightly more forgiving with extra whitespace. - -=back - -=head2 1.3 - -Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 23 May 1995. - -=over 5 - -=item 1. - -More whitespace restrictions have been relaxed. In particular some -cases where a tab character was used to delimit fields has been -removed. In these cases any whitespace will now suffice. - -The specific places where changes have been made are in the TYPEMAP -section of a typemap file and the input and OUTPUT: parameter -declarations sections in a .xs file. - -=item 2. - -More error checking added. - -Before processing each typemap file I<xsubpp> now checks that it is a -text file. If not an warning will be displayed. In addition, a warning -will be displayed if it is not possible to open the typemap file. - -In the TYPEMAP section of a typemap file, an error will be raised if -the line does not have 2 columns. - -When parsing input parameter declarations check that there is at least -a type and name pair. - -=back - -=head2 1.4 - -When parsing the OUTPUT arguments check that they are all present in -the corresponding input argument definitions. - -=head2 1.5 - -Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 1 June 1995. - -Started tidy up to allow clean run using C<-w> flag. - -Added some more error checking. - -The CASE: functionality now works. - -=head2 1.6 - -Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 3 June 1995. - -Added some more error checking. - -=head2 1.7 - -Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 5 June 1995. - -When an error or warning message is printed C<xsubpp> will now attempt -to identify the exact line in the C<.xs> file where the fault occurs. -This can be achieved in the majority of cases. - -=head2 1.8 - -Changes by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>, 6 June 1995. - -Accept backslash-newline as in C. Allow preprocessor directives -anywhere. Ignore whitespace in front of comments and on blank lines. - -=head2 1.9 - -Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 21 June 1995. - -=over 5 - -=item 1. - -Changed duplicate function error to a warning. - -=item 2. - -Changed the comment placed at the top of the C<.c> file to be more like -the comment used by MakeMaker. - -=item 3. - -When parsing the type for an XSUB parameter I<xsubpp> can now accept -definitions like this: - - char *fred - -i.e. the '*' is recognised as part of the type, rather than the first -character of the variable. - -=item 4. - -Fixed a problem with command line parsing - I<xsubpp> was not properly -detecting the case where there was no filename present on the command -line. - -=back +See the file F<changes.pod>. =head1 SEE ALSO @@ -203,17 +65,21 @@ perl(1), perlapi(1) =cut # Global Constants -$XSUBPP_version = "1.9" ; +$XSUBPP_version = "1.922"; +require 5.001; -$usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n"; +$usage = "Usage: xsubpp [-v] [-C++] [-except] [-s pattern] [-typemap typemap]... file.xs\n"; -SWITCH: while ($ARGV[0] =~ /^-/) { +$except = ""; +SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) { $flag = shift @ARGV; $flag =~ s/^-// ; $spat = shift, next SWITCH if $flag eq 's'; $cplusplus = 1, next SWITCH if $flag eq 'C++'; - $except = 1, next SWITCH if $flag eq 'except'; + $except = " TRY", next SWITCH if $flag eq 'except'; push(@tm,shift), next SWITCH if $flag eq 'typemap'; + (print "xsubpp version $XSUBPP_version\n"), exit + if $flag eq 'v'; die $usage; } @ARGV == 1 or die $usage; @@ -266,41 +132,31 @@ foreach $typemap (@tm) { $current = \$junk; while (<TYPEMAP>) { next if /^\s*#/; - if (/^INPUT\s*$/) { $mode = 'Input'; next; } - if (/^OUTPUT\s*$/) { $mode = 'Output'; next; } - if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; } + if (/^INPUT\s*$/) { $mode = 'Input'; $current = \$junk; next; } + if (/^OUTPUT\s*$/) { $mode = 'Output'; $current = \$junk; next; } + if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk; next; } if ($mode eq 'Typemap') { chomp; my $line = $_ ; TrimWhitespace($_) ; # skip blank lines and comment lines next if /^$/ or /^#/ ; - my @words = split (' ') ; - warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next - unless @words >= 2 ; - my $kind = pop @words ; - TrimWhitespace($kind) ; - $type_kind{TidyType("@words")} = $kind ; + my($type,$kind) = /^\s*(.*?\S)\s+(\S+)\s*$/ or + warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next; + $type_kind{TidyType($type)} = $kind ; + } + elsif (/^\s/) { + $$current .= $_; } elsif ($mode eq 'Input') { - if (/^\s/) { - $$current .= $_; - } - else { - s/\s*$//; - $input_expr{$_} = ''; - $current = \$input_expr{$_}; - } + s/\s+$//; + $input_expr{$_} = ''; + $current = \$input_expr{$_}; } else { - if (/^\s/) { - $$current .= $_; - } - else { - s/\s*$//; - $output_expr{$_} = ''; - $current = \$output_expr{$_}; - } + s/\s+$//; + $output_expr{$_} = ''; + $current = \$output_expr{$_}; } } close(TYPEMAP); @@ -310,6 +166,187 @@ foreach $key (keys %input_expr) { $input_expr{$key} =~ s/\n+$//; } +$END = "!End!\n\n"; # "impossible" keyword (multiple newline) + +# Match an XS keyword +$BLOCK_re= "\\s*(REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|$END)\\s*:"; + +# Input: ($_, @line) == unparsed input. +# Output: ($_, @line) == (rest of line, following lines). +# Return: the matched keyword if found, otherwise 0 +sub check_keyword { + $_ = shift(@line) while !/\S/ && @line; + s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2; +} + + +sub print_section { + $_ = shift(@line) while !/\S/ && @line; + for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { + print "$_\n"; + } +} + +sub CASE_handler { + blurt ("Error: `CASE:' after unconditional `CASE:'") + if $condnum && $cond eq ''; + $cond = $_; + TrimWhitespace($cond); + print " ", ($condnum++ ? " else" : ""), ($cond ? " if ($cond)\n" : "\n"); + $_ = '' ; +} + +sub INPUT_handler { + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + last if /^\s*NOT_IMPLEMENTED_YET/; + next unless /\S/; # skip blank lines + + TrimWhitespace($_) ; + my $line = $_ ; + + # remove trailing semicolon if no initialisation + s/\s*;$//g unless /=/ ; + + # check for optional initialisation code + my $var_init = '' ; + $var_init = $1 if s/\s*(=.*)$//s ; + $var_init =~ s/"/\\"/g; + + s/\s+/ /g; + my ($var_type, $var_addr, $var_name) = /^(.*?[^& ]) *(\&?) *\b(\w+)$/s + or blurt("Error: invalid argument declaration '$line'"), next; + + # Check for duplicate definitions + blurt ("Error: duplicate definition of argument '$var_name' ignored"), next + if $arg_list{$var_name} ++ ; + + $thisdone |= $var_name eq "THIS"; + $retvaldone |= $var_name eq "RETVAL"; + $var_types{$var_name} = $var_type; + print "\t" . &map_type($var_type); + $var_num = $args_match{$var_name}; + if ($var_addr) { + $var_addr{$var_name} = 1; + $func_args =~ s/\b($var_name)\b/&$1/; + } + if ($var_init =~ /^=\s*NO_INIT\s*;?\s*$/) { + print "\t$var_name;\n"; + } elsif ($var_init =~ /\S/) { + &output_init($var_type, $var_num, "$var_name $var_init"); + } elsif ($var_num) { + # generate initialization code + &generate_init($var_type, $var_num, $var_name); + } else { + print ";\n"; + } + } +} + +sub OUTPUT_handler { + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ; + blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next + if $outargs{$outarg} ++ ; + if (!$gotRETVAL and $outarg eq 'RETVAL') { + # deal with RETVAL last + $RETVAL_code = $outcode ; + $gotRETVAL = 1 ; + next ; + } + blurt ("Error: OUTPUT $outarg not an argument"), next + unless defined($args_match{$outarg}); + blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next + unless defined $var_types{$outarg} ; + if ($outcode) { + print "\t$outcode\n"; + } else { + $var_num = $args_match{$outarg}; + &generate_output($var_types{$outarg}, $var_num, $outarg); + } + } +} + +sub GetAliases +{ + my ($line) = @_ ; + my ($orig) = $line ; + my ($alias) ; + my ($value) ; + + # Parse alias definitions + # format is + # alias = value alias = value ... + + while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) { + $alias = $1 ; + $orig_alias = $alias ; + $value = $2 ; + + # check for optional package definition in the alias + $alias = $Packprefix . $alias if $alias !~ /::/ ; + + # check for duplicate alias name & duplicate value + Warn("Warning: Ignoring duplicate alias '$orig_alias'") + if defined $XsubAliases{$pname}{$alias} ; + + Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$pname}{$value}' have identical values") + if $XsubAliasValues{$pname}{$value} ; + + $XsubAliases{$pname}{$alias} = $value ; + $XsubAliasValues{$pname}{$value} = $orig_alias ; + } + + blurt("Error: Cannot parse ALIAS definitions from '$orig'") + if $line ; +} + +sub ALIAS_handler +{ + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_) ; + GetAliases($_) if $_ ; + } +} + +sub REQUIRE_handler +{ + # the rest of the current line should contain a version number + my ($Ver) = $_ ; + + TrimWhitespace($Ver) ; + + death ("Error: REQUIRE expects a version number") + unless $Ver ; + + # check that the version number is of the form n.n + death ("Error: REQUIRE: expected a number, got '$Ver'") + unless $Ver =~ /^\d+(\.\d*)?/ ; + + death ("Error: xsubpp $Ver (or better) required--this is only $XSUBPP_version.") + unless $XSUBPP_version >= $Ver ; +} + +sub check_cpp { + my @cpp = grep(/^\#\s*(?:if|e\w+)/, @line); + if (@cpp) { + my ($cpp, $cpplevel); + for $cpp (@cpp) { + if ($cpp =~ /^\#\s*if/) { + $cpplevel++; + } elsif (!$cpplevel) { + Warn("Warning: #else/elif/endif without #if in this function"); + return; + } elsif ($cpp =~ /^\#\s*endif/) { + $cpplevel--; + } + } + Warn("Warning: #if without #endif in this function") if $cpplevel; + } +} + + sub Q { my($text) = @_; $text =~ tr/#//d; @@ -354,18 +391,18 @@ sub fetch_para { if ($lastline =~ /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) { $Module = $1; - $Package = $2; - $Prefix = $3; + $Package = defined($2) ? $2 : ''; # keep -w happy + $Prefix = defined($3) ? $3 : ''; # keep -w happy ($Module_cname = $Module) =~ s/\W/_/g; - ($Packid = $Package) =~ s/:/_/g; + ($Packid = $Package) =~ tr/:/_/; $Packprefix = $Package; - $Packprefix .= "::" if defined $Packprefix && $Packprefix ne ""; + $Packprefix .= "::" if $Packprefix ne ""; $lastline = ""; } for(;;) { if ($lastline !~ /^\s*#/ || - $lastline =~ /^#[ \t]*((if|ifn?def|else|elif|endif|define|undef|pragma)\b|include\s*["<].*[>"])/) { + $lastline =~ /^#[ \t]*(?:(?:if|ifn?def|else|elif|endif|define|undef|pragma)\b|include\s*["<].*[>"])/) { last if $lastline =~ /^\S/ && @line && $line[-1] eq ""; push(@line, $lastline); push(@line_no, $lastline_no) ; @@ -376,18 +413,17 @@ sub fetch_para { $lastline_no = $.; my $tmp_line; $lastline .= $tmp_line - while ($lastline =~ /\\\n$/ && defined($tmp_line = <F>)); + while ($lastline =~ /\\$/ && defined($tmp_line = <F>)); - # chomp $lastline; + chomp $lastline; $lastline =~ s/^\s+$//; } pop(@line), pop(@line_no) while @line && $line[-1] eq ""; - $PPCODE = grep(/^\s*PPCODE\s*:/, @line); 1; } PARAGRAPH: -while (&fetch_para) { +while (fetch_para()) { # Print initial preprocessor statements and blank lines print shift(@line), "\n" while @line && $line[0] !~ /^[^\#]/; @@ -398,8 +434,6 @@ while (&fetch_para) { if $line[0] =~ /^\s/; # initialize info arrays - # my(%args_match,%var_types,%var_addr); - # my($class,$static,$elipsis,$wantRETVAL,%arg_list); undef(%args_match); undef(%var_types); undef(%var_addr); @@ -410,53 +444,51 @@ while (&fetch_para) { undef($wantRETVAL) ; undef(%arg_list) ; - # extract return type, function name and arguments - my($ret_type) = TidyType(shift(@line)); + $_ = shift(@line); + if (check_keyword("REQUIRE")) { + REQUIRE_handler() ; + next PARAGRAPH unless @line ; + $_ = shift(@line); + } - if ($ret_type =~ /^BOOT\s*:/) { - push (@BootCode, @line, "", "") ; + if (check_keyword("BOOT")) { + &check_cpp; + push (@BootCode, $_, @line, "") ; next PARAGRAPH ; } + + # extract return type, function name and arguments + my($ret_type) = TidyType($_); + # a function definition needs at least 2 lines blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH unless @line ; - if ($ret_type =~ /^static\s+(.*)$/) { - $static = 1; - $ret_type = $1; - } + $static = 1 if $ret_type =~ s/^static\s+//; + $func_header = shift(@line); blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH - unless $func_header =~ /^([\w:]+)\s*\((.*)\)$/; + unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*$/s; - ($func_name, $orig_args) = ($1, $2) ; - if ($func_name =~ /(.*)::(.*)/) { - $class = $1; - $func_name = $2; - } - $Prefix = '' unless defined $Prefix ; # keep -w happy + ($class, $func_name, $orig_args) = ($1, $2, $3) ; ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/; # Check for duplicate function definition - Warn("Warning: duplicate function definition '$func_name' detected") - if defined $Func_name{"${Packid}_$func_name"} ; + if (defined $Func_name{"${Packid}_$func_name"} ) { + Warn("Warning: duplicate function definition '$func_name' detected") + } + else { + push(@Func_name, "${Packid}_$func_name"); + push(@Func_pname, $pname); + } $Func_name{"${Packid}_$func_name"} ++ ; - push(@Func_name, "${Packid}_$func_name"); - push(@Func_pname, $pname); @args = split(/\s*,\s*/, $orig_args); if (defined($class)) { - if (defined($static)) { - unshift(@args, "CLASS"); - $orig_args = "CLASS, $orig_args"; - $orig_args =~ s/^CLASS, $/CLASS/; - } - else { - unshift(@args, "THIS"); - $orig_args = "THIS, $orig_args"; - $orig_args =~ s/^THIS, $/THIS/; - } + my $arg0 = (defined($static) ? "CLASS" : "THIS"); + unshift(@args, $arg0); + ($orig_args = "$arg0, $orig_args") =~ s/^$arg0, $/$arg0/; } $orig_args =~ s/"/\\"/g; $min_args = $num_args = @args; @@ -469,7 +501,7 @@ while (&fetch_para) { last; } } - if ($args[$i] =~ /([^=]*\S)\s*=\s*(.*)/) { + if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) { $min_args--; $args[$i] = $1; $defaults{$args[$i]} = $2; @@ -483,14 +515,20 @@ while (&fetch_para) { } @args_match{@args} = 1..@args; + $PPCODE = grep(/^\s*PPCODE\s*:/, @line); + $ALIAS = grep(/^\s*ALIAS\s*:/, @line); + # print function header print Q<<"EOF"; #XS(XS_${Packid}_$func_name) #[[ # dXSARGS; EOF + print Q<<"EOF" if $ALIAS ; +# dXSI32; +EOF if ($elipsis) { - $cond = qq(items < $min_args); + $cond = ($min_args ? qq(items < $min_args) : 0); } elsif ($min_args == $num_args) { $cond = qq(items != $min_args); @@ -504,10 +542,15 @@ EOF # *errbuf = '\0'; EOF - print Q<<"EOF"; -# if ($cond) { + if ($ALIAS) + { print Q<<"EOF" if $cond } +# if ($cond) +# croak("Usage: %s($orig_args)", GvNAME(CvGV(cv))); +EOF + else + { print Q<<"EOF" if $cond } +# if ($cond) # croak("Usage: $pname($orig_args)"); -# } EOF print Q<<"EOF" if $PPCODE; @@ -517,43 +560,16 @@ EOF # Now do a block of some sort. $condnum = 0; - $else_cond = 0 ; - if (!@line) { - @line = "CLEANUP:"; - } + $cond = ''; # last CASE: condidional + push(@line, "$END:"); + push(@line_no, $line_no[-1]); + $_ = ''; + &check_cpp; while (@line) { - if ($line[0] =~ s/^\s*CASE\s*:\s*//) { - $cond = shift(@line); - TrimWhitespace($cond) ; - if ($condnum == 0) { - # Check $cond is not blank - blurt("Error: First CASE: needs a condition") - if $cond eq '' ; - print " if ($cond)\n" - } - elsif ($cond ne '') { - print " else if ($cond)\n"; - } - else { - blurt ("Error: Too many CASE: statements without a condition") - unless $else_cond ; - ++ $else_cond ; - print " else\n"; - } - $condnum++; - $_ = '' ; - } - - if ($except) { - print Q<<"EOF"; -# TRY [[ -EOF - } - else { - print Q<<"EOF"; -# [[ + &CASE_handler if check_keyword("CASE"); + print Q<<"EOF"; +# $except [[ EOF - } # do initialization of input variables $thisdone = 0; @@ -561,71 +577,11 @@ EOF $deferred = ""; %arg_list = () ; $gotRETVAL = 0; - while (@line) { - $_ = shift(@line); - last if /^\s*NOT_IMPLEMENTED_YET/; - last if /^\s*(PPCODE|CODE|OUTPUT|CLEANUP|CASE)\s*:/; - - TrimWhitespace($_) ; - # skip blank lines - next if /^$/ ; - my $line = $_ ; - - # remove trailing semicolon if no initialisation - s/\s*;+\s*$//g unless /=/ ; - - # check for optional initialisation code - my $var_init = '' ; - $var_init = $1 if s/\s*(=.*)$// ; - - my @words = split (' ') ; - blurt("Error: invalid argument declaration '$line'"), next - unless @words >= 2 ; - my $var_name = pop @words ; - - # move any *'s from the variable name to the type - push(@words, $1) - if $var_name =~ s/^(\*+)// ; - - # check that removing the *'s hasn't eaten the whole variable - blurt("Error: invalid argument declaration '$line'"), next - if $var_name eq '' ; - - my $var_type = "@words" ; - - # catch many errors similar to: SV<tab>* name - blurt("Error: invalid $pname argument name '$var_name' (type '$var_type')\n") - unless ($var_name =~ m/^&?\w+$/); - if ($var_name =~ /^&/) { - $var_name =~ s/^&//; - $var_addr{$var_name} = 1; - } - # Check for duplicate definitions - blurt ("Error: duplicate definition of argument '$var_name' ignored"), next - if $arg_list{$var_name} ++ ; - - $thisdone |= $var_name eq "THIS"; - $retvaldone |= $var_name eq "RETVAL"; - $var_types{$var_name} = $var_type; - print "\t" . &map_type($var_type); - $var_num = $args_match{$var_name}; - if ($var_addr{$var_name}) { - $func_args =~ s/\b($var_name)\b/&$1/; - } - if ($var_init !~ /^=\s*NO_INIT\s*$/) { - if ($var_init !~ /^\s*$/) { - &output_init($var_type, $var_num, - "$var_name $var_init"); - } elsif ($var_num) { - # generate initialization code - &generate_init($var_type, $var_num, $var_name); - } else { - print ";\n"; - } - } else { - print "\t$var_name;\n"; - } + &INPUT_handler; + my $kwd; + while ($kwd = check_keyword("INPUT|PREINIT")) { + if ($kwd eq 'PREINIT') { &print_section; } else { &INPUT_handler; } } if (!$thisdone && defined($class)) { if (defined($static)) { @@ -650,28 +606,26 @@ EOF $args_match{"RETVAL"} = 0; $var_types{"RETVAL"} = $ret_type; } - if (/^\s*PPCODE\s*:/) { - print $deferred; - while (@line) { - $_ = shift(@line); - death ("PPCODE must be last thing") - if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; - print "$_\n"; - } + print $deferred; + while ($kwd = check_keyword("INIT|ALIAS")) { + if ($kwd eq 'INIT') { + &print_section + } + else { + ALIAS_handler + } + } + + if (check_keyword("PPCODE")) { + &print_section; + death ("PPCODE must be last thing") if @line; print "\tPUTBACK;\n\treturn;\n"; - } elsif (/^\s*CODE\s*:/) { - print $deferred; - while (@line) { - $_ = shift(@line); - last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; - print "$_\n"; - } + } elsif (check_keyword("CODE")) { + &print_section; } elsif ($func_name eq "DESTROY") { - print $deferred; print "\n\t"; - print "delete THIS;\n" + print "delete THIS;\n"; } else { - print $deferred; print "\n\t"; if ($ret_type ne "void") { print "RETVAL = "; @@ -680,9 +634,8 @@ EOF if (defined($static)) { if ($func_name =~ /^new/) { $func_name = "$class"; - } - else { - print "$class::"; + } else { + print "${class}::"; } } elsif (defined($class)) { print "THIS->"; @@ -694,75 +647,39 @@ EOF } # do output variables - if (/^\s*OUTPUT\s*:/) { - $gotRETVAL = 0; - my $RETVAL_code ; - my %outargs ; - while (@line) { - $_ = shift(@line); - last if /^\s*(CLEANUP|CASE)\s*:/; - TrimWhitespace($_) ; - next if /^$/ ; - my ($outarg, $outcode) = /^(\S+)\s*(.*)/ ; - if (!$gotRETVAL and $outarg eq 'RETVAL') { - # deal with RETVAL last - $RETVAL_code = $outcode ; - $gotRETVAL = 1 ; - next ; - } - blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next - if $outargs{$outarg} ++ ; - blurt ("Error: OUTPUT $outarg not an argument"), next - unless defined($args_match{$outarg}); - blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next - unless defined $var_types{$outarg} ; - if ($outcode) { - print "\t$outcode\n"; - } else { - $var_num = $args_match{$outarg}; - &generate_output($var_types{$outarg}, $var_num, - $outarg); - } - } - - if ($gotRETVAL) { - if ($RETVAL_code) - { print "\t$RETVAL_code\n" } - else - { &generate_output($ret_type, 0, 'RETVAL') } - } - } + $gotRETVAL = 0; + undef $RETVAL_code ; + undef %outargs ; + &OUTPUT_handler while check_keyword("OUTPUT"); # all OUTPUT done, so now push the return value on the stack - &generate_output($ret_type, 0, "RETVAL") - if $wantRETVAL and ! $gotRETVAL ; + if ($gotRETVAL && $RETVAL_code) { + print "\t$RETVAL_code\n"; + } elsif ($gotRETVAL || $wantRETVAL) { + &generate_output($ret_type, 0, 'RETVAL'); + } # do cleanup - if (/^\s*CLEANUP\s*:/) { - while (@line) { - $_ = shift(@line); - last if /^\s*CASE\s*:/; - print "$_\n"; - } - } + &print_section while check_keyword("CLEANUP"); + # print function trailer - if ($except) { - print Q<<EOF; + print Q<<EOF; # ]] +EOF + print Q<<EOF if $except; # BEGHANDLERS # CATCHALL # sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason); # ENDHANDLERS EOF + if (check_keyword("CASE")) { + blurt ("Error: No `CASE:' at top of function") + unless $condnum; + $_ = "CASE: $_"; # Restore CASE: label + next; } - else { - print Q<<EOF; -# ]] -EOF - } - if (/^\s*CASE\s*:/) { - unshift(@line, $_); - } + last if $_ eq "$END:"; + death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function"); } print Q<<EOF if $except; @@ -790,16 +707,39 @@ print Q<<"EOF"; # EOF +print Q<<"EOF" if defined %XsubAliases ; +# { +# CV * cv ; +# +EOF + for (@Func_name) { $pname = shift(@Func_pname); - print " newXS(\"$pname\", XS_$_, file);\n"; + + if ($XsubAliases{$pname}) { + $XsubAliases{$pname}{$pname} = 0 + unless defined $XsubAliases{$pname}{$pname} ; + while ( ($name, $value) = each %{$XsubAliases{$pname}}) { + print Q<<"EOF" ; +# cv = newXS(\"$name\", XS_$_, file); +# XSANY.any_i32 = $value ; +EOF + } + } + else { + print " newXS(\"$pname\", XS_$_, file);\n"; + } } +print Q<<"EOF" if defined %XsubAliases ; +# } +EOF + if (@BootCode) { - print "\n /* Initialisation Section */\n\n" ; + print "\n /* Initialisation Section */\n" ; print grep (s/$/\n/, @BootCode) ; - print " /* End of Initialisation Section */\n\n" ; + print "\n /* End of Initialisation Section */\n\n" ; } print Q<<"EOF";; @@ -850,12 +790,10 @@ sub generate_init { unless defined($type_kind{$type}); ($ntype = $type) =~ s/\s*\*/Ptr/g; - $subtype = $ntype; - $subtype =~ s/Ptr$//; - $subtype =~ s/Array$//; + ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; $tk = $type_kind{$type}; $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/; - $type =~ s/:/_/g; + $type =~ tr/:/_/; blurt("Error: No INPUT definition for type '$type' found"), return unless defined $input_expr{$tk} ; $expr = $input_expr{$tk}; @@ -901,9 +839,7 @@ sub generate_output { unless defined $output_expr{$type_kind{$type}} ; ($ntype = $type) =~ s/\s*\*/Ptr/g; $ntype =~ s/\(\)//g; - $subtype = $ntype; - $subtype =~ s/Ptr$//; - $subtype =~ s/Array$//; + ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; $expr = $output_expr{$type_kind{$type}}; if ($expr =~ /DO_ARRAY_ELEM/) { blurt("Error: '$subtype' not in typemap"), return @@ -937,12 +873,9 @@ sub generate_output { sub map_type { my($type) = @_; - $type =~ s/:/_/g; - if ($type =~ /^array\(([^,]*),(.*)\)/) { - return "$1 *"; - } else { - return $type; - } + $type =~ tr/:/_/; + $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s; + $type; } diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index cfc8f9f6a1..92d595eec9 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -1,44 +1,5 @@ package Net::Ping; -=head1 NAME - -Net::Ping, pingecho - check a host for upness - -=head1 SYNOPSIS - - use Net::Ping; - print "'jimmy' is alive and kicking\n" if pingecho('jimmy', 10) ; - -=head1 DESCRIPTION - -This module contains routines to test for the reachability of remote hosts. -Currently the only routine implemented is pingecho(). - -pingecho() uses a TCP echo (I<not> an ICMP one) to determine if the -remote host is reachable. This is usually adequate to tell that a remote -host is available to rsh(1), ftp(1), or telnet(1) onto. - -=head2 Parameters - -=over 5 - -=item hostname - -The remote host to check, specified either as a hostname or as an IP address. - -=item timeout - -The timeout in seconds. If not specified it will default to 5 seconds. - -=back - -=head1 WARNING - -pingecho() uses alarm to implement the timeout, so don't set another alarm -while you are using it. - -=cut - # Authors: karrer@bernina.ethz.ch (Andreas Karrer) # pmarquess@bfsec.bt.co.uk (Paul Marquess) @@ -46,27 +7,34 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(ping pingecho); +$VERSION = 1.00; -use Socket; -use Carp ; +use Socket 'PF_INET', 'AF_INET', 'SOCK_STREAM'; +require Carp ; -$tcp_proto = (getprotobyname('tcp'))[2]; -$echo_port = (getservbyname('echo', 'tcp'))[2]; +use strict ; + +$Net::Ping::tcp_proto = (getprotobyname('tcp'))[2]; +$Net::Ping::echo_port = (getservbyname('echo', 'tcp'))[2]; + +# keep -w happy +$Net::Ping::tcp_proto = $Net::Ping::tcp_proto ; +$Net::Ping::echo_port = $Net::Ping::echo_port ; sub ping { - croak "ping not implemented yet. Use pingecho()"; + Carp::croak "ping not implemented yet. Use pingecho()"; } sub pingecho { - croak "usage: pingecho host [timeout]" + Carp::croak "usage: pingecho host [timeout]" unless @_ == 1 || @_ == 2 ; - local ($host, $timeout) = @_; + my ($host, $timeout) = @_; + my ($saddr, $ip); + my ($ret) ; local (*PINGSOCK); - local ($saddr, $ip); - local ($ret) ; # check if $host is alive by connecting to its echo port, within $timeout # (default 5) seconds. returns 1 if OK, 0 if no answer, 0 if host not found @@ -80,24 +48,61 @@ sub pingecho { return 0 unless $ip; # "no such host" - $saddr = pack('S n a4 x8', AF_INET, $echo_port, $ip); + $saddr = pack('S n a4 x8', AF_INET, $Net::Ping::echo_port, $ip); $SIG{'ALRM'} = sub { die } ; alarm($timeout); - - $ret = eval <<'EOM' ; - - return 0 - unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $tcp_proto) ; - - return 0 - unless connect(PINGSOCK, $saddr) ; - - return 1 ; + + $ret = 0; + eval <<'EOM' ; + return unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $Net::Ping::tcp_proto) ; + return unless connect(PINGSOCK, $saddr) ; + $ret=1 ; EOM - alarm(0); close(PINGSOCK); - $ret == 1 ? 1 : 0 ; + $ret; } 1; +__END__ + +=cut + +=head1 NAME + +Net::Ping, pingecho - check a host for upness + +=head1 SYNOPSIS + + use Net::Ping; + print "'jimmy' is alive and kicking\n" if pingecho('jimmy', 10) ; + +=head1 DESCRIPTION + +This module contains routines to test for the reachability of remote hosts. +Currently the only routine implemented is pingecho(). + +pingecho() uses a TCP echo (I<not> an ICMP one) to determine if the +remote host is reachable. This is usually adequate to tell that a remote +host is available to rsh(1), ftp(1), or telnet(1) onto. + +=head2 Parameters + +=over 5 + +=item hostname + +The remote host to check, specified either as a hostname or as an IP address. + +=item timeout + +The timeout in seconds. If not specified it will default to 5 seconds. + +=back + +=head1 WARNING + +pingecho() uses alarm to implement the timeout, so don't set another alarm +while you are using it. + + diff --git a/makedepend.SH b/makedepend.SH index e95818548f..3fa095cea8 100755 --- a/makedepend.SH +++ b/makedepend.SH @@ -45,7 +45,9 @@ esac # We need .. when we are in the x2p directory if we are using the # cppstdin wrapper script. -PATH="$PATH:.:.." +# Put .. and . first so that we pick up the present cppstdin, not +# an older one lying about in /usr/local/bin. +PATH=".:..:$PATH" export PATH $cat /dev/null >.deptmp @@ -21,6 +21,7 @@ #endif */ + void mg_magical(sv) SV* sv; @@ -1227,7 +1228,7 @@ char *sig; for (sigv = sig_name+1; *sigv; sigv++) if (strEQ(sig,*sigv)) - return sigv - sig_name; + return sig_num[sigv - sig_name]; #ifdef SIGCLD if (strEQ(sig,"CHLD")) return SIGCLD; @@ -1239,6 +1240,17 @@ char *sig; return 0; } +char * +whichsigname(sig) +int sig; +{ + register int i; + for (i = 1; sig_num[i]; i++) /* sig_num[] is a 0-terminated list */ + if (sig_num[i] == sig) + return sig_name[i]; + return Nullch; +} + Signal_t sighandler(sig) int sig; @@ -1249,18 +1261,20 @@ int sig; SV *sv; CV *cv; AV *oldstack; + char *signame; #ifdef OS2 /* or anybody else who requires SIG_ACK */ signal(sig, SIG_ACK); #endif - cv = sv_2cv(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]), + signame = whichsigname(sig); + cv = sv_2cv(*hv_fetch(GvHVn(siggv),signame,strlen(signame), TRUE), &st, &gv, TRUE); if (!cv || !CvROOT(cv) && - *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) { + *signame == 'C' && instr(signame,"LD")) { - if (sig_name[sig][1] == 'H') + if (signame[1] == 'H') cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE), &st, &gv, TRUE); else @@ -1271,7 +1285,7 @@ int sig; if (!cv || !CvROOT(cv)) { if (dowarn) warn("SIG%s handler \"%s\" not defined.\n", - sig_name[sig], GvENAME(gv) ); + signame, GvENAME(gv) ); return; } @@ -1281,7 +1295,7 @@ int sig; SWITCHSTACK(stack, signalstack); sv = sv_newmortal(); - sv_setpv(sv,sig_name[sig]); + sv_setpv(sv,signame); PUSHMARK(sp); PUSHs(sv); PUTBACK; diff --git a/minimod.PL b/minimod.PL index 740cb2bee0..c0da491d08 100644 --- a/minimod.PL +++ b/minimod.PL @@ -56,17 +56,19 @@ sub writemain{ print " char *file = __FILE__;\n"; foreach $_ (@exts){ my($pname) = canon('/', $_); - my($mname, $cname); + my($mname, $cname, $ccode); ($mname = $pname) =~ s!/!::!g; ($cname = $pname) =~ s!/!__!g; print "\t{ extern void boot_${cname} _((CV* cv));\n"; if ($pname eq $dl){ # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'! # boot_DynaLoader is called directly in DynaLoader.pm - print "\t/* DynaLoader is a special case */\n"; - print "\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n" + $ccode = "\t/* DynaLoader is a special case */\n +\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n"; + print $ccode unless $SEEN{$ccode}++; } else { - print "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n" + $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n"; + print $ccode unless $SEEN{$ccode}++; } print "\t}\n"; } @@ -2173,7 +2173,7 @@ OP *right; curop->op_type == OP_PADHV || curop->op_type == OP_PADANY) { SV **svp = AvARRAY(comppad_name); - SV *sv = svp[curop->op_targ];; + SV *sv = svp[curop->op_targ]; if (SvCUR(sv) == generation) break; SvCUR(sv) = generation; /* (SvCUR not used any more) */ @@ -2231,9 +2231,10 @@ OP *op; I32 i; SV *sv; for (i = min_intro_pending; i <= max_intro_pending; i++) { - if ((sv = svp[i]) && sv != &sv_undef) + if ((sv = svp[i]) && sv != &sv_undef) { SvIVX(sv) = 999999999; /* Don't know scope end yet. */ SvNVX(sv) = (double)cop_seqmax; + } } min_intro_pending = 0; comppad_name_fill = max_intro_pending; /* Needn't search higher */ @@ -2642,22 +2643,22 @@ CV *cv; if (!(SvFLAGS(cv) & SVpcv_CLONED)) op_free(CvROOT(cv)); CvROOT(cv) = Nullop; - if (CvPADLIST(cv)) { - I32 i = AvFILL(CvPADLIST(cv)); - while (i >= 0) { - SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); - if (svp) - SvREFCNT_dec(*svp); - } - SvREFCNT_dec((SV*)CvPADLIST(cv)); - CvPADLIST(cv) = Nullav; - } - SvREFCNT_dec(CvGV(cv)); - CvGV(cv) = Nullgv; - SvREFCNT_dec(CvOUTSIDE(cv)); - CvOUTSIDE(cv) = Nullcv; LEAVE; } + SvREFCNT_dec(CvGV(cv)); + CvGV(cv) = Nullgv; + SvREFCNT_dec(CvOUTSIDE(cv)); + CvOUTSIDE(cv) = Nullcv; + if (CvPADLIST(cv)) { + I32 i = AvFILL(CvPADLIST(cv)); + while (i >= 0) { + SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); + if (svp) + SvREFCNT_dec(*svp); + } + SvREFCNT_dec((SV*)CvPADLIST(cv)); + CvPADLIST(cv) = Nullav; + } } CV * @@ -2983,11 +2984,6 @@ OP *block; SvPADTMP_on(curpad[ix]); } - CvPADLIST(cv) = av = newAV(); - AvREAL_off(av); - av_store(av, 1, SvREFCNT_inc((SV*)comppad)); - AvFILL(av) = 1; - CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; @@ -3525,6 +3521,7 @@ OP *op; if (op->op_flags & OPf_STACKED) { OP* k; op = ck_sort(op); + kid = cLISTOP->op_first->op_sibling; for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) { kid = k; } @@ -407,8 +407,8 @@ setuid perl scripts securely.\n"); comppadlist = newAV(); AvREAL_off(comppadlist); - av_store(comppadlist, 0, SvREFCNT_inc((SV*)comppad_name)); - av_store(comppadlist, 1, SvREFCNT_inc((SV*)comppad)); + av_store(comppadlist, 0, (SV*)comppad_name); + av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(compcv) = comppadlist; if (xsinit) @@ -996,7 +996,7 @@ char *s; return s; case 'v': printf("\nThis is perl, version %s\n\n",patchlevel); - fputs("\tUnofficial patchlevel 1m.\n",stdout); + fputs("\tUnofficial patchlevel 1n.\n",stdout); fputs("\nCopyright 1987-1994, Larry Wall\n",stdout); #ifdef MSDOS fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n", @@ -941,11 +941,11 @@ EXT SV sv_yes; #endif #ifdef DOINIT -EXT char *sig_name[] = { - SIG_NAME,0 -}; +EXT char *sig_name[] = { SIG_NAME }; +EXT int sig_num[] = { SIG_NUM }; #else EXT char *sig_name[]; +EXT int sig_num[]; #endif #ifdef DOINIT diff --git a/pod/Makefile b/pod/Makefile index fa16e2ce9d..6ef971db45 100644 --- a/pod/Makefile +++ b/pod/Makefile @@ -4,7 +4,7 @@ PERL = ../miniperl POD = \ perl.pod \ - perlapi.pod \ + perlxs.pod \ perlbook.pod \ perlbot.pod \ perlcall.pod \ @@ -33,7 +33,7 @@ POD = \ MAN = \ perl.man \ - perlapi.man \ + perlxs.man \ perlbook.man \ perlbot.man \ perlcall.man \ @@ -62,7 +62,7 @@ MAN = \ HTML = \ perl.html \ - perlapi.html \ + perlxs.html \ perlbook.html \ perlbot.html \ perlcall.html \ @@ -91,7 +91,7 @@ HTML = \ TEX = \ perl.tex \ - perlapi.tex \ + perlxs.tex \ perlbook.tex \ perlbot.tex \ perlcall.tex \ diff --git a/pod/perl.pod b/pod/perl.pod index bab8a91cc0..3664ab6402 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -27,7 +27,7 @@ of sections: perlsec Perl security perltrap Perl traps for the unwary perlstyle Perl style guide - perlapi Perl application programming interface + perlxs Perl XS application programming interface perlguts Perl internal functions for those doing extensions perlcall Perl calling conventions from C perlovl Perl overloading semantics diff --git a/pod/perlcall.pod b/pod/perlcall.pod index bde86796ac..50600f5d1c 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -43,7 +43,7 @@ L<perlembed>. Before you launch yourself head first into the rest of this document, it would be a good idea to have read the following two documents - -L<perlapi> and L<perlguts>. +L<perlxs> and L<perlguts>. =head1 THE PERL_CALL FUNCTIONS @@ -1741,7 +1741,7 @@ A hash is an ideal mechanism to store the mapping between C and Perl. Although I have made use of only the C<POP*> macros to access values returned from Perl subroutines, it is also possible to bypass these -macros and read the stack using the C<ST> macro (See L<perlapi> for a +macros and read the stack using the C<ST> macro (See L<perlxs> for a full description of the C<ST> macro). Most of the time the C<POP*> macros should be adequate, the main @@ -1820,7 +1820,7 @@ refers to the last. =head1 SEE ALSO -L<perlapi>, L<perlguts>, L<perlembed> +L<perlxs>, L<perlguts>, L<perlembed> =head1 AUTHOR diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 8cc2945336..e41c29939a 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -194,6 +194,13 @@ could indicate that SvREFCNT_dec() was called too many times, or that SvREFCNT_inc() was called too few times, or that the SV was mortalized when it shouldn't have been, or that memory has been corrupted. +=item Attempt to use reference as hash key + +(W) References as not very meaningful as hash keys. You probably forgot to +dereference the reference before using it in a hash list, or got mixed up +and used C<{}> or C<[]> instead of C<()>. Or perhaps a missing key in the +hash list is causing values to be treated as keys. + =item Bad arg length for %s, is %d, should be %d (F) You passed a buffer of the wrong size to one of msgctl(), semctl() or diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 886a096671..b836a738cb 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -399,7 +399,7 @@ to use the macros: These macros automatically adjust the stack for you, if needed. -For more information, consult L<perlapi>. +For more information, consult L<perlxs>. =head1 Mortality diff --git a/pod/perlmod.pod b/pod/perlmod.pod index dc825d6386..d557e68ff7 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -223,7 +223,7 @@ arrange to autoload) any additional functionality. The POSIX module happens to do both dynamic loading and autoloading, but the user can just say C<use POSIX> to get it all. -For more information on writing extension modules, see L<perlapi> +For more information on writing extension modules, see L<perlxs> and L<perlguts>. =head1 NOTE diff --git a/pod/perlapi.pod b/pod/perlxs.pod index 22df2e2011..ffbaa6b1c3 100644 --- a/pod/perlapi.pod +++ b/pod/perlxs.pod @@ -1,6 +1,6 @@ =head1 NAME -perlapi - Perl 5 application programming interface for C extensions +perlxs - XS language reference manual =head1 DESCRIPTION @@ -23,8 +23,43 @@ many common C types. A supplement typemap must be created to handle special structures and types for the library being linked. +=head2 Getting Started + +A new extension should begin with the B<h2xs> tool. This will generate +templates for the new Perl module (PM), the XS source file (XS), the MANIFEST +file, and the Makefile.PL (PL) files. The Makefile.PL file is a Perl script +which will generate a Makefile. This makefile knows how to find and run +xsubpp for your extension. When you type "make" your XS file will be run +through xsubpp and a C file will be produced. Then the C file will be +compiled. A simple example looks like this for an example module named +B<Foo>: + + $ h2xs -Afn Foo + $ cd ext/Foo + $ ls + Foo.pm Foo.xs MANIFEST Makefile.PL + $ perl5 Makefile.PL + $ ls + Foo.pm Foo.xs MANIFEST Makefile.PL Makefile + $ <edit Foo.pm and Foo.xs to add your stuff> + $ make + <you will see xsubpp run on Foo.xs and you'll see the C compiler + <run on Foo.c, and a bunch of other less-interesting things + <will happen. + +If your Perl was built with dynamic loading then the makefile will build a +dynamically loadable extension. If you don't have dynamic loading then the +makefile will build a static extension and should create a new Perl binary. +The default behavior depends on what is available. + +For more information about h2xs consult its manpage, embedded in the +source. For information about the Makefile.PL and Makefile consult the +MakeMaker manpage. + +=head2 On The Road + Many of the examples which follow will concentrate on creating an -interface between Perl and the ONC+RPC bind library functions. +interface between Perl and the ONC+ RPC bind library functions. Specifically, the rpcb_gettime() function will be used to demonstrate many features of the XS language. This function has two parameters; the first is an input parameter and the second is an output parameter. The function @@ -66,8 +101,8 @@ expanded later in this document. bool_t rpcb_gettime(host,timep) - char * host - time_t &timep + char *host + time_t &timep OUTPUT: timep @@ -100,37 +135,31 @@ function is called with the correct parameters. This abstraction will allow the programmer to create a more Perl-like interface to the C function. -It is recommended that the B<h2xs> tool be used when creating new -extensions. This tool will generate template source files and Makefiles. -This is discussed in more detail in the section titled "Creating A New -Extension" and in the B<h2xs> manpage. - =head2 The Anatomy of an XSUB -The following XSUB allows a Perl program to access a C library function called sin(). The XSUB will imitate the C -function which takes a single argument and returns a single -value. +The following XSUB allows a Perl program to access a C library function +called sin(). The XSUB will imitate the C function which takes a single +argument and returns a single value. double sin(x) - double<tab>x + double x -The compiler expects a tab between the parameter name and its type, and -any or no whitespace before the type. When using C pointers the -indirection operator C<*> should be considered part of the type and the -address operator C<&> should be considered part of the variable, as is -demonstrated in the rpcb_gettime() function above. See the section on -typemaps for more about handling qualifiers and unary operators in C -types. +When using C pointers the indirection operator C<*> should be considered +part of the type and the address operator C<&> should be considered part of +the variable, as is demonstrated in the rpcb_gettime() function above. See +the section on typemaps for more about handling qualifiers and unary +operators in C types. -The parameter list of a function must not have whitespace -after the open-parenthesis or before the close-parenthesis. +The parameter list of a function must not have whitespace after the +open-parenthesis or before the close-parenthesis. (This restriction will be +relaxed in later versions of B<xsubpp>.) INCORRECT CORRECT double double sin( x ) sin(x) - double x double x + double x double x The function name and the return type must be placed on separate lines. @@ -138,8 +167,8 @@ separate lines. INCORRECT CORRECT double sin(x) double - double x sin(x) - double x + double x sin(x) + double x =head2 The Argument Stack @@ -151,8 +180,8 @@ own range of positions on the stack. In this document the first position on that stack which belongs to the active function will be referred to as position 0 for that function. -XSUBs refer to their stack arguments with the macro B<ST(x)>, where I<x> refers -to a position in this XSUB's part of the stack. Position 0 for that +XSUBs refer to their stack arguments with the macro B<ST(x)>, where I<x> +refers to a position in this XSUB's part of the stack. Position 0 for that function would be known to the XSUB as ST(0). The XSUB's incoming parameters and outgoing return values always begin at ST(0). For many simple cases the B<xsubpp> compiler will generate the code necessary to @@ -246,14 +275,12 @@ variable. The OUTPUT: keyword can also be used to indicate that function parameters are output variables. This may be necessary when a parameter has been modified within the function and the programmer would like the update to -be seen by Perl. If function parameters are listed under OUTPUT: along -with the RETVAL variable then the RETVAL variable must be the last one -listed. +be seen by Perl. bool_t rpcb_gettime(host,timep) - char * host - time_t &timep + char *host + time_t &timep OUTPUT: timep @@ -263,10 +290,10 @@ typemap. bool_t rpcb_gettime(host,timep) - char * host - time_t &timep + char *host + time_t &timep OUTPUT: - timep<tab>sv_setnv(ST(1), (double)timep); + timep sv_setnv(ST(1), (double)timep); =head2 The CODE: Keyword @@ -284,8 +311,8 @@ The XSUB follows. bool_t rpcb_gettime(host,timep) - char * host - time_t timep + char *host + time_t timep CODE: RETVAL = rpcb_gettime( host, &timep ); OUTPUT: @@ -314,8 +341,8 @@ not care about its initial contents. bool_t rpcb_gettime(host,timep) - char * host - time_t &timep = NO_INIT + char *host + time_t &timep = NO_INIT OUTPUT: timep @@ -335,8 +362,8 @@ literally, such as double quotes, must be protected with backslashes. bool_t rpcb_gettime(host,timep) - char * host = (char *)SvPV(ST(0),na); - time_t &timep = 0; + char *host = (char *)SvPV(ST(0),na); + time_t &timep = 0; OUTPUT: timep @@ -368,8 +395,8 @@ the parameters in the correct order for that function. bool_t rpcb_gettime(timep,host="localhost") - char * host - time_t timep = NO_INIT + char *host + time_t timep = NO_INIT CODE: RETVAL = rpcb_gettime( host, &timep ); OUTPUT: @@ -398,7 +425,7 @@ The XS code, with ellipsis, follows. bool_t rpcb_gettime(timep, ...) - time_t timep = NO_INIT + time_t timep = NO_INIT CODE: { char *host = "localhost"; @@ -427,7 +454,7 @@ Perl as a single list. void rpcb_gettime(host) - char * host + char *host PPCODE: { time_t timep; @@ -513,7 +540,7 @@ then not push return values on the stack. void rpcb_gettime(host) - char * host + char *host PPCODE: { time_t timep; @@ -728,7 +755,7 @@ because the XSUB will attempt to verify that the Perl object is of the expected type. The following XS code shows the getnetconfigent() function which is used -with ONC TIRPC. The getnetconfigent() function will return a pointer to a +with ONC+ TIRPC. The getnetconfigent() function will return a pointer to a C structure and has the C prototype shown below. The example will demonstrate how the C pointer will become a Perl reference. Perl will consider this reference to be a pointer to a blessed object and will @@ -754,13 +781,13 @@ trim the name to the word DESTROY as Perl will expect. Netconfig * getnetconfigent(netid) - char * netid + char *netid MODULE = RPC PACKAGE = NetconfigPtr PREFIX = rpcb_ void rpcb_DESTROY(netconf) - Netconfig * netconf + Netconfig *netconf CODE: printf("Now in NetconfigPtr::DESTROY\n"); free( netconf ); @@ -899,7 +926,7 @@ File C<RPC.xs>: Interface to some ONC+ RPC bind library functions. void rpcb_gettime(host="localhost") - char * host + char *host CODE: { time_t timep; @@ -910,13 +937,13 @@ File C<RPC.xs>: Interface to some ONC+ RPC bind library functions. Netconfig * getnetconfigent(netid="udp") - char * netid + char *netid MODULE = RPC PACKAGE = NetconfigPtr PREFIX = rpcb_ void rpcb_DESTROY(netconf) - Netconfig * netconf + Netconfig *netconf CODE: printf("NetconfigPtr::DESTROY\n"); free( netconf ); @@ -956,4 +983,4 @@ File C<rpctest.pl>: Perl test program for the RPC extension. =head1 AUTHOR Dean Roehrich F<E<lt>roehrich@cray.comE<gt>> -May 3, 1995 +Oct 12, 1995 @@ -481,11 +481,11 @@ PP(pp_defined) RETPUSHNO; switch (SvTYPE(sv)) { case SVt_PVAV: - if (AvMAX(sv) >= 0) + if (AvMAX(sv) >= 0 || SvRMAGICAL(sv)) RETPUSHYES; break; case SVt_PVHV: - if (HvARRAY(sv)) + if (HvARRAY(sv) || SvRMAGICAL(sv)) RETPUSHYES; break; case SVt_PVCV: @@ -533,6 +533,11 @@ PP(pp_undef) cv_undef((CV*)sv); sub_generation++; break; + case SVt_PVGV: + if (SvFAKE(sv)) { + sv_setsv(sv, &sv_undef); + break; + } default: if (sv != GvSV(defgv)) { if (SvPOK(sv) && SvLEN(sv)) { @@ -1942,6 +1947,8 @@ PP(pp_anonhash) SV* key = *++MARK; char *tmps; SV *val = NEWSV(46, 0); + if (dowarn && key && SvROK(key)) /* Tom's gripe */ + warn("Attempt to use reference as hash key"); if (MARK < SP) sv_setsv(val, *++MARK); else @@ -1200,7 +1200,7 @@ PP(pp_dbstate) if (!cv) DIE("No DB::DB routine defined"); - if (CvDEPTH(cv) >= 1) /* don't do recursive DB::DB call */ + if (CvDEPTH(cv) >= 1 && !(debug & (1<<30))) /* don't do recursive DB::DB call */ return NORMAL; SAVEI32(debug); @@ -1900,9 +1900,10 @@ int gimme; comppadlist = newAV(); AvREAL_off(comppadlist); - av_store(comppadlist, 0, SvREFCNT_inc((SV*)comppad_name)); - av_store(comppadlist, 1, SvREFCNT_inc((SV*)comppad)); + av_store(comppadlist, 0, (SV*)comppad_name); + av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(compcv) = comppadlist; + SAVEFREESV(compcv); /* make sure we compile in the right package */ @@ -1955,7 +1956,6 @@ int gimme; rschar = nrschar; rspara = (nrslen == 2); compiling.cop_line = 0; - SAVEFREESV(compcv); SAVEFREEOP(eval_root); if (gimme & G_ARRAY) list(eval_root); @@ -144,6 +144,8 @@ PP(pp_concat) dPOPTOPssrl; STRLEN len; char *s; + if (SvGMAGICAL(left)) + mg_get(left); if (TARG != left) { s = SvPV(left,len); sv_setpvn(TARG,s,len); @@ -519,6 +521,8 @@ PP(pp_aassign) if (magic) mg_set(sv); } + if (!i) + av_extend(ary, 0); break; case SVt_PVHV: { char *tmps; @@ -530,9 +534,12 @@ PP(pp_aassign) while (relem < lastrelem) { /* gobble up all the rest */ STRLEN len; - if (*relem) + if (*relem) { sv = *(relem++); - else + if (dowarn && SvROK(sv)) /* Tom's gripe */ + warn("Attempt to use reference as hash key"); + } + else sv = &sv_no, relem++; tmps = SvPV(sv, len); tmpstr = NEWSV(29,0); @@ -543,6 +550,25 @@ PP(pp_aassign) if (magic) mg_set(tmpstr); } + if (relem == lastrelem) { + warn("Odd number of elements in hash list"); + if (*relem) { + STRLEN len; + sv = *relem; + if (dowarn && SvROK(sv)) /* Tom's gripe */ + warn("Attempt to use reference as hash key"); + tmps = SvPV(sv, len); + tmpstr = NEWSV(29,0); + (void) hv_store(hash, tmps, len, tmpstr, 0); + if (magic) + mg_set(tmpstr); + } + relem++; /* allow for (%a,%b) = 1; */ + } + if (!HvARRAY(hash) && !magic) { + Newz(42, hash->sv_any->xhv_array, + sizeof(HE*) * (HvMAX(hash)+1), char); + } } break; default: @@ -1250,7 +1276,7 @@ PP(pp_subst) EXTEND(SP,1); } s = SvPV(TARG, len); - if (!SvPOKp(TARG) || SvREADONLY(TARG)) + if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV)) force_on_match = 1; force_it: @@ -1447,6 +1473,7 @@ PP(pp_subst) safebase)); sv_catpvn(dstr, s, strend - s); + SvOOK_off(TARG); Safefree(SvPVX(TARG)); SvPVX(TARG) = SvPVX(dstr); SvCUR_set(TARG, SvCUR(dstr)); @@ -1622,7 +1649,7 @@ PP(pp_entersub) if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) { sv = GvSV(DBsub); save_item(sv); - if (SvFLAGS(cv) & SVpcv_ANON) /* Is GV potentially non-unique? */ + if (SvFLAGS(cv) & (SVpcv_ANON | SVpcv_CLONED)) /* Is GV potentially non-unique? */ sv_setsv(sv, newRV((SV*)cv)); else { gv = CvGV(cv); @@ -808,6 +808,8 @@ PP(pp_leavewrite) if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */ I32 lines = IoLINES_LEFT(io); char *s = SvPVX(formtarget); + if (lines <= 0) /* Yow, header didn't even fit!!! */ + goto forget_top; while (lines-- > 0) { s = strchr(s, '\n'); if (!s) @@ -1455,9 +1457,9 @@ nuts: PP(pp_accept) { - struct sockaddr_in saddr; /* use a struct to avoid alignment problems */ dSP; dTARGET; #ifdef HAS_SOCKET + struct sockaddr_in saddr; /* use a struct to avoid alignment problems */ GV *ngv; GV *ggv; register IO *nstio; @@ -459,6 +459,7 @@ I32 wait4pid _((int pid, int* statusp, int flags)); void warn _((char* pat,...)) __attribute__((format(printf,1,2))); void watch _((char **addr)); I32 whichsig _((char* sig)); +char* whichsigname _((int sig)); int yyerror _((char* s)); int yylex _((void)); int yyparse _((void)); @@ -912,7 +912,7 @@ char *prog; minmod = 0; if (ln && regrepeat(scan, ln) < ln) return 0; - while (n >= ln) { + while (n >= ln || (n == 32767 && ln > 0)) { /* ln overflow ? */ /* If it could work, try it. */ if (nextchar == -1000 || *reginput == nextchar) if (regmatch(next)) @@ -595,7 +595,10 @@ I32 base; (*SSPOPDPTR)(ptr); break; case SAVEt_REGCONTEXT: - savestack_ix -= SSPOPINT; /* regexp must have croaked */ + { + I32 delta = SSPOPINT; + savestack_ix -= delta; /* regexp must have croaked */ + } break; default: croak("panic: leave_scope inconsistency"); @@ -1410,6 +1410,12 @@ register SV *sstr; stype = SvTYPE(sstr); dtype = SvTYPE(dstr); + if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) { + sv_unglob(dstr); /* so fake GLOB won't perpetuate */ + SvPOK_only(dstr); + dtype = SvTYPE(dstr); + } + #ifdef OVERLOAD SvAMAGIC_off(dstr); #endif /* OVERLOAD */ @@ -2987,13 +2993,17 @@ STRLEN *lp; } else { if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) { - if (SvFAKE(sv)) + if (SvTYPE(sv) == SVt_PVGV && SvFAKE(sv)) { sv_unglob(sv); + s = SvPVX(sv); + *lp = SvCUR(sv); + } else croak("Can't coerce %s to string in %s", sv_reftype(sv,0), op_name[op->op_type]); } - s = sv_2pv(sv, lp); + else + s = sv_2pv(sv, lp); if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */ STRLEN len = *lp; @@ -3180,6 +3190,7 @@ SV* sv; gp_free(sv); sv_unmagic(sv, '*'); Safefree(GvNAME(sv)); + SvMULTI_off(sv); SvFLAGS(sv) &= ~SVTYPEMASK; SvFLAGS(sv) |= SVt_PVMG; } @@ -3192,7 +3203,10 @@ SV* sv; SvRV(sv) = 0; SvROK_off(sv); - SvREFCNT_dec(rv); + if (SvREFCNT(rv) == 1) + sv_2mortal(rv); + else + SvREFCNT_dec(rv); } #ifdef DEBUGGING @@ -8,9 +8,4 @@ If you put out extra lines with a '#' character on the front, you don't have to worry about removing the extra print statements later since TEST ignores lines beginning with '#'. -Several tests assume you have sucessfully included the POSIX -extension. If you have not, lib/[nos]dbm.t will fail. Try replacing -the O_CREAT|O_RDWR with either 0x202 or 0x102 in the tie statements -and run the tests again. - If you come up with new tests, send them to lwall@netlabs.com. diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t index 308b8f489a..d90de6cd59 100755 --- a/t/lib/db-btree.t +++ b/t/lib/db-btree.t @@ -12,7 +12,7 @@ BEGIN { use DB_File; use Fcntl; -print "1..73\n"; +print "1..76\n"; $Dfile = "Op.db-btree"; unlink $Dfile; @@ -348,4 +348,57 @@ print ($status == -1 ? "ok 73\n" : "not ok 73\n") ; undef $Y ; untie %h ; +# test multiple callbacks +$Dfile1 = "btree1" ; +$Dfile2 = "btree2" ; +$Dfile3 = "btree3" ; + +$dbh1 = TIEHASH DB_File::BTREEINFO ; +$dbh1->{compare} = sub { $_[0] <=> $_[1] } ; + +$dbh2 = TIEHASH DB_File::BTREEINFO ; +$dbh2->{compare} = sub { $_[0] cmp $_[1] } ; + +$dbh3 = TIEHASH DB_File::BTREEINFO ; +$dbh3->{compare} = sub { length $_[0] <=> length $_[1] } ; + + +tie(%h, DB_File,$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) ; +tie(%g, DB_File,$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) ; +tie(%k, DB_File,$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) ; + +@Keys = qw( 0123 12 -1234 9 987654321 def ) ; +@srt_1 = sort { $a <=> $b } @Keys ; +@srt_2 = sort { $a cmp $b } @Keys ; +@srt_3 = sort { length $a <=> length $b } @Keys ; + +foreach (@Keys) { + $h{$_} = 1 ; + $g{$_} = 1 ; + $k{$_} = 1 ; +} + +sub ArrayCompare +{ + my($a, $b) = @_ ; + + return 0 if @$a != @$b ; + + foreach (1 .. length @$a) + { + return 0 unless $$a[$_] eq $$b[$_] ; + } + + 1 ; +} + +print ( ArrayCompare (\@srt_1, [keys %h]) ? "ok 74\n" : "not ok 74\n") ; +print ( ArrayCompare (\@srt_2, [keys %g]) ? "ok 75\n" : "not ok 75\n") ; +print ( ArrayCompare (\@srt_3, [keys %k]) ? "ok 76\n" : "not ok 76\n") ; + +untie %h ; +untie %g ; +untie %k ; +unlink $Dfile1, $Dfile2, $Dfile3 ; + exit ; diff --git a/t/lib/socket.t b/t/lib/socket.t new file mode 100644 index 0000000000..2b9b820144 --- /dev/null +++ b/t/lib/socket.t @@ -0,0 +1,62 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bSocket\b/ && $Config{'osname'} ne 'VMS') { + print STDERR "1..0\n"; + exit 0; + } +} + +use Socket; + +print "1..6\n"; + +if( socket(T,PF_INET,SOCK_STREAM,6) ){ + print "ok 1\n"; + + if( connect(T,pack_sockaddr_in(AF_INET,7,inet_aton("localhost")))){ + print "ok 2\n"; + + print "# Connected to ", + inet_ntoa((unpack_sockaddr_in(getpeername(T)))[2]),"\n"; + + syswrite(T,"hello",5); + sysread(T,$buff,10); + print $buff eq "hello" ? "ok 3\n" : "not ok 3\n"; + } + else{ + print "# $!\n"; + print "not ok 2\n"; + } +} +else{ + print "# $!\n"; + print "not ok 1\n"; +} + +if( socket(S,PF_INET,SOCK_STREAM,6) ){ + print "ok 4\n"; + + if( connect(S,pack_sockaddr_in(AF_INET,7,INADDR_LOOPBACK))){ + print "ok 5\n"; + + print "# Connected to ", + inet_ntoa((unpack_sockaddr_in(getpeername(S)))[2]),"\n"; + + syswrite(S,"olleh",5); + sysread(S,$buff,10); + print $buff eq "olleh" ? "ok 6\n" : "not ok 6\n"; + } + else{ + print "# $!\n"; + print "not ok 5\n"; + } +} +else{ + print "# $!\n"; + print "not ok 4\n"; +} + @@ -2327,8 +2327,9 @@ yylex() /* If not a declared subroutine, it's an indirect object. */ /* (But it's an indir obj regardless for sort.) */ - if (last_lop_op == OP_SORT || - (!immediate_paren && (!gv || !GvCV(gv))) ) { + if ((last_lop_op == OP_SORT || + (!immediate_paren && (!gv || !GvCV(gv))) ) && + (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){ expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR; goto bareword; } @@ -4775,9 +4776,7 @@ start_subparse() sv_upgrade((SV *)compcv, SVt_PVCV); comppad = newAV(); - SAVEFREESV((SV*)comppad); comppad_name = newAV(); - SAVEFREESV((SV*)comppad_name); comppad_name_fill = 0; min_intro_pending = 0; av_push(comppad, Nullsv); @@ -4787,8 +4786,8 @@ start_subparse() comppadlist = newAV(); AvREAL_off(comppadlist); - av_store(comppadlist, 0, SvREFCNT_inc((SV*)comppad_name)); - av_store(comppadlist, 1, SvREFCNT_inc((SV*)comppad)); + av_store(comppadlist, 0, (SV*)comppad_name); + av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(compcv) = comppadlist; CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv); @@ -8,6 +8,7 @@ * $Log: a2p.h,v $ */ +#include "../embed.h" #define VOIDUSED 1 #include "../config.h" |