#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

use strict;

#
# Use libraries
use Getopt::Long;
use File::Basename;
use File::Copy      qw(copy);
use Archive::Tar;
use File::Temp      qw(tempdir);
use URI::Escape     qw(uri_escape);
use Cwd;
use YAML;

use RPM::Specfile;

use vars qw/$VERSION/;
$VERSION = $RPM::Specfile::VERSION;

#
# Setup some defaults
my %defaults;

my $orig_cmd = join(" ", $0, @ARGV);

$defaults{'outdir'}  = './';
$defaults{'tmpdir'}  = '/tmp';
$defaults{'release'} = '8';
$defaults{'installdirs'} = "";
{
  my ($username, $fullname) = (getpwuid($<))[0,6];
  $fullname = (split /,/, $fullname)[0];
  $defaults{'email'}  = $fullname ? $fullname . ' ' : '';
  $defaults{'email'} .= '<';
  $defaults{'email'} .= $ENV{REPLYTO} || $username . '@redhat.com';
  $defaults{'email'} .= '>';
}

#
# Parse command line options
my %options;
GetOptions(\%options, "outdir=s", "tmpdir=s", "email=s", "name|n=s", "create",
    "test|t", "epoch|e=n", "version|v=s", "release|r=s", "patch=s@",
    "noarch", "arch|a=s", "noperlreqs", "usage", "buildall|b", "installdirs=s",
    "descfile=s", "help", "requires=s@", "buildrequires=s@", "sign", "post=s",
    "pre=s", "preun=s", "postun=s", "just-spec|j", 'use-usr-local', 'packager') or die_usage();

my $fullname = shift;
my $content;

my @requires = @{$options{'requires'} || []};
my @build_requires = @{$options{'build-requires'} || []};

if(defined($options{'usage'})) {
    usage();
    exit(0);
}

if ($options{'just-spec'} and $options{'buildall'}) {
  print "Error: just-spec and build cannot both be specified.\n";
  exit(1);
}

#
# Make sure filename was provided
die_usage() unless $fullname;

#
# If we were given a description file, make sure it exists
if ($options{'descfile'}) {
  if (! -e $options{'descfile'}) {
    print STDERR "Description file given does not exist!\n";
    print STDERR "File:  ${options{'descfile'}}\n";
    exit(1);
  }
  if (! -r $options{'descfile'}) {
    print STDERR "Description file given is not readable!\n";
    print STDERR "File:  ${options{'descfile'}}\n";
    exit(1);
  }
}

#
# Overide defaults if necessary, otherwise keep them.
my $tarball = basename($fullname);
my $create = $options{create} || '';
my $email = $options{email} || $defaults{'email'};
my $requires = $options{requires} || [];
my $buildrequires = $options{buildrequires} || [];
my $outdir = $options{outdir} || $defaults{'outdir'};
my $tmpdir = $options{tmpdir} || $defaults{'tmpdir'};
my $noarch = $options{noarch} || '';
my $plat_perl_reqs = $options{'noperlreqs'} ? 0 : 1;
my $release = $options{'release'} || $defaults{'release'};
my $build_switch = 's';
my $use_module_build = 0;
my @docs = ();

$tmpdir = tempdir(CLEANUP => 1, DIR => $tmpdir);

#
# Set build arch - this is needed to find out where
# the binary rpm was placed, and copy it back to the
# current working directory.
my $build_arch;
if($options{'arch'}) {
  $build_arch = $options{'arch'};
}
elsif($options{'noarch'}) {
  $build_arch = 'noarch';
}
else {
  $build_arch = get_default_build_arch();
  if($build_arch eq '') {
    print STDERR "Could not get default build arch!\n";
    exit(1);
  }
}

$build_switch = 'a' if(defined($options{'buildall'}));

$tarball =~ /^(.+)\-([^-]+)\.t(ar\.)?gz$/;
my $name = $options{name} || $1;
my $ver = $options{version} || $2;
my $tarball_top_dir = "$name-%{version}";

die "Module name/version not parsable from $tarball" unless $name and $ver;

$name =~ s/::/-/g;

copy($fullname, $tmpdir)
  or die "copy $fullname: $!";
utime((stat($fullname))[8,9], "$tmpdir/$tarball");

if (my @files = Archive::Tar->list_archive("$tmpdir/$tarball")) {
  $use_module_build = 1 if grep { /Build\.PL$/ } @files;

  if (not exists $options{noarch}) {
    $noarch = 1;
    $noarch = 0 if grep { /\.(xs|c|cc|C)$/ } @files;
  }

  my %prefixes;
  foreach (@files) {
    my @path_components = split m[/], $_;
    $prefixes{$path_components[0]}++;

    if ($path_components[-1] eq 'META.yml') {
      my $tar = new Archive::Tar;
      $tar->read("$tmpdir/$tarball", 1);
      my $contents = $tar->get_content($_);
      my $yaml = Load($contents);

      while (my ($mod, $ver) = each %{$yaml->{build_requires}}) {
	push @build_requires, [ "perl($mod)", $ver ];
      }
      while (my ($mod, $ver) = each %{$yaml->{requires}}) {
	push @requires, [ "perl($mod)", $ver ];
      }
    }

    # find docs
    if (m,^${name}-${ver}/(
          authors?|
          change(log|s)|
          credits|
          copy(ing|right)|
          licen[cs]e|
          readme|
          todo
          )$,ix) {
      push(@docs, $1);
    }
  }

  if (scalar keys %prefixes == 1) {
    ($tarball_top_dir) = keys %prefixes;
    $tarball_top_dir =~ s/$ver/%{version}/;
  }
}

#
# Get patches copied into place
my $patchfile  = '';
my @patchfiles = ();
my $patch      = '';
if ($options{patch}) {
    for $patch (@{$options{'patch'}}) {
	copy($patch, $tmpdir) or die "copy ${patch}: $!";
	utime((stat($options{patch}))[8,9],
	      "$tmpdir/" . basename($options{patch}));
	push @patchfiles, (basename($patch));
    }
}

#
# Copy install scriptlets if defined to the tmp directory
foreach my $scriptlet (qw(pre post preun postun)) {
    if(defined($options{$scriptlet})) {
	copy($options{$scriptlet}, $tmpdir)
	    or die "copy ${options{${scriptlet}}}: $!";
	my ($atime, $mtime) = (stat($options{$scriptlet}))[8,9];
	$options{$scriptlet} = "${tmpdir}/" . basename($options{$scriptlet});
	utime($atime, $mtime, $options{$scriptlet});
    }
}

my $spec = new RPM::Specfile;

# some basic spec fields
$spec->name("perl-$name");
$spec->version($ver);
$spec->release($release);
$spec->epoch($options{epoch});
$spec->summary("$name Perl module");
$spec->group("Development/Libraries");
$spec->license('GPL or Artistic');
$spec->packager($email)
  if $defaults{'packager'};
my $clver = defined($options{epoch}) ? "$options{epoch}:" : '';
$clver   .= "$ver-$release";
$spec->add_changelog_entry($email, "Specfile autogenerated with command '$orig_cmd'", $clver);

for my $req (@requires) {
  $spec->push_require($req);
}

for my $req (@build_requires) {
  $spec->push_buildrequire($req);
}

# Setup spec description.  Defaults to summary, unless
# description file provided:
if($options{'descfile'}) {
   $spec->description(read_desc_file($options{'descfile'}));
}
else {
  $spec->description('%{summary}.');
}

#
# Setup build architecture.
$spec->buildarch($options{'arch'}) if(defined($options{'arch'}));
$spec->buildarch('noarch') if $noarch;

#
# Use perl requirements by default (onward and upward...).
if ($plat_perl_reqs) {
  $spec->push_require(q|perl(:MODULE_COMPAT_%(eval "`%{__perl} -V:version`"; echo $version))|);
}

$spec->push_source($tarball);
foreach $patchfile (@patchfiles) {
	$spec->push_patch($patchfile)
}

# make a URL that can actually possibly take you to the right place
$spec->url(sprintf('http://search.cpan.org/dist/%s/', uri_escape($name)));


# now we get into the multiline tags.  stolen mostly verbatim from
# cpanflute1
$spec->prep("%setup -q -n $tarball_top_dir $create\n");
$spec->file_param('-f %{name}-%{version}-%{release}-filelist');
$spec->push_file('%defattr(-,root,root,-)');
$spec->push_file('%doc ' . join(' ', sort @docs)) if @docs;

if ($options{test}) {
  $spec->check("make test");
}

my $installdirs = "";
if ($options{'installdirs'}) {
  # perl 5.8 explicitly supports the INSTALLDIRS option.  in previous
  # perls, it was a vendor added option.  Red Hat and Debian provide
  # this for their perl 5.6.1, but the syntax for 5.8.0 is different,
  # at least in the Red Hat case

  $installdirs = "INSTALLDIRS=$options{'installdirs'}";
}

my $makefile_pl = qq{CFLAGS="\$RPM_OPT_FLAGS" %{__perl} Makefile.PL < /dev/null};
my $make_install = qq{make pure_install PERL_INSTALL_ROOT=\$RPM_BUILD_ROOT};

if ($use_module_build) {
  $makefile_pl = qq{CFLAGS="\$RPM_OPT_FLAGS" %{__perl} Makefile.PL destdir=\$RPM_BUILD_ROOT $installdirs < /dev/null};
}
else {
  $makefile_pl = qq{CFLAGS="\$RPM_OPT_FLAGS" %{__perl} Makefile.PL $installdirs};
}

$spec->build(<<EOB);
$makefile_pl
make %{?_smp_mflags} OPTIMIZE="\$RPM_OPT_FLAGS"
EOB

$spec->clean('rm -rf $RPM_BUILD_ROOT');
my $usr_local_sect = "";
if ($options{'use-usr-local'}) {
  $usr_local_sect = q{
for dir in bin share/doc share/man; do
  if [ -d $RPM_BUILD_ROOT/usr/$dir ]; then
    mkdir -p $RPM_BUILD_ROOT/usr/local/$dir
    mv $RPM_BUILD_ROOT/usr/$dir/* $RPM_BUILD_ROOT/usr/local/$dir/
    rm -Rf $RPM_BUILD_ROOT/usr/$dir
  fi
done
  }
}

my $inst = q{
rm -rf $RPM_BUILD_ROOT

$make_install

find $RPM_BUILD_ROOT -type f -a \( -name perllocal.pod -o -name .packlist \
  -o \( -name '*.bs' -a -empty \) \) -exec rm -f {} ';'
find $RPM_BUILD_ROOT -type d -depth -exec rmdir {} 2>/dev/null ';'
chmod -R u+w $RPM_BUILD_ROOT/*

for brp in %{_prefix}/lib/rpm/%{_build_vendor}/brp-compress \
  %{_prefix}/lib/rpm/brp-compress
do
  [ -x $brp ] && $brp && break
done

$usr_local_sect
find $RPM_BUILD_ROOT -type f \
| sed "s@^$RPM_BUILD_ROOT@@g" \
> %{name}-%{version}-%{release}-filelist

eval `%{__perl} -V:archname -V:installsitelib -V:installvendorlib -V:installprivlib`
for d in $installsitelib $installvendorlib $installprivlib; do
  [ -z "$d" -o "$d" = "UNKNOWN" -o ! -d "$RPM_BUILD_ROOT$d" ] && continue
  find $RPM_BUILD_ROOT$d/* -type d \
  | grep -v "/$archname\(/auto\)\?$" \
  | sed "s@^$RPM_BUILD_ROOT@%dir @g" \
  >> %{name}-%{version}-%{release}-filelist
done

if [ "$(cat %{name}-%{version}-%{release}-filelist)X" = "X" ] ; then
    echo "ERROR: EMPTY FILE LIST"
    exit 1
fi
};

$inst =~ s/\$make_install/$make_install/g;
$inst =~ s/\$usr_local_sect/$usr_local_sect/g;
$inst =~ s/\$options{'?(.*?)'?}/$options{$1} || ''/ge;

$spec->install($inst);

#
# Add the install scriptlets if defined...
foreach my $scriptlet (qw(pre post preun postun)) {
    if(defined($options{$scriptlet})) {
	open(SCRIPTLET, "<${options{${scriptlet}}}") 
	    || die "Could not open scriptlet ${options{${scriptlet}}} for reading!";
	local $/;   # enable slurp mode.
	$content = <SCRIPTLET>;
	close(SCRIPTLET);
	$spec->$scriptlet($content);
    }  
}

if ($options{'just-spec'}) {
  print $spec->generate_specfile;
  exit(0);
}

# write the spec file.  create some macros.
$spec->write_specfile("$tmpdir/perl-$name.spec");

open FH, ">$tmpdir/macros"
  or die "Can't create $tmpdir/macros: $!";

print FH qq{
%_topdir         $tmpdir
%_builddir       %{_topdir}
%_rpmdir         $outdir
%_sourcedir      %{_topdir}
%_specdir        %{_topdir}
%_srcrpmdir      $outdir
%_build_name_fmt %%{NAME}-%%{VERSION}-%%{RELEASE}.%%{ARCH}.rpm
};

close FH;

open FH, ">$tmpdir/rpmrc"
  or die "Can't create $tmpdir/rpmrc: $!";

my $macrofiles = qx(rpm --showrc | grep ^macrofiles | cut -f2- -d:);
chomp $macrofiles;

print FH qq{
include: /usr/lib/rpm/rpmrc
macrofiles: $macrofiles:$tmpdir/macros
};
close FH;

# Build the build command
my @cmd;
push @cmd, 'rpmbuild';
push @cmd, '--rcfile', "$tmpdir/rpmrc";
push @cmd, "-b${build_switch}";
push @cmd, '--rmsource';
push @cmd, '--rmspec';
push @cmd, '--clean',  "$tmpdir/perl-$name.spec";
push @cmd, "--sign" if $options{sign};

# perform the build, die on error
my $retval = system (@cmd);
$retval = $? >> 8;
if ($retval != 0) {
  die "RPM building failed!\n";
}

# clean up macros file
unlink "$tmpdir/rpmrc", "$tmpdir/macros";

# if we did a build all, lets move the rpms into our current
# directory
my $bin_rpm = "./perl-${name}-${ver}-${release}.${build_arch}.rpm";

exit(0);

###############
# Subroutines #
###############
sub die_usage {
  usage();
  exit(1);
}

sub usage {
  print <<EOF;
cpanflute2 Version ${VERSION}

cpanflute2 [--arch=] [--buildall] [--create] [--descfile=...] [--email=...]
	[--epoch=...] [--outdir=...] [--name=...] [--noarch] [--noperlreqs]
	[--patch=...] [--release=...] [--requires=...] 
        [ --buildrequires=...] [--pre=...] [--post=...] [--preun=...] 
	[--postun=...] [--test] [--tmpdir=...] [--version=...] (archive)
cpanflute2 --usage

	--arch=		Set package to this arch if it is not noarch.  Defaults
			to system default (normally i386).
	--buildall	Build binary RPM's also.
        --create        Have %setup macro create the base directory before
	                unpacking the tarball.
	--descfile=	Path to a text file whose contents should be
	                substituted for the description of the RPM.
        --email=        Email address placed in specfile.  Defaults to
	                ${defaults{'email'}}.
        --epoch=        Set specfile Epoch tag.
        --outdir=       Where to output the SRPM and or RPM.  Defaults
	                to ${defaults{'outdir'}}
        --name=		Name of CPAN module.  Defaults to parsing this
	                from the tarball filename.
	--noarch	Forces architecture noarch.
	--noperlreqs	If set PERL interpreter requirements for things like
                        large file support will not be added.  By default
			they are added.
	--patch=	Patch to use.
	--pre=		Path to %pre scriptlet.
	--post=		Path to %post scriptlet.
	--preun=	Path to %preun scriptlet.
	--postun=	Path to %postun scriptlet.
	--release=	Release of RPM to build.  Defaults to ${defaults{'release'}}.
	--requires=     Add items for the Requires directive in the spec file.
        --sign          Sign the RPMs with the key in specified via ~/.rpmmacros
	--buildrequires=
                        Add items for the BuildRequires directive in the spec file.
        --test          Run "make test" in %build.
        --tmpdir=	Temporary directory in which to build.  Defaults
	                to ${defaults{'tmpdir'}}.
        --version=	Version of CPAN module.  Defaults to parsing this
	                from the tarball filename.
        --installdirs=  Specify which INSTALLDIRS setting to use (see MakeMaker)
        --use-usr-local Place some files in /usr/local instead of /usr (i.e., bin and manpages)
        --just-spec     Only output the spec file; do not build source or binary rpms
	(archive)	Name of gzipped tarball containing CPAN source.

EOF
}

sub get_default_build_arch {
  my $build_arch = qx(rpm --eval %{_build_arch});
  chomp $build_arch;

  return $build_arch;
}

#
# Read in description file and return its text.
sub read_desc_file {
  my $file = shift;

  open FILE, "<$file"
    or die "Can't open $file for reading: $!";

  local $/ = undef;
  my $ret = <FILE>;

  close FILE;
  return $ret;
}