代码拉取完成,页面将自动刷新
同步操作将从 openEuler/perlporter 强制同步,此操作会覆盖自 Fork 仓库以来所做的任何修改,且无法恢复!!!
确定后同步将在后台操作,完成时将刷新页面,请耐心等待。
#!/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.
#
# $Id: cpanspec,v 1.67 2009/01/16 20:35:17 stevenpritchard Exp $
#
# perlporter - perl package automation build tool
#
# Copyright (C) 2020 Wei Xiong <myeuler at 163.com>
# perlporter is derived from cpanspec tool, it cooperates with pkgporter
# tool to build perl module packages automatically.
#
# The changes focus on simplify the process and add some outputs
# for pkgporter usage.
#
our $NAME="perlporter";
our $VERSION='1.78';
=head1 NAME
perlporter - Tool for converting a CPAN module to rpm package, Derived from cpanspec tool
=head1 SYNOPSIS
perlporter [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
--release -r Release of package (defaults to 1)
--epoch -e Epoch of package
--disttag -d Disttag (defaults to %{?dist})
--build -b Build source and binary rpms
--install -b Install the built package
--cpan -c CPAN mirror URL
--updatepkg -u update package info
--spec -s create spec file
--requires -q Get all requires
--verbose -v Be more verbose
--root -r The root path for rpm build
--prefer-macros -m Prefer macros over environment variables in the spec
Long options:
--add-provides Add Provides for this item
--add-buildrequires Add BuildRequires for this item
--version Print the version number and exit
=head1 DESCRIPTION
B<perlporter> will create rpm package or output the dependency info for 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<-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<-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<-b>, B<--install>
Install the pacakge built, this need to used combined with --build
=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<-u>, B<--updatepkg>
Update the package info from L<http://www.cpan.org/>.
=item B<-s>, B<--spec>
Create package spec file
=item B<-r>, B<--root>
The root path where to build the rpm
=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<--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 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::Usage;
use File::Basename;
use LWP::UserAgent;
use Parse::CPAN::Packages;
use Pod::Simple::TextContent;
use Digest::MD5 qw(md5 md5_hex);
use File::Spec::Functions 'catfile';
# Apparently gets pulled in by another module.
#use Cwd;
our %opt;
#
# uses perl-XXX as the rpm package name
#
our $g_prefix="perl-";
our %corelist;
our $help=0;
our $compat=0;
our $g_release=1;
our $g_epoch;
our $g_disttag='';
our $g_buildrpm=0;
our $g_install=0;
our $g_create_spec=0;
our $g_get_requires=0;
our $verbose=0;
our $macros=0;
our $g_source;
our $g_rootpath=getcwd();
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 $g_updatepkg=0;
our $updated=0;
our $packages;
# 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;
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_package_details() {
return 1 if ($updated);
verbose("Updating $pkgdetails...");
mkdir_p(dirname($pkgdetails)) if (!-d dirname($pkgdetails));
fetch("$cpan/modules/" . basename($pkgdetails), $pkgdetails);
$updated=1;
}
sub prepare_build_env($) {
if (not -e $g_rootpath) {
print $g_rootpath . "does not exist\n";
exit;
}
my $spath = "$g_rootpath/srpm";
if (not -e $spath) {
mkdir $spath;
}
my $bpath = "$g_rootpath/" . md5_hex($_[0]);
if (not -e $bpath) {
mkdir $bpath;
}
return $bpath, $spath;
}
sub do_pkg_install($) {
my @arch_path = qw(noarch/ x86_64/ aarch64/);
foreach my $path (@arch_path) {
my $bdir = catfile($_[0], $path);
if (-e $bdir) {
$bdir = catfile($bdir, "*");
#
# Try to install without deps, that can help system to avoid
# circle build
#
if (system("rpm", "-ivh", "--nodeps", $bdir) != 0) {
print "install $bdir package failed"
}
}
}
}
sub build_rpm($) {
my $spec=shift;
my ($bdir, $sdir) =prepare_build_env($spec);
my $rpmbuild=(-x "/usr/bin/rpmbuild" ? "/usr/bin/rpmbuild" : "/bin/rpm");
verbose("Building " . ($g_buildrpm ? "rpms" : "source rpm") . " from $spec");
# From Fedora CVS Makefile.common.
if (system($rpmbuild, "--define", "_sourcedir $g_rootpath",
"--define", "_builddir $bdir",
"--define", "_srcrpmdir $sdir",
"--define", "_rpmdir $bdir",
($g_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";
}
}
return $bdir;
}
sub list_files($$) {
my $archive=$_[0];
my $type=$_[1];
if ($type eq 'tar') {
return $archive->list_files();
} elsif ($type eq 'zip') {
return map { $_->fileName(); } $archive->members();
}
}
sub extract($$$) {
my $archive=$_[0];
my $type=$_[1];
my $filename=$_[2];
if ($type eq 'tar') {
return $archive->get_content($filename);
} elsif ($type eq 'zip') {
return $archive->contents($filename);
}
}
sub get_description(%) {
my %args=@_;
my $pm="";
my ($summary, $description);
my $path=$args{module};
$path=~s,::,/,g;
my @pmfiles=("$args{path}/lib/$path.pod",
"$args{path}/lib/$path.pm");
if ($args{module} =~ /::/) {
my @tmp=split '/', $path;
my $last=pop @tmp;
push(@pmfiles, "$args{path}/lib/$last.pod",
"$args{path}/lib/$last.pm");
}
do {
push(@pmfiles, "$args{path}/$path.pod",
"$args{path}/$path.pm");
} while ($path=~s,^[^/]+/,,);
push(@pmfiles, "$args{path}/$args{module}")
if ($args{module} !~ /::/);
for my $file (@pmfiles) {
$pm=(grep { $_ eq $file or $_ eq "./$file" }
list_files($args{archive}, $args{type}))[0];
last if $pm;
}
if ($pm) {
verbose "Trying to fetch description from $pm...";
if (my $content=extract($args{archive}, $args{type}, $pm)) {
my $parser=Pod::Simple::TextContent->new()
or die "Pod::Simple::TextContent->new() failed: $!\n";
$parser->no_whining(1);
my $rendered="";
$parser->output_string(\$rendered);
$parser->parse_string_document($content);
if ($parser->content_seen and $rendered) {
if ($rendered=~/DESCRIPTION\s+(\S.*?)\n\n/s) {
$description=$1;
}
if ($rendered=~/NAME\s*$args{module}\s[-\s]*(\S[^\n]*)/s) {
if ($1 ne "SYNOPSIS") {
$summary=$1;
$summary=~s/[.\s]+$//;
$summary=~s/^(?:An?|The)\s+//i;
$summary=ucfirst($summary);
}
}
return($description, $summary) if (defined($description));
}
} else {
warn "Failed to read $pm from $args{filename}"
. ($args{type} eq 'tar'
? (": " . $args{archive}->error()) : "") . "\n";
}
}
if (my $readme=(sort {
length($a) <=> length($b) or $a cmp $b
} (grep /README/i, @{$args{files}}))[0]) {
verbose "Trying to fetch description from $readme...";
if (my $content=extract($args{archive}, $args{type},
"$args{path}/$readme")) {
$content=~s/\r//g; # Why people use DOS text, I'll never understand.
for my $string (split "\n\n", $content) {
$string=~s/^\n+//;
if ((my @tmp=split "\n", $string) > 2
and $string !~ /^[#\-=]/) {
return($string, undef);
}
}
} else {
warn "Failed to read $readme from $args{filename}"
. ($args{type} eq 'tar'
? (": " . $args{archive}->error()) : "") . "\n";
}
}
return(undef, 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, $repoqueryopts);
if (-x ($repoquery = '/usr/bin/dnf')) {
$repoqueryopts = "whatprovides '${dep}'"
} elsif (-x ($repoquery = '/usr/bin/repoquery')) {
$repoqueryopts = "--whatprovides '${dep}'"
} else {
return undef
}
verbose("Running $repoquery to check for $dep. This may take a while...");
my @out=`$repoquery $repoqueryopts 2>/dev/null`;
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 get_requires($) {
}
sub get_module_info($) {
my ($name, $version, $type, $file, $pkg);
$pkg = $_[0];
# Look up $file in 02packages.details.txt.
$packages=Parse::CPAN::Packages->new($pkgdetails)
if (!defined($packages));
die "Parse::CPAN::Packages->new() failed: $!\n"
if (!defined($packages));
my ($m,$d);
if ($m=$packages->package($pkg) and $d=$m->distribution()) {
$g_source=$cpan . "/authors/id/" . $d->prefix();
$file=basename($d->filename());
fetch($g_source, $file);
$name=$d->dist();
$version=$d->version();
$version=~s/^v\.?//;
if ($file =~ /\.(tar)\.gz$/) {
$type=$1;
} elsif ($file =~ /\.tgz$/) {
$type='tar';
} elsif ($file =~ /\.(zip)$/) {
$type=$1;
} else {
warn "Failed to parse '$file', skipping...\n";
return (1, $name, $version, $type, $file);
}
} else {
warn "Failed to parse '$pkg' or find a module by that name, skipping...\n";
return (1, $name, $version, $type, $file);
}
return (0, $name, $version, $type, $file);
}
sub parse_archive_file($$) {
my ($archive, $file, $type);
$file = $_[0];
$type = $_[1];
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;
}
}
$archive=Archive::Tar->new($f, 1)
or die "Archive::Tar->new() failed: $!\n";
} 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);
}
return $archive
}
sub get_license() {
}
sub get_docs($$) {
my @files = @{$_[0]};
my $path = $_[1];
my @doc=sort { $a cmp $b } grep {
!/\//
and !/\.(pl|xs|h|c|pm|in|pod|cfg|inl)$/i
and !/^\./
and $_ ne $path
and $_ ne "MANIFEST"
and $_ ne "MANIFEST.SKIP"
and $_ ne "INSTALL"
and $_ ne "SIGNATURE"
and $_ ne "META.yml"
and $_ ne "NINJA"
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 "inc"
and $_ ne "autobuild.sh"
and $_ ne "pm_to_blib"
and $_ ne "install.sh"
} @files;
return \@doc
}
sub get_spec($) {
my $specfile = $_[0];
(unlink $specfile) if (-e $specfile);
my $spec=new FileHandle "$specfile", O_WRONLY|O_CREAT|O_EXCL;
if (!$spec) {
die "Failed to create $specfile: $!\n";
}
return $spec
}
sub get_files_from_archive($$$$$) {
my ($archive, $type, $name, $version, $file) = @_;
my @files;
my $path;
my $bogus=0;
for my $entry (list_files($archive, $type)) {
if ($type eq 'tar' and $entry eq 'pax_global_header') {
next;
}
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 ($bogus) {
warn "Skipping $file with $bogus path elements!\n";
next;
}
return (\@files, $path);
}
sub get_license_from_Meta ($) {
# This list of licenses is from the Module::Build::API
# docs, cross referenced with the list of licenses in
# /usr/share/rpmlint/config.
my $meta = $_[0];
my $license;
if ($meta->{license} =~ /^perl$/i) {
$license="GPL+ or Artistic";
} elsif ($meta->{license} =~ /^apache$/i) {
$license="Apache Software License";
} elsif ($meta->{license} =~ /^artistic$/i) {
$license="Artistic";
} elsif ($meta->{license} =~ /^artistic_?2$/i) {
$license="Artistic 2.0";
} elsif ($meta->{license} =~ /^bsd$/i) {
$license="BSD";
} elsif ($meta->{license} =~ /^gpl$/i) {
$license="GPL+";
} elsif ($meta->{license} =~ /^lgpl$/i) {
$license="LGPLv2+";
} 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} =~ /^unrestricted$/i) {
$license="Distributable";
} elsif ($meta->{license} =~ /^restrictive$/i) {
$license="Non-distributable";
warn "License is 'restrictive'." . " This package should not be redistributed.\n";
} else {
warn "Unknown license '" . $meta->{license} . "'!\n";
$license="CHECK(Distributable)";
}
return $license;
}
sub get_info_from_Meta_file ($) {
my $meta = $_[0];
my (%build_requires,%requires, $license);
%build_requires=%{$meta->{build_requires}} if ($meta->{build_requires});
%requires=%{$meta->{requires}} if ($meta->{requires});
if ($meta->{recommends}) {
for my $dep (keys(%{$meta->{recommends}})) {
$requires{$dep}=$requires{$dep} || $meta->{recommends}->{$dep};
}
}
# FIXME - I'm not sure this is sufficient...
my $spt = 0;
if ($meta->{script_files} or $meta->{scripts}) {
$spt=1;
}
if ($meta->{license}) {
$license = get_license_from_Meta($meta)
}
return (\%build_requires, \%requires, $license, $spt)
}
#
# build spec file
#
sub build_spec(%) {
my %args = @_;
my $spec = $args{spec};
my %breqs = %{$args{breqs}};
my %reqs = %{$args{reqs}};
my @doc = @{$args{doc}};
print $spec <<END;
\%global _empty_manifest_terminate_build 0
Name: $g_prefix$args{name}
Version: $args{version}
Release: $g_release$g_disttag
END
print $spec "Epoch: $g_epoch\n" if (defined($g_epoch));
print $spec <<END;
Summary: $args{summary}
License: $args{license}
Group: Development/Libraries
URL: $args{url}
Source0: $g_source
END
printf $spec "%-16s%s\n", "BuildArch:", "noarch" if ($args{noarch});
if (defined($reqs{perl})) {
$breqs{perl}=$breqs{perl} || $reqs{perl};
delete $reqs{perl};
}
if (defined($breqs{perl})) {
$breqs{perl} =~ s/^[<>=]+ *//;
printf $spec "%-16s%s >= %s\n", "BuildRequires:", "perl",
(($breqs{perl} lt "5.6.0" ? "0:" : "1:")
. $breqs{perl}) if $breqs{perl};
delete $breqs{perl};
}
for my $dep (keys(%reqs)) {
$breqs{$dep}=$breqs{$dep} || $reqs{$dep};
}
#
# For most perl modules need generators, hard code here.
# Can not use perl(generators) for the reason that this is
# not a perl module, it provides some commands, need to use
# the native name of the packages
#
printf $spec "%-16s%s", "BuildRequires:", "perl-generators\n";
for my $dep (sort(keys(%breqs))) {
if (exists($corelist{$dep})) {
if (!$compat) {
next
}
}
printf $spec "%-16s%s", "BuildRequires:", "perl($dep)";
print $spec (" >= " . $breqs{$dep})
if ($breqs{$dep});
print $spec "\n";
}
for my $dep (sort(keys(%reqs))) {
next if (!$compat and exists($corelist{$dep}));
printf $spec "%-16s%s", "Requires:", "perl($dep)";
print $spec (" >= " . $reqs{$dep}) if ($reqs{$dep});
print $spec "\n";
}
if (!$compat) {
print $spec <<END;
Requires: perl(:MODULE_COMPAT_\%(eval "`\%{__perl} -V:version`"; echo \$version))
END
}
my $buildpath=$args{path};
$buildpath=~s/$args{version}/\%{version}/;
print $spec <<END;
\%description
$args{desc}
END
print $spec <<END;
\%package help
Summary : $args{summary}
Provides: $g_prefix$args{name}-doc
\%description help
$args{desc}
END
print $spec <<END;
\%prep
\%setup -q@{[(" -n $buildpath")]}
END
if (grep { $_ eq "pm_to_blib" } $args{files}) {
print $spec <<'END';
rm -f pm_to_blib
END
}
print $spec <<END;
\%build
export PERL_MM_OPT=""
END
if ($args{bdpl}) {
print $spec <<END;
\%{__perl} Build.PL --installdirs=vendor@{[$args{noarch} ? '' : qq{ --optimize="$macro{optimize}"} ]}
./Build
END
} else {
print $spec <<END;
\%{__perl} Makefile.PL INSTALLDIRS=vendor@{[$args{noarch} ? '' : qq{ OPTIMIZE="$macro{optimize}"}]}
END
print $spec
"\%{__perl} -pi -e 's/^\\tLD_RUN_PATH=[^\\s]+\\s*/\\t/' Makefile\n"
if ($compat and !$args{noarch});
print $spec <<END;
make \%{?_smp_mflags}
END
}
print $spec <<END;
\%install
export PERL_MM_OPT=""
rm -rf $macro{buildroot}
END
if ($args{bdpl}) {
print $spec
"./Build install --destdir=$macro{buildroot} --create_packlist=0\n";
} else {
print $spec <<END;
make pure_install PERL_INSTALL_ROOT=$macro{buildroot}
find $macro{buildroot} -type f -name .packlist -exec rm -f {} \\;
END
}
if (!$args{noarch}) {
print $spec <<END;
find $macro{buildroot} -type f -name '*.bs' -size 0 -exec rm -f {} \\;
END
}
print $spec <<END;
find $macro{buildroot} -depth -type d -exec rmdir {} 2>/dev/null \\;
\%{_fixperms} $macro{buildroot}/*
END
print $spec <<END;
pushd \%{buildroot}
touch filelist.lst
if [ -d usr/bin ];then
find usr/bin -type f -printf "/\%h/\%f\\n" >> filelist.lst
fi
if [ -d usr/sbin ];then
find usr/bin -type f -printf "/\%h/\%f\\n" >> filelist.lst
fi
if [ -d usr/lib64 ];then
find usr/lib64 -type f -printf "/\%h/\%f\\n" >> filelist.lst
fi
if [ -d usr/lib ];then
find usr/lib -type f -printf "/\%h/\%f\\n" >> filelist.lst
fi
popd
mv \%{buildroot}/filelist.lst .
END
print $spec <<END;
\%check@{[($compat ? ' || :' : '')]}
END
if ($args{bdpl}) {
print $spec "./Build test\n";
} else {
print $spec "make test\n";
}
print $spec <<END;
\%clean
rm -rf $macro{buildroot}
\%files -f filelist.lst
\%defattr(-,root,root,-)
\%doc @doc
END
if ($args{scripts}) {
print $spec "\%{_bindir}/*\n";
# FIXME - How do we auto-detect man pages?
}
if ($args{noarch}) {
print $spec "$args{lib}/*\n";
} else {
print $spec "$args{lib}/auto/*\n$args{lib}/" . (split /::/, $args{module})[0] . "*\n";
}
my $date=strftime("%a %b %d %Y", localtime);
print $spec <<END;
\%files help
\%{_mandir}/*
END
print $spec <<END;
\%changelog
* $date Perl_Bot <Perl_Bot\@openeuler.org> $args{version}-$g_release
- Specfile autogenerated by Perl_Bot
END
}
# 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,
'release|l=i' => \$g_release,
'epoch|e=i' => \$g_epoch,
'disttag|d=s' => \$g_disttag,
'build|b' => \$g_buildrpm,
'install|i' => \$g_install,
'cpan|c=s' => \$cpan,
'spec|s' => \$g_create_spec,
'requires|q' => \$g_get_requires,
'update|u' => \$g_updatepkg,
'verbose|v' => \$verbose,
'version' => \&print_version,
'root|r=s' => \$g_rootpath,
'prefer-macros|m' => \$macros,
) or pod2usage({ -exitval => 1, -verbose => 0 });
pod2usage({ -exitval => 0, -verbose => 1 }) if ($help);
pod2usage({ -exitval => 1, -verbose => 0 }) if (!@ARGV);
%macro = %{ $MACROS[$macros] };
my $rpm=new FileHandle "rpm -q --provides perl|"
or warn "Failed to execute rpm: $!\n";
while (my $provides=<$rpm>) {
chomp $provides;
if ($provides=~/^perl\(([^\)]+)\)(?:\s+=\s+(\S+))\s*$/) {
$corelist{$1}=defined($2) ? $2 : 0;
}
}
#
# Just do update package details info. do not proceed
#
if ($g_updatepkg) {
update_package_details();
exit
}
my @args=@ARGV;
my @processed=();
for my $pkg (@args) {
# keep things happy if we get "Foo-Bar" instead of "Foo::Bar"
$pkg =~ s/-/::/g;
my ($ret, $name,$version,$type, $file);
($ret, $name, $version, $type, $file) = get_module_info($pkg);
#
# ugly but easy&works
#
if ($ret == 1) {
next;
}
my $module=$name;
$module=~s/-/::/g;
my $archive = parse_archive_file($file, $type);
my (@files, $path, $f_ref);
($f_ref, $path) = get_files_from_archive($archive, $type, $name, $version, $file);
@files = @$f_ref;
my $url="http://search.cpan.org/dist/$name/";
$g_source=$g_source || "http://www.cpan.org/modules/by-module/"
. ($module=~/::/ ? (split "::", $module)[0] : (split "-", $name)[0])
. "/" . basename($file);
$g_source=~s/$version/\%{version}/;
my ($description,$summary)=get_description(
archive => $archive,
type => $type,
filename => $file,
name => $name,
module => $module,
version => $version,
files => \@files,
path => $path,
);
if (defined($description) and $description) {
$description=autoformat $description, { "all" => 1,
"left" => 1,
"right" => 75,
"squeeze" => 0,
};
$description=~s/\n+$//s;
} else {
$description="$module Perl module";
}
$summary="$module Perl module" if (!defined($summary));
my $doc_ref = get_docs(\@files, $path);
my @doc = @{$doc_ref};
my $noarch=!grep /\.(c|h|xs|inl)$/i, @files;
my $vendorlib=($noarch ? "vendorlib" : "vendorarch");
my $lib="\%{perl_$vendorlib}";
my $specfile="$g_prefix$name.spec";
verbose "Writing $specfile...";
my $license="";
my $scripts=0;
my (%build_requires,%requires, $br_ref, $r_ref);
my ($yml,$meta);
if (grep /^META\.yml$/, @files and $yml=extract($archive, $type, "$path/META.yml")) {
# Basic idea borrowed from Module::Depends.
my $meta;
eval { $meta=Load($yml); };
if ($@) {
warn "Error parsing $path/META.yml: $@";
goto SKIP;
}
($br_ref, $r_ref, $license, $scripts) = get_info_from_Meta_file($meta);
%build_requires = %$br_ref;
%requires = %$r_ref;
SKIP:
}
if (my @licenses=grep /license|copyright|copying/i, @doc) {
if (!$license) {
$license="Distributable, see @licenses";
} elsif ($license=~/^(OSI-Approved|Distributable|Non-distributable)$/) {
$license.=", see @licenses";
}
}
#
# If can not find license info, just quit, Do not package any unknown license
# perl modules
#
if (!$license) {
die "Unknown license\n";
}
my $usebuildpl=0;
if (grep /^Build\.PL$/, @files) {
$build_requires{'Module::Build'}=0;
$usebuildpl=1;
} else {
$build_requires{'ExtUtils::MakeMaker'}=0;
}
if (!$usebuildpl) {
# This is an ugly hack to parse any PREREQ_PM in Makefile.PL.
if (open(CHILD, "-|") == 0) {
eval {
use subs 'WriteMakefile';
sub WriteMakefile(@) {
my %args=@_;
if (!defined($args{'PREREQ_PM'})) {
return;
}
# Versioned BuildRequires aren't reliably honored by
# rpmbuild, but we'll include them anyway as a hint to the
# packager.
for my $dep (keys(%{$args{'PREREQ_PM'}})) {
print "BuildRequires: $dep";
print " " . $args{'PREREQ_PM'}->{$dep}
if ($args{'PREREQ_PM'}->{$dep});
print "\n";
}
}
};
local $/=undef;
my $makefilepl=extract($archive, $type, "$path/Makefile.PL")
or warn "Failed to extract $path/Makefile.PL";
open(STDIN, ">/dev/null");
open(STDERR, ">/dev/null");
eval "no warnings;
use subs qw(require die warn eval open close rename);
BEGIN { sub require { 1; } }
BEGIN { sub die { 1; } }
BEGIN { sub warn { 1; } }
BEGIN { sub eval { 1; } }
BEGIN { sub open { 1; } }
BEGIN { sub close { 1; } }
BEGIN { sub rename { 1; } }
$makefilepl";
exit 0;
} else {
while (<CHILD>) {
if (/^BuildRequires:\s*(\S+)\s*(\S+)?/) {
my $dep=$1;
my $version=0;
$version=$2 if (defined($2));
$build_requires{$dep}=$version;
}
}
}
}
if ($g_get_requires) {
my @bnames = keys %build_requires;
foreach (@bnames) {
print $_ . "\n";
}
my @rnames = keys %requires;
foreach (@rnames) {
print $_ . "\n";
}
exit;
}
if ($g_create_spec or $g_buildrpm) {
my $spec = get_spec($specfile);
build_spec(
spec => $spec,
name => $name,
module => $module,
version => $version,
summary => $summary,
desc => $description,
license => $license,
url => $url,
noarch => $noarch,
reqs => \%requires,
breqs => \%build_requires,
path => $path,
doc => \@doc,
files => \@files,
bdpl => $usebuildpl,
scripts => $scripts,
lib => $lib,
);
$spec->close();
}
if ($g_buildrpm) {
my $bdir = build_rpm($specfile);
if ($g_install) {
do_pkg_install($bdir);
}
}
push(@processed, $module);
}
# vi: set ai et:
此处可能存在不合适展示的内容,页面不予展示。您可通过相关编辑功能自查并修改。
如您确认内容无涉及 不当用语 / 纯广告导流 / 暴力 / 低俗色情 / 侵权 / 盗版 / 虚假 / 无价值内容或违法国家有关法律法规的内容,可点击提交进行申诉,我们将尽快为您处理。