aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/feature-check.pl32
1 files changed, 31 insertions, 1 deletions
diff --git a/bin/feature-check.pl b/bin/feature-check.pl
index bc3d8c4..154bb2a 100755
--- a/bin/feature-check.pl
+++ b/bin/feature-check.pl
@@ -3,6 +3,7 @@
use v5.14;
use utf8;
use warnings;
+use open qw( :std :encoding(UTF-8) );
use Getopt::Long 2.24 qw(:config gnu_getopt);
use IO::Interactive qw(is_interactive);
@@ -30,6 +31,8 @@ use Path::Tiny;
use Log::Any qw($log);
use Log::Any::Adapter;
use Term::Table;
+use Graph::Easy;
+use Graph::Easy::Parser;
# TODO: handle options --quiet/--verbose/--debug
# TODO: handle output scope, with options --threshold/--all
@@ -135,16 +138,41 @@ readonly \%DOCFILE;
my $threshold = USABLE;
$log->info("acceptance threshold: $MATURITY[$threshold]");
+my $graph = Graph::Easy::Parser->from_text('graph { flow: east; }');
+my $root = 'redpill';
+
my $featureref = path("$BASEDIR")->visit( \&feature );
#use DDP; p $featureref if $log->is_debug;
-my @row;
+my ( @row, %node );
+
+$node{$root} = $graph->add_node($root);
+
for my $feature ( sort keys %$featureref ) {
my @target = @{ $featureref->{$feature}{target} };
+ next unless $featureref->{$feature}{maturity} >= $threshold;
+
push @row, [ $feature, map { join ', ', sort keys %{ $target[$_]{docs} } if $target[$_]{maturity} >= $threshold } EXECUTIVE..EXPERT ]
if $featureref->{$feature}{maturity} >= $threshold;
+
+ next if defined $node{$feature};
+
+ $node{$feature} = undef;
+}
+
+for my $feature ( sort keys %node ) {
+
+ next if defined $node{$feature};
+
+ if ( $feature =~ /^([^-]+).*\K-(?=[^-]+$)/ and defined $node{$`} and !defined $node{$feature} ) {
+ ( undef, $node{$feature} ) = $graph->add_edge( $node{$`}, $feature );
+ $node{$feature}->set_attribute( 'label', $' );
+ }
+ else {
+ ( undef, $node{$feature} ) = $graph->add_edge( $node{$root}, $feature );
+ }
}
my $table = Term::Table->new(
@@ -154,6 +182,8 @@ my $table = Term::Table->new(
say $_ for $table->render;
+print $graph->as_boxart();
+
sub feature {
my ($path, $state) = @_;
my ( $feature, $docs, $maturity );