This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
abb2cbd14dcd32d0fa94f1802f2eda2008a7c980
[perl5.git] / 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{$_}{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|UNDEF_NOT_PROVIDED)__
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 */