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/*.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_hints hints
374 # define PL_perldb perldb
375 # define PL_rsfp_filters rsfp_filters
376 # define PL_rsfpv rsfp
377 # define PL_stdingv stdingv
378 # define PL_sv_no sv_no
379 # define PL_sv_undef sv_undef
380 # define PL_sv_yes sv_yes
392 # define PTR2IV(d) (IV)(d)
396 # define INT2PTR(any,d) (any)(d)
401 # define dTHR extern int Perl___notused
403 # define dTHR extern int errno
408 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
412 # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
416 # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
421 # define newRV_inc(sv) newRV(sv)
425 /* DEFSV appears first in 5.004_56 */
427 # define DEFSV GvSV(PL_defgv)
431 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
436 # define newRV_noinc(sv) \
438 SV *nsv = (SV*)newRV(sv); \
443 # if defined(CRIPPLED_CC) || defined(USE_THREADS)
444 static SV * newRV_noinc (SV * sv)
446 SV *nsv = (SV*)newRV(sv);
451 # define newRV_noinc(sv) \
452 (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
457 /* Provide: newCONSTSUB */
459 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
460 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
462 #if defined(NEED_newCONSTSUB)
465 extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
468 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
470 newCONSTSUB(stash,name,sv)
475 U32 oldhints = PL_hints;
476 HV *old_cop_stash = PL_curcop->cop_stash;
477 HV *old_curstash = PL_curstash;
478 line_t oldline = PL_curcop->cop_line;
479 PL_curcop->cop_line = PL_copline;
481 PL_hints &= ~HINT_BLOCK_SCOPE;
483 PL_curstash = PL_curcop->cop_stash = stash;
487 #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
488 /* before 5.003_22 */
491 # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
495 /* 5.003_23 onwards */
496 start_subparse(FALSE, 0),
500 newSVOP(OP_CONST, 0, newSVpv(name,0)),
501 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
502 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
506 PL_curcop->cop_stash = old_cop_stash;
507 PL_curstash = old_curstash;
508 PL_curcop->cop_line = oldline;
512 #endif /* newCONSTSUB */
515 # define NOOP (void)0
519 # define PERL_UNUSED_DECL __attribute__((unused))
521 # define PERL_UNUSED_DECL
525 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
531 * Boilerplate macros for initializing and accessing interpreter-local
532 * data from C. All statics in extensions should be reworked to use
533 * this, if you want to make the extension thread-safe. See ext/re/re.xs
534 * for an example of the use of these macros.
536 * Code that uses these macros is responsible for the following:
537 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
538 * 2. Declare a typedef named my_cxt_t that is a structure that contains
539 * all the data that needs to be interpreter-local.
540 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
541 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
542 * (typically put in the BOOT: section).
543 * 5. Use the members of the my_cxt_t structure everywhere as
545 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
549 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
550 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
552 /* This must appear in all extensions that define a my_cxt_t structure,
553 * right after the definition (i.e. at file scope). The non-threads
554 * case below uses it to declare the data as static. */
557 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
558 /* Fetches the SV that keeps the per-interpreter data. */
560 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
561 #else /* >= perl5.004_68 */
563 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
564 sizeof(MY_CXT_KEY)-1, TRUE)
565 #endif /* < perl5.004_68 */
567 /* This declaration should be used within all functions that use the
568 * interpreter-local data. */
571 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
573 /* Creates and zeroes the per-interpreter data.
574 * (We allocate my_cxtp in a Perl SV so that it will be released when
575 * the interpreter goes away.) */
576 #define MY_CXT_INIT \
578 /* newSV() allocates one more than needed */ \
579 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
580 Zero(my_cxtp, 1, my_cxt_t); \
581 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
583 /* This macro must be used to access members of the my_cxt_t structure.
584 * e.g. MYCXT.some_data */
585 #define MY_CXT (*my_cxtp)
587 /* Judicious use of these macros can reduce the number of times dMY_CXT
588 * is used. Use is similar to pTHX, aTHX etc. */
589 #define pMY_CXT my_cxt_t *my_cxtp
590 #define pMY_CXT_ pMY_CXT,
591 #define _pMY_CXT ,pMY_CXT
592 #define aMY_CXT my_cxtp
593 #define aMY_CXT_ aMY_CXT,
594 #define _aMY_CXT ,aMY_CXT
596 #else /* single interpreter */
599 #define START_MY_CXT static my_cxt_t my_cxt;
600 #define dMY_CXT_SV dNOOP
601 #define dMY_CXT dNOOP
602 #define MY_CXT_INIT NOOP
603 #define MY_CXT my_cxt
614 #endif /* START_MY_CXT */
616 #endif /* _P_P_PORTABILITY_H_ */
618 /* End of File ppport.h */