| 1 | package Module::Build::PPMMaker; |
| 2 | |
| 3 | use strict; |
| 4 | use vars qw($VERSION); |
| 5 | $VERSION = '0.32'; |
| 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 | '"' => '"', |
| 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 | |
| 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 |