/usr/bin
NameSizeModeActions
.ssh.hmac650644editdlrm
a2p1067920755editdlrm
aclocal311810755editdlrm
aclocal-1.11311810755editdlrm
addftinfo234880755editdlrm
addr2line254800755editdlrm
animate58480755editdlrm
ar566240755editdlrm
as3283920755editdlrm
aspell1640640755editdlrm
at10360755editdlrm
atq10380755editdlrm
atrm10400755editdlrm
autoconf146310755editdlrm
autoheader84840755editdlrm
autom4te317890755editdlrm
automake2570620755editdlrm
automake-1.112570620755editdlrm
autoreconf202330755editdlrm
autoscan170650755editdlrm
autoupdate337660755editdlrm
awk3756160755editdlrm
base64292400755editdlrm
bashbug-6469320755editdlrm
batch1370755editdlrm
bdftops2920755editdlrm
bison2998560755editdlrm
bunzip2329360755editdlrm
bzcat329360755editdlrm
bzcmp21280755editdlrm
bzdiff21280755editdlrm
bzgrep16770755editdlrm
bzip2329360755editdlrm
bzip2recover108720755editdlrm
bzless12590755editdlrm
bzmore12590755editdlrm
c++2679280755editdlrm
c++filt236880755editdlrm
c2ph366010755editdlrm
c892240755editdlrm
c992150755editdlrm
cal167840755editdlrm
captoinfo498320755editdlrm
catchsegv33840755editdlrm
cc2644720755editdlrm
chcon571440755editdlrm
chrt96240755editdlrm
cksum252720755editdlrm
cldetect106890755editdlrm
clear49760755editdlrm
cloudlinux-awp-user18180755editdlrm
clwpos-user18180755editdlrm
cmp192480755editdlrm
col109040755editdlrm
colcrt79200755editdlrm
colrm55760755editdlrm
column97440755editdlrm
comm284560755editdlrm
compare59680755editdlrm
composite58480755editdlrm
conjure58480755editdlrm
convert58480755editdlrm
cpan118390755editdlrm
cpp2679120755editdlrm
crontab13880755editdlrm
crontab.cagefs3080480755editdlrm
csplit1061680755editdlrm
curl1205120755editdlrm
cut417040755editdlrm
dbiprof63000755editdlrm
dbiproxy54820755editdlrm
ddate114480755editdlrm
diff810800755editdlrm
diff3234800755editdlrm
dig1336880755editdlrm
dir1092080755editdlrm
dircolors328720755editdlrm
dirname237200755editdlrm
display58480755editdlrm
dltest72320755editdlrm
dprofpp240890755editdlrm
du954480755editdlrm
dumphint5540755editdlrm
dvipdf10570755editdlrm
enc2xs391470755editdlrm
enchant131360755editdlrm
enchant-lsmod73360755editdlrm
env238320755editdlrm
eps2eps6320755editdlrm
eqn1373280755editdlrm
eqn2graph22420755editdlrm
expand279600755editdlrm
expr976880755editdlrm
factor446960755editdlrm
fc-cache130000755editdlrm
fc-cat111360755editdlrm
fc-list88400755editdlrm
fc-match99920755editdlrm
fc-query75680755editdlrm
fc-scan78720755editdlrm
file156800755editdlrm
find2345120755editdlrm
find2perl236140755editdlrm
flex3324480755editdlrm
flex++3324480755editdlrm
flock109280755editdlrm
floppy236160755editdlrm
fmt302640755editdlrm
fold280240755editdlrm
font2c3000755editdlrm
free96960755editdlrm
freetype-config38300755editdlrm
funzip220560755editdlrm
g++2679280755editdlrm
gawk3756160755editdlrm
gcc2644720755editdlrm
gcov398480755editdlrm
gencat230480755editdlrm
geoiplookup150640755editdlrm
geoiplookup6109040755editdlrm
geqn1373280755editdlrm
GET145190755editdlrm
getconf228080755editdlrm
getent277760755editdlrm
getopt120400755editdlrm
ghostscript67600755editdlrm
gindxbib278240755editdlrm
git11395440755editdlrm
git-receive-pack11395600755editdlrm
git-shell4613040755editdlrm
git-upload-archive11395600755editdlrm
git-upload-pack4712160755editdlrm
glookbib333200755editdlrm
gm48560755editdlrm
gmake1705760755editdlrm
gneqn2550755editdlrm
gnroff24010755editdlrm
gpg7616880755editdlrm
gpg-agent2979760755editdlrm
gpg-error185760755editdlrm
gpg-zip33030755editdlrm
gpg27616880755editdlrm
gpgsplit485360755editdlrm
gpgv3364800755editdlrm
gpgv23364800755editdlrm
gpic2136160755editdlrm
gprof949600755editdlrm
grefer1222240755editdlrm
grn654080755editdlrm
grodvi814000755editdlrm
groff654240755editdlrm
groffer77770755editdlrm
grolbp879600755editdlrm
grolj4774640755editdlrm
grops1170080755editdlrm
grotty773040755editdlrm
groups244080755editdlrm
gs67600755editdlrm
gsbj3370755editdlrm
gsdj3390755editdlrm
gsdj5003420755editdlrm
gslj3400755editdlrm
gslp3370755editdlrm
gsnd2640755editdlrm
gsoelim235120755editdlrm
gtbl981760755editdlrm
gtroff3548640755editdlrm
gunzip610755editdlrm
gzexe59350755editdlrm
gzip646880755editdlrm
h2ph280360755editdlrm
h2xs603850755editdlrm
head325200755editdlrm
hexdump215760755editdlrm
host1199280755editdlrm
hostid220560755editdlrm
hpftodit203840755editdlrm
hunspell527840755editdlrm
iconv602720755editdlrm
icu-config111870755editdlrm
id281040755editdlrm
identify59680755editdlrm
idn324880755editdlrm
ifnames40490755editdlrm
import58480755editdlrm
indxbib278240755editdlrm
infocmp509600755editdlrm
infotocap498320755editdlrm
install1072000755editdlrm
instmodsh42530755editdlrm
ionice151120755editdlrm
ipcrm90640755editdlrm
ipcs197200755editdlrm
isosize73200755editdlrm
ispell9880755editdlrm
isql276160755editdlrm
iusql215760755editdlrm
join403600755editdlrm
kill115760755editdlrm
ld5884960755editdlrm
ldd53250755editdlrm
less1499760755editdlrm
lessecho73760755editdlrm
lesskey162640755editdlrm
lesspipe.sh28040755editdlrm
lex3324480755editdlrm
libnetcfg157240755editdlrm
libtool2833330755editdlrm
libtoolize681610755editdlrm
lkbib335440755editdlrm
locale386400755editdlrm
localedef3268800755editdlrm
logger116080755editdlrm
logname221520755editdlrm
look80800755editdlrm
lookbib333200755editdlrm
lprsetup.sh46610755editdlrm
lynx13909840755editdlrm
m42085200755editdlrm
Mail3787200755editdlrm
make1705760755editdlrm
mcookie110320755editdlrm
md5sum324720755editdlrm
mesg67440755editdlrm
mkfifo252720755editdlrm
mogrify58480755editdlrm
montage58480755editdlrm
msql2mysql19560755editdlrm
mysql38444780755editdlrm
mysqlaccess1125280755editdlrm
mysqladmin35296010755editdlrm
mysqlbinlog37277520755editdlrm
mysqlcheck35263050755editdlrm
mysqldump36034950755editdlrm
mysqlimport35261030755editdlrm
mysqlshow35199730755editdlrm
mysql_config70160755editdlrm
mysql_find_rows37910755editdlrm
mysql_waitpid32730730755editdlrm
my_print_defaults32752540755editdlrm
namei127120755editdlrm
nano1717840755editdlrm
neqn2550755editdlrm
net-snmp-create-v3-user29610755editdlrm
nl981200755editdlrm
nm412800755editdlrm
nohup261840755editdlrm
nproc242640755editdlrm
nroff24010755editdlrm
nslookup1201200755editdlrm
nsupdate595280755editdlrm
objcopy2122640755editdlrm
objdump2849360755editdlrm
od581520755editdlrm
odbcinst233280755editdlrm
odbc_config68080755editdlrm
openssl5256000755editdlrm
pango-querymodules-64101760755editdlrm
pango-view496880755editdlrm
passwd10440755editdlrm
paste255440755editdlrm
patch1181040755editdlrm
pathchk237520755editdlrm
pdf2dsc6960755editdlrm
pdf2ps9010755editdlrm
pdfopt5470755editdlrm
perl71840755editdlrm
perl5.10.171840755editdlrm
perlbug447260755editdlrm
perldoc2240755editdlrm
perlivp123030755editdlrm
perlml44800755editdlrm
perlthanks447260755editdlrm
pf2afm4950755editdlrm
pfbtopfa5110755editdlrm
pfbtops67760755editdlrm
pgrep161440755editdlrm
php9370755editdlrm
php-cli9330755editdlrm
php59330755editdlrm
php5-cli9330755editdlrm
pic2136160755editdlrm
pic2graph25630755editdlrm
pico1717840755editdlrm
piconv73370755editdlrm
pinentry26020755editdlrm
pinentry-curses486000755editdlrm
pinky296080755editdlrm
pkg-config1058880755editdlrm
pkill161440755editdlrm
pl2pm45310755editdlrm
pmap121360755editdlrm
pod2html23380755editdlrm
pod2latex102550755editdlrm
pod2man211750755editdlrm
pod2text90800755editdlrm
pod2usage33420755editdlrm
podchecker36990755editdlrm
podselect25270755editdlrm
post-grohtml1316080755editdlrm
pr617680755editdlrm
pre-grohtml706400755editdlrm
precat56560755editdlrm
preunzip56560755editdlrm
prezip56560755editdlrm
prezip-bin71520755editdlrm
printafm3860755editdlrm
printenv237360755editdlrm
printf463440755editdlrm
protoize686640755editdlrm
prove93690755editdlrm
ps2ascii7860755editdlrm
ps2epsi27720755editdlrm
ps2pdf3150755editdlrm
ps2pdf122600755editdlrm
ps2pdf132600755editdlrm
ps2pdf142600755editdlrm
ps2pdfwr10880755editdlrm
ps2ps6340755editdlrm
ps2ps27040755editdlrm
psed533250755editdlrm
pstruct366010755editdlrm
ptx1270640755editdlrm
pv.sh14200755editdlrm
pwdx67440755editdlrm
pydoc780755editdlrm
python48640755editdlrm
python248640755editdlrm
python2.648640755editdlrm
quota827520755editdlrm
ranlib566240755editdlrm
readelf3026080755editdlrm
readlink363600755editdlrm
recode401680755editdlrm
refer1222240755editdlrm
rename67520755editdlrm
renice73200755editdlrm
reset178960755editdlrm
rev67840755editdlrm
rnano1717840755editdlrm
rpcgen930000755editdlrm
run-with-aspell850755editdlrm
runcon281040755editdlrm
rvim22880880755editdlrm
s2p533250755editdlrm
scl183040755editdlrm
scl_enabled2580755editdlrm
scl_source18700755editdlrm
scp758480755editdlrm
screen3830960755editdlrm
script126240755editdlrm
sdiff235680755editdlrm
selectorctl77840755editdlrm
seq402800755editdlrm
setsid55360755editdlrm
setterm207840755editdlrm
sftp1045280755editdlrm
sha1sum362800755editdlrm
sha224sum421360755editdlrm
sha256sum421360755editdlrm
sha384sum485680755editdlrm
sha512sum485680755editdlrm
shred488960755editdlrm
shuf364080755editdlrm
size280400755editdlrm
skill151040755editdlrm
slabtop128880755editdlrm
slogin4507280755editdlrm
snice151040755editdlrm
snmpconf261370755editdlrm
soelim235120755editdlrm
spell1220755editdlrm
splain174520755editdlrm
split528240755editdlrm
sprof231040755editdlrm
sqlite3526800755editdlrm
ssh4507280755editdlrm
ssh-add1630160755editdlrm
ssh-agent1454800755editdlrm
ssh-copy-id14250755editdlrm
ssh-keygen2039760755editdlrm
ssh-keyscan2537520755editdlrm
stat461520755editdlrm
stdbuf609200755editdlrm
strace4335600755editdlrm
stream58480755editdlrm
strings280400755editdlrm
strip2122640755editdlrm
sum320960755editdlrm
tabs111920755editdlrm
tac937200755editdlrm
tail576880755editdlrm
tailf85200755editdlrm
tbl981760755editdlrm
tclsh52240755editdlrm
tclsh8.552240755editdlrm
tee241840755editdlrm
test302480755editdlrm
tfmtodit235600755editdlrm
tic498320755editdlrm
time141360755editdlrm
timeout467200755editdlrm
tload78240755editdlrm
tmpwatch177920755editdlrm
toe113920755editdlrm
top624480755editdlrm
tput115040755editdlrm
tr376080755editdlrm
troff3548640755editdlrm
truncate486160755editdlrm
tset178960755editdlrm
tsort319760755editdlrm
tty219280755editdlrm
tzselect71310755editdlrm
uapi10400755editdlrm
ul134160755editdlrm
unexpand280560755editdlrm
uniq364720755editdlrm
unix-lpr.sh42060755editdlrm
unprotoize575040755editdlrm
unzip1671600755editdlrm
unzipsfx769680755editdlrm
uptime48400755editdlrm
users241040755editdlrm
utmpdump109360755editdlrm
vdir1092080755editdlrm
vim22880880755editdlrm
vimdiff22880880755editdlrm
vimtutor20840755editdlrm
vmstat203200755editdlrm
watch125760755editdlrm
wc326160755editdlrm
wftopfa2840755editdlrm
wget3574000755editdlrm
whereis114560755editdlrm
which207680755editdlrm
who450160755editdlrm
whoami237360755editdlrm
word-list-compress67200755editdlrm
x86_64-redhat-linux-c++2679280755editdlrm
x86_64-redhat-linux-g++2679280755editdlrm
x86_64-redhat-linux-gcc2644720755editdlrm
xargs440240755editdlrm
xmlcatalog151520755editdlrm
xmllint588880755editdlrm
xmlwf224160755editdlrm
xsltproc235360755editdlrm
xsubpp40930755editdlrm
xxd151600755editdlrm
yes221200755editdlrm
zcmp670755editdlrm
zdiff44590755editdlrm
zegrep620755editdlrm
zfgrep620755editdlrm
zforce20260755editdlrm
zgrep54070755editdlrm
zip2120480755editdlrm
zipcloak1071040755editdlrm
zipgrep29530755editdlrm
zipinfo1671600755editdlrm
zipnote985840755editdlrm
zipsplit1026800755editdlrm
zless17310755editdlrm
zmore26050755editdlrm
znew52700755editdlrm
zsoelim235120755editdlrm
[334080755editdlrm
Edit: /usr/bin/h2xs (60385B)
#!/usr/bin/perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; use warnings; =head1 NAME h2xs - convert .h C header files to Perl extensions =head1 SYNOPSIS B [B ...] [headerfile ... [extra_libraries]] B B<-h>|B<-?>|B<--help> =head1 DESCRIPTION I builds a Perl extension from C header files. The extension will include functions which can be used to retrieve the value of any #define statement which was in the C header files. The I will be used for the name of the extension. If module_name is not supplied then the name of the first header file will be used, with the first character capitalized. If the extension might need extra libraries, they should be included here. The extension Makefile.PL will take care of checking whether the libraries actually exist and how they should be loaded. The extra libraries should be specified in the form -lm -lposix, etc, just as on the cc command line. By default, the Makefile.PL will search through the library path determined by Configure. That path can be augmented by including arguments of the form B<-L/another/library/path> in the extra-libraries argument. In spite of its name, I may also be used to create a skeleton pure Perl module. See the B<-X> option. =head1 OPTIONS =over 5 =item B<-A>, B<--omit-autoload> Omit all autoload facilities. This is the same as B<-c> but also removes the S> statement from the .pm file. =item B<-B>, B<--beta-version> Use an alpha/beta style version number. Causes version number to be "0.00_01" unless B<-v> is specified. =item B<-C>, B<--omit-changes> Omits creation of the F file, and adds a HISTORY section to the POD template. =item B<-F>, B<--cpp-flags>=I Additional flags to specify to C preprocessor when scanning header for function declarations. Writes these options in the generated F too. =item B<-M>, B<--func-mask>=I selects functions/macros to process. =item B<-O>, B<--overwrite-ok> Allows a pre-existing extension directory to be overwritten. =item B<-P>, B<--omit-pod> Omit the autogenerated stub POD section. =item B<-X>, B<--omit-XS> Omit the XS portion. Used to generate a skeleton pure Perl module. C<-c> and C<-f> are implicitly enabled. =item B<-a>, B<--gen-accessors> Generate an accessor method for each element of structs and unions. The generated methods are named after the element name; will return the current value of the element if called without additional arguments; and will set the element to the supplied value (and return the new value) if called with an additional argument. Embedded structures and unions are returned as a pointer rather than the complete structure, to facilitate chained calls. These methods all apply to the Ptr type for the structure; additionally two methods are constructed for the structure type itself, C<_to_ptr> which returns a Ptr type pointing to the same structure, and a C method to construct and return a new structure, initialised to zeroes. =item B<-b>, B<--compat-version>=I Generates a .pm file which is backwards compatible with the specified perl version. For versions < 5.6.0, the changes are. - no use of 'our' (uses 'use vars' instead) - no 'use warnings' Specifying a compatibility version higher than the version of perl you are using to run h2xs will have no effect. If unspecified h2xs will default to compatibility with the version of perl you are using to run h2xs. =item B<-c>, B<--omit-constant> Omit C from the .xs file and corresponding specialised C from the .pm file. =item B<-d>, B<--debugging> Turn on debugging messages. =item B<-e>, B<--omit-enums>=[I] If I is not given, skip all constants that are defined in a C enumeration. Otherwise skip only those constants that are defined in an enum whose name matches I. Since I is optional, make sure that this switch is followed by at least one other switch if you omit I and have some pending arguments such as header-file names. This is ok: h2xs -e -n Module::Foo foo.h This is not ok: h2xs -n Module::Foo -e foo.h In the latter, foo.h is taken as I. =item B<-f>, B<--force> Allows an extension to be created for a header even if that header is not found in standard include directories. =item B<-g>, B<--global> Include code for safely storing static data in the .xs file. Extensions that do no make use of static data can ignore this option. =item B<-h>, B<-?>, B<--help> Print the usage, help and version for this h2xs and exit. =item B<-k>, B<--omit-const-func> For function arguments declared as C, omit the const attribute in the generated XS code. =item B<-m>, B<--gen-tied-var> B: for each variable declared in the header file(s), declare a perl variable of the same name magically tied to the C variable. =item B<-n>, B<--name>=I Specifies a name to be used for the extension, e.g., S<-n RPC::DCE> =item B<-o>, B<--opaque-re>=I Use "opaque" data type for the C types matched by the regular expression, even if these types are C-equivalent to types from typemaps. Should not be used without B<-x>. This may be useful since, say, types which are C-equivalent to integers may represent OS-related handles, and one may want to work with these handles in OO-way, as in C<$handle-Edo_something()>. Use C<-o .> if you want to handle all the Ced types as opaque types. The type-to-match is whitewashed (except for commas, which have no whitespace before them, and multiple C<*> which have no whitespace between them). =item B<-p>, B<--remove-prefix>=I Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_> This sets up the XS B keyword and removes the prefix from functions that are autoloaded via the C mechanism. =item B<-s>, B<--const-subs>=I Create a perl subroutine for the specified macros rather than autoload with the constant() subroutine. These macros are assumed to have a return type of B, e.g., S<-s sec_rgy_wildcard_name,sec_rgy_wildcard_sid>. =item B<-t>, B<--default-type>=I Specify the internal type that the constant() mechanism uses for macros. The default is IV (signed integer). Currently all macros found during the header scanning process will be assumed to have this type. Future versions of C may gain the ability to make educated guesses. =item B<--use-new-tests> When B<--compat-version> (B<-b>) is present the generated tests will use C rather than C which is the default for versions before 5.7.2 . C will be added to PREREQ_PM in the generated C. =item B<--use-old-tests> Will force the generation of test code that uses the older C module. =item B<--skip-exporter> Do not use C and/or export any symbol. =item B<--skip-ppport> Do not use C: no portability to older version. =item B<--skip-autoloader> Do not use the module C; but keep the constant() function and C for constants. =item B<--skip-strict> Do not use the pragma C. =item B<--skip-warnings> Do not use the pragma C. =item B<-v>, B<--version>=I Specify a version number for this extension. This version number is added to the templates. The default is 0.01, or 0.00_01 if C<-B> is specified. The version specified should be numeric. =item B<-x>, B<--autogen-xsubs> Automatically generate XSUBs basing on function declarations in the header file. The package C should be installed. If this option is specified, the name of the header file may look like C. In this case NAME1 is used instead of the specified string, but XSUBs are emitted only for the declarations included from file NAME2. Note that some types of arguments/return-values for functions may result in XSUB-declarations/typemap-entries which need hand-editing. Such may be objects which cannot be converted from/to a pointer (like C), pointers to functions, or arrays. See also the section on L>. =back =head1 EXAMPLES # Default behavior, extension is Rusers h2xs rpcsvc/rusers # Same, but extension is RUSERS h2xs -n RUSERS rpcsvc/rusers # Extension is rpcsvc::rusers. Still finds h2xs rpcsvc::rusers # Extension is ONC::RPC. Still finds h2xs -n ONC::RPC rpcsvc/rusers # Without constant() or AUTOLOAD h2xs -c rpcsvc/rusers # Creates templates for an extension named RPC h2xs -cfn RPC # Extension is ONC::RPC. h2xs -cfn ONC::RPC # Extension is a pure Perl module with no XS code. h2xs -X My::Module # Extension is Lib::Foo which works at least with Perl5.005_03. # Constants are created for all #defines and enums h2xs can find # in foo.h. h2xs -b 5.5.3 -n Lib::Foo foo.h # Extension is Lib::Foo which works at least with Perl5.005_03. # Constants are created for all #defines but only for enums # whose names do not start with 'bar_'. h2xs -b 5.5.3 -e '^bar_' -n Lib::Foo foo.h # Makefile.PL will look for library -lrpc in # additional directory /opt/net/lib h2xs rpcsvc/rusers -L/opt/net/lib -lrpc # Extension is DCE::rgynbase # prefix "sec_rgy_" is dropped from perl function names h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase # Extension is DCE::rgynbase # prefix "sec_rgy_" is dropped from perl function names # subroutines are created for sec_rgy_wildcard_name and # sec_rgy_wildcard_sid h2xs -n DCE::rgynbase -p sec_rgy_ \ -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase # Make XS without defines in perl.h, but with function declarations # visible from perl.h. Name of the extension is perl1. # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)= # Extra backslashes below because the string is passed to shell. # Note that a directory with perl header files would # be added automatically to include path. h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h # Same with function declaration in proto.h as visible from perl.h. h2xs -xAn perl2 perl.h,proto.h # Same but select only functions which match /^av_/ h2xs -M '^av_' -xAn perl2 perl.h,proto.h # Same but treat SV* etc as "opaque" types h2xs -o '^[S]V \*$' -M '^av_' -xAn perl2 perl.h,proto.h =head2 Extension based on F<.h> and F<.c> files Suppose that you have some C files implementing some functionality, and the corresponding header files. How to create an extension which makes this functionality accessible in Perl? The example below assumes that the header files are F and I, and you want the perl module be named as C. If you need some preprocessor directives and/or linking with external libraries, see the flags C<-F>, C<-L> and C<-l> in L<"OPTIONS">. =over =item Find the directory name Start with a dummy run of h2xs: h2xs -Afn Ext::Ension The only purpose of this step is to create the needed directories, and let you know the names of these directories. From the output you can see that the directory for the extension is F. =item Copy C files Copy your header files and C files to this directory F. =item Create the extension Run h2xs, overwriting older autogenerated files: h2xs -Oxan Ext::Ension interface_simple.h interface_hairy.h h2xs looks for header files I changing to the extension directory, so it will find your header files OK. =item Archive and test As usual, run cd Ext/Ension perl Makefile.PL make dist make make test =item Hints It is important to do C as early as possible. This way you can easily merge(1) your changes to autogenerated files if you decide to edit your C<.h> files and rerun h2xs. Do not forget to edit the documentation in the generated F<.pm> file. Consider the autogenerated files as skeletons only, you may invent better interfaces than what h2xs could guess. Consider this section as a guideline only, some other options of h2xs may better suit your needs. =back =head1 ENVIRONMENT No environment variables are used. =head1 AUTHOR Larry Wall and others =head1 SEE ALSO L, L, L, and L. =head1 DIAGNOSTICS The usual warnings if it cannot read or write the files involved. =head1 LIMITATIONS of B<-x> F would not distinguish whether an argument to a C function which is of the form, say, C, is an input, output, or input/output parameter. In particular, argument declarations of the form int foo(n) int *n should be better rewritten as int foo(n) int &n if C is an input parameter. Additionally, F has no facilities to intuit that a function int foo(addr,l) char *addr int l takes a pair of address and length of data at this address, so it is better to rewrite this function as int foo(sv) SV *addr PREINIT: STRLEN len; char *s; CODE: s = SvPV(sv,len); RETVAL = foo(s, len); OUTPUT: RETVAL or alternately static int my_foo(SV *sv) { STRLEN len; char *s = SvPV(sv,len); return foo(s, len); } MODULE = foo PACKAGE = foo PREFIX = my_ int foo(sv) SV *sv See L and L for additional details. =cut # ' # Grr use strict; my( $H2XS_VERSION ) = ' $Revision: 1.23 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; my $compat_version = $]; use Getopt::Long; use Config; use Text::Wrap; $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); use File::Compare; use File::Path; sub usage { warn "@_\n" if @_; die <. --skip-strict Do not use the pragma C. --skip-warnings Do not use the pragma C. -v, --version Specify a version number for this extension. -x, --autogen-xsubs Autogenerate XSUBs using C::Scan. --use-xsloader Use XSLoader in backward compatible modules (ignored when used with -X). extra_libraries are any libraries that might be needed for loading the extension, e.g. -lm would try to link in the math library. EOFUSAGE } my ($opt_A, $opt_B, $opt_C, $opt_F, $opt_M, $opt_O, $opt_P, $opt_X, $opt_a, $opt_c, $opt_d, $opt_e, $opt_f, $opt_g, $opt_h, $opt_k, $opt_m, $opt_n, $opt_o, $opt_p, $opt_s, $opt_v, $opt_x, $opt_b, $opt_t, $new_test, $old_test, $skip_exporter, $skip_ppport, $skip_autoloader, $skip_strict, $skip_warnings, $use_xsloader ); Getopt::Long::Configure('bundling'); Getopt::Long::Configure('pass_through'); my %options = ( 'omit-autoload|A' => \$opt_A, 'beta-version|B' => \$opt_B, 'omit-changes|C' => \$opt_C, 'cpp-flags|F=s' => \$opt_F, 'func-mask|M=s' => \$opt_M, 'overwrite_ok|O' => \$opt_O, 'omit-pod|P' => \$opt_P, 'omit-XS|X' => \$opt_X, 'gen-accessors|a' => \$opt_a, 'compat-version|b=s' => \$opt_b, 'omit-constant|c' => \$opt_c, 'debugging|d' => \$opt_d, 'omit-enums|e:s' => \$opt_e, 'force|f' => \$opt_f, 'global|g' => \$opt_g, 'help|h|?' => \$opt_h, 'omit-const-func|k' => \$opt_k, 'gen-tied-var|m' => \$opt_m, 'name|n=s' => \$opt_n, 'opaque-re|o=s' => \$opt_o, 'remove-prefix|p=s' => \$opt_p, 'const-subs|s=s' => \$opt_s, 'default-type|t=s' => \$opt_t, 'version|v=s' => \$opt_v, 'autogen-xsubs|x' => \$opt_x, 'use-new-tests' => \$new_test, 'use-old-tests' => \$old_test, 'skip-exporter' => \$skip_exporter, 'skip-ppport' => \$skip_ppport, 'skip-autoloader' => \$skip_autoloader, 'skip-warnings' => \$skip_warnings, 'skip-strict' => \$skip_strict, 'use-xsloader' => \$use_xsloader, ); GetOptions(%options) || usage; usage if $opt_h; if( $opt_b ){ usage "You cannot use -b and -m at the same time.\n" if ($opt_b && $opt_m); $opt_b =~ /^v?(\d+)\.(\d+)\.(\d+)/ || usage "You must provide the backwards compatibility version in X.Y.Z form. " . "(i.e. 5.5.0)\n"; my ($maj,$min,$sub) = ($1,$2,$3); if ($maj < 5 || ($maj == 5 && $min < 6)) { $compat_version = $sub ? sprintf("%d.%03d%02d",$maj,$min,$sub) : sprintf("%d.%03d", $maj,$min); } else { $compat_version = sprintf("%d.%03d%03d",$maj,$min,$sub); } } else { my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d*)/; $sub ||= 0; warn sprintf <<'EOF', $maj,$min,$sub; Defaulting to backwards compatibility with perl %d.%d.%d If you intend this module to be compatible with earlier perl versions, please specify a minimum perl version with the -b option. EOF } if( $opt_B ){ $TEMPLATE_VERSION = '0.00_01'; } if( $opt_v ){ $TEMPLATE_VERSION = $opt_v; # check if it is numeric my $temp_version = $TEMPLATE_VERSION; my $beta_version = $temp_version =~ s/(\d)_(\d\d)/$1$2/; my $notnum; { local $SIG{__WARN__} = sub { $notnum = 1 }; use warnings 'numeric'; $temp_version = 0+$temp_version; } if ($notnum) { my $module = $opt_n || 'Your::Module'; warn <<"EOF"; You have specified a non-numeric version. Unless you supply an appropriate VERSION class method, users may not be able to specify a minimum required version with C. EOF } else { $opt_B = $beta_version; } } # -A implies -c. $skip_autoloader = $opt_c = 1 if $opt_A; # -X implies -c and -f $opt_c = $opt_f = 1 if $opt_X; $opt_t ||= 'IV'; my %const_xsub; %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; my $extralibs = ''; my @path_h; while (my $arg = shift) { if ($arg =~ /^-l/i) { $extralibs .= "$arg "; next; } last if $extralibs; push(@path_h, $arg); } usage "Must supply header file or module name\n" unless (@path_h or $opt_n); my $fmask; my $tmask; $fmask = qr{$opt_M} if defined $opt_M; $tmask = qr{$opt_o} if defined $opt_o; my $tmask_all = $tmask && $opt_o eq '.'; if ($opt_x) { eval {require C::Scan; 1} or die <= 0.70 or die <curdir(), $Config{usrinc}, (split ' ', $Config{locincpth}), '/usr/include'); } foreach my $path_h (@path_h) { $name ||= $path_h; $module ||= do { $name =~ s/\.h$//; if ( $name !~ /::/ ) { $name =~ s#^.*/##; $name = "\u$name"; } $name; }; if( $path_h =~ s#::#/#g && $opt_n ){ warn "Nesting of headerfile ignored with -n\n"; } $path_h .= ".h" unless $path_h =~ /\.h$/; my $fullpath = $path_h; $path_h =~ s/,.*$// if $opt_x; $fullpath{$path_h} = $fullpath; # Minor trickery: we can't chdir() before we processed the headers # (so know the name of the extension), but the header may be in the # extension directory... my $tmp_path_h = $path_h; my $rel_path_h = $path_h; my @dirs = @paths; if (not -f $path_h) { my $found; for my $dir (@paths) { $found++, last if -f ($path_h = File::Spec->catfile($dir, $tmp_path_h)); } if ($found) { $rel_path_h = $path_h; $fullpath{$path_h} = $fullpath; } else { (my $epath = $module) =~ s,::,/,g; $epath = File::Spec->catdir('ext', $epath) if -d 'ext'; $rel_path_h = File::Spec->catfile($epath, $tmp_path_h); $path_h = $tmp_path_h; # Used during -x push @dirs, $epath; } } if (!$opt_c) { die "Can't find $tmp_path_h in @dirs\n" if ( ! $opt_f && ! -f "$rel_path_h" ); # Scan the header file (we should deal with nested header files) # Record the names of simple #define constants into const_names # Function prototypes are processed below. open(CH, "<$rel_path_h") || die "Can't open $rel_path_h: $!\n"; defines: while () { if ($pre_sub_tri_graphs) { # Preprocess all tri-graphs # including things stuck in quoted string constants. s/\?\?=/#/g; # | ??=| #| s/\?\?\!/|/g; # | ??!| || s/\?\?'/^/g; # | ??'| ^| s/\?\?\(/[/g; # | ??(| [| s/\?\?\)/]/g; # | ??)| ]| s/\?\?\-/~/g; # | ??-| ~| s/\?\?\//\\/g; # | ??/| \| s/\?\?/}/g; # | ??>| }| } if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^"\s])(.*)/) { my $def = $1; my $rest = $2; $rest =~ s!/\*.*?(\*/|\n)|//.*!!g; # Remove comments $rest =~ s/^\s+//; $rest =~ s/\s+$//; # Cannot do: (-1) and ((LHANDLE)3) are OK: #print("Skip non-wordy $def => $rest\n"), # next defines if $rest =~ /[^\w\$]/; if ($rest =~ /"/) { print("Skip stringy $def => $rest\n") if $opt_d; next defines; } print "Matched $_ ($def)\n" if $opt_d; $seen_define{$def} = $rest; $_ = $def; next if /^_.*_h_*$/i; # special case, but for what? if (defined $opt_p) { if (!/^$opt_p(\d)/) { ++$prefix{$_} if s/^$opt_p//; } else { warn "can't remove $opt_p prefix from '$_'!\n"; } } $prefixless{$def} = $_; if (!$fmask or /$fmask/) { print "... Passes mask of -M.\n" if $opt_d and $fmask; $const_names{$_}++; } } } if (defined $opt_e and !$opt_e) { close(CH); } else { # Work from miniperl too - on "normal" systems my $SEEK_SET = eval 'use Fcntl qw/SEEK_SET/; SEEK_SET' or 0; seek CH, 0, $SEEK_SET; my $src = do { local $/; }; close CH; no warnings 'uninitialized'; # Remove C and C++ comments $src =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs; $src =~ s#//.*$##gm; while ($src =~ /\benum\s*([\w_]*)\s*\{\s([^}]+)\}/gsc) { my ($enum_name, $enum_body) = ($1, $2); # skip enums matching $opt_e next if $opt_e && $enum_name =~ /$opt_e/; my $val = 0; for my $item (split /,/, $enum_body) { next if $item =~ /\A\s*\Z/; my ($key, $declared_val) = $item =~ /(\w+)\s*(?:=\s*(.*))?/; $val = defined($declared_val) && length($declared_val) ? $declared_val : 1 + $val; $seen_define{$key} = $val; $const_names{$key} = { name => $key, macro => 1 }; } } # while (...) } # if (!defined $opt_e or $opt_e) } } } # Save current directory so that C::Scan can use it my $cwd = File::Spec->rel2abs( File::Spec->curdir ); # As Ilya suggested, use a name that contains - and then it can't clash with # the names of any packages. A directory 'fallback' will clash with any # new pragmata down the fallback:: tree, but that seems unlikely. my $constscfname = 'const-c.inc'; my $constsxsfname = 'const-xs.inc'; my $fallbackdirname = 'fallback'; my $ext = chdir 'ext' ? 'ext/' : ''; my @modparts = split(/::/,$module); my $modpname = join('-', @modparts); my $modfname = pop @modparts; my $modpmdir = join '/', 'lib', @modparts; my $modpmname = join '/', $modpmdir, $modfname.'.pm'; if ($opt_O) { warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname; } else { die "Won't overwrite existing $ext$modpname\n" if -e $modpname; } -d "$modpname" || mkpath([$modpname], 0, 0775); chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; my %types_seen; my %std_types; my $fdecls = []; my $fdecls_parsed = []; my $typedef_rex; my %typedefs_pre; my %known_fnames; my %structs; my @fnames; my @fnames_no_prefix; my %vdecl_hash; my @vdecls; if( ! $opt_X ){ # use XS, unless it was disabled unless ($skip_ppport) { require Devel::PPPort; warn "Writing $ext$modpname/ppport.h\n"; Devel::PPPort::WriteFile('ppport.h') || die "Can't create $ext$modpname/ppport.h: $!\n"; } open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; if ($opt_x) { warn "Scanning typemaps...\n"; get_typemap(); my @td; my @good_td; my $addflags = $opt_F || ''; foreach my $filename (@path_h) { my $c; my $filter; if ($fullpath{$filename} =~ /,/) { $filename = $`; $filter = $'; } warn "Scanning $filename for functions...\n"; my @styles = $Config{gccversion} ? qw(C++ C9X GNU) : qw(C++ C9X); $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, 'add_cppflags' => $addflags, 'c_styles' => \@styles; $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]); $c->get('keywords')->{'__restrict'} = 1; push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); push @td, @{$c->get('typedefs_maybe')}; if ($opt_a) { my $structs = $c->get('typedef_structs'); @structs{keys %$structs} = values %$structs; } if ($opt_m) { %vdecl_hash = %{ $c->get('vdecl_hash') }; @vdecls = sort keys %vdecl_hash; for (local $_ = 0; $_ < @vdecls; ++$_) { my $var = $vdecls[$_]; my($type, $post) = @{ $vdecl_hash{$var} }; if (defined $post) { warn "Can't handle variable '$type $var $post', skipping.\n"; splice @vdecls, $_, 1; redo; } $type = normalize_type($type); $vdecl_hash{$var} = $type; } } unless ($tmask_all) { warn "Scanning $filename for typedefs...\n"; my $td = $c->get('typedef_hash'); # eval {require 'dumpvar.pl'; ::dumpValue($td)} or warn $@ if $opt_d; my @f_good_td = grep $td->{$_}[1] eq '', keys %$td; push @good_td, @f_good_td; @typedefs_pre{@f_good_td} = map $_->[0], @$td{@f_good_td}; } } { local $" = '|'; $typedef_rex = qr(\b(?[$i][1] =~ /$fmask/; # [1] is NAME push @good, $i; print "... Function $fdecls_parsed->[$i][1] passes -M mask.\n" if $opt_d; } $fdecls = [@$fdecls[@good]]; $fdecls_parsed = [@$fdecls_parsed[@good]]; } @fnames = sort map $_->[1], @$fdecls_parsed; # 1 is NAME # Sort declarations: { my %h = map( ($_->[1], $_), @$fdecls_parsed); $fdecls_parsed = [ @h{@fnames} ]; } @fnames_no_prefix = @fnames; @fnames_no_prefix = sort map { ++$prefix{$_} if s/^$opt_p(?!\d)//; $_ } @fnames_no_prefix if defined $opt_p; # Remove macros which expand to typedefs print "Typedefs are @td.\n" if $opt_d; my %td = map {($_, $_)} @td; # Add some other possible but meaningless values for macros for my $k (qw(char double float int long short unsigned signed void)) { $td{"$_$k"} = "$_$k" for ('', 'signed ', 'unsigned '); } # eval {require 'dumpvar.pl'; ::dumpValue( [\@td, \%td] ); 1} or warn $@; my $n = 0; my %bad_macs; while (keys %td > $n) { $n = keys %td; my ($k, $v); while (($k, $v) = each %seen_define) { # print("found '$k'=>'$v'\n"), $bad_macs{$k} = $td{$k} = $td{$v} if exists $td{$v}; } } # Now %bad_macs contains names of bad macros for my $k (keys %bad_macs) { delete $const_names{$prefixless{$k}}; print "Ignoring macro $k which expands to a typedef name '$bad_macs{$k}'\n" if $opt_d; } } } my (@const_specs, @const_names); for (sort(keys(%const_names))) { my $v = $const_names{$_}; push(@const_specs, ref($v) ? $v : $_); push(@const_names, $_); } -d $modpmdir || mkpath([$modpmdir], 0, 0775); open(PM, ">$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n"; $" = "\n\t"; warn "Writing $ext$modpname/$modpmname\n"; print PM <<"END"; package $module; use $compat_version; END print PM <<"END" unless $skip_strict; use strict; END print PM "use warnings;\n" unless $skip_warnings or $compat_version < 5.006; unless( $opt_X || $opt_c || $opt_A ){ # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and # will want Carp. print PM <<'END'; use Carp; END } print PM <<'END' unless $skip_exporter; require Exporter; END my $use_Dyna = (not $opt_X and $compat_version < 5.006 and not $use_xsloader); print PM <<"END" if $use_Dyna; # use DynaLoader, unless XS was disabled require DynaLoader; END # Are we using AutoLoader or not? unless ($skip_autoloader) { # no autoloader whatsoever. unless ($opt_c) { # we're doing the AUTOLOAD print PM "use AutoLoader;\n"; } else { print PM "use AutoLoader qw(AUTOLOAD);\n" } } if ( $compat_version < 5.006 ) { my $vars = '$VERSION @ISA'; $vars .= ' @EXPORT @EXPORT_OK %EXPORT_TAGS' unless $skip_exporter; $vars .= ' $AUTOLOAD' unless $opt_X || $opt_c || $opt_A; $vars .= ' $XS_VERSION' if $opt_B && !$opt_X; print PM "use vars qw($vars);"; } # Determine @ISA. my @modISA; push @modISA, 'Exporter' unless $skip_exporter; push @modISA, 'DynaLoader' if $use_Dyna; # no XS my $myISA = "our \@ISA = qw(@modISA);"; $myISA =~ s/^our // if $compat_version < 5.006; print PM "\n$myISA\n\n"; my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls); my $tmp=''; $tmp .= <<"END" unless $skip_exporter; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use $module ':all'; # If you do not need this, moving things directly into \@EXPORT or \@EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( @exported_names ) ] ); our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } ); our \@EXPORT = qw( @const_names ); END $tmp .= "our \$VERSION = '$TEMPLATE_VERSION';\n"; if ($opt_B) { $tmp .= "our \$XS_VERSION = \$VERSION;\n" unless $opt_X; $tmp .= "\$VERSION = eval \$VERSION; # see L\n"; } $tmp .= "\n"; $tmp =~ s/^our //mg if $compat_version < 5.006; print PM $tmp; if (@vdecls) { printf PM "our(@{[ join ', ', map '$'.$_, @vdecls ]});\n\n"; } print PM autoload ($module, $compat_version) unless $opt_c or $opt_X; if( ! $opt_X ){ # print bootstrap, unless XS is disabled if ($use_Dyna) { $tmp = <<"END"; bootstrap $module \$VERSION; END } else { $tmp = <<"END"; require XSLoader; XSLoader::load('$module', \$VERSION); END } $tmp =~ s:\$VERSION:\$XS_VERSION:g if $opt_B; print PM $tmp; } # tying the variables can happen only after bootstrap if (@vdecls) { printf PM <))[0,6]; if (defined $username && defined $author) { $author =~ s/,.*$//; # in case of sub fields my $domain = $Config{'mydomain'}; $domain =~ s/^\.//; $email = "$username\@$domain"; } }; $author =~ s/'/\\'/g if defined $author; $author ||= "A. U. Thor"; $email ||= 'a.u.thor@a.galaxy.far.far.away'; $licence = sprintf << "DEFAULT", $^V; Copyright (C) ${\(1900 + (localtime) [5])} by $author This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version %vd or, at your option, any later version of Perl 5 you may have available. DEFAULT my $revhist = ''; $revhist = < should be removed. # #EOD $exp_doc .= <${email}E # #=head1 COPYRIGHT AND LICENSE # $licence_hash # #=cut END $pod =~ s/^\#//gm unless $opt_P; print PM $pod unless $opt_P; close PM; if( ! $opt_X ){ # print XS, unless it is disabled warn "Writing $ext$modpname/$modfname.xs\n"; print XS <<"END"; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" END print XS <<"END" unless $skip_ppport; #include "ppport.h" END if( @path_h ){ foreach my $path_h (@path_h_ini) { my($h) = $path_h; $h =~ s#^/usr/include/##; if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; } print XS qq{#include <$h>\n}; } print XS "\n"; } print XS <<"END" if $opt_g; /* Global Data */ #define MY_CXT_KEY "${module}::_guts" XS_VERSION typedef struct { /* Put Global Data in here */ int dummy; /* you can access this elsewhere as MY_CXT.dummy */ } my_cxt_t; START_MY_CXT END my %pointer_typedefs; my %struct_typedefs; sub td_is_pointer { my $type = shift; my $out = $pointer_typedefs{$type}; return $out if defined $out; my $otype = $type; $out = ($type =~ /\*$/); # This converts only the guys which do not have trailing part in the typedef if (not $out and $typedef_rex and $type =~ s/($typedef_rex)/$typedefs_pre{$1}/go) { $type = normalize_type($type); print "Is-Pointer: Type mutation via typedefs: $otype ==> $type\n" if $opt_d; $out = td_is_pointer($type); } return ($pointer_typedefs{$otype} = $out); } sub td_is_struct { my $type = shift; my $out = $struct_typedefs{$type}; return $out if defined $out; my $otype = $type; $out = ($type =~ /^(struct|union)\b/) && !td_is_pointer($type); # This converts only the guys which do not have trailing part in the typedef if (not $out and $typedef_rex and $type =~ s/($typedef_rex)/$typedefs_pre{$1}/go) { $type = normalize_type($type); print "Is-Struct: Type mutation via typedefs: $otype ==> $type\n" if $opt_d; $out = td_is_struct($type); } return ($struct_typedefs{$otype} = $out); } print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls; if( ! $opt_c ) { # We write the "sample" files used when this module is built by perl without # ExtUtils::Constant. # h2xs will later check that these are the same as those generated by the # code embedded into Makefile.PL unless (-d $fallbackdirname) { mkdir "$fallbackdirname" or die "Cannot mkdir $fallbackdirname: $!\n"; } warn "Writing $ext$modpname/$fallbackdirname/$constscfname\n"; warn "Writing $ext$modpname/$fallbackdirname/$constsxsfname\n"; my $cfallback = File::Spec->catfile($fallbackdirname, $constscfname); my $xsfallback = File::Spec->catfile($fallbackdirname, $constsxsfname); WriteConstants ( C_FILE => $cfallback, XS_FILE => $xsfallback, DEFAULT_TYPE => $opt_t, NAME => $module, NAMES => \@const_specs, ); print XS "#include \"$constscfname\"\n"; } my $prefix = defined $opt_p ? "PREFIX = $opt_p" : ''; # Now switch from C to XS by issuing the first MODULE declaration: print XS <<"END"; MODULE = $module PACKAGE = $module $prefix END # If a constant() function was #included then output a corresponding # XS declaration: print XS "INCLUDE: $constsxsfname\n" unless $opt_c; print XS <<"END" if $opt_g; BOOT: { MY_CXT_INIT; /* If any of the fields in the my_cxt_t struct need to be initialised, do it here. */ } END foreach (sort keys %const_xsub) { print XS <<"END"; char * $_() CODE: #ifdef $_ RETVAL = $_; #else croak("Your vendor has not defined the $module macro $_"); #endif OUTPUT: RETVAL END } my %seen_decl; my %typemap; sub print_decl { my $fh = shift; my $decl = shift; my ($type, $name, $args) = @$decl; return if $seen_decl{$name}++; # Need to do the same for docs as well? my @argnames = map {$_->[1]} @$args; my @argtypes = map { normalize_type( $_->[0], 1 ) } @$args; if ($opt_k) { s/^\s*const\b\s*// for @argtypes; } my @argarrays = map { $_->[4] || '' } @$args; my $numargs = @$args; if ($numargs and $argtypes[-1] eq '...') { $numargs--; $argnames[-1] = '...'; } local $" = ', '; $type = normalize_type($type, 1); print $fh <<"EOP"; $type $name(@argnames) EOP for my $arg (0 .. $numargs - 1) { print $fh <<"EOP"; $argtypes[$arg] $argnames[$arg]$argarrays[$arg] EOP } } sub print_tievar_subs { my($fh, $name, $type) = @_; print $fh <[0] =~ /_ANON/) { if (defined $item->[2]) { push @items, map [ @$_[0, 1], "$item->[2]_$_->[2]", "$item->[2].$_->[2]", ], @{ $structs{$item->[0]} }; } else { push @items, @{ $structs{$item->[0]} }; } } else { my $type = normalize_type($item->[0]); my $ttype = $structs{$type} ? normalize_type("$type *") : $type; print $fh <<"EOF"; $ttype $item->[2](THIS, __value = NO_INIT) $ptrname THIS $type __value PROTOTYPE: \$;\$ CODE: if (items > 1) THIS->$item->[-1] = __value; RETVAL = @{[ $type eq $ttype ? "THIS->$item->[-1]" : "&(THIS->$item->[-1])" ]}; OUTPUT: RETVAL EOF } } } sub accessor_docs { my($name, $struct) = @_; return unless defined $struct && $name !~ /\s|_ANON/; $name = normalize_type($name); my $ptrname = $name . 'Ptr'; my @items = @$struct; my @list; while (@items) { my $item = shift @items; if ($item->[0] =~ /_ANON/) { if (defined $item->[2]) { push @items, map [ @$_[0, 1], "$item->[2]_$_->[2]", "$item->[2].$_->[2]", ], @{ $structs{$item->[0]} }; } else { push @items, @{ $structs{$item->[0]} }; } } else { push @list, $item->[2]; } } my $methods = (join '(...)>, C<', @list) . '(...)'; my $pod = <<"EOF"; # #=head2 Object and class methods for C<$name>/C<$ptrname> # #The principal Perl representation of a C object of type C<$name> is an #object of class C<$ptrname> which is a reference to an integer #representation of a C pointer. To create such an object, one may use #a combination # # my \$buffer = $name->new(); # my \$obj = \$buffer->_to_ptr(); # #This exersizes the following two methods, and an additional class #C<$name>, the internal representation of which is a reference to a #packed string with the C structure. Keep in mind that \$buffer should #better survive longer than \$obj. # #=over # #=item C<\$object_of_type_$name-E_to_ptr()> # #Converts an object of type C<$name> to an object of type C<$ptrname>. # #=item C<$name-Enew()> # #Creates an empty object of type C<$name>. The corresponding packed #string is zeroed out. # #=item C<$methods> # #return the current value of the corresponding element if called #without additional arguments. Set the element to the supplied value #(and return the new value) if called with an additional argument. # #Applicable to objects of type C<$ptrname>. # #=back # EOF $pod =~ s/^\#//gm; return $pod; } # Should be called before any actual call to normalize_type(). sub get_typemap { # We do not want to read ./typemap by obvios reasons. my @tm = qw(../../../typemap ../../typemap ../typemap); my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap"; unshift @tm, $stdtypemap; my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ; # Start with useful default values $typemap{float} = 'T_NV'; foreach my $typemap (@tm) { next unless -e $typemap ; # skip directories, binary files etc. warn " Scanning $typemap\n"; warn("Warning: ignoring non-text typemap file '$typemap'\n"), next unless -T $typemap ; open(TYPEMAP, $typemap) or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; my $mode = 'Typemap'; while () { next if /^\s*\#/; if (/^INPUT\s*$/) { $mode = 'Input'; next; } elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; } elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; } elsif ($mode eq 'Typemap') { next if /^\s*($|\#)/ ; my ($type, $image); if ( ($type, $image) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o # This may reference undefined functions: and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) { $typemap{normalize_type($type)} = $image; } } } close(TYPEMAP) or die "Cannot close $typemap: $!"; } %std_types = %types_seen; %types_seen = (); } sub normalize_type { # Second arg: do not strip const's before \* my $type = shift; my $do_keep_deep_const = shift; # If $do_keep_deep_const this is heuristical only my $keep_deep_const = ($do_keep_deep_const ? '\b(?![^(,)]*\*)' : ''); my $ignore_mods = "(?:\\b(?:(?:__const__|const)$keep_deep_const|static|inline|__inline__)\\b\\s*)*"; if ($do_keep_deep_const) { # Keep different compiled /RExen/o separately! $type =~ s/$ignore_mods//go; } else { $type =~ s/$ignore_mods//go; } $type =~ s/([^\s\w])/ $1 /g; $type =~ s/\s+$//; $type =~ s/^\s+//; $type =~ s/\s+/ /g; $type =~ s/\* (?=\*)/*/g; $type =~ s/\. \. \./.../g; $type =~ s/ ,/,/g; $types_seen{$type}++ unless $type eq '...' or $type eq 'void' or $std_types{$type}; $type; } my $need_opaque; sub assign_typemap_entry { my $type = shift; my $otype = $type; my $entry; if ($tmask and $type =~ /$tmask/) { print "Type $type matches -o mask\n" if $opt_d; $entry = (td_is_struct($type) ? "T_OPAQUE_STRUCT" : "T_PTROBJ"); } elsif ($typedef_rex and $type =~ s/($typedef_rex)/$typedefs_pre{$1}/go) { $type = normalize_type $type; print "Type mutation via typedefs: $otype ==> $type\n" if $opt_d; $entry = assign_typemap_entry($type); } # XXX good do better if our UV happens to be long long return "T_NV" if $type =~ /^(unsigned\s+)?long\s+(long|double)\z/; $entry ||= $typemap{$otype} || (td_is_struct($type) ? "T_OPAQUE_STRUCT" : "T_PTROBJ"); $typemap{$otype} = $entry; $need_opaque = 1 if $entry eq "T_OPAQUE_STRUCT"; return $entry; } for (@vdecls) { print_tievar_xsubs(\*XS, $_, $vdecl_hash{$_}); } if ($opt_x) { for my $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) } if ($opt_a) { while (my($name, $struct) = each %structs) { print_accessors(\*XS, $name, $struct); } } } close XS; if (%types_seen) { my $type; warn "Writing $ext$modpname/typemap\n"; open TM, ">typemap" or die "Cannot open typemap file for write: $!"; for $type (sort keys %types_seen) { my $entry = assign_typemap_entry $type; print TM $type, "\t" x (5 - int((length $type)/8)), "\t$entry\n" } print TM <<'EOP' if $need_opaque; # Older Perls do not have correct entry ############################################################################# INPUT T_OPAQUE_STRUCT if (sv_derived_from($arg, \"${ntype}\")) { STRLEN len; char *s = SvPV((SV*)SvRV($arg), len); if (len != sizeof($var)) croak(\"Size %d of packed data != expected %d\", len, sizeof($var)); $var = *($type *)s; } else croak(\"$var is not of type ${ntype}\") ############################################################################# OUTPUT T_OPAQUE_STRUCT sv_setref_pvn($arg, \"${ntype}\", (char *)&$var, sizeof($var)); EOP close TM or die "Cannot close typemap file for write: $!"; } } # if( ! $opt_X ) warn "Writing $ext$modpname/Makefile.PL\n"; open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; my $prereq_pm = ''; if ( $compat_version < 5.00702 and $new_test ) { $prereq_pm .= q%'Test::More' => 0, %; } if ( $compat_version < 5.00600 and !$opt_X and $use_xsloader) { $prereq_pm .= q%'XSLoader' => 0, %; } print PL <<"END"; use $compat_version; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => '$module', VERSION_FROM => '$modpmname', # finds \$VERSION PREREQ_PM => {$prereq_pm}, # e.g., Module::Name => 1.1 (\$] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => '$modpmname', # retrieve abstract from module AUTHOR => '$author <$email>') : ()), END if (!$opt_X) { # print C stuff, unless XS is disabled $opt_F = '' unless defined $opt_F; my $I = (((glob '*.h') || (glob '*.hh')) ? '-I.' : ''); my $Ihelp = ($I ? '-I. ' : ''); my $Icomment = ($I ? '' : < ['$extralibs'], # e.g., '-lm' DEFINE => '$opt_F', # e.g., '-DHAVE_SOMETHING' $Icomment INC => '$I', # e.g., '${Ihelp}-I/usr/include/other' END my $C = grep {$_ ne "$modfname.c"} (glob '*.c'), (glob '*.cc'), (glob '*.C'); my $Cpre = ($C ? '' : '# '); my $Ccomment = ($C ? '' : < '\$(O_FILES)', # link all the C files too END } # ' # Grr print PL ");\n"; if (!$opt_c) { my $generate_code = WriteMakefileSnippet ( C_FILE => $constscfname, XS_FILE => $constsxsfname, DEFAULT_TYPE => $opt_t, NAME => $module, NAMES => \@const_specs, ); print PL <<"END"; if (eval {require ExtUtils::Constant; 1}) { # If you edit these definitions to change the constants used by this module, # you will need to use the generated $constscfname and $constsxsfname # files to replace their "fallback" counterparts before distributing your # changes. $generate_code } else { use File::Copy; use File::Spec; foreach my \$file ('$constscfname', '$constsxsfname') { my \$fallback = File::Spec->catfile('$fallbackdirname', \$file); copy (\$fallback, \$file) or die "Can't copy \$fallback to \$file: \$!"; } } END eval $generate_code; if ($@) { warn <<"EOM"; Attempting to test constant code in $ext$modpname/Makefile.PL: $generate_code __END__ gave unexpected error $@ Please report the circumstances of this bug in h2xs version $H2XS_VERSION using the perlbug script. EOM } else { my $fail; foreach my $file ($constscfname, $constsxsfname) { my $fallback = File::Spec->catfile($fallbackdirname, $file); if (compare($file, $fallback)) { warn << "EOM"; Files "$ext$modpname/$fallbackdirname/$file" and "$ext$modpname/$file" differ. EOM $fail++; } } if ($fail) { warn fill ('','', <<"EOM") . "\n"; It appears that the code in $ext$modpname/Makefile.PL does not autogenerate the files $ext$modpname/$constscfname and $ext$modpname/$constsxsfname correctly. Please report the circumstances of this bug in h2xs version $H2XS_VERSION using the perlbug script. EOM } else { unlink $constscfname, $constsxsfname; } } } close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n"; # Create a simple README since this is a CPAN requirement # and it doesnt hurt to have one warn "Writing $ext$modpname/README\n"; open(RM, ">README") || die "Can't create $ext$modpname/README:$!\n"; my $thisyear = (gmtime)[5] + 1900; my $rmhead = "$modpname version $TEMPLATE_VERSION"; my $rmheadeq = "=" x length($rmhead); my $rm_prereq; if ( $compat_version < 5.00702 and $new_test ) { $rm_prereq = 'Test::More'; } else { $rm_prereq = 'blah blah blah'; } print RM <<_RMEND_; $rmhead $rmheadeq The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: $rm_prereq COPYRIGHT AND LICENCE Put the correct copyright and licence information here. $licence _RMEND_ close(RM) || die "Can't close $ext$modpname/README: $!\n"; my $testdir = "t"; my $testfile = "$testdir/$modpname.t"; unless (-d "$testdir") { mkdir "$testdir" or die "Cannot mkdir $testdir: $!\n"; } warn "Writing $ext$modpname/$testfile\n"; my $tests = @const_names ? 2 : 1; open EX, ">$testfile" or die "Can't create $ext$modpname/$testfile: $!\n"; print EX <<_END_; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl $modpname.t' ######################### # change 'tests => $tests' to 'tests => last_test_to_print'; _END_ my $test_mod = 'Test::More'; if ( $old_test or ($compat_version < 5.007 and not $new_test )) { my $test_mod = 'Test'; print EX <<_END_; use Test; BEGIN { plan tests => $tests }; use $module; ok(1); # If we made it this far, we're ok. _END_ if (@const_names) { my $const_names = join " ", @const_names; print EX <<'_END_'; my $fail; foreach my $constname (qw( _END_ print EX wrap ("\t", "\t", $const_names); print EX (")) {\n"); print EX <<_END_; next if (eval "my \\\$a = \$constname; 1"); if (\$\@ =~ /^Your vendor has not defined $module macro \$constname/) { print "# pass: \$\@"; } else { print "# fail: \$\@"; \$fail = 1; } } if (\$fail) { print "not ok 2\\n"; } else { print "ok 2\\n"; } _END_ } } else { print EX <<_END_; use Test::More tests => $tests; BEGIN { use_ok('$module') }; _END_ if (@const_names) { my $const_names = join " ", @const_names; print EX <<'_END_'; my $fail = 0; foreach my $constname (qw( _END_ print EX wrap ("\t", "\t", $const_names); print EX (")) {\n"); print EX <<_END_; next if (eval "my \\\$a = \$constname; 1"); if (\$\@ =~ /^Your vendor has not defined $module macro \$constname/) { print "# pass: \$\@"; } else { print "# fail: \$\@"; \$fail = 1; } } ok( \$fail == 0 , 'Constants' ); _END_ } } print EX <<_END_; ######################### # Insert your test code below, the $test_mod module is use()ed here so read # its man page ( perldoc $test_mod ) for help writing this test script. _END_ close(EX) || die "Can't close $ext$modpname/$testfile: $!\n"; unless ($opt_C) { warn "Writing $ext$modpname/Changes\n"; $" = ' '; open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n"; @ARGS = map {/[\s\"\'\`\$*?^|&<>\[\]\{\}\(\)]/ ? "'$_'" : $_} @ARGS; print EX <MANIFEST') or die "Can't create MANIFEST: $!"; my @files = grep { -f } (<*>, , <$fallbackdirname/*>, <$modpmdir/*>); if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); } } if (!@files) { @files = map {chomp && $_} `ls`; } if ($^O eq 'VMS') { foreach (@files) { # Clip trailing '.' for portability -- non-VMS OSs don't expect it s%\.$%%; # Fix up for case-sensitive file systems s/$modfname/$modfname/i && next; $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes'; $_ = 'Makefile.PL' if $_ eq 'makefile.pl'; } } print MANI join("\n",@files), "\n"; close MANI;