home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / PPMMaker.pm < prev    next >
Text File  |  2005-04-27  |  5KB  |  179 lines
  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.          '"' => '"',
  140.          '&' => '&',
  141.          '>' => '>',
  142.          '<' => '<',
  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. =head1 NAME
  155.  
  156. Module::Build::PPMMaker - Perl Package Manager file creation
  157.  
  158. =head1 SYNOPSIS
  159.  
  160.  On the command line, builds a .ppd file:
  161.  % ./Build ppd
  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. =head1 AUTHOR
  171.  
  172. Dave Rolsky <autarch@urth.org>, Ken Williams <ken@mathforum.org>
  173.  
  174. =head1 SEE ALSO
  175.  
  176. perl(1), Module::Build(3)
  177.  
  178. =cut
  179.