#!/usr/bin/perl -w


# Take a perl tarball and make a specfile for it. Now with bundles.
#
# Copyright 2000,2001 Simon Wilkinson. All rights reserved.
#
# 10/18/2001 - <jesse@bestpractical.com>
#		Added resolution of prereq_pm modules
#
# 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;

use vars qw ($DEBUG $ARCH $builddir $seen @report);

$ARCH = 'i386';

$DEBUG = 0;
# Icky globals

my $release;
my $package;

$seen = {};


sub usage 
{
  print STDERR <<EOM;

Usage: cpan2rpm [--release <release>] [--builddir <rpm build dir>]  <Perl::Module>

Where:
<release> is the release number of the RPM you wish to produce
<Perl::Module> is the name of the module to build
EOM
  exit(1);
}


my $ret=GetOptions("release" => \$release,
		   "builddir=s" => \$builddir);

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


$builddir=ExtractRpmMacro($ENV{HOME}."/.rpmmacros","_topdir") if !$builddir;
$builddir=ExtractRpmMacro("/etc/rpm/macros","_topdir") if !$builddir;
$builddir=getcwd() if !$builddir;
  
die "Build directory $builddir doesn't look like an RPM build root\n"
    if ((! -d "$builddir/SPECS") || (! -d "$builddir/SOURCES"));

process($package,$release);

print join("\n",@report)."\n";

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

  

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

  print "Building $infile\n";

    cpan2rpm($infile,$builddir,$release);

}

# 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) = @_;

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

    foreach my $kid ($obj->contains) {
     	process($kid,$release);
    }
  }
}


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

  my $ret;

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

  print "CPAN tells us the following about $infile:\n",$obj->as_string if ($DEBUG);

  $ret=fetch_source($obj,$builddir);
  $ret=build_specfile($obj,$builddir,$release) if !$ret;
  
  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};

  return "Error: No file for $id\n" 
     if $obj->cpan_file eq "N/A";
  return "Error: $id says 'Contact Author'\n" 
     if $obj->cpan_file =~ /^Contact Author/;
  return "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'));


  # Find all the prereqs for this distribution, then build em.
  # TODO this should be somewhere else

  $dist->make;
  build_prereqs( $dist->prereq_pm());



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

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

  return undef;
}


sub build_prereqs($) {
  my ($prereqs) = @_;
  
  foreach my $prereq (keys %{$prereqs}) {
	process ($prereq, $release);
  }
}
sub build_specfile($$$) {
  my ($obj,$builddir,$release) = @_;

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

  # don't go through dependencies on something we've already dealt with
  return() if ($seen->{$source});
  $seen->{$source} = 1; 

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";
  my $description=$obj->{description};
  $description= $summary if !$description;

  open(SPEC, ">$builddir/SPECS/perl-$name.spec")
    or die "Couldn't open 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);

  system("rpm -ba $builddir/SPECS/perl-$name.spec >/dev/null") == 0
    or push (@report,  "RPM of $source failed with : $!\n"); 
 
  system("rpm -Uvh $builddir/RPMS/$ARCH/perl-$name-$version-$release.$ARCH.rpm") == 0
    or warn "RPM of $source could not be installed: $!\n";

  push (@report,  "Built perl-$name-$version-$release.$ARCH.rpm");
}

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

  my $handle=new IO::File;

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

  while(<$handle>) {
    if (/\%$macro (.*)/) {
       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 <sxw@sxw.org.uk>