package Ovid::Package;
use strict;
use Ovid::Common;
use Ovid::Error;
use POSIX qw/strftime/;
use File::Basename;
use File::Copy;
@Ovid::Package::ISA = qw(Ovid::Common Ovid::Error);
our @macros = qw(rpmdir sourcedir specdir);
sub accessors
{
return {scalar => [qw(forcebuild logfile skipbuild rpm_bin rpmbuild_bin
rpm_name name version builder basedir license installdirs
archive description date buildroot tmpdir build_dir packager), @macros],
array => [qw(provides requires)]};
}
sub defaults
{
return {
license => 'Perl/Artistic License?',
date => POSIX::strftime('%a %b %d %Y', localtime()),
};
}
sub init
{
my $self = shift;
#Find binaries.
my @bin = qw(rpm);
while (my $b = pop @bin){
my $bin = $self->find_exec($b);
fatal "cannot find required binary [$b]" unless $bin;
my $n = "${b}_bin";
if (my $s = $self->can($n)){
$s->($self, $bin);
}
else {
fatal "required accessor [$n] is undeclared";
}
#rpm 4.x uses rpmbuild instead of rpm
if ($b eq 'rpm'){
my $t = `$bin --version`;
if ($t =~ m/3.\d.\d\s*$/){
$self->rpmbuild_bin($bin);
}
else {
push @bin, 'rpmbuild';
}
}
}
$self->load_macros(@macros);
}
sub interrogate
{
my ($self, $obj) = @_;
my %map = (
'version' => 'cpan_version',
'archive' => 'cpan_file',
'provides' => 'containsmods',
);
while (my ($k, $v) = each %map){
if ($obj->can($v)){
my ($name, $type) = split /:/, $k;
if (my $sub = $self->can($name)){
$sub->($self, $obj->$v());
}
else {
fatal "required accessor [$name] is undeclared";
}
}
}
$self->parse_archive;
}
sub load_macros
{
my $self = shift;
my $rpm_bin = $self->rpm_bin;
for my $m (@_){
my $s = qq[%{_${m}}];
my $t = qx/$rpm_bin --eval '$s'/;
chomp $t;
fatal "rpm macro [$m] is undefined" if $s eq $t;
$self->$m($t);
}
}
sub get_description
{
my ($self, $buildir) = @_;
my $f = qq[$buildir/README];
if (-f $f){
if (open(F, $f)){
my @t;
while(<F>){
push @t, $_;
last if /^INSTALL/;
}
close F;
if (@t){
$self->description(join '', @t);
return 1;
}
}
}
}
sub specfile
{
my $self = shift;
my $n = $self->name_string;
my $d = $self->specdir;
return qq[${d}/perl-${n}.spec];
}
sub provreq
{
my ($self,$name, $op, $version) = @_;
my @x = (qq[perl($name)]);
if ($version && $version ne '0'){
push @x, $op, $version;
}
return join ' ', @x;
}
sub requires_string
{
my $self = shift;
my @t = @_ || $self->requires;
return unless scalar @t;
my @out;
for my $r (@t)
{
push @out, $self->provreq($r->{name}, '>=', $r->{version});
}
return unless @out;
return join('', 'Requires: ', join ' ', @out);
}
sub provides_string
{
my $self = shift;
my @t = $self->provides;
return unless @t;
my @out;
for my $n (@t){
push @out, $self->provreq($n);
}
return join('', 'Provides: ', join ' ', @out);
}
sub name_string
{
my $self = shift;
my %args = @_;
my @name = ($self->rpm_name);
#$name[0] =~ s/::/-/g;
push(@name, '-', $self->version) if exists $args{with_version};
unshift(@name, 'perl-') if exists $args{prefixed};
return join '', @name;
}
sub parse_archive
{
my $self = shift;
my $t = $self->archive;
if ($t =~ /^Contact Author/) {
fatal "package [@{[$self->name]}] says: $t\n";
}
$t =~ s/(\.(?:tar\.gz|tgz|zip|gz|pm\.gz|pm))$//;
if ($t =~ m<([^/]+?)[-._]?v?-?([-_.\d]+[a-z]*?\d*)$>){
$self->rpm_name($1);
$self->version($2);
}
else {
fatal "cannot parse archive name [@{[$self->archive]}]";
}
}
sub make_spec
{
my ($self) = @_;
my $t = $self->accessors;
my %macros;
for my $m (@{$t->{scalar}}){
$macros{$m} = $self->$m;
}
$macros{buildroot} ||= $self->tmpdir;
#not much savings here with 3 items
for my $n (qw(provides requires name)){
my $sub_name = qq[${n}_string];
if (my $sub_ref = $self->can($sub_name)){
$macros{$n} = $sub_ref->($self);
}
else {
fatal "required accessor [$sub_name] is not defined";
}
}
for my $t (qw(builder archive build_dir)){
$macros{$t} = basename($macros{$t});
}
my $template = $self->spec_template();
while (my ($name, $value) = each %macros)
{
$template =~ s/\@$name\@/$value/ge;
}
my $specfile = $self->specfile;
open(F, ">$specfile") or fatal "cannot open spec file for writing. $!";
print F $template;
close F;
return $specfile;
}
sub make_rpm
{
my $self = shift;
my $specfile = $self->make_spec;
return if $self->skipbuild;
unless ($self->forcebuild){
if (my $t = $self->rpm_is_installed){
info "skipping rebuild for installed rpm $t";
return;
}
if (my $t = $self->rpm_is_on_disk){
info "skipping rebuild for existing rpm file $t";
return;
}
}
$self->copy_sources;
system($self->rpmbuild_bin, '-ba', $specfile);
}
sub rpm_is_installed
{
my ($self) = @_;
my $rpm_bin = $self->rpm_bin;
my $version = $self->version;
for my $name_ver ($self->name_string(with_version => 1),
$self->name_string(with_version => 1, prefixed => 1)){
#old versions of rpm print errors to stderr, while new ones send to stdout.
my $t = qx(exec 2>&1; $rpm_bin -q $name_ver --queryformat '%{version}');
chomp $t;
if ($t =~ /^$version/){
return $name_ver;
}
}
}
sub rpm_is_on_disk
{
my ($self, $dir) = @_;
$dir ||= $self->rpmdir;
my @names = ($self->name_string(with_version => 1),
$self->name_string(with_version => 1, prefixed => 1));
my $found;
opendir(D, $dir) or fatal "cannot open directory $dir. $!";
my @dirs;
MAIN:
for my $t (readdir(D))
{
my $p =qq[$dir/$t];
if ( -d $p ){
push @dirs, $p unless $t =~ /^\.\.?$/;
}
else {
for my $name_ver (@names){
if ($t =~ /^$name_ver/){
$found=$name_ver;
last MAIN;
}
}
}
}
closedir (D);
return $found if $found;
for my $d (@dirs){
if (my $t = $self->rpm_is_on_disk($d)){
return $t;
}
}
return undef;
}
sub copy_sources
{
my $self = shift;
my $source = join('/', $self->basedir, $self->archive);
my $target = join('/', $self->sourcedir, basename($source));
unless(copy($source, $target)){
warning "error copying file [$source] to [$target]. $!";
}
}
sub spec_template
{
return(<<'EOF');
%define _unpackaged_files_terminate_build 0
Summary: perl-@name@
Name: perl-@name@
Version: @version@
Release: 1
License: @license@
Group: Applications/CPAN
Source: @archive@
BuildRoot: @buildroot@/@name@
Packager: @packager@
AutoReq: no
AutoReqProv: no
@requires@
@provides@
%description
@description@
%prep
%setup -q -n @build_dir@
%build
CFLAGS="$RPM_OPT_FLAGS $CFLAGS" perl @builder@
make
%clean
if [ "%{buildroot}" != "/" ]; then
rm -rf %{buildroot}
fi
%install
make PREFIX=%{_prefix} \
DESTDIR=%{buildroot} \
INSTALLDIRS=@installdirs@ \
install
[ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress
find ${RPM_BUILD_ROOT} \
\( -path '*/perllocal.pod' -o -path '*/.packlist' -o -path '*.bs' \) -a -prune -o \
-type f -printf "/%%P\n" > @name@-filelist
if [ "$(cat @name@-filelist)X" = "X" ] ; then
echo "ERROR: EMPTY FILE LIST"
exit 1
fi
%files -f @name@-filelist
%defattr(-,root,root)
%changelog
* @date@ @packager@
- Initial build
EOF
}
1;