Upgrade to Module::Build 0.2808_01
[p5sagit/p5-mst-13.2.git] / lib / Module / Build / PPMMaker.pm
1 package Module::Build::PPMMaker;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.2808_01';
6 $VERSION = eval $VERSION;
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                  '"' => '&quot;',
143                  '&' => '&amp;',
144                  '>' => '&gt;',
145                  '<' => '&lt;',
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
179 Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org>
180
181
182 =head1 COPYRIGHT
183
184 Copyright (c) 2001-2006 Ken Williams.  All rights reserved.
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