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