rc-task-status

#!/usr/local/bin/perl
## RC task status
#n# 2018-03-12 ... 
#n# 2020-08-16 oops, updating RC reports via 'curl' again
#n# 2022-02-14 compile check was slowing things down (and 'Code-health' does the same job)

use utf8;
use warnings;
use strict 'vars';

my(%P);

chdir "$ENV{HOME}/perl6/Rosetta-Code/meta";

#print `$ENV{HOME}/.rakubrew/shims/raku -v`; 
print `/usr/local/bin/raku -v`; 

# update only once a day
#if (.95 < -M "Category:Programming_Tasks") {
#    print "updating from RC...\n";
#    system <<~'END';
#        ../bin/Rosetta_Code_Find_unimplemented_tasks_raku | sort > Reports:Tasks_not_implemented_in_Raku
#        END
#}
        #mv Category:Programming_Tasks Category:Programming_Tasks~
        #mv Category:Draft_Programming_Tasks Category:Draft_Programming_Tasks~
        #/opt/local/bin/curl -s -O https://rosettacode.org/wiki/Category:Programming_Tasks
        #/opt/local/bin/curl -s -O https://rosettacode.org/wiki/Category:Draft_Programming_Tasks
        #mv Reports:Tasks_not_implemented_in_Raku Reports:Tasks_not_implemented_in_Raku~
        #/opt/local/bin/curl -s -O https://rosettacode.org/wiki/Reports:Tasks_not_implemented_in_Raku

sub path { return $_[0] =~ /^([0-Z])/ ? "$1/" : '0/' }

## characterize RC tasks

# check task source code 
open P, "<Category:Programming_Tasks";
while ($_ = <P>) { examine($_) }

# ditto, and mark as draft
open D, "<Category:Draft_Programming_Tasks";
while ($_ = <D>) { examine($_); mark($_,'D') }

# un-implemented (no code) or un-reliable (marked broken at RC)
open U, "<Reports:Tasks_not_implemented_in_Raku";
while ($_ = <U>) { mark($_,'U') }

# ignored tasks from hard-coded list
while ($_ = <DATA>) { chomp; mark($_,'X') }

# column headers with task totals
my @cols = (
"Moar: Good/Bad [${\tally('M','G')}/${\tally('M','B')}]",       # M
"JVM: Good/Bad [${\tally('J','G')}/${\tally('J','B')}]",        # J
"Smoke testing [${\tally('S')}]",                               # S
"sKipping validation [${\tally('K')}]",                         # K
"Interactive [${\tally('I')}]",                                 # I
"Touched (modified by me) [${\tally('T')}]",                    # T
"Concurrent/Async [${\tally('C')}]",                            # C
"Random seed [${\tally('R')}]",                                 # R
"File output [${\tally('F')}]",                                 # F
"Draft [${\tally('D')}]",                                       # D
"Ignoring [${\tally('X')}]",                                    # X
"Void (no local copy) [${\tally('V')}]",                        # V
"Un-implemented/reliable [${\tally('U')}]",                     # U
);

my $max = scalar @cols;
my $n = $max;
for my $c (@cols) {
    $n--;
    print '|' x ($max-$n-1) . '+' . '-' x $n . "--> $c\n";
}
print '|' x $max . "\n";

# display full task status table
for my $p (sort keys %P) {
    (print $P{$p}{$_} // '.') for qw(M J S K I T C R F D X V U);
    print " $p\n";
}

#####
# record a known task condition
sub mark {
my($l,$t) = @_;
my($p);

    if ($t eq 'X') { return unless $p = pfix($l)  }
    else           { return unless $p = pname($l) }
    $P{$p}{$t} = $t;
}

#####
# look for task under base name, and with suffixes
sub examine {
my($l) = @_;

    return unless my $p = pname($l);

    my $cnt = 0;
    $cnt += document("${p}");
    $cnt += document("${p}-1");
    $cnt += document("${p}-2");
    $cnt += document("${p}-3");
    $P{$p}{'V'} = 'V' if 0 == $cnt; # don't seem to have this task
}

#####
# study task source code, set various condition flags
sub document {
my($p) = @_;
my($task,$header,@concur,$compiles,$mout,$merr,$jout,$jerr,$skip,$srand);

    $task = '../' . path($p) . $p;
    return 0 if ! -e $task;
    return 0 if defined $P{$p}{'M'};

    $header = `grep '^#[mjcft]#' $task`;

    $P{$p}{'M'} = $header =~ /MOAR:\s*OK/ ? 'G' : 'B';
#   $compiles = `$ENV{HOME}/.rakubrew/shims/raku -c $task 2>&1 1>/dev/null`;
    $mout = "../bench/moar/$p.out";
    $P{$p}{'S'} = -e $mout ? 'S' : '.';
    $merr = (-e $mout) ? `grep STDERR $mout` : undef;
    $P{$p}{'M'} = '!' if                         ($P{$p}{'M'} eq 'G' && $merr);
#   $P{$p}{'M'} = '!' if $compiles =~ /SORRY/ || ($P{$p}{'M'} eq 'G' && $merr);

    $P{$p}{'J'} = $header =~ /JVM:\s*OK/ ? 'G' : 'B';
    $jout = "../bench/jvm/$p.out";
    $jerr = (-e $jout) ? `grep STDERR $jout` : undef;
    $P{$p}{'J'} = '!' if $P{$p}{'J'} eq 'G' && $jerr;

    $skip = 'interactive|gui|toodamnslow|skiptest|inprogress|nocode|forever|broken';  # cf. def in 'rc-moar'
    $P{$p}{'K'} = $header =~ /$skip/             ? 'K' : '.';
    $P{$p}{'T'} = $header =~ />RC/               ? 'T' : '.';
    $P{$p}{'F'} = $header =~ /#f#.*RC file/i     ? 'F' : '.';
    $P{$p}{'I'} = $header =~ /#t#.*(inter|gui)/i ? 'I' : '.';

    my $rh = '(race|hyper|Promise)|Lock.*new';
    @concur = `~/bin/pcregrep '\\.$rh' $task`;
    if (@concur) {
        my $active = grep { /^[^#\n]+$rh/ } @concur;
        $P{$p}{'C'} = $active > 0                ? 'C' : 'c';
    } else {
        $P{$p}{'C'} =                                    '.';
    }

    $srand = `grep 'srand|myRNG' $task`; # account for built-in and alternate PRNG
    $P{$p}{'R'} = $srand =~ /srand \d|myRNG/         ? 'R' : '.';

    return 1; # to increment counter
}

#####
# extract potential task names, validate & clean-up
sub pname {
my($l) = @_;

    return '' unless $l =~ m#<li><a href="/wiki/# && $l !~ /Category:/;
    my($p) = $l =~ m#<li><a href="/wiki/(.*?)"#;
    return '' if $p =~ /Niecza|Pugs|Rakudo/;    # stray stuff from 'unimplemented'
    $p =~ s/Brain\*\*\*\*/Brainfuck/;           # 'fix' Brainfuck name
    $p =~ s/%E2%80%93/-/;                       # Burrows%E2%80%93Wheeler_transform
    $p =~ s/%E2%80%99//;                        # Ukkonen%E2%80%99s
    $p =~ s/%C3%B6/oe/;                         # Möbius_function
    $p =~ s/\$10/10/;                           # Hofstadter-Conway_$10,000_sequence
    $p =~ s/A\*/A_star/;                        # A*_search_algorithm
    $p =~ s/0-1/0_1/;                           # Knapsack_problem_0-1, now in two versions: *_0_1-1, *_0_1-2
    $p =~ s/n\*n\*n/n_n_n/;                     # Find_prime_numbers_of_the_form_n_n_n%2B2
    $p =~ s/%C5%91/o/;                          # Erdős-primes, Erdős-Nicolas_numbers, etc
    $p =~ s/ó/o/;                               # Jordan-Polya_numbers: ó = \314\201
#    $p =~ s/Yahoo./Yahoo_/;                     # getting rid of the '!'
    return pfix($p);
}

#####
# standardize task name
sub pfix { 
my($p) = @_;

    $p =~ s#/#_#g;
    $p =~ s#\$#_#g;
    $p =~ s#\!#_#g;
    $p =~ s#[()]##g;
    return $p;
}

#####
# column totals
sub tally {
    my($col,$val) = @_;
    $val = $col unless $val;
    my $x;
    for my $p (keys %P) { $x++ if defined $P{$p}{$col} && $P{$p}{$col} eq $val }
    return $x;
}

# these are being ignored, for various reasons
# NB: Sieve_of_Eratosthenes actually has two good examples, but a third off-topic one that's marked as 'bad'

__DATA__
Arena_storage_pool
Aspect_Oriented_Programming
AudioAlarm
Canny_edge_detector
CLI-based_maze-game
Create_a_file_on_magnetic_tape
Create_DWM_statusbar
Doubly-linked_list_Traversal
Generalised_floating_point_multiplication
Interactive_programming
JortSort
Long_literals,_with_continuations
Max_licenses_in_use
Modulinos
Narcissist
Native_shebang
OLE_Automation
OpenGL
OpenGL/Utah_Teapot
Parametrized_SQL_statement
Play_recorded_sounds
Prime_numbers_p_which_sum_of_prime_numbers_less_or_equal_to_p_is_prime
RCRPG
Random_number_generator_(included)
SQL-based_authentication
Sanitize_user_input
Segmentation_fault_protection
Self-hosting_compiler
Sieve_of_Eratosthenes
Snake
Solving_coin_problems
Sorting_algorithms/Tree_sort_on_a_linked_list
Stair-climbing_puzzle
Unit_testing
User_input/Graphical
Variable_size_Set
Variables
Weather_routing
WiktionaryDumps_to_words
Write_to_Windows_event_log