diff --git a/src/interfaces/perl5/GNUmakefile b/src/interfaces/perl5/GNUmakefile index 7ad2c2402f..75333c458a 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 cd8e5fe681..7ff9478df1 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 #include #include @@ -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 0000000000..7a3c59fc9a --- /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 , 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 () { + $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 () { $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 () { 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 4ccd7fde99..a51f0c2429 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 f84232b9fe..7fe2b04340 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 c3a5d5b855..c1516ea692 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 0000000000..7a3c59fc9a --- /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 , 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 () { + $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 () { $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 () { 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_ */