diff options
| -rwxr-xr-x | bin/feature-check.pl | 305 |
1 files changed, 305 insertions, 0 deletions
diff --git a/bin/feature-check.pl b/bin/feature-check.pl new file mode 100755 index 0000000..b53f4a2 --- /dev/null +++ b/bin/feature-check.pl @@ -0,0 +1,305 @@ +#!/usr/bin/perl + +use v5.14; +use utf8; +use warnings; + +use Getopt::Long 2.24 qw(:config gnu_getopt); +use IO::Interactive qw(is_interactive); + +my $USE_COLOR; +BEGIN { + $USE_COLOR = !( + exists $ENV{NO_COLOR} + or ( $ENV{COLOR} and !$ENV{COLOR} ) + or !is_interactive + ); + $Pod::Usage::Formatter = 'Pod::Text::Color' if $USE_COLOR; +} +use Pod::Usage; + +my $COPYRIGHT; +use Pod::Constants + -trim => 1, + 'COPYRIGHT AND LICENSE' => + sub { ($COPYRIGHT) = s/C<< (.*) >>/$1/gr; $COPYRIGHT =~ s/©/©/g }; + +use List::Util qw(max); +use Readonly::Tiny; +use Path::Tiny; +use Log::Any qw($log); +use Log::Any::Adapter; +use Term::Table; + +# TODO: handle options --quiet/--verbose/--debug +# TODO: handle output scope, with options --threshold/--all +# TODO: handle custom basepath (with builtin as default), taken as argument +# TODO: handle multiple basepaths +# TODO: check scripts (not only documentation) + +Log::Any::Adapter->set( 'Screen', use_color => $USE_COLOR ); + +=head1 NAME + +feature-check - examine maturity and availability status of Redpill features + +=head1 VERSION + +Version v0.1.0 + +=cut + +our $VERSION = 'v0.1.0'; + +my $progname = path($0)->basename; + +our %OPT = (); +my @OPT = (); + +=head1 SYNOPSIS + + feature-check [ --help | --version ] + + feature-check [OPTION...] + +=head1 DESCRIPTION + +B<feature-check> is a command-line tool +to parse and examine a set of Redpill features, +and print a summary on standard output. + +Usability of each feature is evaluated +based on coverage and embedded annotations of its documentation. + +=head1 OPTIONS + +=head2 General + +=over 16 + +=item B<-h>, B<--help> + +print help message and exit + +=item B<--man> + +print manual and exit + +=item B<-v>, B<--version> + +print version and copyright information and exit + +=back + +=cut + +push @OPT, qw( + verbose + help|h + man + version|v +); + +GetOptions( \%OPT, @OPT ) or pod2usage(2); + +pod2usage(1) if ( $OPT{help} ); +pod2usage(-exitval => 0, -verbose => 2) if ($OPT{man}); +if ( $OPT{version} ) { version(); exit 0; } + +pod2usage( join "\n", map {"Unknown argument: $_"} @ARGV ) + if @ARGV; + +my $BASEDIR = path('../..'); + +my @TARGET = qw(executive user expert); +readonly \@TARGET; + +my @MATURITY = qw(unusable buggy incomplete usable good); +readonly \@MATURITY; + +use enum qw( + UNUSABLE=0 BUGGY INCOMPLETE USABLE GOOD + EXECUTIVE=0 USER EXPERT +); + +my %DOCFILE = ( + ADMIN => EXPERT, + INTRO => USER, + OVERVIEW => EXECUTIVE, + README => EXECUTIVE, + SETUP => EXPERT, + USE => USER, +); +readonly \%DOCFILE; + +my $threshold = USABLE; +$log->info("acceptance threshold: $MATURITY[$threshold]"); + +my $featureref = path("$BASEDIR")->visit( \&feature ); + +#use DDP; p $featureref if $log->is_debug; + +my @row; +for my $feature ( sort keys %$featureref ) { + my @target = @{ $featureref->{$feature}{target} }; + + push @row, [ $feature, map { join ', ', sort keys %{ $target[$_]{docs} } if $target[$_]{maturity} >= $threshold } EXECUTIVE..EXPERT ]; +} + +my $table = Term::Table->new( + header => [ 'feature', @TARGET ], + rows => \@row, +); + +say $_ for $table->render; + +sub feature { + my ($path, $state) = @_; + my ( $feature, $docs, $maturity ); + + return unless $path->is_dir; + return if $path->basename =~ qr/\.$/; + + $feature = $path->basename; + $log->trace("found feature: $feature"); + + $docs = $path->visit( \&docfile ); + + for my $target (EXECUTIVE..EXPERT) { + my $maturity; + + if ( exists $docs->{$target} ) { + $state->{$feature}{target}[$target]{docs} = $docs->{$target}; + $maturity = max map { $_->{maturity} } values %{ $docs->{$target} }; + } + else { + $maturity = UNUSABLE; + } + + $state->{$feature}{target}[$target]{maturity} = $maturity; + $log->debug("resolved feature $feature target $target maturity: $maturity"); + } + + if ( exists $state->{$feature}{target}[EXECUTIVE]{docs} && exists $state->{$feature}{target}[EXECUTIVE]{docs}{README} ) { + $maturity = $state->{$feature}{target}[EXECUTIVE]{maturity}; + } + elsif ( INCOMPLETE < $state->{$feature}{target}[EXECUTIVE]{maturity} ) { + $maturity = INCOMPLETE; + } + else { + $maturity = $state->{$feature}{target}[EXECUTIVE]{maturity}; + } + + $state->{$feature}{maturity} = $maturity; + $log->warning("skipping unacceptable feature: $feature") + if $maturity < $threshold; +} + +sub docfile { + my ($path, $state) = @_; + my ( $doc, $category, $content, $maturity ); + + return unless $path->is_file; + $doc = $path->basename('.md'); + return if $path->basename eq $doc; + return unless exists $DOCFILE{$doc}; + $category = $DOCFILE{$doc} + // return; + + $content = $path->slurp_utf8; + if ( $content =~ qr/\bFIXME\b/ ) { + $maturity = BUGGY; + } + elsif ( $content =~ qr/\bTODO\b/ ) { + $maturity = INCOMPLETE; + } + else { + $maturity //= USABLE; + } + + $state->{$category}{$doc}{maturity} = $maturity; + $log->trace("found docfile: $doc", { maturity => $maturity }); +} + + +=head1 MATURITY + +=head2 Documentation file + +A documentation file is considered broken +if it contains any B<FIXME> annotations, +or otherwise considered unfinished +if it contains any B<TODO> annotations. + +=head2 Targeted documentation + +A targeted documentation, +for each of the Redpill targets B<executive>, B<user> and B<expert>, +is as mature as the most mature of their files, +or unusable if none exist for the target. + +=head2 Feature + +A feature is as mature as the most mature targeted documentation, +except it is at most unfinished +unless documentation complies with standard-readme specification. + +=head1 ENVIRONMENT + +=over 6 + +=item NO_COLOR + +If defined, will disable color. +Consulted before COLOR. + +=item COLOR + +Can be set to 0 to explicitly disable colors. +The default is to use color when connected to a terminal. + +=item LOG_LEVEL +=item QUIET +=item VERBOSE +=item DEBUG +=item TRACE + +Used to emit varying details about discoveries to STDERR. +See L<Log::Any::Adapter::Screen> for more details. + +=item LOG_PREFIX + +The default formatter groks these variables. +See B<formatter> in L<Log::Any::Adapter::Screen> for more details. + +=back + +=encoding UTF-8 + +=head1 AUTHOR + +Jonas Smedegaard C<< <dr@jones.dk> >> + +=head1 COPYRIGHT AND LICENSE + + Copyright © 2021 Jonas Smedegaard + +This program is free software: +you can redistribute it and/or modify it +under the terms of the GNU Affero General Public License +as published by the Free Software Foundation, +either version 3, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; +without even the implied warranty +of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +See the GNU Affero General Public License for more details. + +You should have received a copy +of the GNU Affero General Public License along with this program. +If not, see <https://www.gnu.org/licenses/>. + +=cut + +1; |