Commit | Line | Data |
bb4e9162 |
1 | package Module::Build::PPMMaker; |
2 | |
3 | use strict; |
613f422f |
4 | use Config; |
7a827510 |
5 | use vars qw($VERSION); |
229c5935 |
6 | use IO::File; |
7 | |
7dc9e1b4 |
8 | $VERSION = '0.3603'; |
7a827510 |
9 | $VERSION = eval $VERSION; |
bb4e9162 |
10 | |
11 | # This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a |
12 | # few tweaks based on the PPD spec at |
13 | # http://www.xav.com/perl/site/lib/XML/PPD.html |
14 | |
15 | # The PPD spec is based on <http://www.w3.org/TR/NOTE-OSD> |
16 | |
17 | sub new { |
18 | my $package = shift; |
19 | return bless {@_}, $package; |
20 | } |
21 | |
22 | sub make_ppd { |
23 | my ($self, %args) = @_; |
24 | my $build = delete $args{build}; |
25 | |
26 | my @codebase; |
27 | if (exists $args{codebase}) { |
28 | @codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase}); |
29 | } else { |
30 | my $distfile = $build->ppm_name . '.tar.gz'; |
31 | print "Using default codebase '$distfile'\n"; |
32 | @codebase = ($distfile); |
33 | } |
34 | |
35 | my %dist; |
36 | foreach my $info (qw(name author abstract version)) { |
37 | my $method = "dist_$info"; |
38 | $dist{$info} = $build->$method() or die "Can't determine distribution's $info\n"; |
39 | } |
bb4e9162 |
40 | |
41 | $self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}}; |
42 | |
43 | # TODO: could add <LICENSE HREF=...> tag if we knew what the URLs were for |
44 | # various licenses |
45 | my $ppd = <<"PPD"; |
46 | <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\"> |
bb4e9162 |
47 | <ABSTRACT>$dist{abstract}</ABSTRACT> |
48 | @{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]} |
49 | <IMPLEMENTATION> |
50 | PPD |
51 | |
bb4e9162 |
52 | # We don't include recommended dependencies because PPD has no way |
53 | # to distinguish them from normal dependencies. We don't include |
54 | # build_requires dependencies because the PPM installer doesn't |
55 | # build or test before installing. And obviously we don't include |
56 | # conflicts either. |
613f422f |
57 | |
bb4e9162 |
58 | foreach my $type (qw(requires)) { |
59 | my $prereq = $build->$type(); |
60 | while (my ($modname, $spec) = each %$prereq) { |
61 | next if $modname eq 'perl'; |
62 | |
63 | my $min_version = '0.0'; |
64 | foreach my $c ($build->_parse_conditions($spec)) { |
65 | my ($op, $version) = $c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x; |
66 | |
67 | # This is a nasty hack because it fails if there is no >= op |
68 | if ($op eq '>=') { |
69 | $min_version = $version; |
70 | last; |
71 | } |
72 | } |
73 | |
613f422f |
74 | # PPM4 spec requires a '::' for top level modules |
75 | $modname .= '::' unless $modname =~ /::/; |
bb4e9162 |
76 | |
613f422f |
77 | $ppd .= qq! <REQUIRE NAME="$modname" VERSION="$min_version" />\n!; |
bb4e9162 |
78 | } |
79 | } |
80 | |
81 | # We only include these tags if this module involves XS, on the |
613f422f |
82 | # assumption that pure Perl modules will work on any OS. |
bb4e9162 |
83 | if (keys %{$build->find_xs_files}) { |
84 | my $perl_version = $self->_ppd_version($build->perl_version); |
613f422f |
85 | $ppd .= sprintf(<<'EOF', $self->_varchname($build->config) ); |
bb4e9162 |
86 | <ARCHITECTURE NAME="%s" /> |
87 | EOF |
88 | } |
89 | |
90 | foreach my $codebase (@codebase) { |
91 | $self->_simple_xml_escape($codebase); |
92 | $ppd .= sprintf(<<'EOF', $codebase); |
93 | <CODEBASE HREF="%s" /> |
94 | EOF |
95 | } |
96 | |
97 | $ppd .= <<'EOF'; |
98 | </IMPLEMENTATION> |
99 | </SOFTPKG> |
100 | EOF |
101 | |
102 | my $ppd_file = "$dist{name}.ppd"; |
103 | my $fh = IO::File->new(">$ppd_file") |
104 | or die "Cannot write to $ppd_file: $!"; |
613f422f |
105 | |
229c5935 |
106 | my $io_file_ok = eval { IO::File->VERSION(1.13); 1 }; |
613f422f |
107 | $fh->binmode(":utf8") |
229c5935 |
108 | if $io_file_ok && $fh->can('binmode') && $] >= 5.008 && $Config{useperlio}; |
bb4e9162 |
109 | print $fh $ppd; |
110 | close $fh; |
111 | |
112 | return $ppd_file; |
113 | } |
114 | |
115 | sub _ppd_version { |
116 | my ($self, $version) = @_; |
117 | |
118 | # generates something like "0,18,0,0" |
119 | return join ',', (split(/\./, $version), (0)x4)[0..3]; |
120 | } |
121 | |
122 | sub _varchname { # Copied from PPM.pm |
123 | my ($self, $config) = @_; |
124 | my $varchname = $config->{archname}; |
125 | # Append "-5.8" to architecture name for Perl 5.8 and later |
94410036 |
126 | if ($] >= 5.008) { |
127 | my $vstring = sprintf "%vd", $^V; |
128 | $vstring =~ s/\.\d+$//; |
129 | $varchname .= "-$vstring"; |
bb4e9162 |
130 | } |
131 | return $varchname; |
132 | } |
133 | |
134 | { |
135 | my %escapes = ( |
136 | "\n" => "\\n", |
137 | '"' => '"', |
138 | '&' => '&', |
139 | '>' => '>', |
140 | '<' => '<', |
141 | ); |
142 | my $rx = join '|', keys %escapes; |
53fc1c7e |
143 | |
bb4e9162 |
144 | sub _simple_xml_escape { |
145 | $_[1] =~ s/($rx)/$escapes{$1}/go; |
146 | } |
147 | } |
148 | |
149 | 1; |
150 | __END__ |
151 | |
152 | |
153 | =head1 NAME |
154 | |
155 | Module::Build::PPMMaker - Perl Package Manager file creation |
156 | |
157 | |
158 | =head1 SYNOPSIS |
159 | |
160 | On the command line, builds a .ppd file: |
161 | ./Build ppd |
162 | |
163 | |
164 | =head1 DESCRIPTION |
165 | |
166 | This package contains the code that builds F<.ppd> "Perl Package |
167 | Description" files, in support of ActiveState's "Perl Package |
168 | Manager". Details are here: |
169 | L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/> |
170 | |
171 | |
172 | =head1 AUTHOR |
173 | |
77e96e88 |
174 | Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org> |
bb4e9162 |
175 | |
176 | |
177 | =head1 COPYRIGHT |
178 | |
77e96e88 |
179 | Copyright (c) 2001-2006 Ken Williams. All rights reserved. |
bb4e9162 |
180 | |
181 | This library is free software; you can redistribute it and/or |
182 | modify it under the same terms as Perl itself. |
183 | |
184 | |
185 | =head1 SEE ALSO |
186 | |
187 | perl(1), Module::Build(3) |
188 | |
189 | =cut |