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