#!/usr/bin/perl
#
# 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.

=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 0)
   --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
   --old-file=s         Old archive file for extraction of changelog difference
   --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 0.

=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<https://cpan.metacpan.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;
use 5.010;

our $NAME    = "cpanspec";
our $VERSION = '1.84.00';
my $script = __FILE__;

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::Tar::Constant qw/ &DIR /;
use Archive::Zip qw(:ERROR_CODES);
use POSIX;
use locale;
use Text::Autoformat;
use YAML::XS ();
use Getopt::Long;
use Pod::POM;
use PodViewSpec;
use Pod::Usage;
use File::Basename;
use LWP::UserAgent;
use Parse::CPAN::Packages;
use File::Temp;
use File::Path qw(rmtree);
use Perl::PrereqScanner;
use Encode qw/ decode_utf8 /;
use Encode::Guess;
use JSON::PP ();
use Data::Dumper;
use Algorithm::Diff;

require Carp;

my $url="https://metacpan.org/release/\%{cpan_name}";
my $bin = Cwd::abs_path(dirname($script));
my $coder = JSON::PP->new->utf8;

our %opt;

our $help       = 0;
our $compat     = 0;
our $addlicense = 0;
our $noprefix   = 0;
our $force      = 0;
our $packager;
our $release = 0;
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 $cmdperl      = "perl"; # \%{__perl}
our $cmdrm        = "rm"; # \%{__rm}
our $cmdmake      = "make"; # \%{__make}
our $perllicense  = "Artistic-1.0 or GPL-1.0-or-later";
our $config_file;
our $old_file;
our $config = {};
our $cpan = $ENV{'CPAN'} || 'https://cpan.metacpan.org';
my $debug;

our $home = $ENV{'HOME'} || (getpwuid($<))[7];
die "Can't locate home directory.  Please define \$HOME.\n"
  if (!defined($home));

our $pkgdetails = (-d "$home/.local/share/.cpan" ? "$home/.local/share" : "$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);

# 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);
    return 1;

    verbose("Updating $pkgdetails...");

    mkdir_p(dirname($pkgdetails)) if (!-d dirname($pkgdetails));

    fetch("$cpan/modules/" . basename($pkgdetails), $pkgdetails);

    $updated = 1;
}

sub get_file($) {
    my $ofile = shift;
    my ($file, $name, $version, $type);
    # Look up $ofile in 02packages.details.txt.
    verbose("Get file $ofile");
    update_packages();
    if (!defined($packages)) {
        verbose "parsing packages";
        $packages = Parse::CPAN::Packages->new($pkgdetails);
        verbose "done";
    }
    die "Parse::CPAN::Packages->new() failed: $!\n" unless defined $packages;
    my ($m, $d);
    if ($m = $packages->package($ofile) and $d = $m->distribution()) {
        $source = $cpan . "/authors/id/" . $d->prefix();
        $file   = basename($d->filename());
        fetch($source, $file) unless -f $file;
        $name    = $d->dist();
        $version = $d->version();
        $version =~ s/^v\.?//;
        $type = $d->prefix() =~ /\.zip/ ? "zip" : "tar";
    }
    else {
        warn "Failed to parse '$file' or find a module by that name, skipping...\n";
    }
    return ($file, $name, $version, $type);
}

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

    # keep things happy if we get "Foo-Bar" instead of "Foo::Bar"
    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 ($d = $packages->latest_distribution($file)) {
        $source = $cpan . "/authors/id/" . $d->prefix();
        $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');
    return 0 if Module::CoreList::removed_from($module);
    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 {
    my ($filename, $encoding) = @_;
    $encoding //= '';
    local $/ = undef;
    die "empty filename" unless length($filename);
    open my $fh, "<", $basedir . $filename or return undef;
    binmode $fh;
    my $string = <$fh>;
    if ($encoding eq 'guess') {
        $string = decode_latin_or_utf8($string);
    }
    close $fh;
    return $string;
}

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

    my $path = $args{module};     # YAML::PP::LibYAML
    $path =~ s,::,/,g;            # YAML/PP/LibYAML
    my @pmfiles = ("lib/$path.pod", "lib/$path.pm"); # lib/YAML/PP/LibYAML.{pm,pod}
    if ($args{module} =~ /::/) {
        my @tmp = split '/', $path; # YAML PP LibYAML
        my $last = pop @tmp;        # LibYAML
        push(@pmfiles, "lib/$last.pod", "lib/$last.pm"); # lib/LibYAML.{pm,pod}
    }
    do {
        push(@pmfiles, "$path.pod", "$path.pm");
    } while ($path =~ s,^[^/]+/,,);   # PP/LibYAML -> LibYAML
    push(@pmfiles, "$args{module}")   # DateTime
      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 $title  = shift || 'DESCRIPTION';
    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 $title;

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

        return $description = undef unless length($description);
        my @paragraphs = (split /\n\n/, $description);
        my $limit = $config->{description_paragraphs};
        if ($limit) {
            @paragraphs = @paragraphs[0 .. ($limit - 1)];
        }
        $description = join "\n\n", @paragraphs;

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

sub get_summary {
    my ($summary, $cont, $mod) = @_;
    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;

        my $s = $1;
        if($s)
        {
          # strip markup
          $s =~ s/C<([^>]+)>/$1/g;
          return $s;
        }
    }
    return $summary;
}

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

    # 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 'sorry, no author found';
}

sub get_license_from_content($) {
    my $cont   = shift;
    my $license;
    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 =~ /LICEN[CS]E/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;

        if ($license
            && (   $license =~ /under the same terms (and conditions )?as Perl/
                || $license =~ /same terms as the Perl 5/
                || $license =~ /under the terms of the Perl artistic license/
                || $license =~ qr/free software.*dev.perl.org.* for more information/)) {
            $license = $perllicense;
        }
        # return...
        return $license;
    }
    return 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)"));
}

sub map_version($$) {
    my ($module, $version) = @_;
    if (grep { $module eq $_ } qw/Module::Build CPAN::Meta::Requirements ExtUtils::PkgConfig Test::Exception Test::Number::Delta Time::Duration DateTime::Locale File::Path/ ) {
	my $nv = $version . "000000";
	if ($nv =~ /^(.*\.[0-9]{6})/) {
	    return $1;
	}
    }
    return $version;
}

sub extract_old_changes($$) {
    my ($archive, $filename) = @_;

    my $tar = Archive::Tar->new;
    $tar->read($archive, 1, {filter => qr/\Q$filename\E$/});
    my @cfile = $tar->list_files();
    return $tar->get_content($cfile[0]);
}

sub diff_changes($$) {
    my @old_changes = split qr/\n/, shift;
    my @changes     = split qr/\n/, shift;

    #print $old_changes, $changes;
    my $diff = Algorithm::Diff->new(\@old_changes, \@changes);

    # ignore common prefix
    while ($diff->Next()) {
        last unless $diff->Same();
    }

    return '' unless $diff->Next(0);

    if(  $diff->Items(2) && ! $diff->Items(1) ) {
        my $changesdiff = '';
        $changesdiff .= "  $_\n"  for  $diff->Items(2);
        # some cleanups
        $changesdiff =~ s/[ \t\r]+\n/\n/g; # no trailing spaces or line feeds
        $changesdiff =~ s/\n\n\n+/\n\n/g; # not more than a single empty line
        # sanitize diffs with too many empty lines
        my $emptylines = 0;
        while($changesdiff =~ /\n\n/g) { ++$emptylines; }
        $changesdiff =~ s/\n\n/\n/g if $emptylines > 3;
        return $changesdiff;
    }
    return '';
}

sub add_custom_spec_section($$) {
    my ($spec, $section) = @_;
    if ($config->{$section}) {
        print $spec "# MANUAL BEGIN\n";
        chomp $config->{$section};
        print $spec $config->{$section};
        print $spec "\n# MANUAL END\n";
    }
}

sub is_license_file {
    my $file = shift;

    $file = lc $file;
    return 1 if $file =~ /^copying/;
    return 1 if $file =~ /^licen[sc]e/;
    return 1 if $file =~ /^artistic/;
    return 1 if $file =~ /^mit/;
    return 1 if $file =~ /^gpl/;
    return;
}

# 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,
    'old-file=s'          => \$old_file,
    'config=s'            => \$config_file,
    'version'             => \&print_version,
    'prefer-macros|m'     => \$macros,
    'pkgdetails=s'        => \$pkgdetails,
    'debug'               => \$debug,
) 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 $defaultdocdir = `rpm --eval '\%_defaultdocdir'`;
chomp $defaultdocdir;

$config_file ||= "cpanspec.yml" if -f "cpanspec.yml";
$config = YAML::XS::LoadFile($config_file) if $config_file;

$config->{ignored_requires} = {};
for my $r (split(/ /, $config->{ignore_requires} || '')) {
  $config->{ignored_requires}->{$r} = 1;
}
my @args      = @ARGV;
my @processed = ();
local $Data::Dumper::Sortkeys = 1;

for my $ofile (@args) {

    my $type = undef;
    my $download = undef;
    my $summary;
    ($file, $name, $source, $version) = (undef, undef, undef, undef);
    my $license;
    ($content, $description, $author) = (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.
        ($file, $name, $version, $type) = get_file($ofile);
        $download = 1;
    }
    next unless $name;

    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->()) {
            next if $f->type == DIR;
            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';
        $archive->extractTree('', $basedir);
        push(@archive_files, $archive->memberNames());
    }

    my %stats;
    my @files = ();
    my $bogus = 0;
    my $execs = 0;
    my $changes;
    # Sort files, so that Changes comes before Changes.foo
    @archive_files = sort @archive_files;
    my $changesfile;
    foreach my $entry (@archive_files) {

        my $version0=$version;
        $version0=~s/0*$/0*/; # pathnames may not contain as many trailing zeros
        if (
            $entry !~ m{^(?:./)?($name-(?:v\.?)?$version0)(?:/|$)}
            and $entry !~ m{^(?:./)?($name)(?:\/|$)}
            ) {
            warn "BOGUS PATH DETECTED: $entry\n";
            $bogus++;
            next;
        }
        $path //= $1;

        unless ($entry =~ s{^(?:./)?$name-(?:v\.?)?$version0/}{}) {
            $entry =~ s{^(?:./)?$name/}{};
        }
        next if (!$entry);

        push(@files, $entry);

        my $candidate = lc $entry;
        if (!$changes && ($candidate =~ m/^changes/ || $candidate =~ m/^changelog/ || $candidate =~ m/^history/)) {
            $changesfile = $entry;
            $changes     = readfile("$path/$entry", 'guess');
        }

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

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

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

    $description = $config->{description} if $config->{description};
    if (!$description) {
        get_description($content) || get_description($content, 'OVERVIEW');
    }

    # $author //= get_author($content);
    # my $authors="Authors:\n--------\n$author";

    my @doc = find_doc($config, $path, @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}";

    filter_requires($name) if @filter_requires;
    filter_provides($name) if @filter_provides;

    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;
    }
    unless ($spec) {
        warn "Failed to create $specfile: $!\n";
        next;
    }

    print $spec qq[\%{!?perl_$vendorlib: \%define perl_$vendorlib \%(eval "\`$cmdperl -V:install$vendorlib\`"; echo \$install$vendorlib)}\n\n]
      if ($compat);

    my $scripts = 0;
    my (%build_requires, %requires, %recommends, %provides);
    my $dynamic = 1;
    my $got_prereqs = 0;

    if (-e "$basedir/$path/META.json") {
        my $results = read_meta_json("$basedir/$path/META.json", \%stats);
        $got_prereqs = $results->{got_prereqs};
        $dynamic = $results->{dynamic};
        $summary //= $results->{abstract};
        if ($results->{build}) {
            %build_requires = %{ $results->{build_requires} };
            %requires = %{ $results->{requires} };
            %recommends = %{ $results->{recommends} };
        }
        if (my $prov = $results->{provides}) {
            @provides{ keys %$prov } = values %$prov;
        }
        $got_prereqs = $results->{got_prereqs};
    }

    if (-e "$basedir/$path/META.yml") {
        my $results = read_meta_yaml("$path/META.yml", \%stats);
        $dynamic = $results->{dynamic};
        $summary //= $results->{abstract};
        if (not $got_prereqs and $results->{build}) {
            %build_requires = %{ $results->{build_requires} };
            %requires = %{ $results->{requires} };
            %recommends = %{ $results->{recommends} };
        }
        if (not keys %provides and my $prov = $results->{provides}) {
            @provides{ keys %$prov } = values %$prov;
        }
        $got_prereqs = $results->{got_prereqs};
        $scripts = $results->{scripts};
        $license = $results->{license};
    }
    $stats{dynamic} = $dynamic;
    $debug and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$dynamic], ['dynamic']);

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

    $ENV{PERL_MM_USE_DEFAULT} = 1;
    if ($got_prereqs and not $dynamic) {
        $debug and warn "Got prereqs, no need to run Makefile.PL/Build.PL";
    }
    else {
        # Run Makefile.PL/Build.PL and read from generated MYMETA.{json,yml}
        my $cmd = "perl Makefile.PL";
        if ($usebuildpl) {
            $cmd = "perl Build.PL";
        }
        my $out = qx{cd $basedir/$path; $cmd 2>&1};
        if ($?) {
            warn "Error when running $cmd: >>$out<<\n";
        }
        else {
            my $dynamic_results;
            if (-e "$basedir/$path/MYMETA.json") {
                $dynamic_results = read_meta_json("$basedir/$path/MYMETA.json", \%stats);
            }
            elsif (-e "$basedir/$path/MYMETA.yml") {
                $dynamic_results = read_meta_yaml("$path/MYMETA.yml", \%stats);
                $license //= $dynamic_results->{license};
            }
            else {
                warn "No MYMETA files, output from build:>>>\n$out<<<";
            }
            if ($dynamic_results) {
                $summary //= $dynamic_results->{abstract};
                # Add possible new requirements to existing static ones
                my %newrequires = %{ $dynamic_results->{requires} };
                foreach my $dep (keys(%newrequires)) {
                    $requires{$dep} = $newrequires{$dep};
                }
                %newrequires = %{ $dynamic_results->{build_requires} };
                foreach my $dep (keys(%newrequires)) {
                    if (defined $build_requires{$dep}) {
                        next if version->parse($build_requires{$dep}) > version->parse($newrequires{$dep});
                    }
                    $build_requires{$dep} = $newrequires{$dep};
                }
            }
        }
    }

    $license //= get_license_from_content($content);
    $license = "CHECK($perllicense)" unless $license;
    $stats{license}->{spec} = $license;

    $summary =~ s/[CL]<([^>]+)>/$1/g if defined $summary;
    $summary //= get_summary($summary, $content, $module);
    $description //= $summary;
    $stats{summary} = $summary;
    $summary =~ s,\.$,,;
    $summary =~ s,^[aA] ,,;
    $summary = ucfirst $summary;
    if (length($summary) > 79) {
        $summary = substr($summary, 0, 72) . "[cut]";
    }

    $summary = $config->{summary} if $config->{summary};
    if (not length $summary) {
        $summary = "$module Perl module";
    }

    $stats{provides} = keys %provides;
    dump_statistics($module, $version, \%stats);
    unless (%provides) {
        verbose("No 'provides' info in meta, parsing code.\n");
        %provides = parse_provides($basedir . $path, \@files);
    }

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

    rmtree($basedir);
    my $rpm_version = map_version($module, $version);
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    print $spec <<END;
#
# spec file for package $prefix$name (Version $rpm_version)
#
# Copyright (c) $year SUSE LLC
#
# 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 https://bugs.opensuse.org/
#

END

    my $version_string = '%{version}';

    print $spec <<END;
%define cpan_name $name
Name:           $prefix$name
Version:        $rpm_version
Release:        $release
END

    if ($rpm_version ne $version) {
        print $spec "%define cpan_version $version\n";
        $version_string = '%{cpan_version}';
        print $spec "Provides:  perl($module) = $rpm_version\n";
    }

    print $spec "Epoch:          $epoch\n" if (defined($epoch));
    if ($config->{license}) {
        if($config->{license} =~ /^Perl( License)?$/i) {
            $config->{license} = $perllicense;
        }
        if("CHECK($config->{license})" ne $license && $config->{license} ne $license) {
            print $spec "#Upstream: $license\n";
        }
        print $spec "License:   $config->{license}\n";
    }
    else {
        print $spec "License:   $license\n";
    }
    print $spec <<END;
Summary:        $summary
Url:            $url
END
    my $sfile = basename($ofile);
    $sfile =~ s/$name/\%{cpan_name}/;
    $source =~ s/$name/\%{cpan_name}/ if $download;

    my $counter = 0;
    if ($source) {
        if (basename($source) ne $sfile && $sfile !~ /::/) {
           # the current source URL is not the version we're looking for
           # just take a guess - authors don't change daily
           $source = dirname($source) . "/$sfile";
        }
        $source =~ s,$version,$version_string,;
        print $spec "Source$counter:         $source\n";
    }
    else {
        print $spec "Source$counter:         $ofile\n";
    }
    $counter++;

    if ($config->{sources}) {
        for my $s (@{$config->{sources}}) {
            print $spec "Source$counter:         $s\n";
            $counter++;
        }
    }
    if ($config_file) {
        print $spec "Source$counter:     $config_file\n";
    }
    if ($config->{patches}) {
        $counter = 0;
        for my $p (sort keys %{$config->{patches}}) {
            my $args = $config->{patches}->{$p} || '';
            print $spec "# $1\n" if $args =~ / ?(PATCH-FIX.*)/;
            print $spec "Patch$counter:   $p\n";
            $counter++;
        }
    }

    if ($config->{skip_noarch}) {
        printf $spec "# MANUAL\n#%-15s%s\n", "BuildArch:", "noarch" if $noarch;
        $noarch = undef;
    }
    else {
        printf $spec "%-16s%s\n", "BuildArch:", "noarch" if $noarch;
    }

    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));
    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}) {
            if ($config->{ignored_requires}->{$dep}) {
	      printf $spec "#";
            }
            printf $spec "%-16s%s", "BuildRequires:", "perl($dep)";
            print $spec (" >= " . map_version($dep, $build_requires{$dep}))
              if ($build_requires{$dep});
            print $spec "\n";
        }
    }

    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}));
        if ($config->{ignored_requires}->{$dep}) {
           printf $spec "#";
        }
        printf $spec "%-16s%s", "Requires:", "perl($dep)";
        print $spec (" >= " . map_version($dep, $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";
    add_custom_spec_section($spec, "preamble");

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

\%description
$description

\%prep
END

    my $all_patch_args_same = 1;
    my $common_patch_args = undef;
    if ($config->{patches}) {
        for my $p (sort keys %{$config->{patches}}) {
            my $args = $config->{patches}->{$p} || undef;
            $args =~ s/ ?PATCH-FIX.*// if defined($args);
            if (!defined($common_patch_args) && defined($args)) {
                $common_patch_args = $args;
            }
            $all_patch_args_same = ($args // '') eq ($common_patch_args // '');
            last if !$all_patch_args_same;
        }
    }

    my $autosetup_arg = (!$config->{patches} || $all_patch_args_same) ? (defined($common_patch_args) ? " $common_patch_args" : "") : " -N";
        print $spec <<END;
\%autosetup @{[($noprefix ? "" : " -n $buildpath")]}$autosetup_arg

END

    if ($execs) {
        print $spec qq{find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path "*/script/*" ! -path "*/scripts/*" ! -name "configure" -print0 | xargs -0 chmod 644\n};
    }

    if ($config->{patches} && !$all_patch_args_same) {
        my $counter = 0;
        for my $p (sort keys %{$config->{patches}}) {

            my $args = $config->{patches}->{$p} || undef;
            if (defined($args)) {
                $args =~ s/ ?PATCH-FIX.*//;
                print $spec "%patch$counter $args\n";
            } else {
                print $spec "%patch$counter\n";
            }
            $counter++;
        }
    }

    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
    }

    add_custom_spec_section($spec, "post_prep");

    print $spec <<END;

\%build
END

    my $makefile_env = '';
    if (grep { $_ eq 'inc/Module/Install.pm' } @archive_files) {
        # Since perl 5.26, . was removed from @INC, but several modules
        # do "use inc::Module::Install" in Makefile.PL
        $makefile_env = "PERL_USE_UNSAFE_INC=1 ";
    }
    if ($config->{custom_build}) {
        print $spec $config->{custom_build} . "\n";
    }
    else {
        if ($usebuildpl) {
            print $spec <<END;
$makefile_env$cmdperl Build.PL --installdirs=vendor@{[$noarch ? '' : qq{ optimize="$macro{optimize}"} ]}
./Build build --flags=\%{?_smp_mflags}

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

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

            print $spec <<END;
\%make_build

END
        }
    }
    add_custom_spec_section($spec, "post_build");

    print $spec <<END;
\%check@{[($compat ? ' || :' : '')]}
END
    if ($config->{custom_test}) {
        print $spec $config->{custom_test} . "\n";
    }
    else {
      my $noprefix = '';
      if ($config->{no_testing}) {
          print $spec "# MANUAL no testing ($config->{no_testing})\n";
          $noprefix = '#';
      }
      if ($usebuildpl) {
          print $spec "$noprefix./Build test\n";
      }
      else {
          print $spec "$noprefix$cmdmake test\n";
      }
    }

    print $spec <<END;

\%install
END

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

    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
$cmdrm -rf $macro{buildroot}@{[
    (@filter_requires ? ' %{__perl_requires}' : '') .
    (@filter_provides ? ' %{__perl_provides}' : '')]}
END
    }
    else {
        print $spec "\n";
    }

    print $spec "\%files -f \%{name}.files\n";

    if (%hdoc) {
	my (@ldoc, @hdoc);
	for my $f (keys %hdoc) {
	    if (is_license_file($f)) {
		push(@ldoc, $f);
	    } else {
		push(@hdoc, $f);
	    }
	}
	if (@hdoc) {
	    print $spec "%doc " . join(' ', sort(@hdoc)) . "\n";
	}
	if (@ldoc) {
	    print $spec "%license " . join(' ', sort(@ldoc)) . "\n";
	}
    }

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

    print $spec $config->{"misc"} if $config->{"misc"};

    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$}{};
        my $changelogfile = "$basename.changes";
        my $skip = 0;

        my $changes_diff;

        my ($tfh, $tmpfile) = File::Temp::tempfile;
        binmode $tfh, ':encoding(UTF-8)';
        my $cltxt = "";

        if (-f $changelogfile) {
            my $txt = "- updated to $version\n   see $defaultdocdir/$basename/$changesfile\n\n";
            $cltxt .= $txt;
            if ($old_file && $changes) {
                my $old_changes = extract_old_changes($old_file, $changesfile);
                $old_changes = decode_latin_or_utf8($old_changes);
                $old_changes =~ s,\r\n,\n,g;
                $cltxt .= diff_changes($old_changes, $changes) if $old_changes;
            }
            local $/;
            undef $/;
            if(open CHANGES,"<",$changelogfile)
            {
              my $log = <CHANGES>;
              if($log =~ $txt)
              {
                $skip = 1;
                print STDERR "Skip changelog entry, already exists.\n";
              }
              close CHANGES;
            }
        }
        else {
            $cltxt .= "- initial package $version\n * created by $NAME $VERSION";
        }
        $cltxt .= "\n"; # ensure line termination
        $cltxt =~ s/\n+$/\n/; # drop multi-lines at the end, osc adds one again
        print $tfh $cltxt;
        system("osc vc -F $tmpfile $basename.changes") if !$skip;
        die "osc vc failed with $?" if $?;
        close($tfh);
    }
}

sub prereqs_from_metayaml {
    my ($meta) = @_;
    my (%provides, %build_requires, %requires, %recommends);

    if ($meta->{provides}) {
        for my $pkg (keys %{ $meta->{provides} || {} }) {
            $provides{ $pkg } = 1;
        }
    }

    %build_requires = %{$meta->{build_requires}} if ($meta->{build_requires});
    if ($meta->{configure_requires}) {
        while (my ($key, $value) = each(%{$meta->{configure_requires}})) {
            if (defined $build_requires{$key}) {
                next if version->parse($build_requires{$key}) > version->parse($value);
            }
            $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});
    return (\%provides)
        if (not %build_requires and not %requires and not %recommends);
    return (\%provides, \%build_requires, \%requires, \%recommends);
}

sub prereqs_from_metajson {
    my ($metajson) = @_;
    my (%provides, %build, %run, %rec);
    if ($metajson->{provides}) {
        for my $pkg (keys %{ $metajson->{provides} || {} }) {
            $provides{ $pkg } = 1;
        }
    }

    my $prereqs = $metajson->{prereqs};
    return (\%provides) unless keys %$prereqs;

    for my $phase (qw/ build configure test /) {
        if (my $build = $prereqs->{ $phase }) {
            my $req = $build->{requires} || {};
            for my $module (sort keys %$req) {
                next if exists $build{ $module } and
                    version->parse($build{ $module }) > version->parse( $req->{ $module });
                $build{ $module } = $req->{ $module };
            }
        }
    }
    for my $phase (qw/ runtime /) {
        if (my $build = $prereqs->{ $phase }) {
            my $req = $build->{requires} || {};
            @run{ keys %$req } = values %$req;
            my $rec = $build->{recommends} || {};
            @rec{ keys %$rec } = values %$rec;
        }
    }
    return (\%provides, \%build, \%run, \%rec);
}

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

        next unless ($doc);

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

    }
    return %provides;
}

sub decode_latin_or_utf8 {
    my ($string) = @_;
    my $enc = guess_encoding($string, qw/ utf8 latin1 /);
    unless (ref $enc) {
        return decode_utf8 $string;
    }
    #my $name = $enc->name;
    $string = $enc->decode($string);
    return $string;
}

sub read_meta_json {
    $debug and warn __PACKAGE__.':'.__LINE__.": =============== read_meta_json\n";
    my ($file, $stats) = @_;
    my %results = ( dynamic => 1 );
    open my $fh, '<', $file or die $!;
    my $json = do { local $/; <$fh> };
    close $fh;
    my $metajson = eval { $coder->decode($json) };
    if ($@) {
        warn "Error decoding META.json, ignoring ($@)";
        $stats->{metajson} = 'error';
        return;
    }
    $stats->{metajson} = 1;
    if (exists $metajson->{dynamic_config} and not $metajson->{dynamic_config}) {
        $results{dynamic} = 0;
    }

    my ($prov, $build, $run, $rec) = prereqs_from_metajson($metajson);
    if (keys %$prov) {
        @{ $results{provides} }{keys %$prov } = values %$prov;
    }
    if ($build) {
        $results{build} = 1;
        $results{build_requires} = $build;
        $results{requires} = $run;
        $results{recommends} = $rec;
        $results{got_prereqs} = 1;
        if ($debug) {
            warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\%results], ['results']);
        }
    }
    $results{license} = $metajson->{license};
    if ($metajson->{abstract} && $metajson->{abstract} ne 'unknown') {
        my $abstract = $metajson->{abstract};
        $stats->{abstract}->{metajson} = $abstract;
        $results{abstract} = $abstract;
    }
    $stats->{license}->{metajson} = $metajson->{license};
    if ($metajson->{abstract}) {
        $stats->{abstract}->{metajson} = $metajson->{abstract};
    }

    return \%results;
}

sub read_meta_yaml {
    $debug and warn __PACKAGE__.':'.__LINE__.": =============== read_meta_yaml\n";
    my ($file, $stats) = @_;
    my $yml = readfile($file);
    my $meta = eval { YAML::XS::Load($yml); };
    if ($@) {
        warn "Error parsing $file: $@";
        $stats->{metayaml} = 'error';
        return;
    }
    my %results = ( dynamic => 1 );
    $stats->{metayaml} = 1;
    if (exists $meta->{dynamic_config} and not $meta->{dynamic_config}) {
        $results{dynamic} = 0;
    }

    if ($meta->{abstract} && $meta->{abstract} ne 'unknown') {
        my $abstract = $meta->{abstract};
        $stats->{abstract}->{metayaml} = $abstract;
        $results{abstract} = $abstract;
    }

    my ($prov, $build, $run, $rec) = prereqs_from_metayaml($meta);
    if (keys %$prov) {
        @{ $results{provides} }{keys %$prov } = values %$prov;
    }

    if ($build) {
        $results{build} = 1;
        $results{build_requires} = $build;
        $results{requires} = $run;
        $results{recommends} = $rec;
        $results{got_prereqs} = 1;
        if ($debug) {
            warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\%results], ['results']);
        }
    }
    $stats->{got_prereqs} = $results{got_prereqs}; # did we get static dependencies?

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

    $stats->{license}->{metayaml} = $meta->{license};
    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 = $perllicense;
        }
        elsif ($meta->{license} =~ /^apache$/i) {
            $license = "Apache-2.0";
        }
        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 = "BSD-3-Clause";
        }
        elsif ($meta->{license} =~ /^gpl$/i) {
            $license = "GPL-1.0-or-later";
        }
        elsif ($meta->{license} =~ /^gpl2$/i) {
            $license = "GPL-2.0-or-later";
        }
        elsif ($meta->{license} =~ /^lgpl$/i) {
            $license = "LGPL-2.1-or-later";
        }
        elsif ($meta->{license} =~ /^mit$/i) {
            $license = "MIT";
        }
        elsif ($meta->{license} =~ /^mozilla$/i) {
            $license = "MPL";
        }
        elsif ($meta->{license} =~ /^gpl3$/i) {
            $license = "GPL-3.0-or-later";
        }
        elsif ($meta->{license} =~ /^open_source$/i || $meta->{license} =~ /^unrestricted$/i) {
            $license = "SUSE-Public-Domain";    # rpmlint will complain
        }
        elsif ($meta->{license} =~ /^restrictive$/i) {
            $license = "SUSE-NonFree";
            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 in meta '" . $meta->{license} . "'!\n";
        }
    }
    $results{license} = $license;
    return \%results;
}

sub find_doc {
    my ($config, $path, @files) = @_;

    my @skipdoc = split ' ', ($config->{skip_doc} || '');
    my $doskip = sub {
        for my $s (@skipdoc) { return 1 if m/$s/ }
        return 0;
    };

    my @doc = sort { $a cmp $b } grep {
                !m{/}
            and !/\.(pl|xs|h|c|pm|ini?|pod|cfg|inl|bak|spec|yml|toml)$/i
            and !/^\./
            and !/~$/
            and $_ ne $path
            and $_ ne "MANIFEST"
            and $_ ne "MANIFEST.SKIP"
            and $_ ne "SIGNATURE"
            and $_ ne "NINJA"
            and $_ ne "c"
            and $_ ne "configure"
            and $_ ne "config.guess"
            and $_ ne "config.sub"
            and $_ ne "typemap"
            and $_ ne "bin"
            and $_ ne "lib"
            and $_ ne "t"
            and $_ ne "xt"
            and $_ ne "inc"
            and $_ ne "dist.ini.meta"
            and $_ ne "autobuild.sh"
            and $_ ne "debian"
            and $_ ne "cpanfile"
            and $_ ne "pm_to_blib"
            and $_ ne "install.sh"
            and !/^INSTALL/i
            and !/^META\..+$/i
            and !/^MYMETA\..+$/i
            and !/^perlcritic/
            and !/^perltidy/
            and !/\.tar\./
            and !/~$/
            and !$doskip->($_)
        } @files;

    push @doc, split ' ', ($config->{add_doc} || '');

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

sub dump_statistics {
    my ($module, $version, $stats) = @_;
    $stats->{name} = $module;
    $stats->{version} = $version;
    my $yaml = YAML::XS::Dump($stats);
    $yaml =~ s/^/# STATS # /mg;
    $yaml = "# STATS # # $module, $version\n$yaml";
    verbose($yaml);
}

sub filter_requires {
    my ($name) = @_;
    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";
}

sub filter_provides {
    my ($name) = @_;
    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";
}

# vi: set ai et:
