aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/feature-check.pl305
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;