#!/usr/bin/perl

# Take a perl tarball and make a specfile for it. Now with bundles.
#
# Copyright 2000-2002 Simon Wilkinson. All rights reserved.
#
# This program is free software; you can redistribute it 
# and/or modify it under the same terms as Perl itself.
#

use strict;

use CPAN;
use POSIX;
use Sys::Hostname;
use File::Basename;
use Getopt::Long;

# Icky globals

my $release;
my $package;
my $nobuild;
my $tarball;
my $description;

sub usage 
{
  print STDERR <<EOM;

Usage: cpan2rpm [options] <Perl::Module>

Where options is any combination of the following
	--release <release> 	Set the release number of the resulting RPM
	--nobuild		Don't build the RPM, just produce a specfile
	--tarball <file>	Use the tarball <file>, rather than fetching
				the source from CPAN
 	--description <string>	Set the description to <string>

<Perl::Module> is the name of the module being built

EOM
  exit(1);
}


my $ret=GetOptions("release" => \$release,
		   "nobuild" => \$nobuild,
		   "tarball=s" => \$tarball,
		   "descriptio=s" => \$description);

$package=$ARGV[0];
usage() if !$package;
$release=1 if !$release;


my $builddir=ExtractRpmMacro($ENV{HOME}."/.rpmmacros","_topdir");
$builddir=ExtractRpmMacro("/etc/rpm/macros","_topdir") if !$builddir;
$builddir=getcwd() if !$builddir;

print "builddir is $builddir\n";

die "Build directory $builddir doesn't look like an RPM build root\n"
  if ((! -d "$builddir/SPECS") || (! -d "$builddir/SOURCES"));

my @names;

if (!$tarball) {
  @names=process($package,$release,$builddir,$nobuild);
}
else {
  @names=build_specfile($tarball,$description,$builddir,$release,$nobuild);
}

print join("\n",@names),"\n";

sub process {
  my ($infile,$release,$builddir,$nobuild)=@_;

  # Find out where the user is hiding their RPM build root

  # Convert our installation list into an unbundled one
  my $objs=unbundle($infile);

  print STDERR "Building the following modules:\n ", join("\n",@{$objs}),"\n";

  my @names;

  foreach my $module (@{$objs}) {
    my $name=cpan2rpm($module,$release,$builddir,$nobuild);
    push @names,$name;
  }

  return(@names);
}

# Given a Module, try to split it into its required components - this
# currently only handles Bundles, but could also be extended to deal with
# prereqs as well.

sub unbundle {
  my ($item,$seen) = @_;

  $seen=[] if !$seen;

  push(@{$seen},$item);

  if ($item=~/Bundle::/) {

    my $obj=CPAN::Shell->expand('Bundle',$item);

    foreach my $kid ($obj->contains) {

      # Have we already seen this item?
      if (!grep {$_ eq $kid} @{$seen}) {
        $seen=unbundle($kid,$seen);
      }
    }
  }

  return($seen);
}


sub cpan2rpm($$$$) {
  my ($infile,$release,$builddir,$nobuild) = @_;

  my $ret;

  my $obj=CPAN::Shell->expand('Module',$infile);

  die "Could not find a CPAN module called \"$infile\"\n" unless defined $obj;

  print STDERR "CPAN tells us the following about $infile:\n",$obj->as_string;

  fetch_source($obj,$builddir);
  $ret=build_specfile($obj->cpan_file,$obj->{description},$builddir,$release,$nobuild);
  
  return $ret;
}

# FIXME: Some error handling in the function below wouldn't go amiss ...
sub fetch_source($$) {
  my ($obj,$builddir)=@_;

  # Minor Sanity checks
  my $id=$obj->{ID};

  die "Error: No file for $id\n" 
     if $obj->cpan_file eq "N/A";
  die "Error: $id says 'Contact Author'\n" 
     if $obj->cpan_file =~ /^Contact Author/;
  die "Error: $id is contained within Perl itself!\n"
     if ($obj->cpan_file =~/perl-5\.\d?\.\d?\.tar\.gz/xo);

  # We do this so we can take advantage of CPAN's object caching. This is
  # pinched from the CPAN::Distribution::get method, which we can't use
  # directly, as it untars the package as well - which we let RPM do.
 
  my $dist = $CPAN::META->instance('CPAN::Distribution',$obj->cpan_file);

  my($local_wanted) =
       MM->catfile($CPAN::Config->{keep_source_where},
                   "authors",
                   "id",
                   split("/",$dist->{ID})
                   );

  my $local_file = CPAN::FTP->localize("authors/id/$dist->{ID}", $local_wanted);
  
  $dist->{localfile} = $local_file;

  $dist->verifyMD5 if ($CPAN::META->has_inst('MD5'));

  my $infile=basename($obj->cpan_file);

  File::Copy::copy($local_file,"$builddir/SOURCES/$infile");

  return;
}

sub build_specfile($$$$$) {
  my ($file, $description, $builddir,$release,$nobuild) = @_;

  my $source=basename($file);

  my ($name,$version)=($source=~/(.*)-(.*)\.tar\.gz/);
  return "Couldn't get a name for $source\n" if !$name;
  return "Couldn't get a version for $source\n" if !$version; 
  
  my $summary="$name module for perl";
  $description= $summary if !$description;

  open(SPEC, ">$builddir/SPECS/perl-$name.spec")
    or die "Couldn't open $builddir/SPECS/perl-$name.spec for writing.";
  print SPEC <<EOF;

Summary: $summary
Name: perl-$name
Version: $version
Release: $release
Copyright: distributable
Group: Applications/CPAN
Source0: $source
Url: http://www.cpan.org
BuildRoot: /var/tmp/perl-${name}-buildroot/
Requires: perl

%description
This is a perl module, autogenerated by cpan2rpm. The original package's
description was:

$description

%prep
%setup -q -n $name-%{version}

%build
CFLAGS="\$RPM_OPT_FLAGS" perl Makefile.PL
make

%clean
rm -rf \$RPM_BUILD_ROOT

%install
rm -rf \$RPM_BUILD_ROOT
eval `perl '-V:installarchlib'`
mkdir -p \$RPM_BUILD_ROOT/\$installarchlib
make PREFIX=\$RPM_BUILD_ROOT/usr install
/usr/lib/rpm/brp-compress
find \$RPM_BUILD_ROOT/usr -type f -print | sed "s\@^\$RPM_BUILD_ROOT\@\@g" | grep -v perllocal.pod > $name-$version-filelist

%files -f ${name}-${version}-filelist
%defattr(-,root,root)

%changelog
EOF
  print SPEC "* ",POSIX::strftime("%a %b %d %Y",localtime()), " ",$ENV{USER}," <",$ENV{USER},"\@",hostname(),">\n";
  print SPEC "- Spec file automatically generated by cpan2rpm\n";

  close(SPEC);

  if (!$nobuild) {
     system("rpm -ba $builddir/SPECS/perl-$name.spec 1>&2") == 0
         or die "RPM of $source failed with : $!\n";
     return "perl-$name-$version-$release.i386.rpm";
  } else {
     return "perl-$name.spec";
  }
}

sub ExtractRpmMacro($$) {
  my ($file,$macro) = @_;

  my $handle=new IO::File;

  if (!$handle->open($file)) {
    return undef;
  }

  while(<$handle>) {
    if (/\%$macro\s+(.*)/) {
       return $1;
    }
  }

  return undef;
}

=head1 NAME

cpan2rpm - fetch and convert CPAN packages to RPMs

=head1 SYNOPSIS

cpan2rpm --release <release> <package>

=head1 DESCRIPTION

cpan2rpm provides a quick way of creating RPM packages from perl modules
published on CPAN. It interfaces with the perl CPAN module to fetch the
file from the selected mirror, and then creates a spec file from the 
information in CPAN, and invokes RPM on that spec file.

Files are created in the users RPM build root.

=head1 OPTIONS

=over 4

=item release

Sets the release number of the created RPMs.

=back

=head1 SEE ALSO

rpm(1)

=head1 AUTHOR

Simon Wilkinson <simon@sxw.org.uk>
