mirror of
https://github.com/openbsd/ports.git
synced 2026-06-18 07:24:23 +02:00
tb
73fadfa07b
This is some fallout from the v5.36 conversion and more is needed, which espie will do when he gets around to et. ok espie
780 lines
18 KiB
Perl
780 lines
18 KiB
Perl
# ex:ts=8 sw=4:
|
|
# $OpenBSD: Engine.pm,v 1.152 2025/06/07 04:08:00 tb 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;
|