File Coverage

blib/lib/Arepa/BuilderFarm.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Arepa::BuilderFarm;

use strict;
use warnings;

use Carp qw(croak);
use Cwd;
use File::Temp;

use Arepa::Config;
use Arepa::PackageDb;

sub new {
    my ($class, $config_path, %user_opts) = @_;

    my $config = Arepa::Config->new($config_path, %user_opts);
    my $self = bless {
        config_path => $config_path,
        config      => $config,
        package_db  => Arepa::PackageDb->new($config->get_key('package_db')),
        last_build_log => undef,
    }, $class;

    return $self;
}

sub last_build_log {
    my ($self) = @_;
    return $self->{last_build_log};
}

sub package_db {
    my ($self) = @_;
    return $self->{package_db};
}

sub get_builder_config {
    my ($self, $builder) = @_;
    return $self->{config}->get_builder_config($builder);
}

sub builder_type_module {
    my ($self, $type) = @_;
    $type =~ s/[^a-z0-9]//goi;
    return "Arepa::Builder::" . ucfirst(lc($type));
}

sub builder_module {
    my ($self, $builder_name) = @_;
    my %conf = $self->get_builder_config($builder_name);
    my $module = $self->builder_type_module($conf{type});
    eval "use $module;";
    if ($@) {
        croak "Couldn't load builder module '$module' for type '$conf{type}': $@";
    }
    return $module;
}

sub builder {
    my ($self, $builder_name) = @_;

    my $module_name = $self->builder_module($builder_name);
    return $module_name->new($self->get_builder_config($builder_name));
}

sub init_builders {
    my ($self) = @_;

    foreach my $builder ($self->{config}->get_builders) {
        $self->init_builder($builder);
    }
}

sub init_builder {
    my ($self, $builder) = @_;

    my $module = $self->builder_module($builder);
    $module->init($builder);
}

sub uninit_builders {
    my ($self) = @_;

    foreach my $builder ($self->{config}->get_builders) {
        $self->uninit_builder($builder);
    }
}

sub uninit_builder {
    my ($self, $builder) = @_;

    my $module = $self->builder_module($builder);
    $module->uninit($builder);
}

sub compile_package_from_dsc {
    my ($self, $builder_name, $dsc_file, %user_opts) = @_;
    my %opts = (output_dir => '.', %user_opts);

    my $builder = $self->builder_module($builder_name);
    my $r = $builder->compile_package_from_dsc($dsc_file, %opts);
    $self->{last_build_log} = $builder->last_build_log;
    return $r;
}

sub bin_nmu_id {
    my ($self, $source_pkg_attrs, $builder) = @_;

    my %builder_cfg = $self->{config}->get_builder_config($builder);
    my $r = scalar grep { $_ eq $source_pkg_attrs->{distribution} }
                        @{$builder_cfg{bin_nmu_for} || []};
    if ($r) {
        # NOTE: This bin_nmu_id thing is explicitly UNSUPPORTED. I'm not sure I
        # want to go down that path, but it _may_ prove useful. So I'm leaving
        # these two lines here while I make my mind. When/if I decide that it's
        # a good idea, I'll add tests and document it.
        if (exists $builder_cfg{bin_nmu_id}) {
            return $builder_cfg{bin_nmu_id};
        }
        else {
            my @builders = $self->{config}->get_builders;
            for (my $i = 0; $i < scalar @builders; ++$i) {
                return $i+1 if $builders[$i] eq $builder;
            }
            croak "Can't find builder '$builder'?!\n";
        }
    }
    else {
        return undef;
    }
}

sub compile_package_from_queue {
    my ($self, $builder_name, $request_id, %user_opts) = @_;
    my %opts = (output_dir => '.', %user_opts);

    my %request = $self->package_db->get_compilation_request_by_id($request_id);
    $self->package_db->mark_compilation_started($request_id, $builder_name);

    my $builder = $self->builder($builder_name);
    my %source_attrs = $self->package_db->get_source_package_by_id($request{source_package_id});
    $opts{bin_nmu} = $self->bin_nmu_id(\%source_attrs, $builder_name);
    my $r =
        $builder->compile_package_from_repository($source_attrs{name},
                                                  $source_attrs{full_version},
                                                  %opts);
    $self->{last_build_log} = $builder->last_build_log;

    # Save the build log
    my $build_log_dir = $self->{config}->get_key('dir:build_logs');
    my $build_log_path = File::Spec->catfile($build_log_dir,
                                             $request_id);
    open F, ">$build_log_path" or croak "Can't write in $build_log_path";
    print F $self->{last_build_log};
    close F;

    # Mark the compilation request appropriately
    if ($r) {
        $self->package_db->mark_compilation_completed($request_id);
    }
    else {
        $self->package_db->mark_compilation_failed($request_id);
    }
    return $r;
}

sub request_package_compilation {
    my ($self, $source_id) = @_;

    foreach my $target ($self->get_compilation_targets($source_id)) {
        my ($arch, $dist) = @$target;
        $self->{package_db}->request_compilation($source_id, $arch, $dist);
    }
}

sub get_compilation_targets {
    my ($self, $source_id) = @_;

    my %source_attrs = $self->{package_db}->get_source_package_by_id($source_id);
    my @builders = $self->get_matching_builders($source_attrs{architecture},
                                                $source_attrs{distribution});
    return map {
               my %builder_config = $self->{config}->get_builder_config($_);
               $source_attrs{architecture} eq 'any' ?
                   [$builder_config{architecture},
                    $builder_config{distribution}]  :
                   [$source_attrs  {architecture},
                    $builder_config{distribution}];
           } @builders;
}

sub get_matching_builders {
    my ($self, $arch, $distro) = @_;

    # Get the builder information once
    my @builder_information = map { { $self->{config}->get_builder_config($_) } }
                                  $self->{config}->get_builders;

    # Get builders that match *both*:
    return map {
                $_->{name}
           }
           # 1) the architecture in 'architecture' (or 'all' if applicable)
           grep {
               ($arch eq 'any'                            ||
                $arch eq $_->{architecture}               ||
                ($arch eq 'all' && $_->{architecture_all}));
           }
           # 2) the $distro in *either* 'distribution' or
           #    'distribution_aliases'
           grep {
               my @bdistros = ref($_->{distribution_aliases}) eq 'ARRAY' ?
                                   @{$_->{distribution_aliases}} :
                                   $_->{distribution_aliases};
               my @binnmu_distros = ref($_->{bin_nmu_for}) eq 'ARRAY' ?
                                                 @{$_->{bin_nmu_for}} :
                                                 ($_->{bin_nmu_for} || ());

               $distro eq $_->{distribution} ||
                   grep({ $distro eq $_ } @bdistros) ||
                   grep({ $distro eq $_ } @binnmu_distros);
           }
           @builder_information;
}

sub register_source_package {
    my ($self, %source_attrs) = @_;

    my $pdb = $self->package_db;
    my $source_id = $pdb->get_source_package_id($source_attrs{name},
                                                $source_attrs{full_version});
    if (!defined $source_id) {
        $source_id = $pdb->insert_source_package(%source_attrs);
    }
    return $source_id;
}

sub canonical_distribution {
    my ($self, $arch, $distribution) = @_;

    my @builders = $self->get_matching_builders($arch, $distribution);
    my $distro;
    foreach my $b (@builders) {
        my %builder_cfg = $self->{config}->get_builder_config($b);
        if (grep { $_ eq $distribution }
                 @{$builder_cfg{distribution_aliases}},
                 $builder_cfg{distribution}) {
            # There should be only one; if there's more than one, that's a
            # problem
            if ($distro) {
                croak "There is more than one builder that " .
                        "specifies '$distribution' as alias. " .
                        "That's not correct! One of them " .
                        "should specify it as bin_nmu_for";
            }
            $distro = $builder_cfg{distribution};
        }
    }
    return $distro;
}

1;

__END__