| 1 |
|
| 2 |
#ifndef _G_P_P_PORTABILITY_H_ |
| 3 |
#define _G_P_P_PORTABILITY_H_ |
| 4 |
|
| 5 |
/* Perl/Pollution/Portability Version 1.0007-gimp-2 */ |
| 6 |
|
| 7 |
/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and |
| 8 |
distributed under the same license as any version of Perl. */ |
| 9 |
|
| 10 |
/* For the latest version of this code, please retreive the Devel::PPPort |
| 11 |
module from CPAN, contact the author at <kjahds@kjahds.com>, or check |
| 12 |
with the Perl maintainers. */ |
| 13 |
|
| 14 |
/* If you needed to customize this file for your project, please mention |
| 15 |
your changes, and visible alter the version number. */ |
| 16 |
|
| 17 |
|
| 18 |
/* |
| 19 |
In order for a Perl extension module to be as portable as possible |
| 20 |
across differing versions of Perl itself, certain steps need to be taken. |
| 21 |
Including this header is the first major one, then using dTHR is all the |
| 22 |
appropriate places and using a PL_ prefix to refer to global Perl |
| 23 |
variables is the second. |
| 24 |
*/ |
| 25 |
|
| 26 |
|
| 27 |
/* If you use one of a few functions that were not present in earlier |
| 28 |
versions of Perl, please add a define before the inclusion of ppport.h |
| 29 |
for a static include, or use the GLOBAL request in a single module to |
| 30 |
produce a global definition that can be referenced from the other |
| 31 |
modules. |
| 32 |
|
| 33 |
Function: Static define: Extern define: |
| 34 |
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL |
| 35 |
|
| 36 |
*/ |
| 37 |
|
| 38 |
|
| 39 |
/* To verify whether ppport.h is needed for your module, and whether any |
| 40 |
special defines should be used, ppport.h can be run through Perl to check |
| 41 |
your source code. Simply say: |
| 42 |
|
| 43 |
perl -x ppport.h *.c *.h *.xs foo/any.c [etc] |
| 44 |
|
| 45 |
The result will be a list of patches suggesting changes that should at |
| 46 |
least be acceptable, if not necessarily the most efficient solution, or a |
| 47 |
fix for all possible problems. It won't catch where dTHR is needed, and |
| 48 |
doesn't attempt to account for global macro or function definitions, |
| 49 |
nested includes, typemaps, etc. |
| 50 |
|
| 51 |
In order to test for the need of dTHR, please try your module under a |
| 52 |
recent version of Perl that has threading compiled-in. |
| 53 |
|
| 54 |
*/ |
| 55 |
|
| 56 |
|
| 57 |
/* |
| 58 |
#!/usr/bin/perl |
| 59 |
@ARGV = ("*.xs") if !@ARGV; |
| 60 |
%badmacros = %funcs = %macros = (); $replace = 0; |
| 61 |
foreach (<DATA>) { |
| 62 |
$funcs{$1} = 1 if /Provide:\s+(\S+)/; |
| 63 |
$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; |
| 64 |
$replace = $1 if /Replace:\s+(\d+)/; |
| 65 |
$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; |
| 66 |
$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; |
| 67 |
} |
| 68 |
foreach $filename (map(glob($_),@ARGV)) { |
| 69 |
unless (open(IN, "<$filename")) { |
| 70 |
warn "Unable to read from $file: $!\n"; |
| 71 |
next; |
| 72 |
} |
| 73 |
print "Scanning $filename...\n"; |
| 74 |
$c = ""; while (<IN>) { $c .= $_; } close(IN); |
| 75 |
$need_include = 0; %add_func = (); $changes = 0; |
| 76 |
$has_include = ($c =~ /#.*include.*ppport/m); |
| 77 |
|
| 78 |
foreach $func (keys %funcs) { |
| 79 |
if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { |
| 80 |
if ($c !~ /\b$func\b/m) { |
| 81 |
print "If $func isn't needed, you don't need to request it.\n" if |
| 82 |
$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); |
| 83 |
} else { |
| 84 |
print "Uses $func\n"; |
| 85 |
$need_include = 1; |
| 86 |
} |
| 87 |
} else { |
| 88 |
if ($c =~ /\b$func\b/m) { |
| 89 |
$add_func{$func} =1 ; |
| 90 |
print "Uses $func\n"; |
| 91 |
$need_include = 1; |
| 92 |
} |
| 93 |
} |
| 94 |
} |
| 95 |
|
| 96 |
if (not $need_include) { |
| 97 |
foreach $macro (keys %macros) { |
| 98 |
if ($c =~ /\b$macro\b/m) { |
| 99 |
print "Uses $macro\n"; |
| 100 |
$need_include = 1; |
| 101 |
} |
| 102 |
} |
| 103 |
} |
| 104 |
|
| 105 |
foreach $badmacro (keys %badmacros) { |
| 106 |
if ($c =~ /\b$badmacro\b/m) { |
| 107 |
$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); |
| 108 |
print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; |
| 109 |
$need_include = 1; |
| 110 |
} |
| 111 |
} |
| 112 |
|
| 113 |
if (scalar(keys %add_func) or $need_include != $has_include) { |
| 114 |
if (!$has_include) { |
| 115 |
$inc = join('',map("#define NEED_$_\n", sort keys %add_func)). |
| 116 |
"#include \"ppport.h\"\n"; |
| 117 |
$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; |
| 118 |
} elsif (keys %add_func) { |
| 119 |
$inc = join('',map("#define NEED_$_\n", sort keys %add_func)); |
| 120 |
$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; |
| 121 |
} |
| 122 |
if (!$need_include) { |
| 123 |
print "Doesn't seem to need ppport.h.\n"; |
| 124 |
$c =~ s/^.*#.*include.*ppport.*\n//m; |
| 125 |
} |
| 126 |
$changes++; |
| 127 |
} |
| 128 |
|
| 129 |
if ($changes) { |
| 130 |
open(OUT,">/tmp/ppport.h.$$"); |
| 131 |
print OUT $c; |
| 132 |
close(OUT); |
| 133 |
open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); |
| 134 |
while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } |
| 135 |
close(DIFF); |
| 136 |
unlink("/tmp/ppport.h.$$"); |
| 137 |
} else { |
| 138 |
print "Looks OK\n"; |
| 139 |
} |
| 140 |
} |
| 141 |
__DATA__ |
| 142 |
*/ |
| 143 |
|
| 144 |
#ifndef PERL_REVISION |
| 145 |
# ifndef __PATCHLEVEL_H_INCLUDED__ |
| 146 |
# include "patchlevel.h" |
| 147 |
# endif |
| 148 |
# ifndef PERL_REVISION |
| 149 |
# define PERL_REVISION (5) |
| 150 |
/* Replace: 1 */ |
| 151 |
# define PERL_VERSION PATCHLEVEL |
| 152 |
# define PERL_SUBVERSION SUBVERSION |
| 153 |
/* Replace PERL_PATCHLEVEL with PERL_VERSION */ |
| 154 |
/* Replace: 0 */ |
| 155 |
# endif |
| 156 |
#endif |
| 157 |
|
| 158 |
#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) |
| 159 |
|
| 160 |
#ifndef ERRSV |
| 161 |
# define ERRSV perl_get_sv("@",FALSE) |
| 162 |
#endif |
| 163 |
|
| 164 |
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) |
| 165 |
/* Replace: 1 */ |
| 166 |
# define PL_sv_undef sv_undef |
| 167 |
# define PL_sv_yes sv_yes |
| 168 |
# define PL_sv_no sv_no |
| 169 |
# define PL_na na |
| 170 |
# define PL_stdingv stdingv |
| 171 |
# define PL_hints hints |
| 172 |
# define PL_curcop curcop |
| 173 |
# define PL_curstash curstash |
| 174 |
# define PL_copline copline |
| 175 |
# define PL_Sv Sv |
| 176 |
# define PL_perl_destruct_level perl_destruct_level |
| 177 |
/* Replace: 0 */ |
| 178 |
#endif |
| 179 |
|
| 180 |
#ifndef dTHR |
| 181 |
# ifdef WIN32 |
| 182 |
# define dTHR extern int Perl___notused |
| 183 |
# else |
| 184 |
# define dTHR extern int errno |
| 185 |
# endif |
| 186 |
#endif |
| 187 |
|
| 188 |
#ifndef boolSV |
| 189 |
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) |
| 190 |
#endif |
| 191 |
|
| 192 |
#ifndef gv_stashpvn |
| 193 |
# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) |
| 194 |
#endif |
| 195 |
|
| 196 |
#ifndef newSVpvn |
| 197 |
# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) |
| 198 |
#endif |
| 199 |
|
| 200 |
#ifndef newRV_inc |
| 201 |
/* Replace: 1 */ |
| 202 |
# define newRV_inc(sv) newRV(sv) |
| 203 |
/* Replace: 0 */ |
| 204 |
#endif |
| 205 |
|
| 206 |
#ifndef newRV_noinc |
| 207 |
# ifdef __GNUC__ |
| 208 |
# define newRV_noinc(sv) \ |
| 209 |
({ \ |
| 210 |
SV *nsv = (SV*)newRV(sv); \ |
| 211 |
SvREFCNT_dec(sv); \ |
| 212 |
nsv; \ |
| 213 |
}) |
| 214 |
# else |
| 215 |
# if defined(CRIPPLED_CC) || defined(USE_THREADS) |
| 216 |
static SV * newRV_noinc (SV * sv) |
| 217 |
{ |
| 218 |
SV *nsv = (SV*)newRV(sv); |
| 219 |
SvREFCNT_dec(sv); |
| 220 |
return nsv; |
| 221 |
} |
| 222 |
# else |
| 223 |
# define newRV_noinc(sv) \ |
| 224 |
((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) |
| 225 |
# endif |
| 226 |
# endif |
| 227 |
#endif |
| 228 |
|
| 229 |
/* Provide: newCONSTSUB */ |
| 230 |
|
| 231 |
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ |
| 232 |
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) |
| 233 |
|
| 234 |
#if defined(NEED_newCONSTSUB) |
| 235 |
static |
| 236 |
#else |
| 237 |
extern void newCONSTSUB _((HV * stash, char * name, SV *sv)); |
| 238 |
#endif |
| 239 |
|
| 240 |
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) |
| 241 |
void |
| 242 |
newCONSTSUB(stash,name,sv) |
| 243 |
HV *stash; |
| 244 |
char *name; |
| 245 |
SV *sv; |
| 246 |
{ |
| 247 |
U32 oldhints = PL_hints; |
| 248 |
HV *old_cop_stash = PL_curcop->cop_stash; |
| 249 |
HV *old_curstash = PL_curstash; |
| 250 |
line_t oldline = PL_curcop->cop_line; |
| 251 |
PL_curcop->cop_line = PL_copline; |
| 252 |
|
| 253 |
PL_hints &= ~HINT_BLOCK_SCOPE; |
| 254 |
if (stash) |
| 255 |
PL_curstash = PL_curcop->cop_stash = stash; |
| 256 |
|
| 257 |
newSUB( |
| 258 |
|
| 259 |
#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) |
| 260 |
/* before 5.003_22 */ |
| 261 |
start_subparse(), |
| 262 |
#else |
| 263 |
# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) |
| 264 |
/* 5.003_22 */ |
| 265 |
start_subparse(0), |
| 266 |
# else |
| 267 |
/* 5.003_23 onwards */ |
| 268 |
start_subparse(FALSE, 0), |
| 269 |
# endif |
| 270 |
#endif |
| 271 |
|
| 272 |
newSVOP(OP_CONST, 0, newSVpv(name,0)), |
| 273 |
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ |
| 274 |
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) |
| 275 |
); |
| 276 |
|
| 277 |
PL_hints = oldhints; |
| 278 |
PL_curcop->cop_stash = old_cop_stash; |
| 279 |
PL_curstash = old_curstash; |
| 280 |
PL_curcop->cop_line = oldline; |
| 281 |
} |
| 282 |
#endif |
| 283 |
|
| 284 |
#endif /* newCONSTSUB */ |
| 285 |
|
| 286 |
/*GIMP*/ |
| 287 |
#ifndef SvPV_nolen |
| 288 |
# define SvPV_nolen(b) SvPV((b),PL_na) |
| 289 |
#endif |
| 290 |
|
| 291 |
#endif /* _G_P_P_PORTABILITY_H_ */ |