Files
cpanspec/cpanspec
stevenpritchard 4b2d244477 Initial revision
2006-02-01 21:46:06 +00:00

775 lines
21 KiB
Perl
Executable File

#!/usr/bin/perl
#
# cpanspec - Generate a spec file for a CPAN module
#
# Copyright (C) 2004-2005 Steven Pritchard <steve@kspei.com>
# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# $Id: cpanspec,v 1.1 2006/02/01 21:46:07 stevenpritchard Exp $
####
#
# TODO:
#
# * FIXME - The script should make a pass through README to look for a
# line that matches /^[^[:alnum:]]*DESCRIPTION[^[:alnum:]]*$/i
# and use the first paragraph after that, if it exists.
#
# * It might be a good idea to try to render %description as POD.
#
# * Add code to get the path to the source from 02packages.details.txt.gz.
#
# * Planned features (as of 2005-09-19):
#
# - Find and download dependencies automatically (like CPAN::Unwind).
# - Download from CPAN automatically when executed as "cpanspec Foo::Bar".
# + DONE!
# + Add --download-only or something similar to replace cpanget.
#
# KNOWN BUGS:
#
# * This script is known to fail on the following:
#
# - Cache::Cache 1.02 (Tries to do detection magic in Makefile.PL.)
#
####
=head1 NAME
cpanspec - Generate a spec file for a CPAN module
=head1 SYNOPSIS
cpanspec [options] [file [...]]
Options:
--help -h Help message
--old -o Be more compatible with old RHL/FC releases
--noprefix -n Don't add perl- prefix to package name
--force -f Force overwriting existing spec
--packager -p Name and email address of packager (for changelog)
--release -r Release of package (defaults to 1)
--disttag -d Disttag (defaults to %{?dist})
--srpm -s Build a source rpm
--build -b Build source and binary rpms
--cpan -c CPAN mirror URL
--verbose -v Be more verbose
=head1 DESCRIPTION
B<cpanspec> will generate a spec file to build a rpm from a CPAN-style
Perl module distribution.
=head1 OPTIONS
=over 4
=item B<-h>, B<--help>
Print a brief help message and exit.
=item B<-o>, B<--old>
Be more compatible with old RHL/FC releases. With this option enabled,
the generated spec file
=over 4
=item *
Defines perl_vendorlib or perl_vendorarch.
=item *
Includes explicit dependencies for core Perl modules.
=item *
Uses C<%check || :> instead of just C<%check>.
=back
=item B<-n>, B<--noprefix>
Don't add I<perl-> prefix to the name of the package. This is useful
for perl-based applications (such as this one), so that the name of
the rpm is simply B<cpanspec> instead of B<perl-cpanspec>.
=item B<-f>, B<--force>
Force overwriting an existing spec file. Normally B<cpanspec> will
refuse to overwrite an existing spec file for safety. This option
removes that safety check. Please use with caution.
=item B<-p>, B<--packager>
The name and email address of the packager. Overrides the C<%packager>
macro in C<~/.rpmmacros>.
=item B<-r>, B<--release>
The release number of the package. Defaults to 1.
=item B<-d>, B<--disttag>
Disttag (a string to append to the release number), used to
differentiate builds for various releases. Defaults to the
semi-standard (for Fedora Extras) string C<%{?dist}>.
=item B<-s>, B<--srpm>
Build a source rpm from the generated spec file.
=item B<-b>, B<--build>
Build source and binary rpms from the generated spec file.
B<Please be aware that this is likely to fail!> Even if it succeeds,
the generated rpm will almost certainly need some work to make
rpmlint happy.
=item B<-c>, B<--cpan>
The URL to a CPAN mirror. If not specified with this option or the
B<CPAN> environment variable, defaults to L<http://www.cpan.org/>.
=item B<-v>, B<--verbose>
Be more verbose.
=back
=head1 AUTHOR
Steven Pritchard <steve@kspei.com>
=head1 SEE ALSO
L<perl(1)>, L<cpan2rpm(1)>, L<cpanflute2(1)>
=cut
use strict;
use warnings;
use FileHandle;
use Archive::Tar;
use Archive::Zip qw(:ERROR_CODES);
use POSIX;
use Text::Autoformat;
use YAML qw(Load);
use Module::CoreList;
use Getopt::Long;
use Pod::Usage;
use File::Basename;
use LWP::UserAgent;
use Parse::CPAN::Packages;
# Apparently gets pulled in by another module.
#use Cwd;
our %opt;
our $help=0;
our $compat=0;
our $noprefix=0;
our $force=0;
our $packager;
our $release=1;
our $disttag='%{?dist}';
our $buildsrpm=0;
our $buildrpm=0;
our $verbose=0;
our $cpan=$ENV{'CPAN'} || "http://www.cpan.org/";
our $home=$ENV{'HOME'} || (getpwuid($<))[7];
die "Can't locate home directory. Please define \$HOME.\n"
if (!defined($home));
our $pkgdetails="$home/.cpan/sources/modules/02packages.details.txt.gz";
our $updated=0;
our $packages;
sub verbose(@) {
print STDERR @_, "\n" if ($verbose);
}
sub fetch($$) {
my ($url, $file)=@_;
my @locations=();
verbose("Fetching $file from $url...");
my $ua=LWP::UserAgent->new('env_proxy' => 1)
or die "LWP::UserAgent->new() failed: $!\n";
my $request;
LOOP: $request=HTTP::Request->new('GET' => $url)
or die "HTTP::Request->new() failed: $!\n";
my @buf=stat($file);
$request->if_modified_since($buf[9]) if (@buf);
# FIXME - Probably should do $ua->request() here and skip loop detection.
my $response=$ua->simple_request($request)
or die "LWP::UserAgent->simple_request() failed: $!\n";
push(@locations, $url);
if ($response->code eq "301" or $response->code eq "302") {
$url=$response->header('Location');
die "Redirect loop detected! " . join("\n ", @locations, $url) . "\n"
if (grep { $url eq $_ } @locations);
goto LOOP;
}
if ($response->is_success) {
my $fh=new FileHandle ">$file";
print $fh $response->content;
$fh->close();
my $last_modified=$response->last_modified;
utime(time, $last_modified, $file) if ($last_modified);
} elsif ($response->code eq "304") {
verbose("$file is up to date.");
} else {
die "Failed to get $url: " . $response->status_line . "\n";
}
}
sub mkdir_p($) {
my $dir=shift;
my @path=split '/', $dir;
for (my $n=0;$n<@path;$n++) {
my $partial="/" . join("/", @path[0..$n]);
if (!-d $partial) {
verbose("mkdir($partial)");
mkdir $partial or die "mkdir($partial) failed: $!\n";
}
}
}
sub update_packages() {
return 1 if ($updated);
verbose("Updating $pkgdetails...");
mkdir_p(dirname($pkgdetails)) if (!-d dirname($pkgdetails));
fetch("$cpan/modules/" . basename($pkgdetails), $pkgdetails);
$updated=1;
}
sub build_rpm($) {
my $spec=shift;
my $dir=getcwd();
my $rpm=(-x "/usr/bin/rpmbuild" ? "/usr/bin/rpmbuild" : "/usr/bin/rpm");
verbose("Building " . ($buildrpm ? "rpms" : "source rpm") . " from $spec");
# From Fedora Extras Makefile.common.
if (system($rpm, "--define", "_sourcedir $dir",
"--define", "_builddir $dir",
"--define", "_srcrpmdir $dir",
"--define", "_rpmdir $dir",
"--nodeps", ($buildrpm ? "-ba" : "-bs"), $spec) != 0) {
if ($? == -1) {
die "Failed to execute $rpm: $!\n";
} elsif (WIFSIGNALED($?)) {
die "$rpm died with signal " . WTERMSIG($?)
. (($? & 128) ? ", core dumped\n" : "\n");
} else {
die "$rpm exited with value " . WEXITSTATUS($?) . "\n";
}
}
}
sub list_files($$) {
my $archive=$_[0];
my $type=$_[1];
if ($type eq 'tar') {
return $archive->list_files();
} elsif ($type eq 'zip') {
return map { $_->fileName(); } $archive->members();
}
}
sub extract($$$) {
my $archive=$_[0];
my $type=$_[1];
my $filename=$_[2];
if ($type eq 'tar') {
return $archive->get_content($filename);
} elsif ($type eq 'zip') {
return $archive->contents($filename);
}
}
GetOptions(
'help|h' => \$help,
'old|o' => \$compat,
'noprefix|n' => \$noprefix,
'force|f' => \$force,
'packager|p=s' => \$packager,
'release|r=i' => \$release,
'disttag|d=s' => \$disttag,
'srpm|s' => \$buildsrpm,
'build|b' => \$buildrpm,
'cpan|c=s' => \$cpan,
'verbose|v' => \$verbose,
) or pod2usage({ -exitval => 1, -verbose => 0 });
pod2usage({ -exitval => 0, -verbose => 1 }) if ($help);
pod2usage({ -exitval => 1, -verbose => 0 }) if (!@ARGV);
my $prefix=$noprefix ? "" : "perl-";
$packager=$packager || `rpm --eval '\%packager'`;
chomp $packager;
if (!$packager or $packager eq "\%packager") {
die "\%packager not defined in ~/.rpmmacros."
. " Please add or use --packager option.\n";
}
die "Module::CoreList does not support perl version $]!\n"
if (!exists($Module::CoreList::version{$]}));
for my $file (@ARGV) {
my ($name,$version,$type);
if ($file =~ /^(.*)-([^-]+)\.(tar)\.gz$/) {
$name=$1;
$version=$2;
$type=$3;
} elsif ($file =~ /^(.*)-([^-]+)\.(zip)$/) {
$name=$1;
$version=$2;
$type=$3;
} else {
# Look up $file in 02packages.details.txt.
update_packages();
$packages=Parse::CPAN::Packages->new($pkgdetails)
if (!defined($packages));
die "Parse::CPAN::Packages->new() failed: $!\n"
if (!defined($packages));
my ($m,$d);
if ($m=$packages->package($file) and $d=$m->distribution()) {
my $url=$cpan . "/authors/id/" . $d->prefix();
$file=$d->filename();
fetch($url, $file);
$name=$d->dist();
$version=$d->version();
if ($file =~ /\.(tar)\.gz$/) {
$type=$1;
} elsif ($file =~ /\.(zip)$/) {
$type=$1;
} else {
warn "Failed to parse '$file', skipping...\n";
next;
}
} else {
warn "Failed to parse '$file' or find a module by that name, skipping...\n";
next;
}
}
my $module=$name;
$module=~s/-/::/g;
my $archive;
if ($type eq 'tar') {
$archive=Archive::Tar->new($file, 1)
or die "Archive::Tar->new() failed: $!\n";
} elsif ($type eq 'zip') {
$archive=Archive::Zip->new() or die "Archive::Zip->new() failed: $!\n";
die "Read error on $file\n" unless ($archive->read($file) == AZ_OK);
}
my @files;
my $bogus=0;
for my $entry (list_files($archive, $type)) {
if ($entry !~ /^(?:.\/)?$name-$version\//) {
warn "BOGUS PATH DETECTED: $entry\n";
$bogus++;
next;
}
$entry=~s,^(?:.\/)?$name-$version/,,;
next if (!$entry);
push(@files, $entry);
}
if ($bogus) {
warn "Skipping $file with $bogus path elements!\n";
next;
}
my $url="http://search.cpan.org/dist/$name/";
my $vfile=$file;
$vfile=~s/$version/\%{version}/;
my $source="http://www.cpan.org/modules/by-module/"
. ($module=~/::/ ? (split "::", $module)[0] : (split "-", $name)[0])
. "/" . $vfile;
my $description;
my $readme=(sort { $a cmp $b } (grep /README/i, @files))[0];
if ($readme) {
if (my $content=extract($archive, $type, "$name-$version/$readme")) {
$content=~s/\r//g; # Why people use DOS text, I'll never understand.
for my $string (split "\n\n", $content) {
$string=~s/^\n+//;
if ((my @tmp=split "\n", $string) > 2
and $string !~ /^[#\-=]/) {
$description=$string;
last;
}
}
} else {
warn "Failed to read $readme from $file"
. ($type eq 'tar' ? (": " . $archive->error()) : "") . "\n";
}
}
if (defined($description) and $description) {
$description=autoformat $description, { "all" => 1,
"left" => 1,
"right" => 75,
"squeeze" => 0,
};
$description=~s/\n+$//s;
} else {
$description="$module Perl module";
}
my @doc=sort { $a cmp $b } grep {
!/\//
and !/\.(pl|xs|h|c|pm|in|pod)$/i
and !/^\./
and $_ ne "MANIFEST"
and $_ ne "MANIFEST.SKIP"
and $_ ne "INSTALL"
and $_ ne "SIGNATURE"
and $_ ne "META.yml"
and $_ ne "configure"
and $_ ne "typemap"
} @files;
my $date=strftime("%a %b %d %Y", localtime);
my $noarch=!grep /\.(c|xs)$/i, @files;
my $vendorlib=($noarch ? "vendorlib" : "vendorarch");
my $lib="\%{perl_$vendorlib}";
my $specfile="$prefix$name.spec";
my $spec;
if ($force) {
rename($specfile, "$specfile~") if (-e $specfile);
$spec=new FileHandle ">$specfile";
} else {
$spec=new FileHandle "$specfile", O_WRONLY|O_CREAT|O_EXCL;
}
if (!$spec) {
warn "Failed to create $specfile: $!\n";
next;
}
print $spec qq[\%{!?perl_$vendorlib: \%define perl_$vendorlib \%(eval "\`\%{__perl} -V:install$vendorlib\`"; echo \$install$vendorlib)}\n\n]
if ($compat);
my $license="";
my $scripts=0;
my (%build_requires,%requires);
my ($yml,$meta);
if (grep /^META\.yml$/, @files
and $yml=extract($archive, $type, "$name-$version/META.yml")) {
# Basic idea borrowed from Module::Depends.
my $meta=Load($yml);
%build_requires=%{$meta->{build_requires}} if ($meta->{build_requires});
%requires=%{$meta->{requires}} if ($meta->{requires});
if ($meta->{recommends}) {
for my $module (keys(%{$meta->{recommends}})) {
$requires{$module}=$requires{$module}
|| $meta->{recommends}->{$module};
}
}
# FIXME - I'm not sure this is sufficient...
if ($meta->{script_files} or $meta->{scripts}) {
$scripts=1;
}
if ($meta->{license}) {
if ($meta->{license} eq "perl") {
$license="GPL or Artistic";
} elsif ($meta->{license} eq "gpl") {
$license="GPL";
} elsif ($meta->{license} eq "lgpl") {
$license="LGPL";
} elsif ($meta->{license} eq "artistic") {
$license="Artistic";
} elsif ($meta->{license} eq "bsd") {
$license="BSD";
} elsif ($meta->{license} eq "open_source") {
$license="OSI-Approved"; # rpmlint will complain
} elsif ($meta->{license} eq "unrestricted") {
$license="distributable"; # rpmlint should complain
} elsif ($meta->{license} eq "restrictive") {
$license="Proprietary";
warn "License is 'restrictive'."
. " This package should not be redistributed.\n";
} else {
warn "Unknown license '" . $meta->{license} . "'!\n";
$license="CHECK(distributable)";
}
}
}
if (my @licenses=grep /license|copyright|copying/i, @doc) {
if (!$license) {
$license="distributable, see @licenses";
} elsif ($license=~/^(OSI-Approved|distributable|Proprietary)$/) {
$license.=", see @licenses";
}
}
$license="CHECK(GPL or Artistic)" if (!$license);
my $usebuildpl=0;
if (grep /^Build\.PL$/, @files) {
# FIXME - I need to figure out how to parse Build.PL.
$build_requires{'Module::Build'}=0;
$usebuildpl=1 if (!grep /^Makefile\.PL$/, @files);
}
if (!$usebuildpl) {
# This is an ugly hack to parse any PREREQ_PM in Makefile.PL.
if (open(CHILD, "-|") == 0) {
eval {
use subs 'WriteMakefile';
sub WriteMakefile(@) {
my %args=@_;
if (!defined($args{'PREREQ_PM'})) {
return;
}
# Versioned BuildRequires aren't reliably honored by
# rpmbuild, but we'll include them anyway as a hint to the
# packager.
for my $module (keys(%{$args{'PREREQ_PM'}})) {
print "BuildRequires: $module";
print " " . $args{'PREREQ_PM'}->{$module}
if ($args{'PREREQ_PM'}->{$module});
print "\n";
}
}
};
local $/=undef;
my $makefilepl=extract($archive, $type, "$name-$version/Makefile.PL")
or warn "Failed to extract $name-$version/Makefile.PL";
open(STDERR, ">/dev/null");
eval "no warnings;
use subs qw(require die warn eval open close rename);
BEGIN { sub require { 1; } }
BEGIN { sub die { 1; } }
BEGIN { sub warn { 1; } }
BEGIN { sub eval { 1; } }
BEGIN { sub open { 1; } }
BEGIN { sub close { 1; } }
BEGIN { sub rename { 1; } }
$makefilepl";
exit 0;
} else {
while (<CHILD>) {
if (/^BuildRequires:\s*(\S+)\s*(\S+)?/) {
my $module=$1;
my $version=0;
$version=$2 if (defined($2));
$build_requires{$module}=$version;
}
}
}
}
print $spec <<END;
Name: $prefix$name
Version: $version
Release: $release$disttag
Summary: $module Perl module
License: $license
Group: Development/Libraries
URL: $url
Source0: $source
BuildRoot: \%{_tmppath}/\%{name}-\%{version}-\%{release}-root-\%(\%{__id_u} -n)
END
printf $spec "%-16s%s\n", "BuildArch:", "noarch" if ($noarch);
if ($requires{perl}) {
$build_requires{perl}=$build_requires{perl} || $requires{perl};
delete $requires{perl};
}
if ($build_requires{perl}) {
printf $spec "%-16s%s >= %s\n", "BuildRequires:", "perl",
(($build_requires{perl} lt "5.6.0" ? "0:" : "1:")
. $build_requires{perl});
delete $build_requires{perl};
}
for my $module (keys(%requires)) {
$build_requires{$module}=$build_requires{$module} || $requires{$module};
}
for my $module (sort(keys(%build_requires))) {
next if (!$compat and exists($Module::CoreList::version{$]}{$module}));
printf $spec "%-16s%s", "BuildRequires:", "perl($module)";
print $spec (" >= " . $build_requires{$module})
if ($build_requires{$module});
print $spec "\n";
}
for my $module (sort(keys(%requires))) {
next if (!$compat and exists($Module::CoreList::version{$]}{$module}));
printf $spec "%-16s%s", "Requires:", "perl($module)";
print $spec (" >= " . $requires{$module}) if ($requires{$module});
print $spec "\n";
}
print $spec <<END;
Requires: perl(:MODULE_COMPAT_\%(eval "`\%{__perl} -V:version`"; echo \$version))
\%description
$description
\%prep
\%setup -q@{[($noprefix ? "" : " -n $name-\%{version}")]}
\%build
END
if ($usebuildpl) {
print $spec <<END;
perl Build.PL installdirs=vendor@{[$noarch ? '' : ' optimize="$RPM_OPT_FLAGS"']}
./Build
END
} else {
print $spec <<END;
\%{__perl} Makefile.PL INSTALLDIRS=vendor@{[$noarch ? '' : ' OPTIMIZE="$RPM_OPT_FLAGS"']}
END
print $spec
"\%{__perl} -pi -e 's/^\\tLD_RUN_PATH=[^\\s]+\\s*/\\t/' Makefile\n"
if (!$noarch);
print $spec <<END;
make \%{?_smp_mflags}
END
}
print $spec <<END;
\%install
rm -rf \$RPM_BUILD_ROOT
END
if ($usebuildpl) {
print $spec
"./Build install destdir=\$RPM_BUILD_ROOT create_packlist=0\n";
} else {
print $spec <<END;
make pure_install PERL_INSTALL_ROOT=\$RPM_BUILD_ROOT
find \$RPM_BUILD_ROOT -type f -name .packlist -exec rm -f {} \\;
END
}
if (!$noarch) {
print $spec <<END;
find \$RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -exec rm -f {} \\;
END
}
print $spec <<END;
find \$RPM_BUILD_ROOT -type d -depth -exec rmdir {} 2>/dev/null \\;
chmod -R u+rwX,go+rX,go-w \$RPM_BUILD_ROOT/*
END
if (!grep /copying|artistic|copyright|license/i, @doc) {
print $spec <<END;
perldoc -t perlgpl > COPYING
perldoc -t perlartistic > Artistic
END
push(@doc, "COPYING", "Artistic");
}
print $spec <<END;
\%check@{[($compat ? ' || :' : '')]}
END
if ($usebuildpl) {
print $spec "./Build test\n";
} else {
print $spec "make test\n";
}
print $spec <<END;
\%clean
rm -rf \$RPM_BUILD_ROOT
\%files
\%defattr(-,root,root,-)
\%doc @doc
END
if ($scripts) {
print $spec "\%{_bindir}/*\n";
# FIXME - How do we auto-detect man pages?
}
if ($noarch) {
print $spec "$lib/*\n";
} else {
print $spec "$lib/auto/*\n$lib/" . (split /::/, $module)[0] . "*\n";
}
print $spec <<END;
\%{_mandir}/man3/*
\%changelog
* $date $packager $version-$release
- Specfile autogenerated.
END
$spec->close();
build_rpm($specfile) if ($buildsrpm or $buildrpm);
}
# vi: set ai et: