SecBSD's official ports repository
This commit is contained in:
commit
2c0afcbbf3
GPG key ID:
F42C07F07E2E35B7
64331 changed files with 5339189 additions and 0 deletions
779
infrastructure/lib/DPB/Engine.pm
Normal file
779
infrastructure/lib/DPB/Engine.pm
Normal file
|
|
@ -0,0 +1,779 @@
|
|||
# ex:ts=8 sw=4:
|
||||
# $OpenBSD: Engine.pm,v 1.151 2023/07/07 14:43:56 espie Exp $
|
||||
#
|
||||
# Copyright (c) 2010-2013 Marc Espie <espie@openbsd.org>
|
||||
#
|
||||
# Permission to use, copy, modify, and distribute this software for any
|
||||
# purpose with or without fee is hereby granted, provided that the above
|
||||
# copyright notice and this permission notice appear in all copies.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
|
||||
use v5.36;
|
||||
|
||||
use DPB::Limiter;
|
||||
use DPB::SubEngine;
|
||||
use DPB::ErrorList;
|
||||
use DPB::Queue;
|
||||
use Time::HiRes;
|
||||
|
||||
package DPB::Engine;
|
||||
our @ISA = qw(DPB::Limiter);
|
||||
|
||||
use DPB::Heuristics;
|
||||
use DPB::Util;
|
||||
|
||||
# this is the main dpb engine, responsible for moving stuff that can
|
||||
# be built to the right location, and starting the actual builds
|
||||
|
||||
# - it delegates to a subengine class for actually doing stuff
|
||||
# (e.g., build/fetch/roach)
|
||||
|
||||
# - it's responsible for (more or less) monitoring locks and errors
|
||||
|
||||
sub new($class, $state)
|
||||
{
|
||||
my $o = bless {built => DPB::HashQueue->new,
|
||||
tobuild => DPB::HashQueue->new,
|
||||
state => $state,
|
||||
installable => DPB::HashQueue->new,
|
||||
heuristics => $state->heuristics,
|
||||
sizer => $state->sizer,
|
||||
locker => $state->locker,
|
||||
logger => $state->logger,
|
||||
affinity => $state->{affinity},
|
||||
errors => DPB::ErrorList->new,
|
||||
locks => DPB::LockList->new,
|
||||
nfslist => DPB::NFSList->new,
|
||||
built_packages => 0,
|
||||
requeued => DPB::ListQueue->new,
|
||||
ignored => DPB::ListQueue->new}, $class;
|
||||
$o->set_current_time;
|
||||
$o->{buildable} = $class->build_subengine_class($state)->new($o,
|
||||
$state->builder);
|
||||
$o->{tofetch} = $class->fetch_subengine_class($state)->new($o);
|
||||
$o->{toroach} = $class->roach_subengine_class($state)->new($o);
|
||||
$o->{log} = $state->logger->append("engine");
|
||||
$o->{stats} = DPB::Stats->new($state);
|
||||
return $o;
|
||||
}
|
||||
|
||||
sub set_current_time($self)
|
||||
{
|
||||
my $ts = Time::HiRes::time();
|
||||
$self->{ts} = $ts;
|
||||
$self->{timestring} = DPB::Util->ts2string($ts);
|
||||
if ($self->{state}->defines('EXTRA_TS')) {
|
||||
require DPB::ISO8601;
|
||||
state $ts2 = 0;
|
||||
state $extra = '';
|
||||
my $ts3 = int($ts);
|
||||
if ($ts2 != $ts3) {
|
||||
$ts2 = $ts3;
|
||||
$extra = DPB::ISO8601->time2string($ts2);
|
||||
}
|
||||
$self->{timestring}.="($extra)";
|
||||
}
|
||||
}
|
||||
|
||||
sub dump_queue($self, @l)
|
||||
{
|
||||
$self->{buildable}->dump_queue(@l);
|
||||
}
|
||||
|
||||
sub build_subengine_class($class, $state)
|
||||
{
|
||||
if ($state->{fetch_only}) {
|
||||
return "DPB::SubEngine::Dummy";
|
||||
} else {
|
||||
require DPB::SubEngine::Build;
|
||||
return "DPB::SubEngine::Build";
|
||||
}
|
||||
}
|
||||
|
||||
sub fetch_subengine_class($class, $state)
|
||||
{
|
||||
if ($state->{want_fetchinfo}) {
|
||||
require DPB::SubEngine::Fetch;
|
||||
return "DPB::SubEngine::Fetch";
|
||||
} else {
|
||||
return "DPB::SubEngine::Dummy";
|
||||
}
|
||||
}
|
||||
|
||||
sub roach_subengine_class($class, $state)
|
||||
{
|
||||
if ($state->{roach}) {
|
||||
require DPB::SubEngine::Roach;
|
||||
return "DPB::SubEngine::Roach";
|
||||
} else {
|
||||
return "DPB::SubEngine::Dummy";
|
||||
}
|
||||
}
|
||||
|
||||
# forwarder for the wipe external command
|
||||
sub wipe($o, @l)
|
||||
{
|
||||
$o->{buildable}->start_wipe(@l);
|
||||
}
|
||||
|
||||
sub status($self, $v)
|
||||
{
|
||||
# each path is in one location only
|
||||
# this is not efficient but we don't care, as this is user ui
|
||||
for my $k (qw(built tobuild installable buildable errors locks nfslist)) {
|
||||
if ($self->{$k}->contains($v)) {
|
||||
return $k;
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub recheck_errors($self)
|
||||
{
|
||||
# XXX we can't do an OR because we want to run every single one
|
||||
# even though we only care that one did break
|
||||
my $problems = $self->{errors}->recheck($self) +
|
||||
$self->{locks}->recheck($self) +
|
||||
$self->{nfslist}->recheck($self);
|
||||
return $problems != 0;
|
||||
}
|
||||
|
||||
sub log_same_ts($self, $kind, $v = undef, $extra = '')
|
||||
{
|
||||
my $fh = $self->{log};
|
||||
print $fh "$$\@$self->{timestring}: $kind";
|
||||
if (defined $v) {
|
||||
print $fh ": ", $v->logname;
|
||||
if (defined $extra) {
|
||||
print $fh " ", $extra;
|
||||
}
|
||||
}
|
||||
print $fh "\n";
|
||||
}
|
||||
|
||||
sub log($self, @l)
|
||||
{
|
||||
$self->set_current_time;
|
||||
$self->log_same_ts(@l);
|
||||
}
|
||||
|
||||
sub log_as_built($self, $v)
|
||||
{
|
||||
my $n = $v->fullpkgname;
|
||||
my $fh = $self->{logger}->append("built-packages");
|
||||
$self->{built_packages}++;
|
||||
print $fh "$n.tgz\n";
|
||||
}
|
||||
|
||||
sub flush_log($self)
|
||||
{
|
||||
$self->{log}->flush;
|
||||
}
|
||||
|
||||
# returns the number of distfiles to fetch
|
||||
# XXX side-effect: changes the heuristics based
|
||||
# on actual Q number, e.g., tries harder to
|
||||
# fetch if the queue is "low" (30, not tweakable)
|
||||
# and doesn't really care otherwise
|
||||
sub fetchcount($self, $q)
|
||||
{
|
||||
return () if $self->{tofetch}->is_dummy;
|
||||
if ($self->{state}{fetch_only}) {
|
||||
$self->{tofetch}{queue}->set_fetchonly;
|
||||
} elsif ($q < 30) {
|
||||
$self->{tofetch}{queue}->set_h1;
|
||||
} else {
|
||||
$self->{tofetch}{queue}->set_h2;
|
||||
}
|
||||
return ("F=".$self->{tofetch}->count);
|
||||
}
|
||||
|
||||
sub statline($self)
|
||||
{
|
||||
my $q = $self->{buildable}->count;
|
||||
return join(" ",
|
||||
"I=".$self->{installable}->count,
|
||||
"B=".$self->{built}->count,
|
||||
"Q=$q",
|
||||
"T=".$self->{tobuild}->count,
|
||||
$self->fetchcount($q));
|
||||
}
|
||||
|
||||
# see next method, don't bother adding stuff if not needed.
|
||||
sub may_add($self, $prefix, $s)
|
||||
{
|
||||
if ($s eq '') {
|
||||
return '';
|
||||
} else {
|
||||
return "$prefix$s\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub report_tty($self, $state)
|
||||
{
|
||||
my $q = $self->{buildable}->count;
|
||||
my $t = $self->{tobuild}->count;
|
||||
return join(" ",
|
||||
$self->statline,
|
||||
"!=".$self->{ignored}->count)."\n".
|
||||
$self->may_add("L=", $self->{locks}->stringize).
|
||||
$self->may_add("E=", $self->{errors}->stringize).
|
||||
$self->may_add("H=", $self->{nfslist}->stringize);
|
||||
}
|
||||
|
||||
sub stats($self)
|
||||
{
|
||||
$self->{stats}->log($self->{ts}, $self->statline);
|
||||
}
|
||||
|
||||
sub report_notty($self, $state)
|
||||
{
|
||||
$self->{lasterrors} //= 0;
|
||||
if (@{$self->{errors}} != $self->{lasterrors}) {
|
||||
$self->{lasterrors} = @{$self->{errors}};
|
||||
return "Error in ".join(' ', map {$_->fullpkgpath} @{$self->{errors}})."\n";
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub adjust($self, $v, $kind, $kind2 = undef)
|
||||
{
|
||||
return 0 if !exists $v->{info}{$kind};
|
||||
my $not_yet = 0;
|
||||
# XXX don't use `values` in this loop, it may trigger perlbug 77706
|
||||
my @values = values %{$v->{info}{$kind}};
|
||||
for my $d (@values) {
|
||||
$self->{heuristics}->mark_depend($d, $v);
|
||||
if ($self->{installable}{$d} ||
|
||||
(defined $d->{info} &&
|
||||
$d->fullpkgname eq $v->fullpkgname)) {
|
||||
delete $v->{info}{$kind}{$d};
|
||||
$v->{info}{$kind2}{$d} = $d if defined $kind2;
|
||||
} else {
|
||||
$not_yet++;
|
||||
}
|
||||
}
|
||||
return $not_yet if $not_yet;
|
||||
delete $v->{info}{$kind};
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub missing_dep($self, $v, $kind)
|
||||
{
|
||||
return undef if !exists $v->{info}{$kind};
|
||||
for my $d (values %{$v->{info}{$kind}}) {
|
||||
return $d if (defined $d->{info}) && $d->{info}{IGNORE};
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub stub_out($self, $v)
|
||||
{
|
||||
push(@{$self->{ignored}}, $v);
|
||||
|
||||
# keep the info if it exists, make sure it's stubbed out otherwise
|
||||
my $i = $v->{info};
|
||||
$v->{info} = DPB::PortInfo->stub;
|
||||
return if !defined $i;
|
||||
for my $w ($v->build_path_list) {
|
||||
# don't fill in equiv lists if they don't matter.
|
||||
next if !defined $w->{info};
|
||||
if ($w->{info} eq $i) {
|
||||
$w->{info} = DPB::PortInfo->stub;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# need to ignore $v because of some missing $kind dependency:
|
||||
# wipe out its info and put it in the right list
|
||||
sub should_ignore($self, $v, $kind)
|
||||
{
|
||||
if (my $d = $self->missing_dep($v, $kind)) {
|
||||
$self->log_same_ts('!', $v, "because of ".$d->fullpkgpath);
|
||||
$self->stub_out($v);
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub has_known_depends($self, $v)
|
||||
{
|
||||
for my $kind (qw(DEPENDS BDEPENDS)) {
|
||||
next unless defined $v->{info}{$kind};
|
||||
for my $d (values %{$v->{info}{$kind}}) {
|
||||
return 0 unless $d->has_fullpkgname;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub adjust_extra($self, $v, $kind, $kind2)
|
||||
{
|
||||
return 0 if !exists $v->{info}{$kind};
|
||||
my $not_yet = 0;
|
||||
for my $d (values %{$v->{info}{$kind}}) {
|
||||
$self->{heuristics}->mark_depend($d, $v);
|
||||
if ((defined $d->{info} && !$self->{tobuild}{$d} &&
|
||||
$self->has_known_depends($d)) ||
|
||||
($d->has_fullpkgname &&
|
||||
$d->fullpkgname eq $v->fullpkgname)) {
|
||||
if ($self->adjust_distfiles($d)) {
|
||||
$not_yet++;
|
||||
} else {
|
||||
delete $v->{info}{$kind}{$d};
|
||||
$v->{info}{$kind2}{$d} = $d if defined $kind2;
|
||||
}
|
||||
} else {
|
||||
$not_yet++;
|
||||
}
|
||||
}
|
||||
return $not_yet if $not_yet;
|
||||
delete $v->{info}{$kind};
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub adjust_distfiles($self, $v)
|
||||
{
|
||||
return 0 if !exists $v->{info}{FDEPENDS};
|
||||
my $not_yet = 0;
|
||||
for my $f (values %{$v->{info}{FDEPENDS}}) {
|
||||
if ($self->{tofetch}->is_done($f)) {
|
||||
$v->{info}{distsize} //= 0;
|
||||
$v->{info}{distsize} += $f->{sz};
|
||||
delete $v->{info}{FDEPENDS}{$f};
|
||||
next;
|
||||
}
|
||||
$not_yet++;
|
||||
}
|
||||
return $not_yet if $not_yet;
|
||||
delete $v->{info}{FDEPENDS};
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $output = {};
|
||||
|
||||
sub adjust_built($self)
|
||||
{
|
||||
my $changes = 0;
|
||||
|
||||
for my $v (values %{$self->{built}}) {
|
||||
if ($self->adjust($v, 'RDEPENDS') == 0) {
|
||||
delete $self->{built}{$v};
|
||||
# okay, thanks to equiv, some other path was marked
|
||||
# as stub, and obviously we lost our deps
|
||||
if ($v->{info}->is_stub) {
|
||||
$self->log_same_ts('!', $v,
|
||||
"equivalent to an ignored path");
|
||||
# just drop it, it's already ignored as
|
||||
# an equivalent path
|
||||
next;
|
||||
}
|
||||
$self->{installable}{$v} = $v;
|
||||
if ($v->{wantinstall}) {
|
||||
$self->{buildable}->will_install($v);
|
||||
}
|
||||
$self->log_same_ts('I', $v,'# '.$v->fullpkgname);
|
||||
$changes++;
|
||||
} elsif ($self->should_ignore($v, 'RDEPENDS')) {
|
||||
delete $self->{built}{$v};
|
||||
$changes++;
|
||||
}
|
||||
}
|
||||
return $changes;
|
||||
}
|
||||
|
||||
sub adjust_depends1($self, $v, $has)
|
||||
{
|
||||
$has->{$v} = $self->adjust($v, 'DEPENDS', 'BDEPENDS');
|
||||
}
|
||||
|
||||
sub adjust_depends2($self, $v, $has)
|
||||
{
|
||||
if ($has->{$v} != 0) {
|
||||
if (my $d = $self->should_ignore($v, 'DEPENDS')) {
|
||||
delete $self->{tobuild}{$v};
|
||||
} else {
|
||||
$v->{has} = 2;
|
||||
}
|
||||
} else {
|
||||
# okay, thanks to equiv, some other path was marked
|
||||
# as stub, and obviously we lost our deps
|
||||
if ($v->{info}->is_stub) {
|
||||
$self->log_same_ts('!', $v,
|
||||
"equivalent to an ignored path");
|
||||
# just drop it, it's already ignored as
|
||||
# an equivalent path
|
||||
delete $self->{tobuild}{$v};
|
||||
return;
|
||||
}
|
||||
my $has = $has->{$v} +
|
||||
$self->adjust_extra($v, 'EXTRA', 'BEXTRA');
|
||||
|
||||
my $has2 = $self->adjust_distfiles($v);
|
||||
# being buildable directly is a priority,
|
||||
# but put the patch/dist/small stuff down the
|
||||
# line as otherwise we will tend to grab
|
||||
# patch files first
|
||||
$v->{has} = 2 * ($has != 0) + ($has2 > 1);
|
||||
if ($has + $has2 == 0) {
|
||||
delete $self->{tobuild}{$v};
|
||||
# XXX because of this, not all build_path_list
|
||||
# are considered equal...
|
||||
if ($self->should_ignore($v, 'RDEPENDS')) {
|
||||
$self->{buildable}->remove($v);
|
||||
} else {
|
||||
$self->{buildable}->add($v);
|
||||
$self->log_same_ts('Q', $v);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub adjust_tobuild($self)
|
||||
{
|
||||
my $has = {};
|
||||
for my $v (values %{$self->{tobuild}}) {
|
||||
# XXX we don't have enough there !
|
||||
next if $self->{buildable}->detained($v);
|
||||
# due to pkgname aliases, we may have been built through
|
||||
# another pkgpath.
|
||||
next if $self->{buildable}->is_done_quick($v);
|
||||
$self->adjust_depends1($v, $has);
|
||||
}
|
||||
|
||||
for my $v (values %{$self->{tobuild}}) {
|
||||
# XXX we don't have enough there !
|
||||
next if $self->{buildable}->detained($v);
|
||||
$self->adjust_depends2($v, $has);
|
||||
}
|
||||
}
|
||||
|
||||
sub check_buildable($self, $forced = 0)
|
||||
{
|
||||
my $r = $self->limit($forced, 50, "ENG", 1,
|
||||
sub() {
|
||||
$self->log('+');
|
||||
1 while $self->adjust_built;
|
||||
$self->adjust_tobuild;
|
||||
$self->flush_log;
|
||||
});
|
||||
$self->stats;
|
||||
return $r;
|
||||
}
|
||||
sub new_roach($self, $r)
|
||||
{
|
||||
$self->{toroach}->add($r);
|
||||
}
|
||||
|
||||
sub new_path($self, $v)
|
||||
{
|
||||
if (defined $v->{info}{IGNORE} &&
|
||||
!$self->{state}{fetch_only}) {
|
||||
$self->log('!', $v, $v->{info}{IGNORE}->string);
|
||||
$self->stub_out($v);
|
||||
return;
|
||||
}
|
||||
if (defined $v->{info}{MISSING_FILES}) {
|
||||
$self->add_fatal($v, ["fetch manually"],
|
||||
"Missing distfiles: ".
|
||||
$v->{info}{MISSING_FILES}->string,
|
||||
$v->{info}{FETCH_MANUALLY}->string);
|
||||
return;
|
||||
}
|
||||
# $self->{heuristics}->todo($v);
|
||||
if (!$self->{buildable}->is_done_quick($v)) {
|
||||
$self->{tobuild}{$v} = $v;
|
||||
$self->log('T', $v);
|
||||
}
|
||||
my $notyet = 0;
|
||||
if (defined $v->{info}{FDEPENDS}) {
|
||||
for my $f (values %{$v->{info}{FDEPENDS}}) {
|
||||
if ($self->{tofetch}->contains($f) ||
|
||||
$self->{tofetch}{doing}{$f}) {
|
||||
next;
|
||||
}
|
||||
if ($self->{tofetch}->is_done($f)) {
|
||||
$v->{info}{distsize} //= 0;
|
||||
$v->{info}{distsize} += $f->{sz};
|
||||
delete $v->{info}{FDEPENDS}{$f};
|
||||
next;
|
||||
}
|
||||
$self->{tofetch}->add($f);
|
||||
$self->log('F', $f);
|
||||
$notyet = 1;
|
||||
}
|
||||
}
|
||||
return if $notyet;
|
||||
my $has = {};
|
||||
$self->adjust_depends1($v, $has);
|
||||
$self->adjust_depends2($v, $has);
|
||||
}
|
||||
|
||||
sub new_fetch_path($self, $v)
|
||||
{
|
||||
if (defined $v->{info}{IGNORE} &&
|
||||
!$self->{state}{fetch_only}) {
|
||||
$self->log('!', $v, $v->{info}{IGNORE}->string);
|
||||
$self->stub_out($v);
|
||||
return;
|
||||
}
|
||||
if (defined $v->{info}{MISSING_FILES}) {
|
||||
$self->add_fatal($v, ["fetch manually"],
|
||||
"Missing distfiles: ".
|
||||
$v->{info}{MISSING_FILES}->string,
|
||||
$v->{info}{FETCH_MANUALLY}->string);
|
||||
return;
|
||||
}
|
||||
if (defined $v->{info}{FDEPENDS}) {
|
||||
for my $f (values %{$v->{info}{FDEPENDS}}) {
|
||||
if ($self->{tofetch}->contains($f) ||
|
||||
$self->{tofetch}{doing}{$f}) {
|
||||
next;
|
||||
}
|
||||
if ($self->{tofetch}->is_done($f)) {
|
||||
$v->{info}{distsize} //= 0;
|
||||
$v->{info}{distsize} += $f->{sz};
|
||||
delete $v->{info}{FDEPENDS}{$f};
|
||||
next;
|
||||
}
|
||||
$self->{tofetch}->add($f);
|
||||
$self->log('F', $f);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub requeue($self, $v)
|
||||
{
|
||||
$self->{buildable}->add($v);
|
||||
$self->{sizer}->finished($v);
|
||||
}
|
||||
|
||||
sub requeue_dist($self, $v)
|
||||
{
|
||||
$self->{tofetch}->add($v);
|
||||
}
|
||||
|
||||
sub rescan($self, $v)
|
||||
{
|
||||
push(@{$self->{requeued}}, $v->path);
|
||||
}
|
||||
|
||||
sub add_fatal($self, $v, $l, @messages)
|
||||
{
|
||||
push(@{$self->{errors}}, $v);
|
||||
my $error = join(' ', @$l);
|
||||
if (length $error > 60) {
|
||||
$error = substr($error, 0, 58)."...";
|
||||
}
|
||||
$self->log('!', $v, $error);
|
||||
if ($self->{heldlocks}{$v}) {
|
||||
print {$self->{heldlocks}{$v}} "error=$error\n";
|
||||
delete $self->{heldlocks}{$v};
|
||||
} else {
|
||||
my $lock = $self->{locker}->lock($v);
|
||||
$lock->write("error", $error) if $lock;
|
||||
}
|
||||
$self->{logger}->log_error($v, @$l, @messages);
|
||||
$self->stub_out($v);
|
||||
}
|
||||
|
||||
sub rebuild_info($self, $core)
|
||||
{
|
||||
my @l = @{$self->{requeued}};
|
||||
my %d = ();
|
||||
$self->{requeued} = [];
|
||||
my %subdirs = map {($_->pkgpath_and_flavors, 1)} @l;
|
||||
|
||||
for my $v (@l) {
|
||||
$self->{buildable}->detain($v);
|
||||
if (defined $v->{info}{FDEPENDS}) {
|
||||
for my $f (values %{$v->{info}{FDEPENDS}}) {
|
||||
$f->forget;
|
||||
$self->{tofetch}->detain($f);
|
||||
$d{$f} = $f;
|
||||
}
|
||||
}
|
||||
delete $v->{info};
|
||||
}
|
||||
$self->{state}->grabber->forget_cache;
|
||||
$self->{state}->grabber->grab_subdirs($core, \%subdirs, undef);
|
||||
for my $v (@l) {
|
||||
$self->{buildable}->release($v);
|
||||
}
|
||||
for my $f (values %d) {
|
||||
$self->{tofetch}->release($f);
|
||||
}
|
||||
}
|
||||
|
||||
sub start_new_job($self)
|
||||
{
|
||||
my $r = $self->{buildable}->start;
|
||||
$self->flush_log;
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub start_new_fetch($self)
|
||||
{
|
||||
my $r = $self->{tofetch}->start;
|
||||
$self->flush_log;
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub start_new_roach($self)
|
||||
{
|
||||
my $r = $self->{toroach}->start;
|
||||
$self->flush_log;
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub can_build($self)
|
||||
{
|
||||
return $self->{buildable}->non_empty || @{$self->{requeued}} > 0;
|
||||
}
|
||||
|
||||
sub can_fetch($self)
|
||||
{
|
||||
return $self->{tofetch}->non_empty;
|
||||
}
|
||||
|
||||
sub can_roach($self)
|
||||
{
|
||||
return $self->{toroach}->non_empty;
|
||||
}
|
||||
|
||||
sub dump_category($self, $k, $fh = \*STDOUT)
|
||||
{
|
||||
$k =~ m/^./;
|
||||
my $q = "\u$&: ";
|
||||
my $cache = {};
|
||||
for my $v (sort {$a->fullpkgpath cmp $b->fullpkgpath}
|
||||
values %{$self->{$k}}) {
|
||||
print $fh $q;
|
||||
if (defined $cache->{$v->{info}}) {
|
||||
print $fh $v->fullpkgpath, " same as ",
|
||||
$cache->{$v->{info}}, "\n";
|
||||
} else {
|
||||
$v->quick_dump($fh);
|
||||
$cache->{$v->{info}} = $v->fullpkgpath;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub info_dump($self, $fh)
|
||||
{
|
||||
for my $k (qw(tobuild built)) {
|
||||
$self->dump_category($k, $fh);
|
||||
}
|
||||
$self->{buildable}->dump('Q', $fh);
|
||||
print $fh "\n";
|
||||
}
|
||||
|
||||
sub end_dump($self, $fh = \*STDOUT)
|
||||
{
|
||||
for my $v (values %{$self->{built}}) {
|
||||
$self->adjust($v, 'RDEPENDS');
|
||||
}
|
||||
for my $k (qw(tobuild built)) {
|
||||
$self->dump_category($k, $fh);
|
||||
}
|
||||
print $fh "\n";
|
||||
}
|
||||
|
||||
sub smart_dump($self, $fh)
|
||||
{
|
||||
$self->{buildable}->smart_dump($fh);
|
||||
}
|
||||
|
||||
sub dump($self, $fh = \*STDOUT)
|
||||
{
|
||||
for my $k (qw(built tobuild installable)) {
|
||||
$self->dump_category($k, $fh);
|
||||
}
|
||||
print $fh "\n";
|
||||
}
|
||||
|
||||
# special case: dump all dependencies at end of listing, and use that to
|
||||
# restart dpb quicker if we abort and restart.
|
||||
#
|
||||
# namely, scan the most important ports first.
|
||||
#
|
||||
# use case: when we restart dpb after a few hours, we want the listing job
|
||||
# to get to gettext/iconv/gmake very quickly.
|
||||
|
||||
sub dump_dependencies($self)
|
||||
{
|
||||
my $cache = {};
|
||||
for my $v (DPB::PkgPath->seen) {
|
||||
next unless exists $v->{info};
|
||||
for my $k (qw(DEPENDS RDEPENDS EXTRA)) {
|
||||
next unless exists $v->{info}{$k};
|
||||
for my $d (values %{$v->{info}{$k}}) {
|
||||
$cache->{$d->fullpkgpath}++;
|
||||
}
|
||||
}
|
||||
}
|
||||
my $state = $self->{state};
|
||||
$state->{log_user}->rewrite_file($state, $state->{dependencies_log},
|
||||
sub($log) {
|
||||
for my $k (sort {$cache->{$b} <=> $cache->{$a}} keys %$cache) {
|
||||
print $log "$k $cache->{$k}\n" or return 0;
|
||||
}
|
||||
return 1;
|
||||
});
|
||||
}
|
||||
|
||||
sub find_best($self, $file, $limit)
|
||||
{
|
||||
my $list = [];
|
||||
if (open my $fh, '<', $file) {
|
||||
my $i = 0;
|
||||
while (<$fh>) {
|
||||
if (m/^(\S+)\s\d+$/) {
|
||||
push(@$list, $1);
|
||||
$i++;
|
||||
}
|
||||
last if $i > $limit;
|
||||
}
|
||||
}
|
||||
return $list;
|
||||
}
|
||||
|
||||
package DPB::Stats;
|
||||
use DPB::Clock;
|
||||
|
||||
sub new($class, $state)
|
||||
{
|
||||
my $o = bless {
|
||||
fh => DPB::Util->make_hot($state->logger->append("stats")),
|
||||
delta => $state->{starttime},
|
||||
statline => ''},
|
||||
$class;
|
||||
DPB::Clock->register($o);
|
||||
return $o;
|
||||
}
|
||||
|
||||
sub log($self, $ts, $line)
|
||||
{
|
||||
return if $line eq $self->{statline};
|
||||
|
||||
$self->{statline} = $line;
|
||||
print {$self->{fh}} join(' ', $$, DPB::Util->ts2string($ts),
|
||||
DPB::Util->ts2string($ts-$self->{delta}), $line), "\n";
|
||||
}
|
||||
|
||||
sub stopped_clock($self, $gap)
|
||||
{
|
||||
$self->{delta} += $gap;
|
||||
}
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue