| 1 | ################################################################################ |
| 2 | # |
| 3 | # PPPort_pm.PL -- generate PPPort.pm |
| 4 | # |
| 5 | # Set the environment variable DPPP_CHECK_LEVEL to more than zero for some |
| 6 | # extra checking. 1 or 2 currently |
| 7 | |
| 8 | ################################################################################ |
| 9 | # |
| 10 | # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
| 11 | # Copyright (C) 2018, The perl5 porters |
| 12 | # Version 2.x, Copyright (C) 2001, Paul Marquess. |
| 13 | # Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
| 14 | # |
| 15 | # This program is free software; you can redistribute it and/or |
| 16 | # modify it under the same terms as Perl itself. |
| 17 | # |
| 18 | ################################################################################ |
| 19 | |
| 20 | use strict; |
| 21 | BEGIN { $^W = 1; } |
| 22 | require "./parts/ppptools.pl"; |
| 23 | require "./parts/inc/inctools"; |
| 24 | |
| 25 | my $INCLUDE = 'parts/inc'; |
| 26 | my $DPPP = 'DPPP_'; |
| 27 | |
| 28 | # The keys of %embed are the names of the items found in all the .fnc files, |
| 29 | # and each value is all the information parse_embed returns for that item. |
| 30 | my %embed = map { ( $_->{name} => $_ ) } |
| 31 | parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc)); |
| 32 | |
| 33 | my(%provides, %prototypes, %explicit); |
| 34 | |
| 35 | my $data = do { local $/; <DATA> }; |
| 36 | |
| 37 | # Call include(file, params) for every line that begins with %include |
| 38 | # These fill in %provides and %prototypes. |
| 39 | # The keys of %provides are the items provided by Devel::PPPort, and each |
| 40 | # value is the name of the file (in parts/inc/) that has the code to provide |
| 41 | # it. |
| 42 | # An entry in %prototypes looks like: |
| 43 | # 'grok_bin' => 'UV grok_bin(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result)', |
| 44 | |
| 45 | $data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$} |
| 46 | {eval "$1('$2', $3)" or die $@}gem; |
| 47 | |
| 48 | # And expand it. |
| 49 | $data = expand($data); |
| 50 | |
| 51 | # Just the list of provided items. |
| 52 | my @provided = sort dictionary_order keys %provides; |
| 53 | |
| 54 | # which further expands $data. |
| 55 | $data =~ s{^(.*)__PROVIDED_API__(\s*?)^} |
| 56 | {join '', map "$1$_\n", @provided}gem; |
| 57 | |
| 58 | { |
| 59 | my $len = 0; |
| 60 | for (keys %explicit) { |
| 61 | length > $len and $len = length; |
| 62 | } |
| 63 | my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5; |
| 64 | $len = 3*$len + 23; |
| 65 | |
| 66 | $data =~ s!^(.*)__EXPLICIT_API__(\s*?)^! |
| 67 | sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') . |
| 68 | $1 . '-'x$len . "\n" . |
| 69 | join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" } |
| 70 | sort dictionary_order keys %explicit) |
| 71 | !gem; |
| 72 | } |
| 73 | |
| 74 | # These hashes look like: |
| 75 | # { ... 'gv_check' => '5.003007', |
| 76 | # 'gv_const_sv' => '5.009003', |
| 77 | # 'gv_dump' => '5.006000', |
| 78 | # ... }, |
| 79 | |
| 80 | # What's provided when without ppport.h, as far as we've been able to |
| 81 | # determine |
| 82 | my %raw_base = %{&parse_todo('parts/base')}; |
| 83 | |
| 84 | # What's provided when using ppport.h, as far as we've been able to |
| 85 | # determine |
| 86 | my %raw_todo = %{&parse_todo('parts/todo')}; |
| 87 | |
| 88 | # Invert so each key is the 7 digit version number, and it's value is an array |
| 89 | # of all symbols within it, like: |
| 90 | # '5005003' => [ |
| 91 | # 'POPpx', |
| 92 | # 'get_vtbl', |
| 93 | # 'save_generic_svref' |
| 94 | # ], |
| 95 | my %todo; |
| 96 | for (keys %raw_todo) { |
| 97 | push @{$todo{int_parse_version($raw_todo{$_}{version})}}, $_; |
| 98 | } |
| 99 | |
| 100 | # Most recent first |
| 101 | my @todo_list = reverse sort keys %todo; |
| 102 | |
| 103 | # Here, @todo_list contains the integer version numbers that have support. |
| 104 | # The first and final elements give the extremes of the supported versions. |
| 105 | # (Use defaults that were reasonable at the time of this commit if the |
| 106 | # directories are empty (which should only happen during regeneration of the |
| 107 | # base and todo files).). Actually the final element is for blead (at the |
| 108 | # time things were regenerated), which is 1 beyond the max version supported. |
| 109 | my $INT_MAX_PERL = (@todo_list) ? $todo_list[0] - 1 : '5030000'; |
| 110 | my $MAX_PERL = format_version($INT_MAX_PERL); |
| 111 | my $INT_MIN_PERL = (@todo_list) ? $todo_list[-1] : 5003007; |
| 112 | my $MIN_PERL = format_version($INT_MIN_PERL); |
| 113 | |
| 114 | # Get rid of blead. It contains the things marked as todo, meaning they |
| 115 | # don't compile at all, and not getting rid of it would mean they would be |
| 116 | # listed as working but introduced in blead. |
| 117 | shift @todo_list if @todo_list && $todo_list[0] > $INT_MAX_PERL; |
| 118 | |
| 119 | # check consistency between our list of everything provided, and our lists of |
| 120 | # what got provided when |
| 121 | for (@provided) { |
| 122 | if ( exists $raw_todo{$_} |
| 123 | && $raw_todo{$_}{version} > $INT_MIN_PERL # INT_MIN_PERL contents are real |
| 124 | # symbols, not something to do |
| 125 | && $raw_todo{$_}{version} <= $INT_MAX_PERL # Above this would be things that |
| 126 | # don't compile in blead |
| 127 | && exists $raw_base{$_}) |
| 128 | { |
| 129 | if ($raw_base{$_}{version} == $raw_todo{$_}{version}) { |
| 130 | warn "$INCLUDE/$provides{$_} provides $_, which is still marked " |
| 131 | . "todo for " . format_version($raw_todo{$_}) . "\n"; |
| 132 | } |
| 133 | else { |
| 134 | check(2, "$_ was ported back to " . format_version($raw_todo{$_}{version}) |
| 135 | . " (baseline revision: " . format_version($raw_base{$_}{version}) |
| 136 | . ")."); |
| 137 | } |
| 138 | } |
| 139 | } |
| 140 | |
| 141 | my @perl_api; |
| 142 | for (@provided) { |
| 143 | next if /^Perl_(.*)/ && exists $embed{$1}; |
| 144 | next if exists $embed{$_}; |
| 145 | push @perl_api, $_; |
| 146 | check(2, "No API definition for provided element $_ found."); |
| 147 | } |
| 148 | |
| 149 | # At this point @perl_api is the list of things we provide that weren't found |
| 150 | # in the .fnc files. |
| 151 | my @prototype_unknown = @perl_api; |
| 152 | |
| 153 | # Add in the .fnc file definitions. |
| 154 | push @perl_api, keys %embed; |
| 155 | @perl_api = sort dictionary_order @perl_api; |
| 156 | |
| 157 | for (@perl_api) { # $_ is the item name |
| 158 | if (exists $provides{$_} && !exists $raw_base{$_}) { |
| 159 | check(2, "Mmmh, $_ doesn't seem to need backporting."); |
| 160 | } |
| 161 | |
| 162 | # Create the lines that ppport.h reads. These look like |
| 163 | # CopyD|5.009002|5.003007|p |
| 164 | my $line = "$_|"; |
| 165 | $line .= $raw_base{$_}{version} if exists $raw_base{$_} |
| 166 | # If is above the max, it means it never actually got defined |
| 167 | && int_parse_version($raw_base{$_}{version}) <= $INT_MAX_PERL; |
| 168 | $line .= '|'; |
| 169 | $line .= $raw_todo{$_}{version} |
| 170 | if exists $raw_todo{$_} |
| 171 | && int_parse_version($raw_todo{$_}{version}) <= $INT_MAX_PERL; |
| 172 | $line .= '|'; |
| 173 | $line .= 'p' if exists $provides{$_}; |
| 174 | my $e; |
| 175 | $e = $embed{$_} if exists $embed{$_}; |
| 176 | my $is_documented = 0; |
| 177 | my $is_accessible = 0; |
| 178 | if (defined $e) { |
| 179 | if (exists $e->{flags}{p}) { # Has 'Perl_' prefix |
| 180 | my $args = $e->{args}; |
| 181 | $line .= 'v' if @$args && $args->[-1][0] eq '...'; |
| 182 | } |
| 183 | $line .= 'o' if exists $e->{ppport_fnc}; |
| 184 | $line .= 'n' if exists $e->{flags}{T}; # No thread context parameter |
| 185 | $line .= 'd' if exists $e->{flags}{D}; # deprecated |
| 186 | $line .= 'x' if exists $e->{flags}{x}; # experimental |
| 187 | $line .= 'c' if exists $e->{flags}{C} # core-only |
| 188 | || ( exists $e->{flags}{X} |
| 189 | && (exists $e->{flags}{E} || ! exists $e->{flags}{m})); |
| 190 | $is_accessible = 1 if exists $e->{flags}{A} |
| 191 | || exists $e->{flags}{C} |
| 192 | || ( exists $e->{flags}{X} |
| 193 | && ! exists $e->{flags}{E} |
| 194 | && exists $e->{flags}{m}); |
| 195 | $is_documented = 1 if exists $e->{flags}{d}; |
| 196 | } |
| 197 | |
| 198 | # scanprov adds the M and F flags. The M is for provided macros; F for |
| 199 | # functions we didn't find in testing (usually because they are hidden |
| 200 | # behind ifdefs, like PERL_GLOBAL_STRUCT_PRIVATE). None of them were |
| 201 | # verified |
| 202 | if (exists $raw_base{$_}{code}) { |
| 203 | $line .= 'V' if $raw_base{$_}{code} =~ /[MFX]/; |
| 204 | $is_accessible = 1 if $raw_base{$_}{code} =~ /M/; |
| 205 | } |
| 206 | $line .= 'i' unless $is_accessible; |
| 207 | $line .= 'u' unless $is_documented; |
| 208 | |
| 209 | $_ = $line; |
| 210 | } |
| 211 | |
| 212 | $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/ |
| 213 | join "\n", map "$1$_", sort dictionary_order @perl_api |
| 214 | /gem; |
| 215 | |
| 216 | my $undocumented = "(undocumented)"; |
| 217 | |
| 218 | my @todo; |
| 219 | for (@todo_list) { |
| 220 | my $ver = format_version($_); |
| 221 | $ver .= " (at least)" if $_ == $todo_list[-1]; |
| 222 | my $todo = "=item perl $ver\n\n"; |
| 223 | for (sort dictionary_order @{$todo{$_}}) { |
| 224 | $todo .= " $_"; |
| 225 | $todo .= " (DEPRECATED)" if $embed{$_}->{flags}{D}; |
| 226 | $todo .= " (marked experimental)" if $embed{$_}->{flags}{x}; |
| 227 | $todo .= " $undocumented" unless $embed{$_}->{flags}{d}; |
| 228 | $todo .= "\n"; |
| 229 | } |
| 230 | push @todo, $todo; |
| 231 | } |
| 232 | |
| 233 | if (@prototype_unknown) { |
| 234 | my $todo = "=item Backported version unknown\n\n"; |
| 235 | for (sort dictionary_order @prototype_unknown) { |
| 236 | $todo .= " $_ $undocumented\n"; |
| 237 | } |
| 238 | push @todo, $todo; |
| 239 | } |
| 240 | |
| 241 | $data =~ s{^__UNSUPPORTED_API__(\s*?)^} |
| 242 | {join "\n", @todo}gem; |
| 243 | |
| 244 | $data =~ s{__MIN_PERL__}{$MIN_PERL}g; |
| 245 | $data =~ s{__MAX_PERL__}{$MAX_PERL}g; |
| 246 | |
| 247 | open FH, ">PPPort.pm" or die "PPPort.pm: $!\n"; |
| 248 | print FH $data; |
| 249 | close FH; |
| 250 | |
| 251 | exit 0; |
| 252 | |
| 253 | sub include |
| 254 | { |
| 255 | my($file, $opt) = @_; |
| 256 | |
| 257 | print "including $file\n"; |
| 258 | |
| 259 | my $data = parse_partspec("$INCLUDE/$file"); |
| 260 | |
| 261 | for (@{$data->{provides}}) { |
| 262 | if (exists $provides{$_}) { |
| 263 | if ($provides{$_} ne $file) { |
| 264 | warn "$file: $_ already provided by $provides{$_}\n"; |
| 265 | } |
| 266 | } |
| 267 | else { |
| 268 | $provides{$_} = $file; |
| 269 | } |
| 270 | } |
| 271 | |
| 272 | for (keys %{$data->{prototypes}}) { |
| 273 | $prototypes{$_} = $data->{prototypes}{$_}; |
| 274 | $prototypes{$_} = normalize_prototype($data->{prototypes}{$_}); |
| 275 | $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg; |
| 276 | } |
| 277 | |
| 278 | my $out = $data->{implementation}; |
| 279 | |
| 280 | if (exists $opt->{indent}) { |
| 281 | $out =~ s/^/$opt->{indent}/gm; |
| 282 | } |
| 283 | |
| 284 | return $out; |
| 285 | } |
| 286 | |
| 287 | sub expand |
| 288 | { |
| 289 | my $code = shift; |
| 290 | $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem; |
| 291 | $code =~ s{^\s* |
| 292 | __UNDEFINED__ |
| 293 | \s+ |
| 294 | ( |
| 295 | ( \w+ ) |
| 296 | (?: \( [^)]* \) )? |
| 297 | ) |
| 298 | [^\r\n\S]* |
| 299 | ( |
| 300 | (?:[^\r\n\\]|\\[^\r\n])* |
| 301 | (?: |
| 302 | \\ |
| 303 | (?:\r\n|[\r\n]) |
| 304 | (?:[^\r\n\\]|\\[^\r\n])* |
| 305 | )* |
| 306 | ) |
| 307 | \s*$} |
| 308 | {expand_undefined($2, $1, $3)}gemx; |
| 309 | $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} |
| 310 | {expand_need_var($1, $3, $2, $4)}gem; |
| 311 | $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} |
| 312 | {expand_need_dummy_var($1, $3, $2, $4)}gem; |
| 313 | return $code; |
| 314 | } |
| 315 | |
| 316 | sub expand_need_var |
| 317 | { |
| 318 | my($indent, $var, $type, $init) = @_; |
| 319 | |
| 320 | $explicit{$var} = 'var'; |
| 321 | |
| 322 | my $myvar = "$DPPP(my_$var)"; |
| 323 | $init = defined $init ? " = $init" : ""; |
| 324 | |
| 325 | my $code = <<ENDCODE; |
| 326 | #if defined(NEED_$var) |
| 327 | static $type $myvar$init; |
| 328 | #elif defined(NEED_${var}_GLOBAL) |
| 329 | $type $myvar$init; |
| 330 | #else |
| 331 | extern $type $myvar; |
| 332 | #endif |
| 333 | #define $var $myvar |
| 334 | ENDCODE |
| 335 | |
| 336 | $code =~ s/^/$indent/mg; |
| 337 | |
| 338 | return $code; |
| 339 | } |
| 340 | |
| 341 | sub expand_need_dummy_var |
| 342 | { |
| 343 | my($indent, $var, $type, $init) = @_; |
| 344 | |
| 345 | $explicit{$var} = 'var'; |
| 346 | |
| 347 | my $myvar = "$DPPP(dummy_$var)"; |
| 348 | $init = defined $init ? " = $init" : ""; |
| 349 | |
| 350 | my $code = <<ENDCODE; |
| 351 | #if defined(NEED_$var) |
| 352 | static $type $myvar$init; |
| 353 | #elif defined(NEED_${var}_GLOBAL) |
| 354 | $type $myvar$init; |
| 355 | #else |
| 356 | extern $type $myvar; |
| 357 | #endif |
| 358 | ENDCODE |
| 359 | |
| 360 | $code =~ s/^/$indent/mg; |
| 361 | |
| 362 | return $code; |
| 363 | } |
| 364 | |
| 365 | sub expand_undefined |
| 366 | { |
| 367 | my($macro, $withargs, $def) = @_; |
| 368 | my $rv = "#ifndef $macro\n# define "; |
| 369 | |
| 370 | if (defined $def && $def =~ /\S/) { |
| 371 | $rv .= sprintf "%-30s %s", $withargs, $def; |
| 372 | } |
| 373 | else { |
| 374 | $rv .= $withargs; |
| 375 | } |
| 376 | |
| 377 | $rv .= "\n#endif\n"; |
| 378 | |
| 379 | return $rv; |
| 380 | } |
| 381 | |
| 382 | sub expand_pp_expressions |
| 383 | { |
| 384 | my $pp = shift; |
| 385 | $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge; |
| 386 | return $pp; |
| 387 | } |
| 388 | |
| 389 | sub expand_pp_expr |
| 390 | { |
| 391 | my $expr = shift; |
| 392 | |
| 393 | if ($expr =~ /^\s*need\s+(\w+)\s*$/i) { |
| 394 | my $func = $1; |
| 395 | my $e = $embed{$func} or die "unknown API function '$func' in NEED\n"; |
| 396 | my $proto = make_prototype($e); |
| 397 | if (exists $prototypes{$func}) { |
| 398 | if (compare_prototypes($proto, $prototypes{$func})) { |
| 399 | my $proto_no_pTHX = $proto; |
| 400 | $proto_no_pTHX =~ s/pTHX_\s*//; |
| 401 | if (compare_prototypes($proto_no_pTHX, $prototypes{$func})) { |
| 402 | check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}"); |
| 403 | } |
| 404 | else { |
| 405 | check(1, "prototypes differ in pTHX_ for $func:\n API: $proto\n PPP: $prototypes{$func}"); |
| 406 | } |
| 407 | $proto = $prototypes{$func}; |
| 408 | } |
| 409 | } |
| 410 | else { |
| 411 | warn "found no prototype for $func\n";; |
| 412 | } |
| 413 | |
| 414 | $explicit{$func} = 'func'; |
| 415 | |
| 416 | $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/; |
| 417 | my $embed = make_embed($e); |
| 418 | |
| 419 | return "defined(NEED_$func)\n" |
| 420 | . "static $proto;\n" |
| 421 | . "static\n" |
| 422 | . "#else\n" |
| 423 | . "extern $proto;\n" |
| 424 | . "#endif\n" |
| 425 | . "\n" |
| 426 | . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)\n" |
| 427 | . "\n" |
| 428 | . "$embed\n"; |
| 429 | } |
| 430 | |
| 431 | die "cannot expand preprocessor expression '$expr'\n"; |
| 432 | } |
| 433 | |
| 434 | sub make_embed |
| 435 | { |
| 436 | my $f = shift; |
| 437 | my $n = $f->{name}; |
| 438 | my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} }; |
| 439 | my $lastarg = ${$f->{args}}[-1]; |
| 440 | |
| 441 | if ($f->{flags}{T}) { |
| 442 | if ($f->{flags}{p}) { |
| 443 | return "#define $n $DPPP(my_$n)\n" . |
| 444 | "#define Perl_$n $DPPP(my_$n)"; |
| 445 | } |
| 446 | else { |
| 447 | return "#define $n $DPPP(my_$n)"; |
| 448 | } |
| 449 | } |
| 450 | else { |
| 451 | my $undef = <<UNDEF; |
| 452 | #ifdef $n |
| 453 | # undef $n |
| 454 | #endif |
| 455 | UNDEF |
| 456 | if ($f->{flags}{p}) { |
| 457 | if ($f->{flags}{f}) { |
| 458 | return "#define Perl_$n $DPPP(my_$n)"; |
| 459 | } |
| 460 | elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) { |
| 461 | return $undef . "#define $n $DPPP(my_$n)\n" . |
| 462 | "#define Perl_$n $DPPP(my_$n)"; |
| 463 | } |
| 464 | else { |
| 465 | return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" . |
| 466 | "#define Perl_$n $DPPP(my_$n)"; |
| 467 | } |
| 468 | } |
| 469 | else { |
| 470 | return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)"; |
| 471 | } |
| 472 | } |
| 473 | } |
| 474 | |
| 475 | sub check |
| 476 | { |
| 477 | my $level = shift; |
| 478 | |
| 479 | if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) { |
| 480 | print STDERR @_, "\n"; |
| 481 | } |
| 482 | } |
| 483 | |
| 484 | __DATA__ |
| 485 | ################################################################################ |
| 486 | # |
| 487 | # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!! |
| 488 | # |
| 489 | # This file was automatically generated from the definition files in the |
| 490 | # parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this |
| 491 | # works, please read the F<HACKERS> file that came with this distribution. |
| 492 | # |
| 493 | ################################################################################ |
| 494 | # |
| 495 | # Perl/Pollution/Portability |
| 496 | # |
| 497 | ################################################################################ |
| 498 | # |
| 499 | # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
| 500 | # Copyright (C) 2018, The perl5 porters |
| 501 | # Version 2.x, Copyright (C) 2001, Paul Marquess. |
| 502 | # Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
| 503 | # |
| 504 | # This program is free software; you can redistribute it and/or |
| 505 | # modify it under the same terms as Perl itself. |
| 506 | # |
| 507 | ################################################################################ |
| 508 | |
| 509 | =head1 NAME |
| 510 | |
| 511 | Devel::PPPort - Perl/Pollution/Portability |
| 512 | |
| 513 | =head1 SYNOPSIS |
| 514 | |
| 515 | Devel::PPPort::WriteFile(); # defaults to ./ppport.h |
| 516 | Devel::PPPort::WriteFile('someheader.h'); |
| 517 | |
| 518 | # Same as above but retrieve contents rather than write file |
| 519 | my $contents = Devel::PPPort::GetFileContents(); |
| 520 | my $contents = Devel::PPPort::GetFileContents('someheader.h'); |
| 521 | |
| 522 | =head1 Start using Devel::PPPort for XS projects |
| 523 | |
| 524 | $ cpan Devel::PPPort |
| 525 | $ perl -MDevel::PPPort -e'Devel::PPPort::WriteFile' |
| 526 | $ perl ppport.h --compat-version=5.6.1 --patch=diff.patch *.xs |
| 527 | $ patch -p0 < diff.patch |
| 528 | $ echo ppport.h >>MANIFEST |
| 529 | |
| 530 | =head1 DESCRIPTION |
| 531 | |
| 532 | Perl's API has changed over time, gaining new features, new functions, |
| 533 | increasing its flexibility, and reducing the impact on the C namespace |
| 534 | environment (reduced pollution). The header file written by this module, |
| 535 | typically F<ppport.h>, attempts to bring some of the newer Perl API |
| 536 | features to older versions of Perl, so that you can worry less about |
| 537 | keeping track of old releases, but users can still reap the benefit. |
| 538 | |
| 539 | C<Devel::PPPort> contains two functions, C<WriteFile> and C<GetFileContents>. |
| 540 | C<WriteFile>'s only purpose is to write the F<ppport.h> C header file. |
| 541 | This file contains a series of macros and, if explicitly requested, functions |
| 542 | that allow XS modules to be built using older versions of Perl. Currently, |
| 543 | Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported. |
| 544 | |
| 545 | C<GetFileContents> can be used to retrieve the file contents rather than |
| 546 | writing it out. |
| 547 | |
| 548 | This module is used by C<h2xs> to write the file F<ppport.h>. |
| 549 | |
| 550 | =head2 Why use ppport.h? |
| 551 | |
| 552 | You should use F<ppport.h> in modern code so that your code will work |
| 553 | with the widest range of Perl interpreters possible, without significant |
| 554 | additional work. |
| 555 | |
| 556 | You should attempt to get older code to fully use F<ppport.h>, because the |
| 557 | reduced pollution of newer Perl versions is an important thing. It's so |
| 558 | important that the old polluting ways of original Perl modules will not be |
| 559 | supported very far into the future, and your module will almost certainly |
| 560 | break! By adapting to it now, you'll gain compatibility and a sense of |
| 561 | having done the electronic ecology some good. |
| 562 | |
| 563 | =head2 How to use ppport.h |
| 564 | |
| 565 | Don't direct the users of your module to download C<Devel::PPPort>. |
| 566 | They are most probably not XS writers. Also, don't make F<ppport.h> |
| 567 | optional. Rather, just take the most recent copy of F<ppport.h> that |
| 568 | you can find (e.g. by generating it with the latest C<Devel::PPPort> |
| 569 | release from CPAN), copy it into your project, adjust your project to |
| 570 | use it, and distribute the header along with your module. |
| 571 | |
| 572 | =head2 Running ppport.h |
| 573 | |
| 574 | But F<ppport.h> is more than just a C header. It's also a Perl script |
| 575 | that can check your source code. It will suggest hints and portability |
| 576 | notes, and can even make suggestions on how to change your code. You |
| 577 | can run it like any other Perl program: |
| 578 | |
| 579 | perl ppport.h [options] [files] |
| 580 | |
| 581 | It also has embedded documentation, so you can use |
| 582 | |
| 583 | perldoc ppport.h |
| 584 | |
| 585 | to find out more about how to use it. |
| 586 | |
| 587 | =head1 FUNCTIONS |
| 588 | |
| 589 | =head2 WriteFile |
| 590 | |
| 591 | C<WriteFile> takes one optional argument. When called with one |
| 592 | argument, it expects to be passed a filename. When called with |
| 593 | no arguments, it defaults to the filename F<ppport.h>. |
| 594 | |
| 595 | The function returns a true value if the file was written successfully. |
| 596 | Otherwise it returns a false value. |
| 597 | |
| 598 | =head2 GetFileContents |
| 599 | |
| 600 | C<GetFileContents> behaves like C<WriteFile> above, but returns the contents |
| 601 | of the would-be file rather than writing it out. |
| 602 | |
| 603 | =head1 COMPATIBILITY |
| 604 | |
| 605 | F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__ |
| 606 | in threaded and non-threaded configurations. |
| 607 | |
| 608 | =head2 Provided Perl compatibility API |
| 609 | |
| 610 | The header file written by this module, typically F<ppport.h>, provides access |
| 611 | to the following elements of the Perl API that are not otherwise available in |
| 612 | Perl releases older than when the elements were first introduced. (Note that |
| 613 | many of these are not supported all the way back to __MIN_PERL__, but it may |
| 614 | be that they are supported back as far as you need; see L</Supported Perl API, |
| 615 | sorted by version> for that information.) |
| 616 | |
| 617 | __PROVIDED_API__ |
| 618 | |
| 619 | =head2 Supported Perl API, sorted by version |
| 620 | |
| 621 | The table in this section lists all the Perl API elements available, sorted by |
| 622 | the version in which support starts. This includes all the elements that |
| 623 | F<ppport.h> helps out with, as well as those elements that it doesn't. |
| 624 | |
| 625 | In some cases, it doesn't make practical sense for elements to be supported |
| 626 | earlier than they already are. For example, UTF-8 functionality isn't |
| 627 | provided prior to the release where it was first introduced. |
| 628 | |
| 629 | But in other cases, it just is that no one has implemented support yet. |
| 630 | Patches welcome! Some elements are ported backward for some releases, but not |
| 631 | all the way to __MIN_PERL__. |
| 632 | |
| 633 | If an element, call it ELEMENT, is not on this list, try using this command to |
| 634 | find out why: |
| 635 | |
| 636 | perl ppport.h --api-info=ELEMENT |
| 637 | |
| 638 | A few of the entries in the list below are marked as DEPRECATED. You should |
| 639 | not use these for new code, and should be converting existing uses to use |
| 640 | something better. |
| 641 | |
| 642 | Some of the entries in the list are marked as "experimental". This means |
| 643 | these should not generally be used. They may be removed or changed without |
| 644 | notice. You can ask why they are experimental by sending email to |
| 645 | L<mailto:perl5-porters@perl.org>. |
| 646 | |
| 647 | And some of the entries are marked as "undocumented". This means that they |
| 648 | aren't necessarily considered stable, and could be changed or removed in some |
| 649 | future release without warning. It is therefore a bad idea to use them |
| 650 | without further checking. It could be that these are considered to be for |
| 651 | perl core use only; or it could be, though, that C<Devel::PPPort> doesn't know |
| 652 | where to find their documentation, or that it's just an oversight that they |
| 653 | haven't been documented. If you want to use one, and potentially have it |
| 654 | backported, first send mail to L<mailto:perl5-porters@perl.org>. |
| 655 | |
| 656 | =over 4 |
| 657 | |
| 658 | __UNSUPPORTED_API__ |
| 659 | |
| 660 | =back |
| 661 | |
| 662 | =head1 BUGS |
| 663 | |
| 664 | If you find any bugs, C<Devel::PPPort> doesn't seem to build on your |
| 665 | system, or any of its tests fail, please send a bug report to |
| 666 | L<https://github.com/Dual-Life/Devel-PPPort/issues/new>. |
| 667 | |
| 668 | =head1 AUTHORS |
| 669 | |
| 670 | =over 2 |
| 671 | |
| 672 | =item * |
| 673 | |
| 674 | Version 1.x of Devel::PPPort was written by Kenneth Albanowski. |
| 675 | |
| 676 | =item * |
| 677 | |
| 678 | Version 2.x was ported to the Perl core by Paul Marquess. |
| 679 | |
| 680 | =item * |
| 681 | |
| 682 | Version 3.x was ported back to CPAN by Marcus Holland-Moritz. |
| 683 | |
| 684 | =item * |
| 685 | |
| 686 | Versions >= 3.22 are maintained by perl5 porters |
| 687 | |
| 688 | =back |
| 689 | |
| 690 | =head1 COPYRIGHT |
| 691 | |
| 692 | Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
| 693 | |
| 694 | Copyright (C) 2018, The perl5 porters |
| 695 | |
| 696 | Version 2.x, Copyright (C) 2001, Paul Marquess. |
| 697 | |
| 698 | Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
| 699 | |
| 700 | This program is free software; you can redistribute it and/or |
| 701 | modify it under the same terms as Perl itself. |
| 702 | |
| 703 | =head1 SEE ALSO |
| 704 | |
| 705 | See L<h2xs>, L<ppport.h>. |
| 706 | |
| 707 | =cut |
| 708 | |
| 709 | package Devel::PPPort; |
| 710 | |
| 711 | use strict; |
| 712 | use vars qw($VERSION $data); |
| 713 | |
| 714 | $VERSION = '3.55'; |
| 715 | |
| 716 | sub _init_data |
| 717 | { |
| 718 | $data = do { local $/; <DATA> }; |
| 719 | my $pkg = 'Devel::PPPort'; |
| 720 | $data =~ s/__PERL_VERSION__/$]/g; |
| 721 | $data =~ s/__VERSION__/$VERSION/g; |
| 722 | $data =~ s/__PKG__/$pkg/g; |
| 723 | $data =~ s/^\|>//gm; |
| 724 | } |
| 725 | |
| 726 | sub GetFileContents { |
| 727 | my $file = shift || 'ppport.h'; |
| 728 | defined $data or _init_data(); |
| 729 | my $copy = $data; |
| 730 | $copy =~ s/\bppport\.h\b/$file/g; |
| 731 | |
| 732 | return $copy; |
| 733 | } |
| 734 | |
| 735 | sub WriteFile |
| 736 | { |
| 737 | my $file = shift || 'ppport.h'; |
| 738 | my $data = GetFileContents($file); |
| 739 | open F, ">$file" or return undef; |
| 740 | print F $data; |
| 741 | close F; |
| 742 | |
| 743 | return 1; |
| 744 | } |
| 745 | |
| 746 | 1; |
| 747 | |
| 748 | __DATA__ |
| 749 | #if 0 |
| 750 | <<'SKIP'; |
| 751 | #endif |
| 752 | /* |
| 753 | ---------------------------------------------------------------------- |
| 754 | |
| 755 | ppport.h -- Perl/Pollution/Portability Version __VERSION__ |
| 756 | |
| 757 | Automatically created by __PKG__ running under perl __PERL_VERSION__. |
| 758 | |
| 759 | Do NOT edit this file directly! -- Edit PPPort_pm.PL and the |
| 760 | includes in parts/inc/ instead. |
| 761 | |
| 762 | Use 'perldoc ppport.h' to view the documentation below. |
| 763 | |
| 764 | ---------------------------------------------------------------------- |
| 765 | |
| 766 | SKIP |
| 767 | |
| 768 | %include ppphdoc { indent => '|>' } |
| 769 | |
| 770 | %include inctools |
| 771 | |
| 772 | %include ppphbin |
| 773 | |
| 774 | __DATA__ |
| 775 | */ |
| 776 | |
| 777 | #ifndef _P_P_PORTABILITY_H_ |
| 778 | #define _P_P_PORTABILITY_H_ |
| 779 | |
| 780 | #ifndef DPPP_NAMESPACE |
| 781 | # define DPPP_NAMESPACE DPPP_ |
| 782 | #endif |
| 783 | |
| 784 | #define DPPP_CAT2(x,y) CAT2(x,y) |
| 785 | #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) |
| 786 | |
| 787 | %include version |
| 788 | |
| 789 | %include threads |
| 790 | |
| 791 | %include limits |
| 792 | |
| 793 | %include variables |
| 794 | |
| 795 | %include newCONSTSUB |
| 796 | |
| 797 | %include magic_defs |
| 798 | |
| 799 | %include misc |
| 800 | |
| 801 | %include sv_xpvf |
| 802 | |
| 803 | %include SvPV |
| 804 | |
| 805 | %include warn |
| 806 | |
| 807 | %include format |
| 808 | |
| 809 | %include uv |
| 810 | |
| 811 | %include memory |
| 812 | |
| 813 | %include mess |
| 814 | |
| 815 | %include mPUSH |
| 816 | |
| 817 | %include call |
| 818 | |
| 819 | %include newRV |
| 820 | |
| 821 | %include MY_CXT |
| 822 | |
| 823 | %include SvREFCNT |
| 824 | |
| 825 | %include newSV_type |
| 826 | |
| 827 | %include newSVpv |
| 828 | |
| 829 | %include Sv_set |
| 830 | |
| 831 | %include shared_pv |
| 832 | |
| 833 | %include HvNAME |
| 834 | |
| 835 | %include gv |
| 836 | |
| 837 | %include pvs |
| 838 | |
| 839 | %include magic |
| 840 | |
| 841 | %include cop |
| 842 | |
| 843 | %include grok |
| 844 | |
| 845 | %include snprintf |
| 846 | |
| 847 | %include sprintf |
| 848 | |
| 849 | %include exception |
| 850 | |
| 851 | %include strlfuncs |
| 852 | |
| 853 | %include utf8 |
| 854 | |
| 855 | %include pv_tools |
| 856 | |
| 857 | #endif /* _P_P_PORTABILITY_H_ */ |
| 858 | |
| 859 | /* End of File ppport.h */ |