This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Module::Build to CPAN version 0.3800
[perl5.git] / cpan / Module-Build / lib / Module / Build / PPMMaker.pm
1 package Module::Build::PPMMaker;
2
3 use strict;
4 use Config;
5 use vars qw($VERSION);
6 use IO::File;
7
8 $VERSION = '0.3800';
9 $VERSION = eval $VERSION;
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   }
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}\">
47     <ABSTRACT>$dist{abstract}</ABSTRACT>
48 @{[ join "\n", map "    <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
49     <IMPLEMENTATION>
50 PPD
51
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.
57
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
74       # PPM4 spec requires a '::' for top level modules
75       $modname .= '::' unless $modname =~ /::/;
76
77       $ppd .= qq!        <REQUIRE NAME="$modname" VERSION="$min_version" />\n!;
78     }
79   }
80
81   # We only include these tags if this module involves XS, on the
82   # assumption that pure Perl modules will work on any OS.
83   if (keys %{$build->find_xs_files}) {
84     my $perl_version = $self->_ppd_version($build->perl_version);
85     $ppd .= sprintf(<<'EOF', $self->_varchname($build->config) );
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: $!";
105
106   my $io_file_ok = eval { IO::File->VERSION(1.13); 1 };
107   $fh->binmode(":utf8")
108     if $io_file_ok && $fh->can('binmode') && $] >= 5.008 && $Config{useperlio};
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
126   if ($] >= 5.008) {
127       my $vstring = sprintf "%vd", $^V;
128       $vstring =~ s/\.\d+$//;
129       $varchname .= "-$vstring";
130   }
131   return $varchname;
132 }
133
134 {
135   my %escapes = (
136                  "\n" => "\\n",
137                  '"' => '&quot;',
138                  '&' => '&amp;',
139                  '>' => '&gt;',
140                  '<' => '&lt;',
141                 );
142   my $rx = join '|', keys %escapes;
143
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 =head1 SYNOPSIS
158
159   On the command line, builds a .ppd file:
160   ./Build ppd
161
162
163 =head1 DESCRIPTION
164
165 This package contains the code that builds F<.ppd> "Perl Package
166 Description" files, in support of ActiveState's "Perl Package
167 Manager".  Details are here:
168 L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/>
169
170
171 =head1 AUTHOR
172
173 Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org>
174
175
176 =head1 COPYRIGHT
177
178 Copyright (c) 2001-2006 Ken Williams.  All rights reserved.
179
180 This library is free software; you can redistribute it and/or
181 modify it under the same terms as Perl itself.
182
183
184 =head1 SEE ALSO
185
186 perl(1), Module::Build(3)
187
188 =cut