[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / PPPort.pm


package Devel::PPPort;

=head1 NAME

Perl/Pollution/Portability

=head1 SYNOPSIS

    Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
    Devel::PPPort::WriteFile('someheader.h') ;

=head1 DESCRIPTION

Perl has changed over time, gaining new features, new functions,
increasing its flexibility, and reducing the impact on the C namespace
environment (reduced pollution). The header file, typicaly C<ppport.h>,
written by this module attempts to bring some of the newer Perl
features to older versions of Perl, so that you can worry less about
keeping track of old releases, but users can still reap the benefit.
 
Why you should use C<ppport.h> in modern code: so that your code will work
with the widest range of Perl interpreters possible, without significant
additional work.

Why you should attempt older code to fully use C<ppport.h>: because
the reduced pollution of newer Perl versions is an important thing, so
important that the old polluting ways of original Perl modules will not be
supported very far into the future, and your module will almost certainly
break! By adapting to it now, you'll gained compatibility and a sense of
having done the electronic ecology some good.

How to use ppport.h: Don't direct the user to download C<Devel::PPPort>,
and don't make C<ppport.h> optional. Rather, just take the most recent
copy of C<ppport.h> that you can find (probably in C<Devel::PPPort>
on CPAN), copy it into your project, adjust your project to use it,
and distribute the header along with your module.

C<Devel::PPPort> contains a single function, called C<WriteFile>. It's
purpose is to write a 'C' header file that is used when writing XS
modules. The file contains a series of macros that allow XS modules to
be built using older versions of Perl.

This module is used by h2xs to write the file F<ppport.h>. 

=head2 WriteFile

C<WriteFile> takes a zero or one parameters. When called with one
parameter it expects to be passed a filename. When called with no
parameters, it defults to the filename C<./pport.h>.

The function returns TRUE if the file was written successfully. Otherwise
it returns FALSE.

=head1 ppport.h

The file written by this module, typically C<ppport.h>, provides access
to the following Perl API if not already available:

    DEFSV
    ERRSV
    INT2PTR(any,d)
    MY_CXT
    MY_CXT_INIT
    NOOP
    PERL_REVISION
    PERL_SUBVERSION
    PERL_UNUSED_DECL
    PERL_VERSION
    PL_Sv
    PL_compiling
    PL_copline
    PL_curcop
    PL_curstash
    PL_defgv
    PL_dirty
    PL_hints
    PL_na
    PL_perldb
    PL_rsfp_filters
    PL_rsfpv
    PL_stdingv
    PL_sv_no
    PL_sv_undef
    PL_sv_yes
    PTR2IV(d)
    SAVE_DEFSV
    START_MY_CXT
    _aMY_CXT
    _pMY_CXT
    aMY_CXT
    aMY_CXT_
    aTHX
    aTHX_
    boolSV(b)
    dMY_CXT	
    dMY_CXT_SV
    dNOOP
    dTHR
    gv_stashpvn(str,len,flags)
    newCONSTSUB(stash,name,sv)
    newRV_inc(sv)
    newRV_noinc(sv)
    newSVpvn(data,len)
    pMY_CXT
    pMY_CXT_
    pTHX
    pTHX_

=head1 AUTHOR

Version 1.x of Devel::PPPort was written by Kenneth Albanowski.

Version 2.x was ported to the Perl core by Paul Marquess.

=head1 SEE ALSO

See L<h2xs>.

=cut


package Devel::PPPort;

require Exporter;
require DynaLoader;
#use warnings;
use strict;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );

$VERSION = "2.0002";

@ISA = qw(Exporter DynaLoader);
@EXPORT =  qw();
# Other items we are prepared to export if requested
@EXPORT_OK = qw( );

bootstrap Devel::PPPort;

package Devel::PPPort;

{
    local $/ = undef;
    $data = <DATA> ;
    my $now = localtime;
    my $pkg = __PACKAGE__;
    $data =~ s/__VERSION__/$VERSION/g;
    $data =~ s/__DATE__/$now/g;
    $data =~ s/__PKG__/$pkg/g;
}

sub WriteFile
{
    my $file = shift || 'ppport.h' ;

    open F, ">$file" || return undef ;
    print F $data ;
    close F;

    return 1 ;
}

1;

__DATA__;

/* ppport.h -- Perl/Pollution/Portability Version __VERSION__ 
 *
 * Automatically Created by __PKG__ on __DATE__ 
 *
 * Do NOT edit this file directly! -- Edit PPPort.pm instead.
 *
 * Version 2.x, Copyright (C) 2001, Paul Marquess.
 * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 * This code may be used and distributed under the same license as any
 * version of Perl.
 * 
 * This version of ppport.h is designed to support operation with Perl
 * installations back to 5.004, and has been tested up to 5.8.0.
 *
 * If this version of ppport.h is failing during the compilation of this
 * module, please check if a newer version of Devel::PPPort is available
 * on CPAN before sending a bug report.
 *
 * If you are using the latest version of Devel::PPPort and it is failing
 * during compilation of this module, please send a report to perlbug@perl.com
 *
 * Include all following information:
 *
 *  1. The complete output from running "perl -V"
 *
 *  2. This file.
 *
 *  3. The name & version of the module you were trying to build.
 *
 *  4. A full log of the build that failed.
 *
 *  5. Any other information that you think could be relevant.
 *
 *
 * For the latest version of this code, please retreive the Devel::PPPort
 * module from CPAN.
 * 
 */

/*
 * In order for a Perl extension module to be as portable as possible
 * across differing versions of Perl itself, certain steps need to be taken.
 * Including this header is the first major one, then using dTHR is all the
 * appropriate places and using a PL_ prefix to refer to global Perl
 * variables is the second.
 *
 */


/* If you use one of a few functions that were not present in earlier
 * versions of Perl, please add a define before the inclusion of ppport.h
 * for a static include, or use the GLOBAL request in a single module to
 * produce a global definition that can be referenced from the other
 * modules.
 * 
 * Function:            Static define:           Extern define:
 * newCONSTSUB()        NEED_newCONSTSUB         NEED_newCONSTSUB_GLOBAL
 *
 */
 

/* To verify whether ppport.h is needed for your module, and whether any
 * special defines should be used, ppport.h can be run through Perl to check
 * your source code. Simply say:
 * 
 * 	perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
 * 
 * The result will be a list of patches suggesting changes that should at
 * least be acceptable, if not necessarily the most efficient solution, or a
 * fix for all possible problems. It won't catch where dTHR is needed, and
 * doesn't attempt to account for global macro or function definitions,
 * nested includes, typemaps, etc.
 * 
 * In order to test for the need of dTHR, please try your module under a
 * recent version of Perl that has threading compiled-in.
 *
 */ 


/*
#!/usr/bin/perl
@ARGV = ("*.xs") if !@ARGV;
%badmacros = %funcs = %macros = (); $replace = 0;
foreach (<DATA>) {
	$funcs{$1} = 1 if /Provide:\s+(\S+)/;
	$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
	$replace = $1 if /Replace:\s+(\d+)/;
	$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
	$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
}
foreach $filename (map(glob($_),@ARGV)) {
	unless (open(IN, "<$filename")) {
		warn "Unable to read from $file: $!\n";
		next;
	}
	print "Scanning $filename...\n";
	$c = ""; while (<IN>) { $c .= $_; } close(IN);
	$need_include = 0; %add_func = (); $changes = 0;
	$has_include = ($c =~ /#.*include.*ppport/m);

	foreach $func (keys %funcs) {
		if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
			if ($c !~ /\b$func\b/m) {
				print "If $func isn't needed, you don't need to request it.\n" if
				$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
			} else {
				print "Uses $func\n";
				$need_include = 1;
			}
		} else {
			if ($c =~ /\b$func\b/m) {
				$add_func{$func} =1 ;
				print "Uses $func\n";
				$need_include = 1;
			}
		}
	}

	if (not $need_include) {
		foreach $macro (keys %macros) {
			if ($c =~ /\b$macro\b/m) {
				print "Uses $macro\n";
				$need_include = 1;
			}
		}
	}

	foreach $badmacro (keys %badmacros) {
		if ($c =~ /\b$badmacro\b/m) {
			$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
			print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
			$need_include = 1;
		}
	}
	
	if (scalar(keys %add_func) or $need_include != $has_include) {
		if (!$has_include) {
			$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
			       "#include \"ppport.h\"\n";
			$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
		} elsif (keys %add_func) {
			$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
			$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
		}
		if (!$need_include) {
			print "Doesn't seem to need ppport.h.\n";
			$c =~ s/^.*#.*include.*ppport.*\n//m;
		}
		$changes++;
	}
	
	if ($changes) {
		open(OUT,">/tmp/ppport.h.$$");
		print OUT $c;
		close(OUT);
		open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
		while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
		close(DIFF);
		unlink("/tmp/ppport.h.$$");
	} else {
		print "Looks OK\n";
	}
}
__DATA__
*/

#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_

#ifndef PERL_REVISION
#   ifndef __PATCHLEVEL_H_INCLUDED__
#       include "patchlevel.h"
#   endif
#   ifndef PERL_REVISION
#	define PERL_REVISION	(5)
        /* Replace: 1 */
#       define PERL_VERSION	PATCHLEVEL
#       define PERL_SUBVERSION	SUBVERSION
        /* Replace PERL_PATCHLEVEL with PERL_VERSION */
        /* Replace: 0 */
#   endif
#endif

#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)

/* It is very unlikely that anyone will try to use this with Perl 6 
   (or greater), but who knows.
 */
#if PERL_REVISION != 5
#	error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */

#ifndef ERRSV
#	define ERRSV perl_get_sv("@",FALSE)
#endif

#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
#	define PL_Sv		Sv
#	define PL_compiling	compiling
#	define PL_copline	copline
#	define PL_curcop	curcop
#	define PL_curstash	curstash
#	define PL_defgv		defgv
#	define PL_dirty		dirty
#	define PL_hints		hints
#	define PL_na		na
#	define PL_perldb	perldb
#	define PL_rsfp_filters	rsfp_filters
#	define PL_rsfpv		rsfp
#	define PL_stdingv	stdingv
#	define PL_sv_no		sv_no
#	define PL_sv_undef	sv_undef
#	define PL_sv_yes	sv_yes
/* Replace: 0 */
#endif

#ifdef HASATTRIBUTE
#  if defined(__GNUC__) && defined(__cplusplus)
#    define PERL_UNUSED_DECL
#  else
#    define PERL_UNUSED_DECL __attribute__((unused))
#  endif
#else
#  define PERL_UNUSED_DECL
#endif

#ifndef dNOOP
#  define NOOP (void)0
#  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
#endif

#ifndef dTHR
#  define dTHR          dNOOP
#endif

#ifndef dTHX
#  define dTHX          dNOOP
#  define dTHXa(x)      dNOOP
#  define dTHXoa(x)     dNOOP
#endif

#ifndef pTHX
#    define pTHX	void
#    define pTHX_
#    define aTHX
#    define aTHX_
#endif         

#ifndef PTR2IV
#    define PTR2IV(d)   (IV)(d)
#endif
 
#ifndef INT2PTR
#    define INT2PTR(any,d)      (any)(d)
#endif

#ifndef boolSV
#	define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif

#ifndef gv_stashpvn
#	define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
#endif

#ifndef newSVpvn
#	define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
#endif

#ifndef newRV_inc
/* Replace: 1 */
#	define newRV_inc(sv) newRV(sv)
/* Replace: 0 */
#endif

/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
#  define DEFSV	GvSV(PL_defgv)
#endif

#ifndef SAVE_DEFSV
#    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif

#ifndef newRV_noinc
#  ifdef __GNUC__
#    define newRV_noinc(sv)               \
      ({                                  \
          SV *nsv = (SV*)newRV(sv);       \
          SvREFCNT_dec(sv);               \
          nsv;                            \
      })
#  else
#    if defined(USE_THREADS)
static SV * newRV_noinc (SV * sv)
{
          SV *nsv = (SV*)newRV(sv);       
          SvREFCNT_dec(sv);               
          return nsv;                     
}
#    else
#      define newRV_noinc(sv)    \
        (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
#    endif
#  endif
#endif

/* Provide: newCONSTSUB */

/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))

#if defined(NEED_newCONSTSUB)
static
#else
extern void newCONSTSUB(HV * stash, char * name, SV *sv);
#endif

#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
newCONSTSUB(stash,name,sv)
HV *stash;
char *name;
SV *sv;
{
	U32 oldhints = PL_hints;
	HV *old_cop_stash = PL_curcop->cop_stash;
	HV *old_curstash = PL_curstash;
	line_t oldline = PL_curcop->cop_line;
	PL_curcop->cop_line = PL_copline;

	PL_hints &= ~HINT_BLOCK_SCOPE;
	if (stash)
		PL_curstash = PL_curcop->cop_stash = stash;

	newSUB(

#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
     /* before 5.003_22 */
		start_subparse(),
#else
#  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
     /* 5.003_22 */
     		start_subparse(0),
#  else
     /* 5.003_23  onwards */
     		start_subparse(FALSE, 0),
#  endif
#endif

		newSVOP(OP_CONST, 0, newSVpv(name,0)),
		newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
		newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
	);

	PL_hints = oldhints;
	PL_curcop->cop_stash = old_cop_stash;
	PL_curstash = old_curstash;
	PL_curcop->cop_line = oldline;
}
#endif

#endif /* newCONSTSUB */

#ifndef START_MY_CXT

/*
 * Boilerplate macros for initializing and accessing interpreter-local
 * data from C.  All statics in extensions should be reworked to use
 * this, if you want to make the extension thread-safe.  See ext/re/re.xs
 * for an example of the use of these macros.
 *
 * Code that uses these macros is responsible for the following:
 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
 * 2. Declare a typedef named my_cxt_t that is a structure that contains
 *    all the data that needs to be interpreter-local.
 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
 *    (typically put in the BOOT: section).
 * 5. Use the members of the my_cxt_t structure everywhere as
 *    MY_CXT.member.
 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
 *    access MY_CXT.
 */

#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
    defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)

/* This must appear in all extensions that define a my_cxt_t structure,
 * right after the definition (i.e. at file scope).  The non-threads
 * case below uses it to declare the data as static. */
#define START_MY_CXT

#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV \
	SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,		\
				  sizeof(MY_CXT_KEY)-1, TRUE)
#endif /* < perl5.004_68 */

/* This declaration should be used within all functions that use the
 * interpreter-local data. */
#define dMY_CXT	\
	dMY_CXT_SV;							\
	my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))

/* Creates and zeroes the per-interpreter data.
 * (We allocate my_cxtp in a Perl SV so that it will be released when
 * the interpreter goes away.) */
#define MY_CXT_INIT \
	dMY_CXT_SV;							\
	/* newSV() allocates one more than needed */			\
	my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
	Zero(my_cxtp, 1, my_cxt_t);					\
	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))

/* This macro must be used to access members of the my_cxt_t structure.
 * e.g. MYCXT.some_data */
#define MY_CXT		(*my_cxtp)

/* Judicious use of these macros can reduce the number of times dMY_CXT
 * is used.  Use is similar to pTHX, aTHX etc. */
#define pMY_CXT		my_cxt_t *my_cxtp
#define pMY_CXT_	pMY_CXT,
#define _pMY_CXT	,pMY_CXT
#define aMY_CXT		my_cxtp
#define aMY_CXT_	aMY_CXT,
#define _aMY_CXT	,aMY_CXT

#else /* single interpreter */


#define START_MY_CXT	static my_cxt_t my_cxt;
#define dMY_CXT_SV	dNOOP
#define dMY_CXT		dNOOP
#define MY_CXT_INIT	NOOP
#define MY_CXT		my_cxt

#define pMY_CXT		void
#define pMY_CXT_
#define _pMY_CXT
#define aMY_CXT
#define aMY_CXT_
#define _aMY_CXT

#endif 

#endif /* START_MY_CXT */

#endif /* _P_P_PORTABILITY_H_ */

/* End of File ppport.h */
Commit	Line	Data
0a7c7f4f	1
	2	package Devel::PPPort;
	3
	4	=head1 NAME
	5
	6	Perl/Pollution/Portability
	7
	8	=head1 SYNOPSIS
	9
	10	Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
	11	Devel::PPPort::WriteFile('someheader.h') ;
	12
	13	=head1 DESCRIPTION
	14
44284200	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.
	21
	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
	24	additional work.
	25
	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.
	32
	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.
	38
	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.
	43
	44	This module is used by h2xs to write the file F<ppport.h>.
0a7c7f4f	45
	46	=head2 WriteFile
	47
	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>.
	51
	52	The function returns TRUE if the file was written successfully. Otherwise
	53	it returns FALSE.
	54
44284200	55	=head1 ppport.h
	56
	57	The file written by this module, typically C<ppport.h>, provides access
	58	to the following Perl API if not already available:
	59
	60	DEFSV
	61	ERRSV
	62	INT2PTR(any,d)
	63	MY_CXT
	64	MY_CXT_INIT
	65	NOOP
	66	PERL_REVISION
	67	PERL_SUBVERSION
	68	PERL_UNUSED_DECL
	69	PERL_VERSION
	70	PL_Sv
	71	PL_compiling
	72	PL_copline
	73	PL_curcop
	74	PL_curstash
	75	PL_defgv
	76	PL_dirty
	77	PL_hints
	78	PL_na
	79	PL_perldb
	80	PL_rsfp_filters
	81	PL_rsfpv
	82	PL_stdingv
	83	PL_sv_no
	84	PL_sv_undef
	85	PL_sv_yes
	86	PTR2IV(d)
	87	SAVE_DEFSV
	88	START_MY_CXT
	89	_aMY_CXT
	90	_pMY_CXT
	91	aMY_CXT
	92	aMY_CXT_
	93	aTHX
	94	aTHX_
	95	boolSV(b)
	96	dMY_CXT
	97	dMY_CXT_SV
	98	dNOOP
	99	dTHR
	100	gv_stashpvn(str,len,flags)
	101	newCONSTSUB(stash,name,sv)
	102	newRV_inc(sv)
	103	newRV_noinc(sv)
	104	newSVpvn(data,len)
	105	pMY_CXT
	106	pMY_CXT_
	107	pTHX
	108	pTHX_
	109
0a7c7f4f	110	=head1 AUTHOR
0a7c7f4f	111
dbda3434	112	Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
0a7c7f4f	113
dbda3434	114	Version 2.x was ported to the Perl core by Paul Marquess.
0a7c7f4f	115
	116	=head1 SEE ALSO
	117
	118	See L<h2xs>.
	119
	120	=cut
	121
44284200	122
	123	package Devel::PPPort;
	124
	125	require Exporter;
	126	require DynaLoader;
0a7c7f4f	127	#use warnings;
0a7c7f4f	128	use strict;
44284200	129	use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );
	130
	131	$VERSION = "2.0002";
	132
	133	@ISA = qw(Exporter DynaLoader);
	134	@EXPORT = qw();
	135	# Other items we are prepared to export if requested
	136	@EXPORT_OK = qw( );
0a7c7f4f	137
44284200	138	bootstrap Devel::PPPort;
	139
	140	package Devel::PPPort;
0a7c7f4f	141
	142	{
	143	local $/ = undef;
	144	$data = <DATA> ;
	145	my $now = localtime;
	146	my $pkg = __PACKAGE__;
dbda3434	147	$data =~ s/__VERSION__/$VERSION/g;
	148	$data =~ s/__DATE__/$now/g;
	149	$data =~ s/__PKG__/$pkg/g;
0a7c7f4f	150	}
	151
	152	sub WriteFile
	153	{
	154	my $file = shift \|\| 'ppport.h' ;
	155
	156	open F, ">$file" \|\| return undef ;
	157	print F $data ;
	158	close F;
	159
	160	return 1 ;
	161	}
	162
	163	1;
	164
	165	__DATA__;
0a7c7f4f	166
44284200	167	/* ppport.h -- Perl/Pollution/Portability Version __VERSION__
	168	*
	169	* Automatically Created by __PKG__ on __DATE__
	170	*
	171	* Do NOT edit this file directly! -- Edit PPPort.pm instead.
	172	*
	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
	176	* version of Perl.
	177	*
	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.
	180	*
	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.
	184	*
	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
	187	*
	188	* Include all following information:
	189	*
	190	* 1. The complete output from running "perl -V"
	191	*
	192	* 2. This file.
	193	*
	194	* 3. The name & version of the module you were trying to build.
	195	*
	196	* 4. A full log of the build that failed.
	197	*
	198	* 5. Any other information that you think could be relevant.
	199	*
	200	*
	201	* For the latest version of this code, please retreive the Devel::PPPort
	202	* module from CPAN.
	203	*
	204	*/
0a7c7f4f	205
0a7c7f4f	206	/*
44284200	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.
	212	*
	213	*/
0a7c7f4f	214
	215
	216	/* If you use one of a few functions that were not present in earlier
44284200	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
	220	* modules.
	221	*
	222	* Function: Static define: Extern define:
	223	* newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
	224	*
	225	*/
0a7c7f4f	226
	227
	228	/* To verify whether ppport.h is needed for your module, and whether any
44284200	229	* special defines should be used, ppport.h can be run through Perl to check
	230	* your source code. Simply say:
	231	*
20d72259	232	* perl -x ppport.h .c .h .xs foo/bar.c [etc]
44284200	233	*
	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.
	239	*
	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.
	242	*
	243	*/
0a7c7f4f	244
	245
	246	/*
	247	#!/usr/bin/perl
	248	@ARGV = ("*.xs") if !@ARGV;
	249	%badmacros = %funcs = %macros = (); $replace = 0;
	250	foreach (<DATA>) {
	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 /^#\sdefine\s+([a-zA-Z0-9_]+).?\s+([a-zA-Z0-9_]+)/;
	255	$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
	256	}
	257	foreach $filename (map(glob($_),@ARGV)) {
	258	unless (open(IN, "<$filename")) {
	259	warn "Unable to read from $file: $!\n";
	260	next;
	261	}
	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);
	266
	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);
	272	} else {
	273	print "Uses $func\n";
	274	$need_include = 1;
	275	}
	276	} else {
	277	if ($c =~ /\b$func\b/m) {
	278	$add_func{$func} =1 ;
	279	print "Uses $func\n";
	280	$need_include = 1;
	281	}
	282	}
	283	}
	284
	285	if (not $need_include) {
	286	foreach $macro (keys %macros) {
	287	if ($c =~ /\b$macro\b/m) {
	288	print "Uses $macro\n";
	289	$need_include = 1;
	290	}
	291	}
	292	}
	293
	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";
	298	$need_include = 1;
	299	}
	300	}
	301
	302	if (scalar(keys %add_func) or $need_include != $has_include) {
	303	if (!$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;
310	}
311	if (!$need_include) {
312	print "Doesn't seem to need ppport.h.\n";
313	$c =~ s/^.#.include.ppport.\n//m;
314	}
315	$changes++;
316	}
317
318	if ($changes) {
319	open(OUT,">/tmp/ppport.h.$$");
320	print OUT $c;
321	close(OUT);
322	open(DIFF, "diff -u $filename /tmp/ppport.h.$$\|");
323	while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
324	close(DIFF);
325	unlink("/tmp/ppport.h.$$");
326	} else {
327	print "Looks OK\n";
328	}
329	}
330	__DATA__
331	*/
332
44284200	333	#ifndef _P_P_PORTABILITY_H_
	334	#define _P_P_PORTABILITY_H_
	335
0a7c7f4f	336	#ifndef PERL_REVISION
	337	# ifndef __PATCHLEVEL_H_INCLUDED__
	338	# include "patchlevel.h"
	339	# endif
	340	# ifndef PERL_REVISION
	341	# define PERL_REVISION (5)
	342	/* Replace: 1 */
	343	# define PERL_VERSION PATCHLEVEL
	344	# define PERL_SUBVERSION SUBVERSION
	345	/* Replace PERL_PATCHLEVEL with PERL_VERSION */
	346	/* Replace: 0 */
	347	# endif
	348	#endif
	349
	350	#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
	351
44284200	352	/* It is very unlikely that anyone will try to use this with Perl 6
	353	(or greater), but who knows.
	354	*/
	355	#if PERL_REVISION != 5
	356	# error ppport.h only works with Perl version 5
	357	#endif /* PERL_REVISION != 5 */
	358
0a7c7f4f	359	#ifndef ERRSV
	360	# define ERRSV perl_get_sv("@",FALSE)
	361	#endif
	362
	363	#if (PERL_VERSION < 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
	364	/* Replace: 1 */
	365	# define PL_Sv Sv
	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
	373	# define PL_na na
	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
	381	/* Replace: 0 */
	382	#endif
	383
5a0bf5be	384	#ifdef HASATTRIBUTE
	385	# if defined(__GNUC__) && defined(__cplusplus)
	386	# define PERL_UNUSED_DECL
	387	# else
	388	# define PERL_UNUSED_DECL __attribute__((unused))
	389	# endif
	390	#else
	391	# define PERL_UNUSED_DECL
	392	#endif
	393
	394	#ifndef dNOOP
	395	# define NOOP (void)0
	396	# define dNOOP extern int Perl___notused PERL_UNUSED_DECL
	397	#endif
	398
	399	#ifndef dTHR
	400	# define dTHR dNOOP
	401	#endif
	402
	403	#ifndef dTHX
	404	# define dTHX dNOOP
	405	# define dTHXa(x) dNOOP
	406	# define dTHXoa(x) dNOOP
	407	#endif
	408
0a7c7f4f	409	#ifndef pTHX
5a0bf5be	410	# define pTHX void
0a7c7f4f	411	# define pTHX_
	412	# define aTHX
	413	# define aTHX_
	414	#endif
	415
	416	#ifndef PTR2IV
	417	# define PTR2IV(d) (IV)(d)
	418	#endif
	419
	420	#ifndef INT2PTR
	421	# define INT2PTR(any,d) (any)(d)
	422	#endif
	423
0a7c7f4f	424	#ifndef boolSV
	425	# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
	426	#endif
	427
	428	#ifndef gv_stashpvn
	429	# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
	430	#endif
	431
	432	#ifndef newSVpvn
	433	# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
	434	#endif
	435
	436	#ifndef newRV_inc
	437	/* Replace: 1 */
	438	# define newRV_inc(sv) newRV(sv)
	439	/* Replace: 0 */
	440	#endif
	441
	442	/* DEFSV appears first in 5.004_56 */
	443	#ifndef DEFSV
	444	# define DEFSV GvSV(PL_defgv)
	445	#endif
	446
	447	#ifndef SAVE_DEFSV
	448	# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
	449	#endif
	450
	451	#ifndef newRV_noinc
	452	# ifdef __GNUC__
	453	# define newRV_noinc(sv) \
	454	({ \
	455	SV nsv = (SV)newRV(sv); \
	456	SvREFCNT_dec(sv); \
	457	nsv; \
	458	})
	459	# else
9ede5bc8	460	# if defined(USE_THREADS)
0a7c7f4f	461	static SV * newRV_noinc (SV * sv)
	462	{
	463	SV nsv = (SV)newRV(sv);
	464	SvREFCNT_dec(sv);
	465	return nsv;
	466	}
	467	# else
	468	# define newRV_noinc(sv) \
97dc1cde	469	(PL_Sv=(SV)newRV(sv), SvREFCNT_dec(sv), (SV)PL_Sv)
0a7c7f4f	470	# endif
	471	# endif
	472	#endif
	473
	474	/* Provide: newCONSTSUB */
	475
	476	/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
	477	#if (PERL_VERSION < 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
	478
	479	#if defined(NEED_newCONSTSUB)
	480	static
	481	#else
c68a00c0	482	extern void newCONSTSUB(HV * stash, char * name, SV *sv);
0a7c7f4f	483	#endif
	484
	485	#if defined(NEED_newCONSTSUB) \|\| defined(NEED_newCONSTSUB_GLOBAL)
	486	void
	487	newCONSTSUB(stash,name,sv)
	488	HV *stash;
	489	char *name;
	490	SV *sv;
	491	{
	492	U32 oldhints = PL_hints;
	493	HV *old_cop_stash = PL_curcop->cop_stash;
	494	HV *old_curstash = PL_curstash;
	495	line_t oldline = PL_curcop->cop_line;
	496	PL_curcop->cop_line = PL_copline;
	497
	498	PL_hints &= ~HINT_BLOCK_SCOPE;
	499	if (stash)
	500	PL_curstash = PL_curcop->cop_stash = stash;
	501
	502	newSUB(
	503
	504	#if (PERL_VERSION < 3) \|\| ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
	505	/* before 5.003_22 */
	506	start_subparse(),
	507	#else
	508	# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
	509	/* 5.003_22 */
	510	start_subparse(0),
	511	# else
	512	/* 5.003_23 onwards */
	513	start_subparse(FALSE, 0),
	514	# endif
	515	#endif
	516
	517	newSVOP(OP_CONST, 0, newSVpv(name,0)),
	518	newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
	519	newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
	520	);
	521
	522	PL_hints = oldhints;
	523	PL_curcop->cop_stash = old_cop_stash;
	524	PL_curstash = old_curstash;
	525	PL_curcop->cop_line = oldline;
	526	}
	527	#endif
	528
	529	#endif /* newCONSTSUB */
	530
0a7c7f4f	531	#ifndef START_MY_CXT
	532
	533	/*
	534	* Boilerplate macros for initializing and accessing interpreter-local
	535	* data from C. All statics in extensions should be reworked to use
	536	* this, if you want to make the extension thread-safe. See ext/re/re.xs
	537	* for an example of the use of these macros.
	538	*
	539	* Code that uses these macros is responsible for the following:
	540	* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
	541	* 2. Declare a typedef named my_cxt_t that is a structure that contains
	542	* all the data that needs to be interpreter-local.
	543	* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
	544	* 4. Use the MY_CXT_INIT macro such that it is called exactly once
	545	* (typically put in the BOOT: section).
	546	* 5. Use the members of the my_cxt_t structure everywhere as
	547	* MY_CXT.member.
	548	* 6. Use the dMY_CXT macro (a declaration) in all the functions that
	549	* access MY_CXT.
	550	*/
	551
	552	#if defined(MULTIPLICITY) \|\| defined(PERL_OBJECT) \|\| \
	553	defined(PERL_CAPI) \|\| defined(PERL_IMPLICIT_CONTEXT)
	554
	555	/* This must appear in all extensions that define a my_cxt_t structure,
	556	* right after the definition (i.e. at file scope). The non-threads
	557	* case below uses it to declare the data as static. */
	558	#define START_MY_CXT
	559
44284200	560	#if (PERL_VERSION < 4 \|\| (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
0a7c7f4f	561	/* Fetches the SV that keeps the per-interpreter data. */
	562	#define dMY_CXT_SV \
	563	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
	564	#else /* >= perl5.004_68 */
	565	#define dMY_CXT_SV \
	566	SV my_cxt_sv = hv_fetch(PL_modglobal, MY_CXT_KEY, \
	567	sizeof(MY_CXT_KEY)-1, TRUE)
	568	#endif /* < perl5.004_68 */
	569
	570	/* This declaration should be used within all functions that use the
	571	* interpreter-local data. */
	572	#define dMY_CXT \
	573	dMY_CXT_SV; \
	574	my_cxt_t my_cxtp = INT2PTR(my_cxt_t,SvUV(my_cxt_sv))
	575
	576	/* Creates and zeroes the per-interpreter data.
	577	* (We allocate my_cxtp in a Perl SV so that it will be released when
	578	* the interpreter goes away.) */
	579	#define MY_CXT_INIT \
	580	dMY_CXT_SV; \
	581	/* newSV() allocates one more than needed */ \
	582	my_cxt_t my_cxtp = (my_cxt_t)SvPVX(newSV(sizeof(my_cxt_t)-1));\
	583	Zero(my_cxtp, 1, my_cxt_t); \
	584	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
	585
	586	/* This macro must be used to access members of the my_cxt_t structure.
	587	* e.g. MYCXT.some_data */
	588	#define MY_CXT (*my_cxtp)
	589
	590	/* Judicious use of these macros can reduce the number of times dMY_CXT
	591	* is used. Use is similar to pTHX, aTHX etc. */
	592	#define pMY_CXT my_cxt_t *my_cxtp
	593	#define pMY_CXT_ pMY_CXT,
	594	#define _pMY_CXT ,pMY_CXT
	595	#define aMY_CXT my_cxtp
	596	#define aMY_CXT_ aMY_CXT,
	597	#define _aMY_CXT ,aMY_CXT
	598
	599	#else /* single interpreter */
	600
0a7c7f4f	601
	602	#define START_MY_CXT static my_cxt_t my_cxt;
	603	#define dMY_CXT_SV dNOOP
	604	#define dMY_CXT dNOOP
	605	#define MY_CXT_INIT NOOP
	606	#define MY_CXT my_cxt
	607
	608	#define pMY_CXT void
	609	#define pMY_CXT_
	610	#define _pMY_CXT
	611	#define aMY_CXT
	612	#define aMY_CXT_
	613	#define _aMY_CXT
	614
	615	#endif
	616
	617	#endif /* START_MY_CXT */
	618
0a7c7f4f	619	#endif /* _P_P_PORTABILITY_H_ */
44284200	620
44284200	621	/* End of File ppport.h */