aboutsummaryrefslogtreecommitdiff
path: root/bin/feature-check.pl
blob: b53f4a2f813fe8520894c8c5ffa9369005037af1 (plain)
  1. #!/usr/bin/perl
  2. use v5.14;
  3. use utf8;
  4. use warnings;
  5. use Getopt::Long 2.24 qw(:config gnu_getopt);
  6. use IO::Interactive qw(is_interactive);
  7. my $USE_COLOR;
  8. BEGIN {
  9. $USE_COLOR = !(
  10. exists $ENV{NO_COLOR}
  11. or ( $ENV{COLOR} and !$ENV{COLOR} )
  12. or !is_interactive
  13. );
  14. $Pod::Usage::Formatter = 'Pod::Text::Color' if $USE_COLOR;
  15. }
  16. use Pod::Usage;
  17. my $COPYRIGHT;
  18. use Pod::Constants
  19. -trim => 1,
  20. 'COPYRIGHT AND LICENSE' =>
  21. sub { ($COPYRIGHT) = s/C<< (.*) >>/$1/gr; $COPYRIGHT =~ s/©/©/g };
  22. use List::Util qw(max);
  23. use Readonly::Tiny;
  24. use Path::Tiny;
  25. use Log::Any qw($log);
  26. use Log::Any::Adapter;
  27. use Term::Table;
  28. # TODO: handle options --quiet/--verbose/--debug
  29. # TODO: handle output scope, with options --threshold/--all
  30. # TODO: handle custom basepath (with builtin as default), taken as argument
  31. # TODO: handle multiple basepaths
  32. # TODO: check scripts (not only documentation)
  33. Log::Any::Adapter->set( 'Screen', use_color => $USE_COLOR );
  34. =head1 NAME
  35. feature-check - examine maturity and availability status of Redpill features
  36. =head1 VERSION
  37. Version v0.1.0
  38. =cut
  39. our $VERSION = 'v0.1.0';
  40. my $progname = path($0)->basename;
  41. our %OPT = ();
  42. my @OPT = ();
  43. =head1 SYNOPSIS
  44. feature-check [ --help | --version ]
  45. feature-check [OPTION...]
  46. =head1 DESCRIPTION
  47. B<feature-check> is a command-line tool
  48. to parse and examine a set of Redpill features,
  49. and print a summary on standard output.
  50. Usability of each feature is evaluated
  51. based on coverage and embedded annotations of its documentation.
  52. =head1 OPTIONS
  53. =head2 General
  54. =over 16
  55. =item B<-h>, B<--help>
  56. print help message and exit
  57. =item B<--man>
  58. print manual and exit
  59. =item B<-v>, B<--version>
  60. print version and copyright information and exit
  61. =back
  62. =cut
  63. push @OPT, qw(
  64. verbose
  65. help|h
  66. man
  67. version|v
  68. );
  69. GetOptions( \%OPT, @OPT ) or pod2usage(2);
  70. pod2usage(1) if ( $OPT{help} );
  71. pod2usage(-exitval => 0, -verbose => 2) if ($OPT{man});
  72. if ( $OPT{version} ) { version(); exit 0; }
  73. pod2usage( join "\n", map {"Unknown argument: $_"} @ARGV )
  74. if @ARGV;
  75. my $BASEDIR = path('../..');
  76. my @TARGET = qw(executive user expert);
  77. readonly \@TARGET;
  78. my @MATURITY = qw(unusable buggy incomplete usable good);
  79. readonly \@MATURITY;
  80. use enum qw(
  81. UNUSABLE=0 BUGGY INCOMPLETE USABLE GOOD
  82. EXECUTIVE=0 USER EXPERT
  83. );
  84. my %DOCFILE = (
  85. ADMIN => EXPERT,
  86. INTRO => USER,
  87. OVERVIEW => EXECUTIVE,
  88. README => EXECUTIVE,
  89. SETUP => EXPERT,
  90. USE => USER,
  91. );
  92. readonly \%DOCFILE;
  93. my $threshold = USABLE;
  94. $log->info("acceptance threshold: $MATURITY[$threshold]");
  95. my $featureref = path("$BASEDIR")->visit( \&feature );
  96. #use DDP; p $featureref if $log->is_debug;
  97. my @row;
  98. for my $feature ( sort keys %$featureref ) {
  99. my @target = @{ $featureref->{$feature}{target} };
  100. push @row, [ $feature, map { join ', ', sort keys %{ $target[$_]{docs} } if $target[$_]{maturity} >= $threshold } EXECUTIVE..EXPERT ];
  101. }
  102. my $table = Term::Table->new(
  103. header => [ 'feature', @TARGET ],
  104. rows => \@row,
  105. );
  106. say $_ for $table->render;
  107. sub feature {
  108. my ($path, $state) = @_;
  109. my ( $feature, $docs, $maturity );
  110. return unless $path->is_dir;
  111. return if $path->basename =~ qr/\.$/;
  112. $feature = $path->basename;
  113. $log->trace("found feature: $feature");
  114. $docs = $path->visit( \&docfile );
  115. for my $target (EXECUTIVE..EXPERT) {
  116. my $maturity;
  117. if ( exists $docs->{$target} ) {
  118. $state->{$feature}{target}[$target]{docs} = $docs->{$target};
  119. $maturity = max map { $_->{maturity} } values %{ $docs->{$target} };
  120. }
  121. else {
  122. $maturity = UNUSABLE;
  123. }
  124. $state->{$feature}{target}[$target]{maturity} = $maturity;
  125. $log->debug("resolved feature $feature target $target maturity: $maturity");
  126. }
  127. if ( exists $state->{$feature}{target}[EXECUTIVE]{docs} && exists $state->{$feature}{target}[EXECUTIVE]{docs}{README} ) {
  128. $maturity = $state->{$feature}{target}[EXECUTIVE]{maturity};
  129. }
  130. elsif ( INCOMPLETE < $state->{$feature}{target}[EXECUTIVE]{maturity} ) {
  131. $maturity = INCOMPLETE;
  132. }
  133. else {
  134. $maturity = $state->{$feature}{target}[EXECUTIVE]{maturity};
  135. }
  136. $state->{$feature}{maturity} = $maturity;
  137. $log->warning("skipping unacceptable feature: $feature")
  138. if $maturity < $threshold;
  139. }
  140. sub docfile {
  141. my ($path, $state) = @_;
  142. my ( $doc, $category, $content, $maturity );
  143. return unless $path->is_file;
  144. $doc = $path->basename('.md');
  145. return if $path->basename eq $doc;
  146. return unless exists $DOCFILE{$doc};
  147. $category = $DOCFILE{$doc}
  148. // return;
  149. $content = $path->slurp_utf8;
  150. if ( $content =~ qr/\bFIXME\b/ ) {
  151. $maturity = BUGGY;
  152. }
  153. elsif ( $content =~ qr/\bTODO\b/ ) {
  154. $maturity = INCOMPLETE;
  155. }
  156. else {
  157. $maturity //= USABLE;
  158. }
  159. $state->{$category}{$doc}{maturity} = $maturity;
  160. $log->trace("found docfile: $doc", { maturity => $maturity });
  161. }
  162. =head1 MATURITY
  163. =head2 Documentation file
  164. A documentation file is considered broken
  165. if it contains any B<FIXME> annotations,
  166. or otherwise considered unfinished
  167. if it contains any B<TODO> annotations.
  168. =head2 Targeted documentation
  169. A targeted documentation,
  170. for each of the Redpill targets B<executive>, B<user> and B<expert>,
  171. is as mature as the most mature of their files,
  172. or unusable if none exist for the target.
  173. =head2 Feature
  174. A feature is as mature as the most mature targeted documentation,
  175. except it is at most unfinished
  176. unless documentation complies with standard-readme specification.
  177. =head1 ENVIRONMENT
  178. =over 6
  179. =item NO_COLOR
  180. If defined, will disable color.
  181. Consulted before COLOR.
  182. =item COLOR
  183. Can be set to 0 to explicitly disable colors.
  184. The default is to use color when connected to a terminal.
  185. =item LOG_LEVEL
  186. =item QUIET
  187. =item VERBOSE
  188. =item DEBUG
  189. =item TRACE
  190. Used to emit varying details about discoveries to STDERR.
  191. See L<Log::Any::Adapter::Screen> for more details.
  192. =item LOG_PREFIX
  193. The default formatter groks these variables.
  194. See B<formatter> in L<Log::Any::Adapter::Screen> for more details.
  195. =back
  196. =encoding UTF-8
  197. =head1 AUTHOR
  198. Jonas Smedegaard C<< <dr@jones.dk> >>
  199. =head1 COPYRIGHT AND LICENSE
  200. Copyright © 2021 Jonas Smedegaard
  201. This program is free software:
  202. you can redistribute it and/or modify it
  203. under the terms of the GNU Affero General Public License
  204. as published by the Free Software Foundation,
  205. either version 3, or (at your option) any later version.
  206. This program is distributed in the hope that it will be useful,
  207. but WITHOUT ANY WARRANTY;
  208. without even the implied warranty
  209. of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  210. See the GNU Affero General Public License for more details.
  211. You should have received a copy
  212. of the GNU Affero General Public License along with this program.
  213. If not, see <https://www.gnu.org/licenses/>.
  214. =cut
  215. 1;