File Coverage

blib/lib/RPM/Make/Simple.pm

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

package RPM::Make::Simple;

use strict;
use warnings;

use RPM::Make;
use File::Copy;
use File::Path;
use Carp;

our $VERSION = '0.03';

# parameter => default
# '' denotes mandatory parameter
my %param_defs = (
    arch => '',
    version => '0.01',
    release => '1',
    name => '',
    build_root => './build',
    temp_build_loc => 'temp_build_loc'
);

sub new {
    my($proto, %params) = @_;
    my $self = {};
    my $class = ref($proto) || $proto;

    bless ($self, $class);

    while(my($param, $val) = each(%param_defs)) {
        if(($val eq '') && (!defined $params{$param})) {
            croak("Undefined mandatory parameter $param");
        }

        if(defined $params{$param}) {
            $self->{$param} = $params{$param};
        }
        else {
            $self->{$param} = $val;
        }
    }

    $self->{requires} = [];

    return($self);
}

my %built_dirs;

# Causes health check nightmares, left here for legacy reasons
sub FilePerms {
    my ($self, %file_perms) = @_;

    while(my($file, $perms) = each(%file_perms)) {
        my $file_build_path = $self->{build_root}."/".$file;

        croak("No such file $file in ".$self->{build_root})
            if(!-e $file_build_path);

        croak("Cannot modify $file in ".$self->{build_root})
            if(!chmod($perms, $file_build_path));
    }
}

sub Clean {
    my($self) = shift;

    rmtree($self->{build_root});
}

sub Files {
    my ($self, %locs) = @_;

    my $err = 0;

    while(my($from, $to) = each(%locs)) {
        if(!-e $from) {
            carp("From file $from does not exist");
            $err++;
            next;
        }
        if(-d $from) {
            carp("From file $from is a directory, won't build");
            $err++;
            next;
        }

        my $new_dir = $to;

        if($to =~ /\/$/) {
            my @to_parts = split(/\//, $from);
            $to .= pop(@to_parts);
        }
        else {
            $new_dir =~ s/\/[^\/]*$//;
        }

        if(!defined $built_dirs{$new_dir}) {
            mkpath([$self->{build_root}."/$new_dir"], 1, 0711);
            $built_dirs{$new_dir} = 1;
        }

        print("$from, $self->{build_root}.\"/$to\"\n");

        copy($from, $self->{build_root}."/$to");
        push(@{$self->{build_files}}, $self->{build_root}."/$to");
    }

    croak("Encountered $err errors, cannot proceed") if($err > 0);
}

sub _check_file {
    my($self, @files) = @_;

    my @missing_file;

    foreach(@files) {
        my $file = $_;

        if(!-e $self->{build_root}."/$file") {
            push(@missing_file, $file);
        }
    }

    return join(', ', @missing_file);
}

sub Doc {
    my($self, @docs) = @_;

    my $missing = $self->_check_file(@docs);

    croak("Document files missing in ".$self->{build_root}.": $missing")
        if($missing);

    $self->{doc} = { map {$_ => 1} @docs };
}

sub Conf {
    my($self, @conf) = @_;

    my $missing = $self->_check_file(@conf);

    croak("Config files missing in ".$self->{build_root}.": $missing")
        if($missing);

    $self->{conf} = { map {$_ => 1} @conf };
}

sub ConfNoReplace {
    my($self, @conf_no_replace) = @_;

    my $missing = $self->_check_file(@conf_no_replace);

    croak("Non-replacable config files missing in ".$self->{build_root}.
          ": $missing") if($missing);

    $self->{confnoreplace} = { map {$_ => 1} @conf_no_replace };
}

sub Requires {
    my ($self, %reqs) = @_;

    while(my($req_pack, $req_ver) = each(%reqs)) {
        my $pre_req = "PreReq: $req_pack";

        # if we have a version defined, use that too
        if(defined $req_ver) {
            $pre_req .= " >= $req_ver";
        }
        push(@{$self->{requires}}, $pre_req);
    }
}

# all of these are mandatory. if the value is '1' then it's case sensitive
my %req_metadata = (
    summary => 0,
    vendor => 0,
    group => 0,
    AutoReqProv => 1
);

my %metadata;

# nightmarishly complicated!
sub MetaData {
    my $self = shift;

    carp("RPM name already defined")
        if(defined $_->{name});

    %metadata = @_;
}

sub Build {
    my($self) = shift;

    $metadata{requires} = $self->{requires};
    $metadata{name} = $self->{name};

    my $bad_meta;
    foreach(keys(%req_metadata)) {
        my $tag = $_;
        $tag = lc($tag) if($req_metadata{$_} ne '1');
        if(!defined $metadata{$tag}) {
            my $msg = "Undefined mandatory metadata tag '$tag'";
            $msg .= ", this tag is case sensitive"
                if($req_metadata{$_} eq '1');

            carp($msg);
            $bad_meta = 1;
        }
    }

    croak("Fatal error, there's some undefined metadata") if($bad_meta);

    eval {
        RPM::Make::execute($self->{name}, $self->{version}, $self->{release},
                           $self->{arch}, $self->{temp_build_loc},
                           $self->{build_root}, $self->{build_files},
                           $self->{doc}, $self->{conf}, $self->{confnoreplace},
                           \%metadata);
    };
    if($@) {
        croak($!);
    }

    return(1);
}

sub DESTROY {
    my($self) = shift;
    rmtree($self->{temp_build_loc})	if($self->{temp_build_loc});
}

1;

__END__