Eliminate POLLUTE=1 hack for cross-Perl-version compatibility by using

Devel::PPPort instead.  Thanks to Gilles Darold for doing the legwork.

7 files changed, 592 insertions, 15 deletions

diff --git a/src/interfaces/perl5/GNUmakefile b/src/interfaces/perl5/GNUmakefile
index 7ad2c2402f3..75333c458a4 100644
--- a/src/interfaces/perl5/GNUmakefile
+++ b/src/interfaces/perl5/GNUmakefile
@@ -4,7 +4,7 @@
 # Makefile according to its own ideas and then invoke the rules from
 # that file.
 #
-# $Header: /cvsroot/pgsql/src/interfaces/perl5/Attic/GNUmakefile,v 1.2 2000/08/31 16:11:58 petere Exp $
+# $Header: /cvsroot/pgsql/src/interfaces/perl5/Attic/GNUmakefile,v 1.3 2000/10/24 16:59:59 tgl Exp $
 
 subdir = src/interfaces/perl5
 top_builddir = ../../..
@@ -15,7 +15,7 @@ all: Makefile libpq-all
 	$(MAKE) -f $< all
 
 Makefile: Makefile.PL
-	$(PERL) $< POLLUTE=1
+	$(PERL) $<
 
 .PHONY: libpq-all
 libpq-all:
@@ -35,7 +35,7 @@ install: Makefile
 	$(MAKE) -f Makefile clean
 	POSTGRES_LIB="$(libdir)" \
 	  POSTGRES_INCLUDE="$(includedir)" \
-	  $(PERL) $(srcdir)/Makefile.PL POLLUTE=1
+	  $(PERL) $(srcdir)/Makefile.PL
 	$(MAKE) -f Makefile all
 	-@if [ -w "`$(MAKE) --quiet -f Makefile echo-installdir`" ]; then \
 		$(MAKE) -f Makefile install; \
diff --git a/src/interfaces/perl5/Pg.xs b/src/interfaces/perl5/Pg.xs
index cd8e5fe6818..7ff9478df14 100644
--- a/src/interfaces/perl5/Pg.xs
+++ b/src/interfaces/perl5/Pg.xs
@@ -1,6 +1,6 @@
 /*-------------------------------------------------------
  *
- * $Id: Pg.xs,v 1.14 2000/03/11 03:08:37 tgl Exp $ with patch for NULs
+ * $Id: Pg.xs,v 1.15 2000/10/24 17:00:00 tgl Exp $ with patch for NULs
  *
  * Copyright (c) 1997, 1998  Edmund Mergl
  *
@@ -9,6 +9,7 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#include "ppport.h"
 #include <string.h>
 #include <stdio.h>
 #include <fcntl.h>
@@ -581,7 +582,7 @@ PQprint(fout, res, header, align, standard, html3, expanded, pager, fieldSep, ta
 		ps.caption   = caption;
 		Newz(0, ps.fieldName, items + 1 - 11, char*);
 		for (i = 11; i < items; i++) {
-			ps.fieldName[i - 11] = (char *)SvPV(ST(i), na);
+			ps.fieldName[i - 11] = (char *)SvPV(ST(i), PL_na);
 		}
 		PQprint(fout, res, &ps);
 		Safefree(ps.fieldName);
@@ -1252,7 +1253,7 @@ PQfetchrow(res)
 				EXTEND(sp, cols);
 				while (col < cols) {
 					if (PQgetisnull(res->result, res->row, col)) {
-						PUSHs(&sv_undef);
+						PUSHs(&PL_sv_undef);
 					} else {
 						char *val = PQgetvalue(res->result, res->row, col);
 						PUSHs(sv_2mortal((SV*)newSVpv(val, 0)));
@@ -1292,7 +1293,7 @@ PQprint(res, fout, header, align, standard, html3, expanded, pager, fieldSep, ta
 		ps.caption   = caption;
 		Newz(0, ps.fieldName, items + 1 - 11, char*);
 		for (i = 11; i < items; i++) {
-			ps.fieldName[i - 11] = (char *)SvPV(ST(i), na);
+			ps.fieldName[i - 11] = (char *)SvPV(ST(i), PL_na);
 		}
 		PQprint(fout, res->result, &ps);
 		Safefree(ps.fieldName);
diff --git a/src/interfaces/perl5/ppport.h b/src/interfaces/perl5/ppport.h
new file mode 100644
index 00000000000..7a3c59fc9a6
--- /dev/null
+++ b/src/interfaces/perl5/ppport.h
@@ -0,0 +1,286 @@
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+/* Perl/Pollution/Portability Version 1.0007 */
+
+/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
+   distributed under the same license as any version of Perl. */
+   
+/* For the latest version of this code, please retreive the Devel::PPPort
+   module from CPAN, contact the author at <kjahds@kjahds.com>, or check
+   with the Perl maintainers. */
+   
+/* If you needed to customize this file for your project, please mention
+   your changes, and visible alter the version number. */
+
+
+/*
+   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/*.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 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)
+
+#ifndef ERRSV
+#	define ERRSV perl_get_sv("@",FALSE)
+#endif
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+#	define PL_sv_undef	sv_undef
+#	define PL_sv_yes	sv_yes
+#	define PL_sv_no		sv_no
+#	define PL_na		na
+#	define PL_stdingv	stdingv
+#	define PL_hints		hints
+#	define PL_curcop	curcop
+#	define PL_curstash	curstash
+#	define PL_copline	copline
+#	define PL_Sv		Sv
+/* Replace: 0 */
+#endif
+
+#ifndef dTHR
+#  ifdef WIN32
+#	define dTHR extern int Perl___notused
+#  else
+#	define dTHR extern int errno
+#  endif
+#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
+
+#ifndef newRV_noinc
+#  ifdef __GNUC__
+#    define newRV_noinc(sv)               \
+      ({                                  \
+          SV *nsv = (SV*)newRV(sv);       \
+          SvREFCNT_dec(sv);               \
+          nsv;                            \
+      })
+#  else
+#    if defined(CRIPPLED_CC) || 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 */
+
+
+#endif /* _P_P_PORTABILITY_H_ */
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index 4ccd7fde99d..a51f0c2429d 100644
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -1,4 +1,4 @@
-# $Header: /cvsroot/pgsql/src/pl/plperl/GNUmakefile,v 1.4 2000/09/17 13:02:51 petere Exp $
+# $Header: /cvsroot/pgsql/src/pl/plperl/GNUmakefile,v 1.5 2000/10/24 17:01:05 tgl Exp $
 
 subdir = src/pl/plperl
 top_builddir = ../../..
@@ -13,7 +13,7 @@ all: Makefile
 Makefile: Makefile.PL
 	@plperl_installdir='$(plperl_installdir)' \
 	  EXTRA_INCLUDES='-I$(top_srcdir)/src/include $(INCLUDES)' \
-	  $(PERL) $< POLLUTE=1
+	  $(PERL) $<
 
 install: all installdirs
 	$(MAKE) -f Makefile install
diff --git a/src/pl/plperl/eloglvl.c b/src/pl/plperl/eloglvl.c
index f84232b9fe8..7fe2b043400 100644
--- a/src/pl/plperl/eloglvl.c
+++ b/src/pl/plperl/eloglvl.c
@@ -1,3 +1,5 @@
+#include "postgres.h"
+
 #include "utils/elog.h"
 
 /*
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index c3a5d5b855d..c1516ea6928 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.13 2000/09/12 04:28:30 momjian Exp $
+ *	  $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.14 2000/10/24 17:01:05 tgl Exp $
  *
  **********************************************************************/
 
@@ -75,8 +75,10 @@
 #ifndef HAS_UNION_SEMUN
 #define HAS_UNION_SEMUN
 #endif
+
 #include "EXTERN.h"
 #include "perl.h"
+#include "ppport.h"
 
 
 /**********************************************************************
@@ -330,7 +332,7 @@ plperl_create_sub(char * s)
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
-		elog(ERROR, "creation of function failed : %s", SvPV_nolen(ERRSV));
+		elog(ERROR, "creation of function failed: %s", SvPV(ERRSV, PL_na));
 	}
 
 	if (count != 1) {
@@ -446,7 +448,7 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
-		elog(ERROR, "plperl : didn't get a return item from function");
+		elog(ERROR, "plperl: didn't get a return item from function");
 	}
 
 	if (SvTRUE(ERRSV))
@@ -455,7 +457,7 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
-		elog(ERROR, "plperl : error from function : %s", SvPV_nolen(ERRSV));
+		elog(ERROR, "plperl: error from function: %s", SvPV(ERRSV, PL_na));
 	}
 
 	retval = newSVsv(POPs);
@@ -661,7 +663,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 	else
 	{
 		retval = FunctionCall3(&prodesc->result_in_func,
-							   PointerGetDatum(SvPV_nolen(perlret)),
+							   PointerGetDatum(SvPV(perlret, PL_na)),
 							   ObjectIdGetDatum(prodesc->result_in_elem),
 							   Int32GetDatum(prodesc->result_in_len));
 	}
@@ -2184,6 +2186,6 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 			sv_catpvf(output, "'%s' => undef,", attname);
 	}
 	sv_catpv(output, "}");
-	output = perl_eval_pv(SvPV_nolen(output), TRUE);
+	output = perl_eval_pv(SvPV(output, PL_na), TRUE);
 	return output;
 }
diff --git a/src/pl/plperl/ppport.h b/src/pl/plperl/ppport.h
new file mode 100644
index 00000000000..7a3c59fc9a6
--- /dev/null
+++ b/src/pl/plperl/ppport.h
@@ -0,0 +1,286 @@
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+/* Perl/Pollution/Portability Version 1.0007 */
+
+/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
+   distributed under the same license as any version of Perl. */
+   
+/* For the latest version of this code, please retreive the Devel::PPPort
+   module from CPAN, contact the author at <kjahds@kjahds.com>, or check
+   with the Perl maintainers. */
+   
+/* If you needed to customize this file for your project, please mention
+   your changes, and visible alter the version number. */
+
+
+/*
+   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/*.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 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)
+
+#ifndef ERRSV
+#	define ERRSV perl_get_sv("@",FALSE)
+#endif
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+#	define PL_sv_undef	sv_undef
+#	define PL_sv_yes	sv_yes
+#	define PL_sv_no		sv_no
+#	define PL_na		na
+#	define PL_stdingv	stdingv
+#	define PL_hints		hints
+#	define PL_curcop	curcop
+#	define PL_curstash	curstash
+#	define PL_copline	copline
+#	define PL_Sv		Sv
+/* Replace: 0 */
+#endif
+
+#ifndef dTHR
+#  ifdef WIN32
+#	define dTHR extern int Perl___notused
+#  else
+#	define dTHR extern int errno
+#  endif
+#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
+
+#ifndef newRV_noinc
+#  ifdef __GNUC__
+#    define newRV_noinc(sv)               \
+      ({                                  \
+          SV *nsv = (SV*)newRV(sv);       \
+          SvREFCNT_dec(sv);               \
+          nsv;                            \
+      })
+#  else
+#    if defined(CRIPPLED_CC) || 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 */
+
+
+#endif /* _P_P_PORTABILITY_H_ */