dist/Devel-PPPort/PPPort_pm.PL

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