1 ################################################################################
3 # PPPort_pm.PL -- generate PPPort.pm
5 ################################################################################
9 # $Date: 2005/06/25 17:56:28 +0200 $
11 ################################################################################
13 # Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
14 # Version 2.x, Copyright (C) 2001, Paul Marquess.
15 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
17 # This program is free software; you can redistribute it and/or
18 # modify it under the same terms as Perl itself.
20 ################################################################################
24 require "parts/ppptools.pl";
26 my $INCLUDE = 'parts/inc';
29 my %embed = map { ( $_->{name} => $_ ) }
30 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc));
32 my(%provides, %prototypes, %explicit);
34 my $data = do { local $/; <DATA> };
35 $data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
36 {eval "$1('$2', $3)" or die $@}gem;
38 $data = expand($data);
40 my @api = sort { lc $a cmp lc $b } keys %provides;
42 $data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
43 {join '', map "$1$_\n", @api}gem;
47 for (keys %explicit) {
48 length > $len and $len = length;
50 my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5;
53 $data =~ s/^(.*)__EXPLICIT_API__(\s*?)^/
54 sprintf("$1$format\n", 'Function', 'Static Request', 'Global Request') .
55 $1 . '-'x$len . "\n" .
56 join('', map { sprintf "$1$format\n", "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
61 my %raw_base = %{&parse_todo('parts/base')};
62 my %raw_todo = %{&parse_todo('parts/todo')};
65 for (keys %raw_todo) {
66 push @{$todo{$raw_todo{$_}}}, $_;
71 if (exists $raw_todo{$_}) {
72 if ($raw_base{$_} eq $raw_todo{$_}) {
73 warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
74 . "todo for " . format_version($raw_todo{$_}) . "\n";
77 check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
78 " (baseline revision: " . format_version($raw_base{$_}) . ").");
84 for (keys %provides) {
85 next if exists $embed{$_};
87 check(2, "No API definition for provided element $_ found.");
90 push @perl_api, keys %embed;
93 if (exists $provides{$_} && !exists $raw_base{$_}) {
94 check(2, "Mmmh, $_ doesn't seem to need backporting.");
96 my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
97 $line .= ($raw_todo{$_} || '') . '|';
98 $line .= 'p' if exists $provides{$_};
99 if (exists $embed{$_}) {
101 if (exists $e->{flags}{p}) {
102 my $args = $e->{args};
103 $line .= 'v' if @$args && $args->[-1][0] eq '...';
105 $line .= 'n' if exists $e->{flags}{n};
110 $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
111 join "\n", map "$1$_", sort @perl_api
115 for (reverse sort keys %todo) {
116 my $ver = format_version($_);
117 my $todo = "=item perl $ver\n\n";
118 for (sort @{$todo{$_}}) {
124 $data =~ s{^__UNSUPPORTED_API__(\s*?)^}
125 {join "\n", @todo}gem;
127 $data =~ s{__MIN_PERL__}{5.003}g;
128 $data =~ s{__MAX_PERL__}{5.9.3}g;
130 open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
138 my($file, $opt) = @_;
140 print "including $file\n";
142 my $data = parse_partspec("$INCLUDE/$file");
144 for (@{$data->{provides}}) {
145 if (exists $provides{$_}) {
146 if ($provides{$_} ne $file) {
147 warn "$file: $_ already provided by $provides{$_}\n";
151 $provides{$_} = $file;
155 for (keys %{$data->{prototypes}}) {
156 $prototypes{$_} = $data->{prototypes}{$_};
157 $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
160 my $out = $data->{implementation};
162 if (exists $opt->{indent}) {
163 $out =~ s/^/$opt->{indent}/gm;
172 $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
182 (?:[^\r\n\\]|\\[^\r\n])*
186 (?:[^\r\n\\]|\\[^\r\n])*
190 {expand_undefined($2, $1, $3)}gemx;
196 my($macro, $withargs, $def) = @_;
197 my $rv = "#ifndef $macro\n# define ";
199 if (defined $def && $def =~ /\S/) {
200 $rv .= sprintf "%-30s %s", $withargs, $def;
211 sub expand_pp_expressions
214 $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
222 if ($expr =~ /^\s*need\s*(\w+)\s*$/i) {
224 my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
225 my $proto = make_prototype($e);
226 if (exists $prototypes{$func}) {
227 if (compare_prototypes($proto, $prototypes{$func})) {
228 check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
229 $proto = $prototypes{$func};
233 warn "found no prototype for $func\n";;
236 $explicit{$func} = 1;
238 $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
239 my $embed = make_embed($e);
241 return "defined(NEED_$func)\n"
250 . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
253 die "cannot expand preprocessor expression '$expr'\n";
260 my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
262 if ($f->{flags}{n}) {
263 if ($f->{flags}{p}) {
264 return "#define $n $DPPP(my_$n)\n" .
265 "#define Perl_$n $DPPP(my_$n)";
268 return "#define $n $DPPP(my_$n)";
277 if ($f->{flags}{p}) {
278 if ($f->{flags}{f}) {
279 return "#define Perl_$n $DPPP(my_$n)";
282 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
283 "#define Perl_$n $DPPP(my_$n)";
287 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
296 if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
297 print STDERR @_, "\n";
302 ################################################################################
304 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
306 ################################################################################
308 # Perl/Pollution/Portability
310 ################################################################################
314 # $Date: 2005/06/25 17:56:28 +0200 $
316 ################################################################################
318 # Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
319 # Version 2.x, Copyright (C) 2001, Paul Marquess.
320 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
322 # This program is free software; you can redistribute it and/or
323 # modify it under the same terms as Perl itself.
325 ################################################################################
329 Devel::PPPort - Perl/Pollution/Portability
333 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
334 Devel::PPPort::WriteFile('someheader.h');
338 Perl's API has changed over time, gaining new features, new functions,
339 increasing its flexibility, and reducing the impact on the C namespace
340 environment (reduced pollution). The header file written by this module,
341 typically F<ppport.h>, attempts to bring some of the newer Perl API
342 features to older versions of Perl, so that you can worry less about
343 keeping track of old releases, but users can still reap the benefit.
345 C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
346 only purpose is to write the F<ppport.h> C header file. This file
347 contains a series of macros and, if explicitly requested, functions that
348 allow XS modules to be built using older versions of Perl. Currently,
349 Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
351 This module is used by C<h2xs> to write the file F<ppport.h>.
353 =head2 Why use ppport.h?
355 You should use F<ppport.h> in modern code so that your code will work
356 with the widest range of Perl interpreters possible, without significant
359 You should attempt older code to fully use F<ppport.h>, because the
360 reduced pollution of newer Perl versions is an important thing. It's so
361 important that the old polluting ways of original Perl modules will not be
362 supported very far into the future, and your module will almost certainly
363 break! By adapting to it now, you'll gain compatibility and a sense of
364 having done the electronic ecology some good.
366 =head2 How to use ppport.h
368 Don't direct the users of your module to download C<Devel::PPPort>.
369 They are most probably no XS writers. Also, don't make F<ppport.h>
370 optional. Rather, just take the most recent copy of F<ppport.h> that
371 you can find (e.g. by generating it with the latest C<Devel::PPPort>
372 release from CPAN), copy it into your project, adjust your project to
373 use it, and distribute the header along with your module.
375 =head2 Running ppport.h
377 But F<ppport.h> is more than just a C header. It's also a Perl script
378 that can check your source code. It will suggest hints and portability
379 notes, and can even make suggestions on how to change your code. You
380 can run it like any other Perl program:
382 perl ppport.h [options] [files]
384 It also has embedded documentation, so you can use
388 to find out more about how to use it.
394 C<WriteFile> takes one optional argument. When called with one
395 argument, it expects to be passed a filename. When called with
396 no arguments, it defaults to the filename F<ppport.h>.
398 The function returns a true value if the file was written successfully.
399 Otherwise it returns a false value.
403 F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
404 in threaded and non-threaded configurations.
406 =head2 Provided Perl compatibility API
408 The header file written by this module, typically F<ppport.h>, provides
409 access to the following elements of the Perl API that is not available
410 in older Perl releases:
414 =head2 Perl API not supported by ppport.h
416 There is still a big part of the API not supported by F<ppport.h>.
417 Either because it doesn't make sense to back-port that part of the API,
418 or simply because it hasn't been implemented yet. Patches welcome!
420 Here's a list of the currently unsupported API, and also the version of
421 Perl below which it is unsupported:
431 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
432 system or any of its tests fail, please use the CPAN Request Tracker
433 at L<http://rt.cpan.org/> to create a ticket for the module.
441 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
445 Version 2.x was ported to the Perl core by Paul Marquess.
449 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
455 Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
457 Version 2.x, Copyright (C) 2001, Paul Marquess.
459 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
461 This program is free software; you can redistribute it and/or
462 modify it under the same terms as Perl itself.
466 See L<h2xs>, L<ppport.h>.
470 package Devel::PPPort;
474 use vars qw($VERSION @ISA $data);
476 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.06_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
478 @ISA = qw(DynaLoader);
480 bootstrap Devel::PPPort;
484 $data = do { local $/; <DATA> };
486 my $pkg = 'Devel::PPPort';
487 $data =~ s/__PERL_VERSION__/$]/g;
488 $data =~ s/__VERSION__/$VERSION/g;
489 $data =~ s/__DATE__/$now/g;
490 $data =~ s/__PKG__/$pkg/g;
496 my $file = shift || 'ppport.h';
497 defined $data or _init_data();
499 $copy =~ s/\bppport\.h\b/$file/g;
501 open F, ">$file" or return undef;
515 ----------------------------------------------------------------------
517 ppport.h -- Perl/Pollution/Portability Version __VERSION__
519 Automatically created by __PKG__ running under
520 perl __PERL_VERSION__ on __DATE__.
522 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
523 includes in parts/inc/ instead.
525 Use 'perldoc ppport.h' to view the documentation below.
527 ----------------------------------------------------------------------
531 %include ppphdoc { indent => '|>' }
538 #ifndef _P_P_PORTABILITY_H_
539 #define _P_P_PORTABILITY_H_
541 #ifndef DPPP_NAMESPACE
542 # define DPPP_NAMESPACE DPPP_
545 #define DPPP_CAT2(x,y) CAT2(x,y)
546 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
582 #endif /* _P_P_PORTABILITY_H_ */
584 /* End of File ppport.h */