Commit 2c56ab7d authored by Michael Pyne's avatar Michael Pyne

Merge remote-tracking branch 'origin/make_it_mojo' into mojo-err-checking

Conflicts:
	modules/web/BackendServer.pm
parents 9daa521c 02e624fb
Pipeline #7591 passed with stage
in 1 minute and 25 seconds
......@@ -351,49 +351,6 @@ DONE
= values %auxOptions;
}
sub _yieldModuleDependencyTreeEntry
{
my ($nodeInfo, $module, $context) = @_;
my $depth = $nodeInfo->{depth};
my $index = $nodeInfo->{idx};
my $count = $nodeInfo->{count};
my $build = $nodeInfo->{build};
my $currentItem = $nodeInfo->{currentItem};
my $currentBranch = $nodeInfo->{currentBranch};
my $parentItem = $nodeInfo->{parentItem};
my $parentBranch = $nodeInfo->{parentBranch};
my $buildStatus = $build ? 'built' : 'not built';
my $statusInfo = $currentBranch ? "($buildStatus: $currentBranch)" : "($buildStatus)";
my $connectorStack = $context->{stack};
my $prefix = pop(@$connectorStack);
while($context->{depth} > $depth) {
$prefix = pop(@$connectorStack);
--($context->{depth});
}
push(@$connectorStack, $prefix);
my $connector;
if ($depth == 0) {
$connector = $prefix . ' ── ';
push(@$connectorStack, $prefix . (' ' x 4));
}
else {
$connector = $prefix . ($index == $count ? '└── ': '├── ');
push(@$connectorStack, $prefix . ($index == $count ? ' ' x 4: ''));
}
$context->{depth} = $depth + 1;
$context->{report}($connector . $currentItem . ' ' . $statusInfo);
}
# Generates the build context, builds various module, dependency and branch
# group resolvers, and splits up the provided option/selector mix read from
# cmdline into selectors (returned to caller, if any) and pre-built context and
......@@ -577,6 +534,8 @@ sub modulesFromSelectors
(!defined $branch or $branch); # This is the actual test
} (@modules);
my @modulesFromCommand = @modules;
my $moduleGraph = $self->_resolveModuleDependencyGraph(@modules);
if (!$moduleGraph || !exists $moduleGraph->{graph}) {
......@@ -590,6 +549,7 @@ sub modulesFromSelectors
my $result = {
dependencyInfo => $moduleGraph,
modulesFromCommand => \@modulesFromCommand,
selectedModules => [],
build => 0
};
......@@ -609,6 +569,7 @@ sub modulesFromSelectors
if(exists $self->{debugFlags}->{'list-build'}) {
my $result = {
dependencyInfo => $moduleGraph,
modulesFromCommand => \@modulesFromCommand,
selectedModules => [],
build => 0
};
......@@ -617,6 +578,7 @@ sub modulesFromSelectors
my $result = {
dependencyInfo => $moduleGraph,
modulesFromCommand => \@modulesFromCommand,
selectedModules => \@modules,
build => 1
};
......
......@@ -673,74 +673,16 @@ sub resolveToModuleGraph
}
}
sub _descendModuleGraph
sub hasErrors
{
my ($moduleGraph, $callback, $nodeInfo, $context) = @_;
my $depth = $nodeInfo->{depth};
my $index = $nodeInfo->{idx};
my $count = $nodeInfo->{count};
my $currentItem = $nodeInfo->{currentItem};
my $currentBranch = $nodeInfo->{currentBranch};
my $parentItem = $nodeInfo->{parentItem};
my $parentBranch = $nodeInfo->{parentBranch};
my $subGraph = $moduleGraph->{$currentItem};
&$callback($nodeInfo, $subGraph->{module}, $context);
++$depth;
my @items = keys(%{$subGraph->{deps}});
my $itemCount = scalar(@items);
my $itemIndex = 1;
for my $item (@items)
{
$subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $itemInfo = {
build => $subGraph->{build},
depth => $depth,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => $currentItem,
parentBranch => $currentBranch
};
_descendModuleGraph($moduleGraph, $callback, $itemInfo, $context);
++$itemIndex;
}
}
my $info = shift;
sub walkModuleDependencyTrees
{
my $moduleGraph = shift;
my $callback = shift;
my $context = shift;
my @modules = @_;
my $itemCount = scalar(@modules);
my $itemIndex = 1;
my $cycles = $info->{cycles} // 0;
my $pathErrors = $info->{pathErrors} // 0;
my $branchErrors = $info->{branchErrors} // 0;
my $syntaxErrors = $info->{syntaxErrors} // 0;
for my $module (@modules) {
assert_isa($module, 'ksb::Module');
my $item = $module->name();
my $subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $info = {
build => $subGraph->{build},
depth => 0,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => '',
parentBranch => ''
};
_descendModuleGraph($moduleGraph, $callback, $info, $context);
++$itemIndex;
}
return $cycles || $pathErrors || $branchErrors || $syntaxErrors;
}
sub _compareBuildOrder
......
package ksb::UserInterface::DependencyGraph;
use strict;
use warnings;
use 5.014;
sub _descendModuleGraph
{
my ($moduleGraph, $callback, $nodeInfo, $context) = @_;
my $depth = $nodeInfo->{depth};
my $index = $nodeInfo->{idx};
my $count = $nodeInfo->{count};
my $currentItem = $nodeInfo->{currentItem};
my $currentBranch = $nodeInfo->{currentBranch};
my $parentItem = $nodeInfo->{parentItem};
my $parentBranch = $nodeInfo->{parentBranch};
my $subGraph = $moduleGraph->{$currentItem};
&$callback($nodeInfo, $subGraph->{module}, $context);
++$depth;
my @items = @{$subGraph->{deps}};
my $itemCount = scalar(@items);
my $itemIndex = 1;
for my $item (@items)
{
$subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $itemInfo = {
build => $subGraph->{build},
depth => $depth,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => $currentItem,
parentBranch => $currentBranch
};
_descendModuleGraph($moduleGraph, $callback, $itemInfo, $context);
++$itemIndex;
}
}
sub _walkModuleDependencyTrees
{
my $moduleGraph = shift;
my $callback = shift;
my $context = shift;
my @modules = @_;
my $itemCount = scalar(@modules);
my $itemIndex = 1;
for my $item (@modules) {
my $subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $info = {
build => $subGraph->{build},
depth => 0,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => '',
parentBranch => ''
};
_descendModuleGraph($moduleGraph, $callback, $info, $context);
++$itemIndex;
}
}
sub _treeOutputConnectors
{
my ($depth, $index, $count) = @_;
my $blankPadding = (' ' x 4);
return (' ── ', $blankPadding) if ($depth == 0);
return ('└── ', $blankPadding) if ($index == $count);
return ('├── ', '');
}
sub _yieldModuleDependencyTreeEntry
{
my ($nodeInfo, $module, $context) = @_;
my $depth = $nodeInfo->{depth};
my $index = $nodeInfo->{idx};
my $count = $nodeInfo->{count};
my $build = $nodeInfo->{build};
my $currentItem = $nodeInfo->{currentItem};
my $currentBranch = $nodeInfo->{currentBranch};
my $parentItem = $nodeInfo->{parentItem};
my $parentBranch = $nodeInfo->{parentBranch};
my $buildStatus = $build ? 'built' : 'not built';
my $statusInfo = $currentBranch ? "($buildStatus: $currentBranch)" : "($buildStatus)";
my $connectorStack = $context->{stack};
my $prefix = pop(@$connectorStack);
while($context->{depth} > $depth) {
$prefix = pop(@$connectorStack);
--($context->{depth});
}
push(@$connectorStack, $prefix);
my ($connector, $padding) = _treeOutputConnectors($depth, $index, $count);
push(@$connectorStack, $prefix . $padding);
$context->{depth} = $depth + 1;
my $line = $prefix . $connector . $currentItem . ' ' . $statusInfo;
$context->{report}($line);
}
sub printTrees
{
my $tree = shift;
my @modules = @_;
#
# Hack: reopen STDOUT to get rid of ... "does not map to ascii" noise
# Yes: the code points do not map to ASCII, that is sort of the point
#
my $ok = open my $fh, '>&', STDOUT;
return 1 unless $ok;
my $depTreeCtx = {
stack => [''],
depth => 0,
report => sub {
my $line = shift;
print $fh $line, "\n";
}
};
_walkModuleDependencyTrees(
$tree,
\&_yieldModuleDependencyTreeEntry,
$depTreeCtx,
@modules
);
close $fh;
return 0;
}
1;
......@@ -41,6 +41,8 @@ use ksb::BuildException;
use ksb::StatusView;
use ksb::Util;
use ksb::Debug;
use ksb::UserInterface::DependencyGraph;
use Mojo::Promise;
use IO::Handle; # For methods on event_stream file
use List::Util qw(max);
......@@ -76,6 +78,57 @@ sub _check_error {
die $err;
};
sub _fetchModuleList
{
my ($ua, $list) = @_;
return $ua->get_p($list)->then(sub {
my $tx = _check_error(shift);
return $tx->result->json;
});
}
sub dumpDependencyTree
{
my ($ua, $tree) = @_;
#
# TODO: this could fail, how to properly promisify?
#
my $errors = $tree->{errors} // {};
my $errorCount = $errors->{errors} // 0;
if ($errorCount != 0) {
say "Unable to resolve dependencies, number of errors encountered is: $errorCount";
my $p = Mojo::Promise->new();
return $p->resolve(1);
}
my $data = $tree->{data};
if (!defined($data)) {
say "Unable to resolve dependencies, did not obtain (valid) results";
my $p = Mojo::Promise->new();
return $p->resolve(1);
}
else {
#
# TODO: this is *not* how we should await things in general.
# Fix using Mojo::AsyncAwait?
#
return _fetchModuleList($ua, '/modulesFromCommand')->then(sub {
my $list = shift;
my @names = map { $_->{name} } (@$list);
return @names;
})->then(sub {
my @modules = @_;
my $err = ksb::UserInterface::DependencyGraph::printTrees(
$data,
@modules
);
return $err ? 1 : 0;
});
}
}
# Returns a promise chain to handle the "debug and show some output but don't
# actually build anything" use case.
sub _runModeDebug
......@@ -90,8 +143,10 @@ sub _runModeDebug
$app->log->debug("Dumping dependency tree (in a later release...)");
return $ua->get_p('/moduleGraph')->then(sub {
my $tx = _check_error(shift);
say $tx->result->text;
return 0;
return $tx->result->json;
})->then(sub {
my $tree = shift;
return dumpDependencyTree($ua, $tree);
});
}
elsif ($debugFlags{'list-build'}) {
......
package ksb::dto::ModuleInfo;
use strict;
use warnings;
use 5.014;
use ksb::Module;
#
# dto::ModuleInfo
#
# This module provides utilities to convert from the internal representation
# of a module object to its wire format equivalent, and vice versa.
# Using DTOs is a well known good practice to ensure API output reflects a
# semantically meaningful view, without cluttering it with internal,
# implementation specific notions of what 'model' is actually represented.
#
sub selectedModuleToDto
{
my $graph = shift;
# TODO
# Perl WTF: does *not* work: assert_isa(shift, 'ksb::Module');
# but say (ref $module) outputs ksb::Module
my $module = shift;
my $name = $module->name();
my $branch = $graph->{$name}->{branch} // '';
my $isBuilt = $graph->{$name}->{build} ? 1: 0;
my $dto = {
name => $name,
path => $graph->{$name}->{path}
};
$dto->{branch} = "$branch" unless $branch eq '';
$dto->{build} = \$isBuilt;
return $dto;
}
sub selectedModulesToDtos
{
my ($graph, $modules) = @_;
my @dtos = map { selectedModuleToDto($graph, $_); } (@$modules);
return @dtos;
}
1;
......@@ -6,6 +6,8 @@ use Mojo::Util qw(trim);
use ksb::Application;
use ksb::dto::ModuleGraph;
use ksb::dto::ModuleInfo;
use ksb::DependencyResolver;
use Cwd;
......@@ -46,7 +48,7 @@ sub make_new_ksb
));
if(@selectors) {
$c->app->log->info("Module selectors requested:", join(', ', @selectors));
$c->app->log->info("Module selectors requested:" . join(', ', @selectors));
} else {
$c->app->log->info("All modules to be built");
}
......@@ -268,6 +270,33 @@ sub _generateRoutes {
}
});
$r->get('/modulesFromCommand' => sub {
my $c = shift;
my $work = $c->app->ksb->workLoad() // {};
my $info = $work->{dependencyInfo};
if (!defined($info)
|| ksb::DependencyResolver::hasErrors($info)
|| !exists $info->{graph})
{
$c->reply->not_found;
return;
}
my $graph = $info->{graph};
my $modules = $work->{modulesFromCommand};
my @dtos = ksb::dto::ModuleInfo::selectedModulesToDtos(
$graph,
$modules
);
#
# Trap for the unwary: make sure to return a reference.
# Without this Mojolicious won't encode the array properly
#
$c->render(json => \@dtos);
});
$r->post('/build' => sub {
my $c = shift;
if ($c->in_build) {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment