#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
# cpanspec - Generate a spec file for a CPAN module
#
# Copyright (C) 2004-2009 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.67 2009/01/16 20:35:17 stevenpritchard Exp $

=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
   --license    -l      Include generated license texts if absent in source
   --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)
   --epoch      -e      Epoch of package
   --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
   --prefer-macros  -m  Prefer macros over environment variables in the spec

 Long options:
   --follow             Process build dependencies
   --filter-requires    Specify Requires to remove
   --filter-provides    Specify Provides to remove
   --add-requires       Add Requires for this item
   --add-provides       Add Provides for this item
   --add-buildrequires  Add BuildRequires for this item
   --skip-changes       Do not create or update .changes file
   --version            Print the version number and exit

=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>.

=item *

Includes a hack to remove LD_RUN_PATH from Makefile.

=back

=item B<-l>, B<--license>

Generate COPYING and Artistic license texts if the source doesn't seem
to include them.

=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<-e>, B<--epoch>

The epoch number of the package.  By default, this is undefined, so
no epoch will be used in the generated spec.

=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) 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.

=item B<-m>, B<--prefer-macros>

Prefer the macro form of common spec constructs over the environment variable
form (e.g. %{buildroot} vs $RPM_BUILD_ROOT).

=item B<--follow>

Add build dependencies to the list of modules to process.

=item B<--filter-requires>

Specify Requires to remove.

=item B<--filter-provides>

Specify Provides to remove.

=item B<--add-requires>

Add Requires for this item.

=item B<--add-provides>

Add Provides for this item.

=item B<--add-buildrequires>

Add BuildRequires for this item.

=item B<--version>

Print the version number and exit.

=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;

our $NAME="cpanspec";
our $VERSION='1.78.08';

use Cwd;
BEGIN {
  my ($wd) = Cwd::abs_path($0) =~ m-(.*)/- ;
  $wd ||= '.';
  unshift @INC,  "$wd";
  unshift @INC,  "$wd/lib";
}

use Module::CoreList;
use FileHandle;
use Archive::Tar;
use Archive::Zip qw(:ERROR_CODES);
use POSIX;
use locale;
use Text::Autoformat;
use YAML qw(Load);
use Getopt::Long;
use Pod::POM;
use Pod::POM::View::Text;
use Pod::Usage;
use File::Basename;
use LWP::UserAgent;
use Parse::CPAN::Packages;
use File::Temp;
use File::Path qw(rmtree);
use Intrusive;
use Perl::PrereqScanner;

# Apparently gets pulled in by another module.
#use Cwd;

require Carp;

$SIG{__DIE__} = sub {
#    Carp::confess("Died");
};

our %opt;

our $help=0;
our $compat=0;
our $addlicense=0;
our $noprefix=0;
our $force=0;
our $packager;
our $release=1;
our $epoch;
our $disttag='%{?dist}';
our $buildsrpm=0;
our $buildrpm=0;
our $verbose=0;
our $follow=0;
our $macros=1;
our $skip_changes=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 $basedir = mkdtemp( "/tmp/cpanspecXXXXXX") . "/";

our $packages;

our @filter_requires;
our @filter_provides;
our @add_requires;
our @add_provides;
our @add_buildrequires;

our ($file,$name,$source,$version);
our ($content,$summary,$description,$author,$license);

# env. vars and their macro analogues
my @MACROS = (

    # 0 is for the full expansions....
    {
        'optimize'  => '$RPM_OPT_FLAGS',
        'buildroot' => '$RPM_BUILD_ROOT',
    },

    # 1 is for the macros.
    {
        'optimize'  => '%{optflags}',
        'buildroot' => '%{buildroot}',
    },
);

# this is set after the parameters are passed
our %macro;

sub print_version {
    print "$NAME version $VERSION\n";
    exit 0;
}

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"
            or die "Can't write to $file: $!\n";
        print $fh $response->content;
        $fh->close();

        my $last_modified=$response->last_modified;
        verbose("Set last modified to $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 get_file($) {
    $file=shift;
    # Look up $file in 02packages.details.txt.
    verbose("Get file $file");
    update_packages();
    if (!defined($packages)) {
	verbose "parsing packages";
	$packages=Parse::CPAN::Packages->new($pkgdetails);
	verbose "done";
    }
    die "Parse::CPAN::Packages->new() failed: $!\n"
        if (!defined($packages));
    my ($m,$d);
    if ($m=$packages->package($file) and $d=$m->distribution()) {
        $source=$cpan . "/authors/id/" . $d->prefix();
        $file=basename($d->filename());
        fetch($source, $file) if (!-f $file);
        $name=$d->dist();
        $version=$d->version();
        $version=~s/^v\.?//;
        $source=~s/$version/\%{version}/;
    } else {
        warn "Failed to parse '$file' or find a module by that name, skipping...\n";
        next;
    }
}

sub get_source($) {
    my $file=shift;

    # keep things happy if we get "Foo-Bar" instead of "Foo::Bar"
    $file =~ s/-/::/g;

    verbose("Get source $file");
    # Look up $file in 02packages.details.txt.
    update_packages();
    if (!defined($packages)) {
	$packages=Parse::CPAN::Packages->new($pkgdetails);
    }
    die "Parse::CPAN::Packages->new() failed: $!\n"
        if (!defined($packages));
    my ($m,$d);
    if ($m=$packages->package($file) and $d=$m->distribution()) {
        $source=$cpan . "/authors/id/" . $d->prefix();
        $source=~s/$version/\%{version}/;
        $source=~s/$name/\%{cpan_name}/;
    } else {
        warn "Failed to parse '$file' or find a module by that name in $pkgdetails, skipping...\n";
        $source='';
        return;
    }
}

sub build_rpm($) {
    my $spec=shift;
    my $dir=getcwd();

    my $rpmbuild=(-x "/usr/bin/rpmbuild" ? "/usr/bin/rpmbuild" : "/bin/rpm");

    verbose("Building " . ($buildrpm ? "rpms" : "source rpm") . " from $spec");

    # From Fedora CVS Makefile.common.
    if (system($rpmbuild, "--define", "_sourcedir $dir",
                          "--define", "_builddir $dir",
                          "--define", "_srcrpmdir $dir",
                          "--define", "_rpmdir $dir",
                          ($buildrpm ? "-ba" : ("-bs", "--nodeps")),
                          $spec) != 0) {
        if ($? == -1) {
            die "Failed to execute $rpmbuild: $!\n";
        } elsif (WIFSIGNALED($?)) {
            die "$rpmbuild died with signal " . WTERMSIG($?)
                . (($? & 128) ? ", core dumped\n" : "\n");
        } else {
            die "$rpmbuild exited with value " . WEXITSTATUS($?) . "\n";
        }
    }
}

sub is_in_core($$) {
  my ($module, $version) = (@_);
  return 1 if ($module eq 'perl');
  my $release = Module::CoreList::first_release($module, $version);
  return 0 unless $release;
  # 10.1 is the minimum we care for
  my $ret = $release <= 5.008008;
  return $ret;
}

sub readfile($) {
    local $/=undef;
    my $filename = shift;
    die "empty filename" unless length($filename);
    open FILE, $basedir . $filename or return undef;
    binmode FILE;
    my $string = <FILE>;
    close FILE;
    return $string;
}

sub get_content(%) {
    my %args=@_;
    my $pm="";
    my $cont;

    my $path=$args{module};
    $path=~s,::,/,g;
    my @pmfiles=("lib/$path.pod",
        "lib/$path.pm");
    if ($args{module} =~ /::/) {
        my @tmp=split '/', $path;
        my $last=pop @tmp;
        push(@pmfiles, "lib/$last.pod",
            "lib/$last.pm");
    }
    do {
        push(@pmfiles, "$path.pod", "$path.pm");
    } while ($path=~s,^[^/]+/,,);
    push(@pmfiles, "$args{module}")
        if ($args{module} !~ /::/);

    for my $file (@pmfiles) {
        $pm=(grep { $_ eq $file or $_ eq "./$file" } @{$args{files}})[0];
        last if $pm;
    }

    return (undef, undef) if (!length($pm));

    if (my $cont=readfile("$args{path}/$pm")) {
        return $cont;
    } else {
        warn "Failed to read $args{path}/$pm from $args{filename}\n";
        return(undef, undef);
    }
}

sub get_description($) {
    my $cont = shift;
    my $parser = Pod::POM->new;

    # extract pod; the file may contain no pod, that's ok
    my $pom = $parser->parse_text($cont);


    HEAD1:
    foreach my $head1 ($pom->head1) {

        next HEAD1 unless $head1->title eq 'DESCRIPTION';

        $description = '';
        foreach my $item ($head1->content()) {
           last if ($item->type() eq 'head2');
           eval { $description .= $item->present('Pod::POM::View::Text'); };
        }

	return $description=undef unless length($description);
        # no limit
        my @paragraphs = (split /\n\n/, $description);

        $description = join "\n\n", @paragraphs;

        # autoformat and return...
        return autoformat $description, { all => 1 };
    }
    return $description=undef;
}

sub get_summary($$) {
    my $cont = shift;
    my $mod = shift;
    my $parser = Pod::POM->new;

    # extract pod; the file may contain no pod, that's ok
    my $pom = $parser->parse_text($cont);

    HEAD1:
    foreach my $head1 ($pom->head1) {

        next HEAD1 unless $head1->title eq 'NAME';

        my $pom = $head1->content;
        $pom =~ /^[^-]+ - (.*)$/m;

        # return...
        return $summary = $1 if $pom;
    }
    return $summary;
}

sub get_author($) {
    my $cont = shift;
    my @lines=();
    my $parser = Pod::POM->new;

    # extract pod; the file may contain no pod, that's ok
    my $pom = $parser->parse_text($cont);

    HEAD1:
    foreach my $head1 ($pom->head1) {

        next HEAD1 unless $head1->title eq 'AUTHOR';

        my $pom = $head1->content;
        eval { $author = $pom->present('Pod::POM::View::Text'); };

        my @paragraphs = (split /\n/, $author);
        foreach my $line (@paragraphs){
            next if $line eq "";
            $line =~ s/^/     /;
            push(@lines, $line);
        }
  
        $author = join "\n", @lines; 

        # return...
        return $author;
    }
    return $author='sorry, no author found';
}

sub get_license($) {
    my $cont = shift;
    my @lines=();
    my $parser = Pod::POM->new;

    # extract pod; the file may contain no pod, that's ok
    my $pom = $parser->parse_text($cont);

    HEAD1:
    foreach my $head1 ($pom->head1) {

        next HEAD1 unless $head1->title =~ /LICENSE/i || $head1->title =~ /COPYRIGHT/i ;

        my $pom = $head1->content;
        eval { $license = $pom->present('Pod::POM::View::Text'); };

        my @paragraphs = (split /\n/, $license);
        foreach my $line (@paragraphs){
            next if $line eq "";
            next if $line =~ /Copyright/i;
            $line =~ s/^/     /;
            push(@lines, $line);
        }

        $license = join " ", @lines;
        $license =~ s,\s+, ,g;

        # return...
        return $license;
    }
    return $license=undef;

}

sub check_rpm($) {
    my $dep=shift;

    my $rpm="/bin/rpm";
    return undef if (!-x $rpm);

    my @out=`$rpm -q --whatprovides "$dep"`;

    if ($? != 0) {
        #warn "backtick (rpm) failed with return value $?";
        return undef;
    }

    return @out;
}

sub check_repo($) {
    my $dep=shift;

    my $repoquery="/usr/bin/repoquery";
    return undef if (!-x $repoquery);

    verbose("Running $repoquery to check for $dep.  This may take a while...");
    my @out=`$repoquery --whatprovides "$dep"`;

    if ($? != 0) {
        #warn "backtick (repoquery) failed with return value $?";
        return undef;
    }

    return grep { /^\S+-[^-]+-[^-]+$/ } @out;
}

sub check_dep($) {
    my $module=shift;

    return (check_rpm("perl($module)") || check_repo("perl($module)"));
}

# Set locale to en_US.UTF8 so that dates in changelog will be correct
# if using another locale. Also ensures writing out UTF8. (Thanks to
# Roy-Magne Mo for pointing out the problem and providing a solution.)
setlocale(LC_ALL, "en_US.UTF-8");

GetOptions(
        'help|h'            => \$help,
        'old|o'             => \$compat,
        'license|l'         => \$addlicense,
        'noprefix|n'        => \$noprefix,
        'force|f'           => \$force,
        'packager|p=s'      => \$packager,
        'release|r=i'       => \$release,
        'epoch|e=i'         => \$epoch,
        'disttag|d=s'       => \$disttag,
        'srpm|s'            => \$buildsrpm,
        'build|b'           => \$buildrpm,
        'cpan|c=s'          => \$cpan,
        'verbose|v'         => \$verbose,
        'follow'            => \$follow,
        'filter-requires=s' => \@filter_requires,
        'filter-provides=s' => \@filter_provides,
        'add-requires=s'    => \@add_requires,
        'add-provides=s'    => \@add_provides,
        'add-buildrequires=s' => \@add_buildrequires,
        'skip-changes'      => \$skip_changes,
        'version'           => \&print_version,
        'prefer-macros|m'   => \$macros,
    ) or pod2usage({ -exitval => 1, -verbose => 0 });

pod2usage({ -exitval => 0, -verbose => 1 }) if ($help);
pod2usage({ -exitval => 1, -verbose => 0 }) if (!@ARGV);

if ($follow and $buildrpm) {
    warn "Sorry, --follow and --build are mutually exclusive right now.\n"
        . "We can't build when tracking deps right now.  Ignoring --build.\n";
    $buildrpm=0;
}

%macro = %{ $MACROS[$macros] };

my $prefix=$noprefix ? "" : "perl-";

$packager=$packager || `rpm --eval '\%packager'`;

my @args=@ARGV;
my @processed=();

for my $ofile (@args) {

    my $type = undef;
    ($file,$name,$source,$version) = (undef, undef, undef, undef);
    ($content,$summary,$description,$author,$license) = (undef, undef, undef, undef, undef);

    if ($ofile =~ /^(?:.*\/)?(.*)-(?:v\.?)?([^-]+)\.(tar)\.(?:gz|bz2)$/i) {
        $file=$ofile;
        $name=$1;
        $version=$2;
        $type=$3;
    } elsif ($ofile =~ /^(?:.*\/)?(.*)-(?:v\.?)?([^-]+)\.tgz$/i) {
        $file=$ofile;
        $name=$1;
        $version=$2;
        $type = 'tar';
    } elsif ($ofile =~ /^(?:.*\/)?(.*)-(?:v\.?)?([^-]+)\.(zip)$/i) {
        $file=$ofile;
        $name=$1;
        $version=$2;
        $type=$3;
    } else {
        
        # keep things happy if we get "Foo-Bar" instead of "Foo::Bar"
        $ofile =~ s/-/::/g;

        # Look up $file in 02packages.details.txt.
        get_file($ofile);
    }

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

    my $archive;
    my $path;
    my $ext = '.gz';
    my @archive_files = ();

    if ($type eq 'tar') {
        my $f=$file;
        if ($file=~/\.bz2$/) {
            #eval {
            #    use IO::Uncompress::Bunzip2;
            #};

            if ($@) {
                warn "Failed to load IO::Uncompress::Bunzip2: $@\n";
                warn "Skipping $file...\n";
                next;
            }

            $f=IO::Uncompress::Bunzip2->new($file);
            if (!defined($f)) {
                warn "IO::Uncompress::Bunzip2->new() failed on $file: $!\n";
                next;
            }
            $ext = '.bz2';
        }
	my $next = Archive::Tar->iter( $f, 1, { prefix => "/tmp/tar" });
	
	while( my $f = $next->() ) {
	    push(@archive_files, $f->full_path);
	    $f->extract($basedir . $f->full_path) or warn "Extraction failed " . $f->full_path;
	}
    } 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);
        $ext = '.zip';
	die "we do not support ZIP atm\n";
    }
 
    my @files = ();
    my $bogus=0;
    my $execs=0;
    foreach my $entry (@archive_files) {
        if ($entry !~ /^(?:.\/)?($name-(?:v\.?)?$version)(?:\/|$)/) {
            warn "BOGUS PATH DETECTED: $entry\n";
            $bogus++;
            next;
        } elsif (!defined($path)) {
            $path=$1;
        }

        $entry=~s,^(?:.\/)?$name-(?:v\.?)?$version/,,;
        next if (!$entry);

        push(@files, $entry);

	if (-x "$basedir$path/$entry" && -f "$basedir$path/$entry") {
	    if ($entry !~ m/.pl$/ && $entry !~ m,^bin/,) {
		verbose("disable executables because of $entry");
		$execs=1;
	    }
	    chmod 0644, "$basedir$path/$entry";
	}

    }
    if ($bogus) {
        warn "Skipping $file with $bogus path elements!\n";
        next;
    }

    my $url="http://search.cpan.org/dist/$name/";

    get_source($name) if(!defined $source && -d dirname($pkgdetails));

    $content = get_content(
            filename    => $file,
            name        => $name,
            module      => $module,
            version     => $version,
            files       => \@files,
            path        => $path,
        );

    get_description($content) if(!defined($description));

    get_summary($content,$module) if (!defined($summary));
    
    get_author($content) if (!defined($author));

    my $authors="Authors:\n--------\n$author";

    my @doc=sort { $a cmp $b } grep {
                !/\//
            and !/\.(pl|xs|h|c|pm|in|pod|cfg|inl|bak)$/i
            and !/^\./
            and $_ ne $path
            and $_ ne "MANIFEST"
            and $_ ne "MANIFEST.SKIP"
            and $_ ne "INSTALL"
            and $_ ne "SIGNATURE"
            and $_ ne "META.json"
            and $_ ne "META.yml"
            and $_ ne "NINJA"
            and $_ ne "c"
            and $_ ne "configure"
            and $_ ne "config.guess"
            and $_ ne "config.sub"
            and $_ ne "dist.ini"
            and $_ ne "typemap"
            and $_ ne "bin"
            and $_ ne "lib"
            and $_ ne "t"
            and $_ ne "inc"
            and $_ ne "autobuild.sh"
            and $_ ne "perlcriticrc"
            and $_ ne "perltidyrc"
            and $_ ne "pm_to_blib"
            and $_ ne "install.sh"
            } @files;

    # special subdir
    push(@doc, "examples") if grep(/^examples\//, @files);
    push(@doc, "doc") if grep(/^doc\//, @files);
    push(@doc, "util") if grep(/^util\//, @files);
    push(@doc, "example") if grep(/^example\//, @files);

    my $date=strftime("%a %b %d %Y", localtime);

    my $noarch=!grep /\.(c|h|xs|inl)$/i, @files;
    my $vendorlib=($noarch ? "vendorlib" : "vendorarch");
    my $lib="\%{perl_$vendorlib}";

    if (@filter_requires) {
        my $script="$name-filter-requires.sh";
        verbose "Writing $script...";
        my $sh;
        if ($force) {
            rename($script, "$script~") if (-e $script);
            $sh=new FileHandle ">$script";
        } else {
            $sh=new FileHandle $script, O_WRONLY|O_CREAT|O_EXCL;
        }
        die "Failed to create $script: $!\n" if (!$sh);

        print $sh "#!/bin/sh\n\n"
            . "\@\@PERL_REQ\@\@ \"\$\@\" | sed -e '/^$filter_requires[0]\$/d'";
        if (@filter_requires > 1) {
            for my $dep (@filter_requires[1..$#filter_requires]) {
                print $sh " \\\n    -e '/^$dep\$/d'";
            }
        }
        print $sh "\n";
    }

    if (@filter_provides) {
        my $script="$name-filter-provides.sh";
        verbose "Writing $script...";
        my $sh;
        if ($force) {
            rename($script, "$script~") if (-e $script);
            $sh=new FileHandle ">$script";
        } else {
            $sh=new FileHandle $script, O_WRONLY|O_CREAT|O_EXCL;
        }
        die "Failed to create $script: $!\n" if (!$sh);

        print $sh "#!/bin/sh\n\n"
            . "\@\@PERL_PROV\@\@ \"\$\@\" | sed -e '/^$filter_provides[0]\$/d'";
        if (@filter_provides > 1) {
            for my $dep (@filter_provides[1..$#filter_provides]) {
                print $sh " \\\n    -e '/^$dep\$/d'";
            }
        }
        print $sh "\n";
    }

    my $specfile="$prefix$name.spec";
    verbose "Writing $specfile...";

    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);

    $license=undef;

    my $scripts=0;
    my (%build_requires,%requires,%recommends,%possible_build_requires);
    my ($yml,$meta);
    if (grep /^META\.yml$/, @files
        and $yml=readfile("$path/META.yml")) {
        # Basic idea borrowed from Module::Depends.
        my $meta;
        eval { $meta=Load($yml); };
        if ($@) {
            warn "Error parsing $path/META.yml: $@";
            goto SKIP;
        }

        if ($meta->{abstract}) {
          my $abstract=$meta->{abstract};
          $summary=$abstract if (!defined($summary));
        }

        %build_requires=%{$meta->{build_requires}} if ($meta->{build_requires});
        if ($meta->{configure_requires}) {
          while (my ($key, $value) = each(%{$meta->{configure_requires}})) {
            $build_requires{$key} = $value;
          }
        }
        if ($meta->{test_requires}) {
          while (my ($key, $value) = each(%{$meta->{test_requires}})) {
            $build_requires{$key} = $value;
          }
        }
 
        %requires=%{$meta->{requires}} if ($meta->{requires});
        %recommends=%{$meta->{recommends}} if ($meta->{recommends});

        # FIXME - I'm not sure this is sufficient...
        if ($meta->{script_files} or $meta->{scripts}) {
            $scripts=1;
        }

        if ($meta->{license}) {
            # This list of licenses is from the Module::Build::API
            # docs, cross referenced with the list of licenses in
            # /usr/share/rpmlint/config.
            if ($meta->{license} =~ /^perl$/i) {
                $license="Artistic-1.0 or GPL-1.0+";
            } elsif ($meta->{license} =~ /^apache$/i) {
                $license="Apache Software License";
            } elsif ($meta->{license} =~ /^artistic$/i) {
                $license="Artistic-1.0";
            } elsif ($meta->{license} =~ /^artistic_?2$/i) {
                $license="Artistic-2.0";
            } elsif ($meta->{license} =~ /^bsd$/i) {
                $license="BSD3c";
            } elsif ($meta->{license} =~ /^gpl$/i) {
                $license="GPL-1.0+";
            } elsif ($meta->{license} =~ /^lgpl$/i) {
                $license="LGPL-2.1+";
            } elsif ($meta->{license} =~ /^mit$/i) {
                $license="MIT";
            } elsif ($meta->{license} =~ /^mozilla$/i) {
                $license="MPL";
            } elsif ($meta->{license} =~ /^open_source$/i) {
                $license="OSI-Approved"; # rpmlint will complain
            } elsif ($meta->{license} =~ /^restrictive$/i) {
                $license="Non-distributable";
                warn "License is 'restrictive'."
                    . "  This package should not be redistributed.\n";
            } elsif ($meta->{license} =~ /^unknown$/i) {
                # do nothing, it's unknown and we know
            } else {
                warn "Unknown license '" . $meta->{license} . "'!\n";
            }
        }
        SKIP:
    }

    if (!defined($license)) {
       get_license($content);
       if ($license && ($license =~ /under the same terms as Perl itself/ || 
           $license =~ /under the terms of the Perl artistic license/)) {
          $license = "GPL-1.0+ or Artistic-1.0";
       }
    }

    if (!length($summary)) {
      $summary="$module Perl module";
    }

    $license="CHECK(GPL-1.0+ or Artistic-1.0)" if (!$license);

    $description=$summary if (!defined($description));

    if (length($summary) > 79) {
	$summary = substr($summary, 0, 72) . "[cut]";
    }

    my $usebuildpl=0;
    my $usebuildplt=0;
    if (grep /^Build\.PL$/, @files) {
        $usebuildpl=1;
	if (defined $build_requires{'Module::Build::Tiny'}) {
	   $usebuildplt=1;
        } else {
          $build_requires{'Module::Build'} ||=0;
        }
    } else {
        $build_requires{'ExtUtils::MakeMaker'}=0;
    }

    my $deps = Intrusive->new->dist_dir( $basedir . $path )->find_modules;
    my %lrequires = %{$deps->requires};
    foreach my $dep (keys(%lrequires)) {
	$requires{$dep}=$lrequires{$dep};
    }
    %lrequires = %{$deps->build_requires};
    foreach my $dep (keys(%lrequires)) {
	$build_requires{$dep}=$lrequires{$dep};
    }

    my %packages = ();

    my $scanner = Perl::PrereqScanner->new;
    foreach my $test (grep /\.(pm|t|PL|pl)/, @files) {
	my $doc = PPI::Document->new($basedir . $path . "/" . $test);

        next unless ($doc);

 	# Get the name of the main package
	my $pkg = $doc->find_first('PPI::Statement::Package');
	if ($pkg) {
	    $packages{$pkg->namespace} = 1;
	}

	my %scanneddeps = %{$scanner->scan_ppi_document($doc)->as_string_hash};
	foreach my $dep (keys(%scanneddeps)) {
	    my $ndep = $scanneddeps{$dep};
	    unless ($build_requires{$dep} && $build_requires{$dep} > $ndep) {
                $possible_build_requires{$dep} = $scanneddeps{$dep};
	    }
	}
    }

    foreach my $pkg (keys %packages) { delete $build_requires{$pkg} };
    
    my %hdoc = ();
    if (@doc) {
       foreach my $d (@doc) { 
          $hdoc{$d} = 1; 
       }
    }

    rmtree($basedir);

    print $spec <<END;
#
# spec file for package $prefix$name (Version $version)
#
# Copyright (c) 2011 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
# upon. The license for this file, and modifications and additions to the
# file, is the same license as for the pristine package itself (unless the
# license for the pristine package is not an Open Source License, in which
# case the license is the MIT License). An "Open Source License" is a
# license that conforms to the Open Source Definition (Version 1.9)
# published by the Open Source Initiative.

# Please submit bugfixes or comments via http://bugs.opensuse.org/
#

END

    print $spec <<END;
Name:           $prefix$name
Version:        $version
Release:        $release
END

    print $spec "Epoch:          $epoch\n" if (defined($epoch));

    print $spec <<END;
License:        $license
%define cpan_name $name
Summary:        $summary
Url:            $url
Group:          Development/Libraries/Perl
END
    my $sfile = basename($ofile);
    $sfile=~s/$version/\%{version}/;
    $sfile=~s/$name/\%{cpan_name}/;

    if ($source) {
       if (basename($source) eq $sfile) {
          print $spec "Source:         $source\n";
       } else {
         print $spec "#Source:        $source\n";
         print $spec "Source:         $ofile\n";
       }
    } else {
       print $spec "Source:         $ofile\n";
    }
    printf $spec "%-16s%s\n", "BuildArch:", "noarch" if ($noarch);
    print $spec "BuildRoot:      \%{_tmppath}/\%{name}-\%{version}-build\n";

    printf $spec "%-16s%s\n", "BuildRequires:", "perl";
    printf $spec "%-16s%s\n", "BuildRequires:", "perl-macros";

    for my $dep (keys(%requires)) {
        next if ($dep eq 'perl');
        $build_requires{$dep}=$build_requires{$dep} || $requires{$dep};
    }

    my @treqs = sort(keys(%build_requires));
    foreach my $dep (sort(keys(%possible_build_requires))) {
       push(@treqs, $dep) if (!defined $build_requires{$dep});
    }
    for my $dep (@treqs) {
        my $iscore = 0;
        eval { $iscore = is_in_core($dep, $build_requires{$dep}); };
        next if $iscore;
        if ($follow) {
            if ($dep ne $module and !(grep { $_ eq $dep } @processed, @args)) {
                if (check_dep($dep)) {
                    verbose("$dep is available, skipping.");
                } else {
                    verbose("$dep is not available, adding it to the list.");
                    push(@args, $dep);
                }
            }
        }
        if (defined $build_requires{$dep}) {
          printf $spec "%-16s%s", "BuildRequires:", "perl($dep)";
          print $spec (" >= " . $build_requires{$dep})
              if ($build_requires{$dep});
          print $spec "\n";
        } else { 
          #printf $spec "#%-15s%s", "BuildRequires:", "perl($dep)";
          #print $spec (" >= " . $possible_build_requires{$dep})
          #    if ($possible_build_requires{$dep});
        }
    }

    for my $dep (sort @add_buildrequires) {
        printf $spec "%-16s%s\n", "BuildRequires:", $dep if (length($dep));
    }

    for my $dep (sort(keys(%requires))) {
        next if (is_in_core($dep, $requires{$dep}));
        printf $spec "%-16s%s", "Requires:", "perl($dep)";
        print $spec (" >= " . $requires{$dep}) if ($requires{$dep});
        print $spec "\n";
    }

    for my $dep (@add_requires) {
        printf $spec "%-16s%s\n", "Requires:", $dep;
    }


    for my $prov (@add_provides) {
        printf $spec "%-16s%s\n", "Provides:", $prov;
    }
    for my $dep (sort(keys(%recommends))) {
        next if (is_in_core($dep, $recommends{$dep}));
        next if ($dep eq 'perl');
        printf $spec "%-16s%s", "Recommends:", "perl($dep)";
        print $spec (" >= " . $recommends{$dep}) if ($recommends{$dep});
        print $spec "\n";
    }
 

    if (@filter_requires) {
        print $spec <<END

Source98:       $name-filter-requires.sh
\%global real_perl_requires \%{__perl_requires}
\%define __perl_requires \%{_tmppath}/\%{name}-\%{version}-\%{release}-\%(\%{__id_u} -n)-filter-requires
END
    }

    if (@filter_provides) {
        print $spec <<END

Source99:       $name-filter-provides.sh
\%global real_perl_provides \%{__perl_provides}
\%define __perl_provides \%{_tmppath}/\%{name}-\%{version}-\%{release}-\%(\%{__id_u} -n)-filter-provides
END
    }

    print $spec "%{perl_requires}\n";

    my $buildpath=$path;
    $buildpath=~s/$name/\%{cpan_name}/;
    $buildpath=~s/$version/\%{version}/;
    print $spec <<END;

\%description
$description

\%prep
\%setup -q@{[($noprefix ? "" : " -n $buildpath")]}
END

    if ($execs) {
	print $spec "find . -type f -print0 | xargs -0 chmod 644\n";
    } 
    
    if (@filter_requires) {
        print $spec <<'END';

sed -e 's,@@PERL_REQ@@,%{real_perl_requires},' %{SOURCE98} > %{__perl_requires}
chmod +x %{__perl_requires}
END
    }

    if (@filter_provides) {
        print $spec <<'END';

sed -e 's,@@PERL_PROV@@,%{real_perl_provides},' %{SOURCE99} > %{__perl_provides}
chmod +x %{__perl_provides}
END
    }

    if (grep { $_ eq "pm_to_blib" } @files) {
        print $spec <<'END';

rm -f pm_to_blib
END
    }

    print $spec <<END;

\%build
END

    if ($usebuildplt) {
        print $spec <<END;
\%{__perl} Build.PL --installdirs=vendor@{[$noarch ? '' : qq{ optimize="$macro{optimize}"} ]}
./Build build --flags=\%{?_smp_mflags}

END
    } elsif ($usebuildpl) {
        print $spec <<END;
\%{__perl} Build.PL installdirs=vendor@{[$noarch ? '' : qq{ optimize="$macro{optimize}"} ]}
./Build build flags=\%{?_smp_mflags}

END
    } else {
        print $spec <<END;
\%{__perl} Makefile.PL INSTALLDIRS=vendor@{[$noarch ? '' : qq{ OPTIMIZE="$macro{optimize}"}]}
END

        print $spec
            "\%{__perl} -pi -e 's/^\\tLD_RUN_PATH=[^\\s]+\\s*/\\t/' Makefile\n"
            if ($compat and !$noarch);

        print $spec <<END;
\%{__make} \%{?_smp_mflags}

END
    }

    print $spec <<END;
\%check@{[($compat ? ' || :' : '')]}
END
    if ($usebuildpl) {
        print $spec "./Build test\n";
    } else {
        print $spec "\%{__make} test\n";
    }


    print $spec <<END;

\%install
END

    if ($usebuildplt) {
        print $spec
           "./Build install --destdir=$macro{buildroot} --create_packlist=0\n";
    } elsif ($usebuildpl) {
        print $spec
            "./Build install destdir=$macro{buildroot} create_packlist=0\n";
    } else {
        print $spec <<END;
%perl_make_install
%perl_process_packlist
END
    }
    print $spec
        "%perl_gen_filelist\n";

    if ($addlicense and !grep /copying|artistic|copyright|license/i, @doc) {
        print $spec <<END;
perldoc -t perlgpl > COPYING
perldoc -t perlartistic > Artistic

END

        $hdoc{"COPYING"} = 1;
        $hdoc{"Artistic"} = 1;
    }

   if (@filter_requires || @filter_provides) {
     print $spec <<END;
\%clean
\%{__rm} -rf $macro{buildroot}@{[
    (@filter_requires ? ' %{__perl_requires}' : '') .
    (@filter_provides ? ' %{__perl_provides}' : '')]}
END
   } else {
     print $spec "\n";
   }

    print $spec "\%files -f \%{name}.files\n";
    print $spec "\%defattr(-,root,root,755)\n";

    if (%hdoc) {
       print $spec "%doc " . join(' ', sort(keys(%hdoc))) . "\n";
    }

    if ($scripts) {
        print $spec "\%{_bindir}/*\n";
        # FIXME - How do we auto-detect man pages?
    }

    print $spec <<END;

\%changelog
END

    $spec->close();
    my ($fh, $filename) = File::Temp::tempfile;
    if (-x "/usr/lib/obs/service/format_spec_file.files/prepare_spec") {
      if (!system("/usr/lib/obs/service/format_spec_file.files/prepare_spec '$specfile' > '$filename'")) {
        # don't want to reimplement cross-device rename
        system("mv '$filename' '$specfile'");
      }
    } else {
      print STDERR "please install obs-service-format_spec_file\n";
    }

    build_rpm($specfile) if ($buildsrpm or $buildrpm);

    push(@processed, $module);

    if (!$skip_changes) {
      (my $basename = $specfile) =~ s{\.spec$}{};
      if (-f "$basename.changes") {
        verbose "Updating $basename.changes";
        system("osc vc -m 'updated to $version' $basename.changes");
      } else {
        verbose "Writing $basename.changes";
        system("osc vc -m 'initial package $version
    * created by $NAME $VERSION' $basename.changes");
      }
   }
}

# vi: set ai et:
