1 ################################################################################
3 # PPPort_pm.PL -- generate PPPort.pm
5 ################################################################################
7 # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
8 # Version 2.x, Copyright (C) 2001, Paul Marquess.
9 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
11 # This program is free software; you can redistribute it and/or
12 # modify it under the same terms as Perl itself.
14 ################################################################################
18 require "parts/ppptools.pl";
20 my $INCLUDE = 'parts/inc';
23 my %embed = map { ( $_->{name} => $_ ) }
24 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc));
26 my(%provides, %prototypes, %explicit);
28 my $data = do { local $/; <DATA> };
29 $data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
30 {eval "$1('$2', $3)" or die $@}gem;
32 $data = expand($data);
34 my @api = sort { lc $a cmp lc $b or $a cmp $b } keys %provides;
36 $data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
37 {join '', map "$1$_\n", @api}gem;
41 for (keys %explicit) {
42 length > $len and $len = length;
44 my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5;
47 $data =~ s!^(.*)__EXPLICIT_API__(\s*?)^!
48 sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') .
49 $1 . '-'x$len . "\n" .
50 join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
55 my %raw_base = %{&parse_todo('parts/base')};
56 my %raw_todo = %{&parse_todo('parts/todo')};
59 for (keys %raw_todo) {
60 push @{$todo{$raw_todo{$_}}}, $_;
65 if (exists $raw_todo{$_} and exists $raw_base{$_}) {
66 if ($raw_base{$_} eq $raw_todo{$_}) {
67 warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
68 . "todo for " . format_version($raw_todo{$_}) . "\n";
71 check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
72 " (baseline revision: " . format_version($raw_base{$_}) . ").");
78 for (keys %provides) {
79 next if /^Perl_(.*)/ && exists $embed{$1};
80 next if exists $embed{$_};
82 check(2, "No API definition for provided element $_ found.");
85 push @perl_api, keys %embed;
88 if (exists $provides{$_} && !exists $raw_base{$_}) {
89 check(2, "Mmmh, $_ doesn't seem to need backporting.");
91 my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
92 $line .= ($raw_todo{$_} || '') . '|';
93 $line .= 'p' if exists $provides{$_};
94 if (exists $embed{$_}) {
96 if (exists $e->{flags}{p}) {
97 my $args = $e->{args};
98 $line .= 'v' if @$args && $args->[-1][0] eq '...';
100 $line .= 'n' if exists $e->{flags}{n};
105 $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
106 join "\n", map "$1$_", sort @perl_api
110 for (reverse sort keys %todo) {
111 my $ver = format_version($_);
112 my $todo = "=item perl $ver\n\n";
113 for (sort @{$todo{$_}}) {
119 $data =~ s{^__UNSUPPORTED_API__(\s*?)^}
120 {join "\n", @todo}gem;
122 $data =~ s{__MIN_PERL__}{5.003}g;
123 $data =~ s{__MAX_PERL__}{5.20}g;
125 open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
133 my($file, $opt) = @_;
135 print "including $file\n";
137 my $data = parse_partspec("$INCLUDE/$file");
139 for (@{$data->{provides}}) {
140 if (exists $provides{$_}) {
141 if ($provides{$_} ne $file) {
142 warn "$file: $_ already provided by $provides{$_}\n";
146 $provides{$_} = $file;
150 for (keys %{$data->{prototypes}}) {
151 $prototypes{$_} = $data->{prototypes}{$_};
152 $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
155 my $out = $data->{implementation};
157 if (exists $opt->{indent}) {
158 $out =~ s/^/$opt->{indent}/gm;
167 $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
177 (?:[^\r\n\\]|\\[^\r\n])*
181 (?:[^\r\n\\]|\\[^\r\n])*
185 {expand_undefined($2, $1, $3)}gemx;
186 $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
187 {expand_need_var($1, $3, $2, $4)}gem;
188 $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
189 {expand_need_dummy_var($1, $3, $2, $4)}gem;
195 my($indent, $var, $type, $init) = @_;
197 $explicit{$var} = 'var';
199 my $myvar = "$DPPP(my_$var)";
200 $init = defined $init ? " = $init" : "";
202 my $code = <<ENDCODE;
203 #if defined(NEED_$var)
204 static $type $myvar$init;
205 #elif defined(NEED_${var}_GLOBAL)
213 $code =~ s/^/$indent/mg;
218 sub expand_need_dummy_var
220 my($indent, $var, $type, $init) = @_;
222 $explicit{$var} = 'var';
224 my $myvar = "$DPPP(dummy_$var)";
225 $init = defined $init ? " = $init" : "";
227 my $code = <<ENDCODE;
228 #if defined(NEED_$var)
229 static $type $myvar$init;
230 #elif defined(NEED_${var}_GLOBAL)
237 $code =~ s/^/$indent/mg;
244 my($macro, $withargs, $def) = @_;
245 my $rv = "#ifndef $macro\n# define ";
247 if (defined $def && $def =~ /\S/) {
248 $rv .= sprintf "%-30s %s", $withargs, $def;
259 sub expand_pp_expressions
262 $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
270 if ($expr =~ /^\s*need\s+(\w+)\s*$/i) {
272 my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
273 my $proto = make_prototype($e);
274 if (exists $prototypes{$func}) {
275 if (compare_prototypes($proto, $prototypes{$func})) {
276 check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
277 $proto = $prototypes{$func};
281 warn "found no prototype for $func\n";;
284 $explicit{$func} = 'func';
286 $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
287 my $embed = make_embed($e);
289 return "defined(NEED_$func)\n"
298 . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
301 die "cannot expand preprocessor expression '$expr'\n";
308 my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
309 my $lastarg = ${$f->{args}}[-1];
311 if ($f->{flags}{n}) {
312 if ($f->{flags}{p}) {
313 return "#define $n $DPPP(my_$n)\n" .
314 "#define Perl_$n $DPPP(my_$n)";
317 return "#define $n $DPPP(my_$n)";
326 if ($f->{flags}{p}) {
327 if ($f->{flags}{f}) {
328 return "#define Perl_$n $DPPP(my_$n)";
330 elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) {
331 return $undef . "#define $n $DPPP(my_$n)\n" .
332 "#define Perl_$n $DPPP(my_$n)";
335 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
336 "#define Perl_$n $DPPP(my_$n)";
340 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
349 if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
350 print STDERR @_, "\n";
355 ################################################################################
357 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
359 # This file was automatically generated from the definition files in the
360 # parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this
361 # works, please read the F<HACKERS> file that came with this distribution.
363 ################################################################################
365 # Perl/Pollution/Portability
367 ################################################################################
369 # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
370 # Version 2.x, Copyright (C) 2001, Paul Marquess.
371 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
373 # This program is free software; you can redistribute it and/or
374 # modify it under the same terms as Perl itself.
376 ################################################################################
380 Devel::PPPort - Perl/Pollution/Portability
384 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
385 Devel::PPPort::WriteFile('someheader.h');
387 # Same as above but retrieve contents rather than write file
388 my $contents = Devel::PPPort::GetFileContents();
389 my $contents = Devel::PPPort::GetFileContents('someheader.h');
393 Perl's API has changed over time, gaining new features, new functions,
394 increasing its flexibility, and reducing the impact on the C namespace
395 environment (reduced pollution). The header file written by this module,
396 typically F<ppport.h>, attempts to bring some of the newer Perl API
397 features to older versions of Perl, so that you can worry less about
398 keeping track of old releases, but users can still reap the benefit.
400 C<Devel::PPPort> contains two functions, C<WriteFile> and C<GetFileContents>.
401 C<WriteFile>'s only purpose is to write the F<ppport.h> C header file.
402 This file contains a series of macros and, if explicitly requested, functions
403 that allow XS modules to be built using older versions of Perl. Currently,
404 Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
406 C<GetFileContents> can be used to retrieve the file contents rather than
409 This module is used by C<h2xs> to write the file F<ppport.h>.
411 =head2 Why use ppport.h?
413 You should use F<ppport.h> in modern code so that your code will work
414 with the widest range of Perl interpreters possible, without significant
417 You should attempt older code to fully use F<ppport.h>, because the
418 reduced pollution of newer Perl versions is an important thing. It's so
419 important that the old polluting ways of original Perl modules will not be
420 supported very far into the future, and your module will almost certainly
421 break! By adapting to it now, you'll gain compatibility and a sense of
422 having done the electronic ecology some good.
424 =head2 How to use ppport.h
426 Don't direct the users of your module to download C<Devel::PPPort>.
427 They are most probably no XS writers. Also, don't make F<ppport.h>
428 optional. Rather, just take the most recent copy of F<ppport.h> that
429 you can find (e.g. by generating it with the latest C<Devel::PPPort>
430 release from CPAN), copy it into your project, adjust your project to
431 use it, and distribute the header along with your module.
433 =head2 Running ppport.h
435 But F<ppport.h> is more than just a C header. It's also a Perl script
436 that can check your source code. It will suggest hints and portability
437 notes, and can even make suggestions on how to change your code. You
438 can run it like any other Perl program:
440 perl ppport.h [options] [files]
442 It also has embedded documentation, so you can use
446 to find out more about how to use it.
452 C<WriteFile> takes one optional argument. When called with one
453 argument, it expects to be passed a filename. When called with
454 no arguments, it defaults to the filename F<ppport.h>.
456 The function returns a true value if the file was written successfully.
457 Otherwise it returns a false value.
459 =head2 GetFileContents
461 C<GetFileContents> behaves like C<WriteFile> above, but returns the contents
462 of the would-be file rather than writing it out.
466 F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
467 in threaded and non-threaded configurations.
469 =head2 Provided Perl compatibility API
471 The header file written by this module, typically F<ppport.h>, provides
472 access to the following elements of the Perl API that is not available
473 in older Perl releases:
477 =head2 Perl API not supported by ppport.h
479 There is still a big part of the API not supported by F<ppport.h>.
480 Either because it doesn't make sense to back-port that part of the API,
481 or simply because it hasn't been implemented yet. Patches welcome!
483 Here's a list of the currently unsupported API, and also the version of
484 Perl below which it is unsupported:
494 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
495 system, or any of its tests fail, please file an issue here:
496 L<https://github.com/mhx/Devel-PPPort/issues/>
504 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
508 Version 2.x was ported to the Perl core by Paul Marquess.
512 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
516 Versions >= 3.22 are maintained with support from Matthew Horsfall (alh).
522 Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
524 Version 2.x, Copyright (C) 2001, Paul Marquess.
526 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
528 This program is free software; you can redistribute it and/or
529 modify it under the same terms as Perl itself.
533 See L<h2xs>, L<ppport.h>.
537 package Devel::PPPort;
540 use vars qw($VERSION $data);
546 $data = do { local $/; <DATA> };
547 my $pkg = 'Devel::PPPort';
548 $data =~ s/__PERL_VERSION__/$]/g;
549 $data =~ s/__VERSION__/$VERSION/g;
550 $data =~ s/__PKG__/$pkg/g;
554 sub GetFileContents {
555 my $file = shift || 'ppport.h';
556 defined $data or _init_data();
558 $copy =~ s/\bppport\.h\b/$file/g;
565 my $file = shift || 'ppport.h';
566 my $data = GetFileContents($file);
567 open F, ">$file" or return undef;
581 ----------------------------------------------------------------------
583 ppport.h -- Perl/Pollution/Portability Version __VERSION__
585 Automatically created by __PKG__ running under perl __PERL_VERSION__.
587 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
588 includes in parts/inc/ instead.
590 Use 'perldoc ppport.h' to view the documentation below.
592 ----------------------------------------------------------------------
596 %include ppphdoc { indent => '|>' }
603 #ifndef _P_P_PORTABILITY_H_
604 #define _P_P_PORTABILITY_H_
606 #ifndef DPPP_NAMESPACE
607 # define DPPP_NAMESPACE DPPP_
610 #define DPPP_CAT2(x,y) CAT2(x,y)
611 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
677 #endif /* _P_P_PORTABILITY_H_ */
679 /* End of File ppport.h */