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