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
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
# 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!!!!!
;;
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'
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
: Configure runs within the UU subdirectory
test -d UU || mkdir UU
-cd UU && rm -f *
+cd UU && rm -f ./*
dynamic_ext=''
extensions=''
cppflags=''
ldflags=''
lkflags=''
+locincpth=''
optimize=''
+cf_email=''
cf_by=''
cf_time=''
contains=''
d_pathconf=''
d_pause=''
d_pipe=''
+d_poll=''
d_portable=''
d_readdir=''
d_rewinddir=''
db_prefixtype=''
i_db=''
i_dbm=''
+i_rpcsvcdbm=''
d_dirnamlen=''
direntrytype=''
i_dirent=''
libc=''
glibpth=''
libpth=''
+loclibpth=''
plibpth=''
xlibpth=''
libs=''
phostname=''
c=''
n=''
+d_eofnblk=''
+eagain=''
+o_nonblock=''
+rd_nodata=''
groupcat=''
hostcat=''
passcat=''
package=''
spackage=''
patchlevel=''
+perladmin=''
prefix=''
prefixexp=''
installprivlib=''
scriptdirexp=''
selecttype=''
sig_name=''
+sig_max=''
+sig_num=''
d_sitelib=''
installsitelib=''
sitelib=''
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"
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'
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;;
rm
sed
sort
+tail
touch
tr
uniq
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`
/*)
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."
;;
/*)
echo $file is in $xxx.
;;
+ ?:[\\/]*)
+ echo $file is in $xxx.
+ ;;
*)
echo "I don't see $file out there, $say."
say=either
osname=news_os
fi
$rm -f ../UU/kernel.what
+ elif test -d c:/.; then
+ set X $myuname
+ osname=os2
+ osvers="$5"
fi
fi
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
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
'') ;;
*) 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 " "
esac
$rm -f testcpp.c testcpp.out
-: determine optimize, if desired, or use for debug flag also
-case "$optimize" in
-' ') dflt='none';;
-'') dflt='-O';;
-*) dflt="$optimize";;
+: 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
-$cat <<EOH
-Some C compilers have problems with their optimizers, by default, $package
-compiles with the -O flag to use the optimizer. Alternately, you might want
-to use the symbolic debugger, which uses the -g flag (on traditional Unix
-systems). Either flag can be specified here. To use neither flag, specify
-the word "none".
+: 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'
-EOH
-rp="What optimizer/debugger flag should be used?"
+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
-optimize="$ans"
-case "$optimize" in
-'none') optimize=" ";;
+case "$ans" in
+none) libpth=' ';;
+*) libpth="$ans";;
esac
-dflt=''
-case "$ccflags" in
-'')
- case "$gccversion" in
- 1*) dflt='-fpcc-struct-return' ;;
- esac
- case "$optimize" in
- *-g*) dflt="$dflt -DDEBUGGING";;
- esac
- case "$gccversion" in
- 2*) if test -d /etc/conf/kconfig.d &&
- $contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
- then
- dflt="$dflt -posix"
- fi
- ;;
- 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
-case "$mips_type" in
-*BSD*) ;;
+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
'') ;;
-*) inclwanted="$inclwanted $usrinc/bsd";;
+*)
+ case "$ans" in
+ "$prefix") ;;
+ *) oldprefix="$prefix";;
+ esac
+ ;;
esac
-for thisincl in $inclwanted; do
- if $test -d $thisincl; then
- if $test x$thisincl != x$usrinc; then
- case "$dflt" in
- *$thisincl*);;
- *) dflt="$dflt -I$thisincl";;
- esac
- fi
- fi
-done
+prefix="$ans"
+prefixexp="$ansexp"
-inctest='if $contains $2 $usrinc/$1 >/dev/null 2>&1; then
- xxx=true;
-elif $contains $2 $usrinc/sys/$1 >/dev/null 2>&1; then
- xxx=true;
-else
- xxx=false;
-fi;
-if $xxx; then
- case "$dflt" in
- *$2*);;
- *) dflt="$dflt -D$2";;
- esac;
-fi'
+: 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'
-if ./osf1; then
- set signal.h __LANGUAGE_C__; eval $inctest
+: is AFS running?
+echo " "
+if test -d /afs; then
+ echo "AFS may be running... I'll be extra cautious then..." >&4
+ afs=true
else
- set signal.h LANGUAGE_C; eval $inctest
+ echo "AFS does not seem to be running..." >&4
+ afs=false
fi
-set signal.h NO_PROTOTYPE; eval $inctest
-set signal.h _NO_PROTO; eval $inctest
-case "$dflt" in
-'') dflt=none;;
-esac
-case "$ccflags" in
-'') ;;
-*) dflt="$ccflags";;
-esac
-$cat <<EOH
+: 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
-Your C compiler may want other flags. For this question you should include
--I/whatever and -DWHATEVER flags and any other flags used by the C compiler,
-but you should NOT include libraries or ld flags like -lwhatever. If you
-want $package to honor its debug switch, you should include -DDEBUGGING here.
-Your C compiler might also need additional flags, such as -D_POSIX_SOURCE,
--DHIDEMYMALLOC or -DCRIPPLED_CC.
+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).
-To use no flags, specify the word "none".
+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
-EOH
-set X $dflt
-shift
-dflt=${1+"$@"}
-rp="Any additional cc flags?"
-. ./myread
-case "$ans" in
-none) ccflags='';;
-*) ccflags="$ans";;
-esac
+: 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';;
+'') dflt='-O';;
+*) dflt="$optimize";;
+esac
+$cat <<EOH
+
+Some C compilers have problems with their optimizers, by default, $package
+compiles with the -O flag to use the optimizer. Alternately, you might want
+to use the symbolic debugger, which uses the -g flag (on traditional Unix
+systems). Either flag can be specified here. To use neither flag, specify
+the word "none".
+
+EOH
+rp="What optimizer/debugger flag should be used?"
+. ./myread
+optimize="$ans"
+case "$optimize" in
+'none') optimize=" ";;
+esac
+
+dflt=''
+case "$ccflags" in
+'')
+ case "$gccversion" in
+ 1*) dflt='-fpcc-struct-return' ;;
+ esac
+ case "$optimize" in
+ *-g*) dflt="$dflt -DDEBUGGING";;
+ esac
+ case "$gccversion" in
+ 2*) if test -d /etc/conf/kconfig.d &&
+ $contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
+ then
+ dflt="$dflt -posix"
+ fi
+ ;;
+ esac
+ ;;
+esac
+
+case "$mips_type" in
+*BSD*|'') inclwanted="$locincpth $usrinc";;
+*) inclwanted="$locincpth $inclwanted $usrinc/bsd";;
+esac
+for thisincl in $inclwanted; do
+ if $test -d $thisincl; then
+ if $test x$thisincl != x$usrinc; then
+ case "$dflt" in
+ *$thisincl*);;
+ *) dflt="$dflt -I$thisincl";;
+ esac
+ fi
+ fi
+done
+
+inctest='if $contains $2 $usrinc/$1 >/dev/null 2>&1; then
+ xxx=true;
+elif $contains $2 $usrinc/sys/$1 >/dev/null 2>&1; then
+ xxx=true;
+else
+ xxx=false;
+fi;
+if $xxx; then
+ case "$dflt" in
+ *$2*);;
+ *) dflt="$dflt -D$2";;
+ esac;
+fi'
+
+if ./osf1; then
+ set signal.h __LANGUAGE_C__; eval $inctest
+else
+ set signal.h LANGUAGE_C; eval $inctest
+fi
+set signal.h NO_PROTOTYPE; eval $inctest
+set signal.h _NO_PROTO; eval $inctest
+
+case "$dflt" in
+'') dflt=none;;
+esac
+case "$ccflags" in
+'') ;;
+*) dflt="$ccflags";;
+esac
+$cat <<EOH
+
+Your C compiler may want other flags. For this question you should include
+-I/whatever and -DWHATEVER flags and any other flags used by the C compiler,
+but you should NOT include libraries or ld flags like -lwhatever. If you
+want $package to honor its debug switch, you should include -DDEBUGGING here.
+Your C compiler might also need additional flags, such as -D_POSIX_SOURCE,
+-DHIDEMYMALLOC or -DCRIPPLED_CC.
+
+To use no flags, specify the word "none".
+
+EOH
+set X $dflt
+shift
+dflt=${1+"$@"}
+rp="Any additional cc flags?"
+. ./myread
+case "$ans" in
+none) ccflags='';;
+*) ccflags="$ans";;
+esac
: the following weeds options from ccflags that are of no interest to cpp
cppflags="$ccflags"
esac
: flags used in final linking phase
+
case "$ldflags" in
'') if ./venix; then
dflt='-i -z'
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
: 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:
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
'')
*"-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
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
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;
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;
esac;;
*)
case "$tval" in
- $define) tval=true;;
- *) tval=false;;
- esac;;
-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) tval=true;;
+ *) tval=false;;
+ esac;;
+esac;
+eval "$2=$tval"'
: define an is-in-libc? function
inlibc='echo " "; td=$define; tu=$undef;
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
#endif
main() {
exit(R_OK);
-}
-EOCP
- : check sys/file.h first, no particular reason here
- if $test `./findhdr sys/file.h` && \
- $cc $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
- h_sysfile=true;
- echo "<sys/file.h> defines the *_OK access constants." >&4
- elif $test `./findhdr fcntl.h` && \
- $cc $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
- h_fcntl=true;
- echo "<fcntl.h> defines the *_OK access constants." >&4
- elif $test `./findhdr unistd.h` && \
- $cc $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
- echo "<unistd.h> defines the *_OK access constants." >&4
- else
- echo "I can't find the four *_OK access constants--I'll use mine." >&4
- fi
- ;;
-esac
-$rm -f access*
-
-: see if alarm exists
-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
+}
+EOCP
+ : check sys/file.h first, no particular reason here
+ if $test `./findhdr sys/file.h` && \
+ $cc $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
+ h_sysfile=true;
+ echo "<sys/file.h> defines the *_OK access constants." >&4
+ elif $test `./findhdr fcntl.h` && \
+ $cc $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
+ h_fcntl=true;
+ echo "<fcntl.h> defines the *_OK access constants." >&4
+ elif $test `./findhdr unistd.h` && \
+ $cc $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
+ echo "<unistd.h> defines the *_OK access constants." >&4
+ else
+ echo "I can't find the four *_OK access constants--I'll use mine." >&4
+ fi
+ ;;
+esac
+$rm -f access*
-: 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 alarm exists
+set alarm d_alarm
+eval $inlibc
: Look for GNU-cc style attribute checking
echo " "
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
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
$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
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
;;
*) 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
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
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
fi
;;
esac
-echo "Your system uses $freetype free(), it would seem." >&4
-$rm -f malloc.[co]
-: see if nice exists
-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*
+echo "Your system uses $freetype free(), it would seem." >&4
+$rm -f malloc.[co]
+: see if nice exists
+set nice d_nice
+eval $inlibc
: see if pause exists
set pause d_pause
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
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"
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"
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
'') 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)';;
'') 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)';;
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 ;;
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 ;;
set d_stdio_cnt_lval
eval $setvar
-
: see if _base is also standard
val="$undef"
case "$d_stdstdio" 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
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
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
'')
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'
(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?
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
$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
. ./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
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
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:"
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) {
}
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
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 " "
ccdlflags='$ccdlflags'
ccflags='$ccflags'
cf_by='$cf_by'
+cf_email='$cf_email'
cf_time='$cf_time'
chgrp='$chgrp'
chmod='$chmod'
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'
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'
dlext='$dlext'
dlsrc='$dlsrc'
dynamic_ext='$dynamic_ext'
+eagain='$eagain'
echo='$echo'
egrep='$egrep'
emacs='$emacs'
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'
lkflags='$lkflags'
ln='$ln'
lns='$lns'
+locincpth='$locincpth'
+loclibpth='$loclibpth'
lp='$lp'
lpr='$lpr'
ls='$ls'
n='$n'
nm_opt='$nm_opt'
nroff='$nroff'
+o_nonblock='$o_nonblock'
optimize='$optimize'
orderlib='$orderlib'
osname='$osname'
passcat='$passcat'
patchlevel='$patchlevel'
perl='$perl'
+perladmin='$perladmin'
pg='$pg'
phostname='$phostname'
plibpth='$plibpth'
prototype='$prototype'
randbits='$randbits'
ranlib='$ranlib'
+rd_nodata='$rd_nodata'
rm='$rm'
rmail='$rmail'
runnm='$runnm'
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'
--- /dev/null
+=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
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
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
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
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
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
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
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
# 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
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;
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
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
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
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
# 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 $';
######################################################################
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;
$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;
undef @offsetof;
undef @indices;
undef @typeof;
+ undef @fieldnames;
$mname = &munge($name);
}
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";
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}++;
print STDERR "\n" if $trace;
unless ($perl && $opt_a) {
- print "\n1;\n";
+ print "\n1;\n" if $perl;
exit;
}
print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
}
- print "\n1;\n";
+ print "\n1;\n" if $perl;
exit;
}
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 = $_;
$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 {
}
}
- $template = &fetch_template($type) x
- ($count ? &scripts2count($count) : 1);
+ $template = &fetch_template($type);
+ &repeat_template($template,$count);
if (! $finished_template{$sname}) {
$template{$sname} .= $template;
($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
# 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) . ']';
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;
#$_ = &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;
sub scrunch {
local($_) = @_;
+ return '' if $_ eq '';
+
study;
s/\$//g;
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;
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
$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;
+ }
+ }
+}
* $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
*/
*/
#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.
*/
*/
#$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
*/
#$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
*/
#$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
*/
#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.
*/
#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
*/
#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.
*/
#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.
*/
#$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.
*/
#$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!
sub DELETE{ &readonly }
sub CLEAR { &readonly }
+sub config_sh { $config_sh }
1;
ENDOFEND
#! /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 "$@"
#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
#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
# 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
=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:
=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,
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
=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.
=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
=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" ;
=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 ;
$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' ;
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
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__
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"
#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 {
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) \
#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); \
}
/* 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
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 ;
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 ;
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 ;
static I32
GetArrayLength(db)
-DB_File db ;
+DB * db ;
{
DBT key ;
DBT value ;
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)
{
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);
if (svp && SvOK(*svp))
{
info.hash.hash = hash_cb ;
- hash_callback.sub = *svp ;
+ RETVAL->hash = newSVsv(*svp) ;
}
else
info.hash.hash = NULL ;
}
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 ;
if (svp && SvOK(*svp))
{
info.btree.prefix = btree_prefix ;
- prefix_callback.sub = *svp ;
+ RETVAL->prefix = newSVsv(*svp) ;
}
else
info.btree.prefix = NULL ;
}
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);
}
- 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) ;
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
DB_File db
DBTKEY key
u_int flags
+ INIT:
+ CurrentDB = db ;
int
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);
DBTKEY key
DBT value
u_int flags
+ INIT:
+ CurrentDB = db ;
int
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);
{
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);
int i ;
int One ;
+ CurrentDB = db ;
RETVAL = -1 ;
for (i = items-1 ; i > 0 ; --i)
{
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;
}
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);
}
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);
}
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:
length(db)
DB_File db
CODE:
- RETVAL = GetArrayLength(db) ;
+ CurrentDB = db ;
+ RETVAL = GetArrayLength(db->dbp) ;
OUTPUT:
RETVAL
DB_File db
DBTKEY key
u_int flags
+ INIT:
+ CurrentDB = db ;
int
DBTKEY key
DBT value
u_int flags
+ INIT:
+ CurrentDB = db ;
OUTPUT:
value
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
DBTKEY key
DBT value
u_int flags
+ INIT:
+ CurrentDB = db ;
OUTPUT:
key
value
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,
+ );
+
INPUT
T_dbtkeydatum
- if (db->close != DB_recno_close)
+ if (db->type != DB_RECNO)
{
$var.data = SvPV($arg, na);
$var.size = (int)na;
--- /dev/null
+# 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;
--- /dev/null
+#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);
--- /dev/null
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'NAME' => 'Devel::DProf',
+ 'VERSION' => 'Apr5,1995',
+ 'clean' => {'FILES' => "tmon.out"},
+ 'EXE_FILES' => ['dprofpp'],
+
+);
--- /dev/null
+Please consult the pod in DProf.pm.
+
+Dean Roehrich
--- /dev/null
+#!/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
+.
+
--- /dev/null
+#!./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();
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
=head1 SYNOPSIS
+ package YourPackage;
require DynaLoader;
@ISA = qw(... DynaLoader ...);
+ bootstrap YourPackage;
=head1 DESCRIPTION
=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
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;
-}
#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) {
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));
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
#include <link.h>
#endif
+#ifndef RTLD_LAZY
+# define RTLD_LAZY 1 /* Solaris 1 */
+#endif
+
#ifndef HAS_DLERROR
# ifdef __NetBSD__
# define dlerror() strerror(errno)
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) ;
#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
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:
#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:
*/
+/* 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()
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,
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;
dl_private_init()
{
(void)dl_generic_private_init();
+ dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
}
MODULE = DynaLoader PACKAGE = DynaLoader
#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
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;
char * filespec
CODE:
char vmsspec[NAM$C_MAXRSS];
- AV *reqAV;
SV *reqSV, **reqSVhndl;
STRLEN deflen;
struct dsc$descriptor_s
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 {
/* 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
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
}
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);
#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;
#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>
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. */
=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
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
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
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
#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
#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;
return 0;
}
+
MODULE = Socket PACKAGE = Socket
double
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));
+ }
sge_amg
sgt_amg
sig_name
+sig_num
siggv
sighandler
simple
q
ref
refkids
-regcomp
+pregcomp
regdump
-regexec
-regfree
+pregexec
+pregfree
regnext
regprop
repeatcpy
warn
watch
whichsig
+whichsigname
xiv_arenaroot
xiv_root
xnv_root
$name;
};
-chdir 'ext' if -d 'ext';
+(chdir 'ext', $ext = 'ext/') if -d 'ext';
if( $module =~ /::/ ){
$nested = 1;
}
-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;
close PM;
-warn "Writing ext/$modpname/$modfname.xs\n";
+warn "Writing $ext$modpname/$modfname.xs\n";
print XS <<"END";
#include "EXTERN.h"
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;
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.
--- /dev/null
+# 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
+
+++ /dev/null
-# 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
# 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"
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"'
+# 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'
+# 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.
*) ;;
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
+
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
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
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"
}
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;
package ExtUtils::Liblist;
-require ExtUtils::MakeMaker; # currently for MM_Unix::lsdir
# Broken out of MakeMaker from version 4.11
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'};
# 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
} 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++;
}
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;
-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";
-
- print STDOUT "MakeMaker (v$Version)" if $Verbose;
+ $self = {} unless (defined $self);
- if ( Carp::longmess("") =~ "runsubdirpl" ){
- $Correct_relativ_directories++;
- } else {
- $Correct_relativ_directories=0;
- }
+ my(%initial_att) = %$self; # record initial attributes
- 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);
+ }
- MY->init_main();
+ $self->{NAME} ||= $self->guess_name;
- print STDOUT "Writing Makefile for $att{NAME}";
+ ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g;
- if (! $att{PERL_SRC} &&
- $INC{'Config.pm'} ne "$Config{'archlib'}/Config.pm"){
+ $self->init_main();
+
+ 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 ":";
+ push @{$self->{RESULT}}, "\n# End.";
+######## untie %::att;
+ pop @ExtUtils::MakeMaker::Parent;
- 1;
+ $self;
}
-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;
-}
-
-sub mksymlists{
- %att = @_;
- parse_args(\%att, @ARGV);
- MY->mksymlists(@_);
-}
-
-# 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);
(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};
}
- 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{$_};
+ 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
}
+ 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
-sub neatvalue{
+ # 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 {
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;
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) . '_';
+ }
+
+
+ ($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)';
}
- ($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->{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
# 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
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( $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->{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( $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};
- $att{MAP_TARGET} = "perl" unless $att{MAP_TARGET};
- $att{LIBPERL_A} = $Is_VMS ? 'libperl.olb' : 'libperl.a'
- unless $att{LIBPERL_A};
+ $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};
+
+ $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
# 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");
} 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$// ;
}
# 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/...
# (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);
}
- if ($out =~ /VER_OK/) {
- print "Using PERL=$dir/$name" if $trace;
- return "$dir/$name";
+ print "Checking $abs\n" if ($trace >= 2);
+ if ($Is_OS2) {
+ $abs .= ".exe" unless -x $abs;
+ }
+ 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;
}
}
}
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
-";
+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)
-
- # 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}
+
+
+# work around a famous dec-osf make(1) feature(?):
+makemakerdflt: all
-.NO_PARALLEL:
+.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
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 {
';
}
+ 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',
DM => '-DDEBUGGING -DEMBED -DMULTIPLICITY',
);
- if ($libperl =~ /libperl(\w*)\.a/){
+ if ($libperl =~ /libperl(\w*)\.$self->{LIB_EXT}/){
$uc = uc($1);
} else {
$uc = ""; # avoid warning
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\"
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";
}
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);
-}
-
-
-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'}
-";
+ $cccmd =~ s/^\s*\Q$Config::Config{cc}\E\s/\$(CC) /;
+ $cccmd .= " \$(DEFINE_VERSION)";
+ $self->{CONST_CCCMD} = "CCCMD = $cccmd\n";
}
-
# --- 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{
};
}
-
-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);
"
";
};
-
-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";
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(@pasthru); # 1 was for runsubdirpl, 2 for normal make in subdirectories
- my(@pasthru1,@pasthru2); # 1 for runsubdirpl, 2 for the rest
-
- foreach $key (qw(INST_LIB INST_ARCHLIB INST_EXE)){
- push @pasthru1, "$key=\"\$($key)\"";
- }
-
- foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN LIBPERL_A LINKTYPE)){
- push @pasthru1, "$key=\"\$($key)\"";
- push @pasthru2, "$key=\"\$($key)\"";
+ foreach $key (qw(INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN
+ INSTALLMAN1DIR INSTALLMAN3DIR LIBPERL_A LINKTYPE)){
+ push @pasthru, "$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 $@
}
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 :: '.$att{MAKEFILE}.' $(INST_LIBDIR)/.exists $(INST_ARCHAUTODIR)/.exists Version_check
+config :: $(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))'
};
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);
# --- 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;\' \
@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,'
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
# 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
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);
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
";
}
}
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")
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.
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
');
# 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
};
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, '
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:
';
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 \
push @m, '
$(OBJECT) : $(PERL_HDRS)
-' if $att{OBJECT};
+' if $self->{OBJECT};
push(@m,'
# Check for unpropogated config.sh changes. Should never happen.
$(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)",
# 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 || []}) );
$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, "
";
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";
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;
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";
}
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;
}
-# --- 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";
- 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 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)=@_;
+ unless (ref $self){
+ ExtUtils::MakeMaker::TieAtt::warndirectuse((caller(0))[3]);
+ $self = $ExtUtils::MakeMaker::Parent[-1];
+ }
+ my($time);
+ 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";
+}
+
+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;
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
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
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
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,
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
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.
+
+=head2 AFS users
+
+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.
-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 Support to Link a new Perl Binary (eg dynamic loading not available)
+
+=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
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
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
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.
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 PL_FILES
+
+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.
+
+ {'foobar.PL' => 'foobar'}
+
+The *.PL files are expected to produce output to the target files
+themselves.
+
+=item EXE_FILES
-=item C<perl Makefile.PL help>
-(if you already have a basic Makefile.PL)
+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 C<make help>
-(if you already have a Makefile)
+=item LINKTYPE
-=item C<perl -e 'use ExtUtils::MakeMaker "&help"; &help;'>
-(if you have neither nor)
+'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
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
=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
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
C<ExtUtils::Manifest::maniread($file);>
-C<ExtUtils::Manifest::manicopy($read,$target);>
+C<ExtUtils::Manifest::manicopy($read,$target,$how);>
=head1 DESCRIPTION
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
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.
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;
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;
}
return @{(_manicheck(2))[1]};
}
+sub skipcheck {
+ _manicheck(6);
+}
+
sub _manicheck {
my($arg) = @_;
my $read = maniread();
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;
}
}
}
$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;
}
}
}
}
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;
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;
}
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;
=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
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
=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
=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;
$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);
$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;
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) ;
$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] !~ /^[^\#]/;
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);
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;
last;
}
}
- if ($args[$i] =~ /([^=]*\S)\s*=\s*(.*)/) {
+ if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) {
$min_args--;
$args[$i] = $1;
$defaults{$args[$i]} = $2;
}
@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);
# *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;
# 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;
$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)) {
$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 = ";
if (defined($static)) {
if ($func_name =~ /^new/) {
$func_name = "$class";
- }
- else {
- print "$class::";
+ } else {
+ print "${class}::";
}
} elsif (defined($class)) {
print "THIS->";
}
# 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;
#
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";;
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};
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
sub map_type {
my($type) = @_;
- $type =~ s/:/_/g;
- if ($type =~ /^array\(([^,]*),(.*)\)/) {
- return "$1 *";
- } else {
- return $type;
- }
+ $type =~ tr/:/_/;
+ $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
+ $type;
}
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)
@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
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.
+
+
# 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
#endif
*/
+
void
mg_magical(sv)
SV* sv;
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;
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;
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
if (!cv || !CvROOT(cv)) {
if (dowarn)
warn("SIG%s handler \"%s\" not defined.\n",
- sig_name[sig], GvENAME(gv) );
+ signame, GvENAME(gv) );
return;
}
SWITCHSTACK(stack, signalstack);
sv = sv_newmortal();
- sv_setpv(sv,sig_name[sig]);
+ sv_setpv(sv,signame);
PUSHMARK(sp);
PUSHs(sv);
PUTBACK;
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";
}
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) */
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 */
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 *
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;
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;
}
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)
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",
#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
POD = \
perl.pod \
- perlapi.pod \
+ perlxs.pod \
perlbook.pod \
perlbot.pod \
perlcall.pod \
MAN = \
perl.man \
- perlapi.man \
+ perlxs.man \
perlbook.man \
perlbot.man \
perlcall.man \
HTML = \
perl.html \
- perlapi.html \
+ perlxs.html \
perlbook.html \
perlbot.html \
perlcall.html \
TEX = \
perl.tex \
- perlapi.tex \
+ perlxs.tex \
perlbook.tex \
perlbot.tex \
perlcall.tex \
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
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
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
=head1 SEE ALSO
-L<perlapi>, L<perlguts>, L<perlembed>
+L<perlxs>, L<perlguts>, L<perlembed>
=head1 AUTHOR
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
These macros automatically adjust the stack for you, if needed.
-For more information, consult L<perlapi>.
+For more information, consult L<perlxs>.
=head1 Mortality
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
=head1 NAME
-perlapi - Perl 5 application programming interface for C extensions
+perlxs - XS language reference manual
=head1 DESCRIPTION
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
bool_t
rpcb_gettime(host,timep)
- char * host
- time_t &timep
+ char *host
+ time_t &timep
OUTPUT:
timep
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.
INCORRECT CORRECT
double sin(x) double
- double x sin(x)
- double x
+ double x sin(x)
+ double x
=head2 The Argument Stack
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
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
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
bool_t
rpcb_gettime(host,timep)
- char * host
- time_t timep
+ char *host
+ time_t timep
CODE:
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
bool_t
rpcb_gettime(host,timep)
- char * host
- time_t &timep = NO_INIT
+ char *host
+ time_t &timep = NO_INIT
OUTPUT:
timep
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
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:
bool_t
rpcb_gettime(timep, ...)
- time_t timep = NO_INIT
+ time_t timep = NO_INIT
CODE:
{
char *host = "localhost";
void
rpcb_gettime(host)
- char * host
+ char *host
PPCODE:
{
time_t timep;
void
rpcb_gettime(host)
- char * host
+ char *host
PPCODE:
{
time_t timep;
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
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 );
void
rpcb_gettime(host="localhost")
- char * host
+ char *host
CODE:
{
time_t timep;
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 );
=head1 AUTHOR
Dean Roehrich F<E<lt>roehrich@cray.comE<gt>>
-May 3, 1995
+Oct 12, 1995
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:
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)) {
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
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);
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 */
rschar = nrschar;
rspara = (nrslen == 2);
compiling.cop_line = 0;
- SAVEFREESV(compcv);
SAVEFREEOP(eval_root);
if (gimme & G_ARRAY)
list(eval_root);
dPOPTOPssrl;
STRLEN len;
char *s;
+ if (SvGMAGICAL(left))
+ mg_get(left);
if (TARG != left) {
s = SvPV(left,len);
sv_setpvn(TARG,s,len);
if (magic)
mg_set(sv);
}
+ if (!i)
+ av_extend(ary, 0);
break;
case SVt_PVHV: {
char *tmps;
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);
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:
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:
safebase));
sv_catpvn(dstr, s, strend - s);
+ SvOOK_off(TARG);
Safefree(SvPVX(TARG));
SvPVX(TARG) = SvPVX(dstr);
SvCUR_set(TARG, SvCUR(dstr));
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);
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)
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;
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));
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))
(*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");
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 */
}
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;
gp_free(sv);
sv_unmagic(sv, '*');
Safefree(GvNAME(sv));
+ SvMULTI_off(sv);
SvFLAGS(sv) &= ~SVTYPEMASK;
SvFLAGS(sv) |= SVt_PVMG;
}
SvRV(sv) = 0;
SvROK_off(sv);
- SvREFCNT_dec(rv);
+ if (SvREFCNT(rv) == 1)
+ sv_2mortal(rv);
+ else
+ SvREFCNT_dec(rv);
}
#ifdef DEBUGGING
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.
use DB_File;
use Fcntl;
-print "1..73\n";
+print "1..76\n";
$Dfile = "Op.db-btree";
unlink $Dfile;
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 ;
--- /dev/null
+#!./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";
+}
+
/* 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;
}
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);
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);
* $Log: a2p.h,v $
*/
+#include "../embed.h"
#define VOIDUSED 1
#include "../config.h"
projects / p5sagit/p5-mst-13.2.git / commitdiff