lib/Module/Build/PPMMaker.pm

   1 package Module::Build::PPMMaker;
   2
   3 use strict;
   4
   5 # This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
   6 # few tweaks based on the PPD spec at
   7 # http://www.xav.com/perl/site/lib/XML/PPD.html
   8
   9 # The PPD spec is based on <http://www.w3.org/TR/NOTE-OSD>
  10
  11 sub new {
  12   my $package = shift;
  13   return bless {@_}, $package;
  14 }
  15
  16 sub make_ppd {
  17   my ($self, %args) = @_;
  18   my $build = delete $args{build};
  19
  20   my @codebase;
  21   if (exists $args{codebase}) {
  22     @codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase});
  23   } else {
  24     my $distfile = $build->ppm_name . '.tar.gz';
  25     print "Using default codebase '$distfile'\n";
  26     @codebase = ($distfile);
  27   }
  28
  29   my %dist;
  30   foreach my $info (qw(name author abstract version)) {
  31     my $method = "dist_$info";
  32     $dist{$info} = $build->$method() or die "Can't determine distribution's $info\n";
  33   }
  34   $dist{version} = $self->_ppd_version($dist{version});
  35
  36   $self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}};
  37
  38   # TODO: could add <LICENSE HREF=...> tag if we knew what the URLs were for
  39   # various licenses
  40   my $ppd = <<"PPD";
  41 <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\">
  42     <TITLE>$dist{name}</TITLE>
  43     <ABSTRACT>$dist{abstract}</ABSTRACT>
  44 @{[ join "\n", map "    <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
  45     <IMPLEMENTATION>
  46 PPD
  47
  48   # TODO: We could set <IMPLTYPE VALUE="PERL" /> or maybe
  49   # <IMPLTYPE VALUE="PERL/XS" /> ???
  50
  51   # We don't include recommended dependencies because PPD has no way
  52   # to distinguish them from normal dependencies.  We don't include
  53   # build_requires dependencies because the PPM installer doesn't
  54   # build or test before installing.  And obviously we don't include
  55   # conflicts either.
  56
  57   foreach my $type (qw(requires)) {
  58     my $prereq = $build->$type();
  59     while (my ($modname, $spec) = each %$prereq) {
  60       next if $modname eq 'perl';
  61
  62       my $min_version = '0.0';
  63       foreach my $c ($build->_parse_conditions($spec)) {
  64         my ($op, $version) = $c =~ /^\s*  (<=?|>=?|==|!=)  \s*  ([\w.]+)  \s*$/x;
  65
  66         # This is a nasty hack because it fails if there is no >= op
  67         if ($op eq '>=') {
  68           $min_version = $version;
  69           last;
  70         }
  71       }
  72
  73       # Another hack - dependencies are on modules, but PPD expects
  74       # them to be on distributions (I think).
  75       $modname =~ s/::/-/g;
  76
  77       $ppd .= sprintf(<<'EOF', $modname, $self->_ppd_version($min_version));
  78         <DEPENDENCY NAME="%s" VERSION="%s" />
  79 EOF
  80
  81     }
  82   }
  83
  84   # We only include these tags if this module involves XS, on the
  85   # assumption that pure Perl modules will work on any OS.  PERLCORE,
  86   # unfortunately, seems to indicate that a module works with _only_
  87   # that version of Perl, and so is only appropriate when a module
  88   # uses XS.
  89   if (keys %{$build->find_xs_files}) {
  90     my $perl_version = $self->_ppd_version($build->perl_version);
  91     $ppd .= sprintf(<<'EOF', $perl_version, $^O, $self->_varchname($build->config) );
  92         <PERLCORE VERSION="%s" />
  93         <OS NAME="%s" />
  94         <ARCHITECTURE NAME="%s" />
  95 EOF
  96   }
  97
  98   foreach my $codebase (@codebase) {
  99     $self->_simple_xml_escape($codebase);
 100     $ppd .= sprintf(<<'EOF', $codebase);
 101         <CODEBASE HREF="%s" />
 102 EOF
 103   }
 104
 105   $ppd .= <<'EOF';
 106     </IMPLEMENTATION>
 107 </SOFTPKG>
 108 EOF
 109
 110   my $ppd_file = "$dist{name}.ppd";
 111   my $fh = IO::File->new(">$ppd_file")
 112     or die "Cannot write to $ppd_file: $!";
 113   print $fh $ppd;
 114   close $fh;
 115
 116   return $ppd_file;
 117 }
 118
 119 sub _ppd_version {
 120   my ($self, $version) = @_;
 121
 122   # generates something like "0,18,0,0"
 123   return join ',', (split(/\./, $version), (0)x4)[0..3];
 124 }
 125
 126 sub _varchname {  # Copied from PPM.pm
 127   my ($self, $config) = @_;
 128   my $varchname = $config->{archname};
 129   # Append "-5.8" to architecture name for Perl 5.8 and later
 130   if (defined($^V) && ord(substr($^V,1)) >= 8) {
 131     $varchname .= sprintf("-%d.%d", ord($^V), ord(substr($^V,1)));
 132   }
 133   return $varchname;
 134 }
 135
 136 {
 137   my %escapes = (
 138                  "\n" => "\\n",
 139                  '"' => '&quot;',
 140                  '&' => '&amp;',
 141                  '>' => '&gt;',
 142                  '<' => '&lt;',
 143                 );
 144   my $rx = join '|', keys %escapes;
 145
 146   sub _simple_xml_escape {
 147     $_[1] =~ s/($rx)/$escapes{$1}/go;
 148   }
 149 }
 150
 151 1;
 152 __END__
 153
 154
 155 =head1 NAME
 156
 157 Module::Build::PPMMaker - Perl Package Manager file creation
 158
 159
 160 =head1 SYNOPSIS
 161
 162   On the command line, builds a .ppd file:
 163   ./Build ppd
 164
 165
 166 =head1 DESCRIPTION
 167
 168 This package contains the code that builds F<.ppd> "Perl Package
 169 Description" files, in support of ActiveState's "Perl Package
 170 Manager".  Details are here:
 171 L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/>
 172
 173
 174 =head1 AUTHOR
 175
 176 Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org>
 177
 178
 179 =head1 COPYRIGHT
 180
 181 Copyright (c) 2001-2006 Ken Williams.  All rights reserved.
 182
 183 This library is free software; you can redistribute it and/or
 184 modify it under the same terms as Perl itself.
 185
 186
 187 =head1 SEE ALSO
 188
 189 perl(1), Module::Build(3)
 190
 191 =cut