File Coverage

blib/lib/CPANPLUS/Dist/SUSE.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package CPANPLUS::Dist::SUSE;
our $VERSION = '0.03';

use strict;
use warnings;
use base 'CPANPLUS::Dist::RPM';

use English;
# imports error(), msg()
use CPANPLUS::Error;
use IPC::Cmd qw{ run can_run };
use Path::Class;
use SUPER;

=head1 NAME

CPANPLUS::Dist::SUSE - To build RPM files from cpan for SUSE

=head1 VERSION

Version 0.03

=cut

=head1 SYNOPSIS

CPANPLUS::Dist::SUSE is a distribution class to create SUSE packages
from CPAN modules, and all its dependencies. This allows you to have
the most recent copies of CPAN modules installed, using your package
manager of choice, but without having to wait for central repositories
to be updated.

You can either install them using the API provided in this package, or
manually via rpm.

This is a simple module which inherits from CPANPLUS::Dist::RPM that
allows for creating RPM packages under SUSE. In particular, this
RPM spec file has been tested in SLES 11.

It also honors Module::Build if Build.PL is in the distribution.

Simple way of creating and installing a module is:

 cpan2dist --verbose --format CPANPLUS::Dist::SUSE --buildprereq --dist-opts="--replacefiles=" --install Module::Builder

"--replacefiles=" can be used when you want to install with rpm option
"--replacefiles"

You can also check for CPANPLUS::Dist::Fedora for information.

=head1 SUBROUTINES/METHODS

=head2 format_available

Checks if /etc/SuSE-release file exists

=cut

sub format_available {

    # Check SUSE release file
    if ( !-f '/etc/SuSE-release' ) {
        error('Not on a SUSE system');
        return 0;
    }

    return super;
}

# my $bool = $self->_has_been_built;
#
# Returns true if there's already a package built for this module.
#
sub _has_been_built {
    my ( $self, $name, $vers ) = @_;

    # FIXME this entire method should be overridden to first check the local
    # rpmdb, then check the yum repos via repoquery.  As is we're pretty
    # broken right now
    #
    # For now, just call super
    return super;
}

sub _is_module_build_compat {
    my $self = shift @_;
    my $module = shift @_ || $self->parent;

    my $makefile = $module->_status->extract . '/Makefile.PL';

    #my $buildfile = $module->_status->extract . '/Build.PL';
    if ( !-f $makefile ) {
        return 0;
    }
    $makefile = file $makefile;
    my $content = $makefile->slurp;

    return $content =~ /Module::Build::Compat/;
}

=head2 install

Overrides the install method of RPM allowing for extra
rpm install arguments in dist-opts, be aware that you
need to specify it as

cpan2dist ... --dist-opts="--aid= --allfiles= --relocate=/a=/b"

        --aid --allfiles --badreloc
        --excludedocs --force -h,--hash
        --ignoresize --ignorearch --ignoreos
        --includedocs --justdb --nodeps
        --nodigest --nosignature --nosuggest
        --noorder --noscripts --notriggers
        --oldpackage --percent
        --repackage --replacefiles --replacepkgs
        --test

=cut

sub install {
    my $self                = shift @_;
    my %opts                = $self->_parse_args(@_);
    my @valid_singleoptions = (
        "--aid",       "--allfiles",     "--badreloc",    "--excludedocs",
        "--force",     "--hash",         "--ignoresize",  "--ignorearch",
        "--ignoreos",  "--includedocs",  "--justdb",      "--nodeps",
        "--nodigest",  "--nosignature",  "--nosuggest",   "--noorder",
        "--noscripts", "--notriggers",   "--oldpackage",  "--percent",
        "--repackage", "--replacefiles", "--replacepkgs", "--test"
    );

    #my $rpm = $self->status->rpm;

    my $otheropts = '';

    foreach my $o (@valid_singleoptions) {
        $otheropts .= $o if ( exists( $opts{$o} ) );
    }

    my $rpmcmd = 'rpm -Uvh ' . $otheropts . ' ' . $self->status->rpmpath;

    if ( $EUID != 0 ) {

        msg 'trying to invoke rpm via sudo';

        $rpmcmd = "sudo $rpmcmd";
    }

    my $buffer;

    my $success = run(
        command => $rpmcmd,
        verbose => $opts{verbose},
        buffer  => \$buffer,
    );

    if ( !( defined($success) ) || not $success ) {
        error "error installing! ($success)";
        printf STDERR $buffer;

        #die;
        return $self->status->installed(0);
    }

    return $self->status->installed(1);
}
1;

__DATA__