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