lib/Module/Build/PPMMaker.pm

   1 package Module::Build::PPMMaker;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5 $VERSION = '0.34';
   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 ($] >= 5.008) {
 134       my $vstring = sprintf "%vd", $^V;
 135       $vstring =~ s/\.\d+$//;
 136       $varchname .= "-$vstring";
 137   }
 138   return $varchname;
 139 }
 140
 141 {
 142   my %escapes = (
 143                  "\n" => "\\n",
 144                  '"' => '&quot;',
 145                  '&' => '&amp;',
 146                  '>' => '&gt;',
 147                  '<' => '&lt;',
 148                 );
 149   my $rx = join '|', keys %escapes;
 150
 151   sub _simple_xml_escape {
 152     $_[1] =~ s/($rx)/$escapes{$1}/go;
 153   }
 154 }
 155
 156 1;
 157 __END__
 158
 159
 160 =head1 NAME
 161
 162 Module::Build::PPMMaker - Perl Package Manager file creation
 163
 164
 165 =head1 SYNOPSIS
 166
 167   On the command line, builds a .ppd file:
 168   ./Build ppd
 169
 170
 171 =head1 DESCRIPTION
 172
 173 This package contains the code that builds F<.ppd> "Perl Package
 174 Description" files, in support of ActiveState's "Perl Package
 175 Manager".  Details are here:
 176 L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/>
 177
 178
 179 =head1 AUTHOR
 180
 181 Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org>
 182
 183
 184 =head1 COPYRIGHT
 185
 186 Copyright (c) 2001-2006 Ken Williams.  All rights reserved.
 187
 188 This library is free software; you can redistribute it and/or
 189 modify it under the same terms as Perl itself.
 190
 191
 192 =head1 SEE ALSO
 193
 194 perl(1), Module::Build(3)
 195
 196 =cut