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