6 Perl/Pollution/Portability
10 Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
11 Devel::PPPort::WriteFile('someheader.h') ;
15 Perl has changed over time, gaining new features, new functions,
16 increasing its flexibility, and reducing the impact on the C namespace
17 environment (reduced pollution). The header file, typicaly C<ppport.h>,
18 written by this module attempts to bring some of the newer Perl
19 features to older versions of Perl, so that you can worry less about
20 keeping track of old releases, but users can still reap the benefit.
22 Why you should use C<ppport.h> in modern code: so that your code will work
23 with the widest range of Perl interpreters possible, without significant
26 Why you should attempt older code to fully use C<ppport.h>: because
27 the reduced pollution of newer Perl versions is an important thing, so
28 important that the old polluting ways of original Perl modules will not be
29 supported very far into the future, and your module will almost certainly
30 break! By adapting to it now, you'll gained compatibility and a sense of
31 having done the electronic ecology some good.
33 How to use ppport.h: Don't direct the user to download C<Devel::PPPort>,
34 and don't make C<ppport.h> optional. Rather, just take the most recent
35 copy of C<ppport.h> that you can find (probably in C<Devel::PPPort>
36 on CPAN), copy it into your project, adjust your project to use it,
37 and distribute the header along with your module.
39 C<Devel::PPPort> contains a single function, called C<WriteFile>. It's
40 purpose is to write a 'C' header file that is used when writing XS
41 modules. The file contains a series of macros that allow XS modules to
42 be built using older versions of Perl.
44 This module is used by h2xs to write the file F<ppport.h>.
48 C<WriteFile> takes a zero or one parameters. When called with one
49 parameter it expects to be passed a filename. When called with no
50 parameters, it defults to the filename C<./pport.h>.
52 The function returns TRUE if the file was written successfully. Otherwise
57 The file written by this module, typically C<ppport.h>, provides access
58 to the following Perl API if not already available:
100 gv_stashpvn(str,len,flags)
101 newCONSTSUB(stash,name,sv)
112 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
114 Version 2.x was ported to the Perl core by Paul Marquess.
123 package Devel::PPPort;
129 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );
133 @ISA = qw(Exporter DynaLoader);
135 # Other items we are prepared to export if requested
138 bootstrap Devel::PPPort;
140 package Devel::PPPort;
146 my $pkg = __PACKAGE__;
147 $data =~ s/__VERSION__/$VERSION/g;
148 $data =~ s/__DATE__/$now/g;
149 $data =~ s/__PKG__/$pkg/g;
154 my $file = shift || 'ppport.h' ;
156 open F, ">$file" || return undef ;
167 /* ppport.h -- Perl/Pollution/Portability Version __VERSION__
169 * Automatically Created by __PKG__ on __DATE__
171 * Do NOT edit this file directly! -- Edit PPPort.pm instead.
173 * Version 2.x, Copyright (C) 2001, Paul Marquess.
174 * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
175 * This code may be used and distributed under the same license as any
178 * This version of ppport.h is designed to support operation with Perl
179 * installations back to 5.004, and has been tested up to 5.8.0.
181 * If this version of ppport.h is failing during the compilation of this
182 * module, please check if a newer version of Devel::PPPort is available
183 * on CPAN before sending a bug report.
185 * If you are using the latest version of Devel::PPPort and it is failing
186 * during compilation of this module, please send a report to perlbug@perl.com
188 * Include all following information:
190 * 1. The complete output from running "perl -V"
194 * 3. The name & version of the module you were trying to build.
196 * 4. A full log of the build that failed.
198 * 5. Any other information that you think could be relevant.
201 * For the latest version of this code, please retreive the Devel::PPPort
207 * In order for a Perl extension module to be as portable as possible
208 * across differing versions of Perl itself, certain steps need to be taken.
209 * Including this header is the first major one, then using dTHR is all the
210 * appropriate places and using a PL_ prefix to refer to global Perl
211 * variables is the second.
216 /* If you use one of a few functions that were not present in earlier
217 * versions of Perl, please add a define before the inclusion of ppport.h
218 * for a static include, or use the GLOBAL request in a single module to
219 * produce a global definition that can be referenced from the other
222 * Function: Static define: Extern define:
223 * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
228 /* To verify whether ppport.h is needed for your module, and whether any
229 * special defines should be used, ppport.h can be run through Perl to check
230 * your source code. Simply say:
232 * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
234 * The result will be a list of patches suggesting changes that should at
235 * least be acceptable, if not necessarily the most efficient solution, or a
236 * fix for all possible problems. It won't catch where dTHR is needed, and
237 * doesn't attempt to account for global macro or function definitions,
238 * nested includes, typemaps, etc.
240 * In order to test for the need of dTHR, please try your module under a
241 * recent version of Perl that has threading compiled-in.
248 @ARGV = ("*.xs") if !@ARGV;
249 %badmacros = %funcs = %macros = (); $replace = 0;
251 $funcs{$1} = 1 if /Provide:\s+(\S+)/;
252 $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
253 $replace = $1 if /Replace:\s+(\d+)/;
254 $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
255 $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
257 foreach $filename (map(glob($_),@ARGV)) {
258 unless (open(IN, "<$filename")) {
259 warn "Unable to read from $file: $!\n";
262 print "Scanning $filename...\n";
263 $c = ""; while (<IN>) { $c .= $_; } close(IN);
264 $need_include = 0; %add_func = (); $changes = 0;
265 $has_include = ($c =~ /#.*include.*ppport/m);
267 foreach $func (keys %funcs) {
268 if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
269 if ($c !~ /\b$func\b/m) {
270 print "If $func isn't needed, you don't need to request it.\n" if
271 $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
273 print "Uses $func\n";
277 if ($c =~ /\b$func\b/m) {
278 $add_func{$func} =1 ;
279 print "Uses $func\n";
285 if (not $need_include) {
286 foreach $macro (keys %macros) {
287 if ($c =~ /\b$macro\b/m) {
288 print "Uses $macro\n";
294 foreach $badmacro (keys %badmacros) {
295 if ($c =~ /\b$badmacro\b/m) {
296 $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
297 print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
302 if (scalar(keys %add_func) or $need_include != $has_include) {
304 $inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
305 "#include \"ppport.h\"\n";
306 $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
307 } elsif (keys %add_func) {
308 $inc = join('',map("#define NEED_$_\n", sort keys %add_func));
309 $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
311 if (!$need_include) {
312 print "Doesn't seem to need ppport.h.\n";
313 $c =~ s/^.*#.*include.*ppport.*\n//m;
319 open(OUT,">/tmp/ppport.h.$$");
322 open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
323 while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
325 unlink("/tmp/ppport.h.$$");
333 #ifndef _P_P_PORTABILITY_H_
334 #define _P_P_PORTABILITY_H_
336 #ifndef PERL_REVISION
337 # ifndef __PATCHLEVEL_H_INCLUDED__
338 # include "patchlevel.h"
340 # ifndef PERL_REVISION
341 # define PERL_REVISION (5)
343 # define PERL_VERSION PATCHLEVEL
344 # define PERL_SUBVERSION SUBVERSION
345 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
350 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
352 /* It is very unlikely that anyone will try to use this with Perl 6
353 (or greater), but who knows.
355 #if PERL_REVISION != 5
356 # error ppport.h only works with Perl version 5
357 #endif /* PERL_REVISION != 5 */
360 # define ERRSV perl_get_sv("@",FALSE)
363 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
366 # define PL_compiling compiling
367 # define PL_copline copline
368 # define PL_curcop curcop
369 # define PL_curstash curstash
370 # define PL_defgv defgv
371 # define PL_dirty dirty
372 # define PL_dowarn dowarn
373 # define PL_hints hints
375 # define PL_perldb perldb
376 # define PL_rsfp_filters rsfp_filters
377 # define PL_rsfpv rsfp
378 # define PL_stdingv stdingv
379 # define PL_sv_no sv_no
380 # define PL_sv_undef sv_undef
381 # define PL_sv_yes sv_yes
386 # if defined(__GNUC__) && defined(__cplusplus)
387 # define PERL_UNUSED_DECL
389 # define PERL_UNUSED_DECL __attribute__((unused))
392 # define PERL_UNUSED_DECL
396 # define NOOP (void)0
397 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
406 # define dTHXa(x) dNOOP
407 # define dTHXoa(x) dNOOP
418 # define PTR2IV(d) (IV)(d)
422 # define INT2PTR(any,d) (any)(d)
426 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
430 # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
434 # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
439 # define newRV_inc(sv) newRV(sv)
443 /* DEFSV appears first in 5.004_56 */
445 # define DEFSV GvSV(PL_defgv)
449 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
454 # define newRV_noinc(sv) \
456 SV *nsv = (SV*)newRV(sv); \
461 # if defined(USE_THREADS)
462 static SV * newRV_noinc (SV * sv)
464 SV *nsv = (SV*)newRV(sv);
469 # define newRV_noinc(sv) \
470 (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
475 /* Provide: newCONSTSUB */
477 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
478 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
480 #if defined(NEED_newCONSTSUB)
483 extern void newCONSTSUB(HV * stash, char * name, SV *sv);
486 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
488 newCONSTSUB(stash,name,sv)
493 U32 oldhints = PL_hints;
494 HV *old_cop_stash = PL_curcop->cop_stash;
495 HV *old_curstash = PL_curstash;
496 line_t oldline = PL_curcop->cop_line;
497 PL_curcop->cop_line = PL_copline;
499 PL_hints &= ~HINT_BLOCK_SCOPE;
501 PL_curstash = PL_curcop->cop_stash = stash;
505 #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
506 /* before 5.003_22 */
509 # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
513 /* 5.003_23 onwards */
514 start_subparse(FALSE, 0),
518 newSVOP(OP_CONST, 0, newSVpv(name,0)),
519 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
520 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
524 PL_curcop->cop_stash = old_cop_stash;
525 PL_curstash = old_curstash;
526 PL_curcop->cop_line = oldline;
530 #endif /* newCONSTSUB */
535 * Boilerplate macros for initializing and accessing interpreter-local
536 * data from C. All statics in extensions should be reworked to use
537 * this, if you want to make the extension thread-safe. See ext/re/re.xs
538 * for an example of the use of these macros.
540 * Code that uses these macros is responsible for the following:
541 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
542 * 2. Declare a typedef named my_cxt_t that is a structure that contains
543 * all the data that needs to be interpreter-local.
544 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
545 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
546 * (typically put in the BOOT: section).
547 * 5. Use the members of the my_cxt_t structure everywhere as
549 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
553 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
554 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
556 /* This must appear in all extensions that define a my_cxt_t structure,
557 * right after the definition (i.e. at file scope). The non-threads
558 * case below uses it to declare the data as static. */
561 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
562 /* Fetches the SV that keeps the per-interpreter data. */
564 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
565 #else /* >= perl5.004_68 */
567 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
568 sizeof(MY_CXT_KEY)-1, TRUE)
569 #endif /* < perl5.004_68 */
571 /* This declaration should be used within all functions that use the
572 * interpreter-local data. */
575 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
577 /* Creates and zeroes the per-interpreter data.
578 * (We allocate my_cxtp in a Perl SV so that it will be released when
579 * the interpreter goes away.) */
580 #define MY_CXT_INIT \
582 /* newSV() allocates one more than needed */ \
583 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
584 Zero(my_cxtp, 1, my_cxt_t); \
585 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
587 /* This macro must be used to access members of the my_cxt_t structure.
588 * e.g. MYCXT.some_data */
589 #define MY_CXT (*my_cxtp)
591 /* Judicious use of these macros can reduce the number of times dMY_CXT
592 * is used. Use is similar to pTHX, aTHX etc. */
593 #define pMY_CXT my_cxt_t *my_cxtp
594 #define pMY_CXT_ pMY_CXT,
595 #define _pMY_CXT ,pMY_CXT
596 #define aMY_CXT my_cxtp
597 #define aMY_CXT_ aMY_CXT,
598 #define _aMY_CXT ,aMY_CXT
600 #else /* single interpreter */
603 #define START_MY_CXT static my_cxt_t my_cxt;
604 #define dMY_CXT_SV dNOOP
605 #define dMY_CXT dNOOP
606 #define MY_CXT_INIT NOOP
607 #define MY_CXT my_cxt
618 #endif /* START_MY_CXT */
620 #endif /* _P_P_PORTABILITY_H_ */
622 /* End of File ppport.h */