Rosetta Code/Run examples: Difference between revisions

Line 263:

=={{header|Perl 6}}==

This is a fairly comprehensive task code runner. It is set up to work for Perl 6 ~~only~~ at this point, but ~~could~~ be easily tweaked to work with other languages. There is so much variation to the task requirements and calling conventions that it would be problematic to make a general purpose, language agnostic code runner. ~~(Heck,~~ a ~~single~~ ~~language~~ ~~one~~ is ~~hard~~ ~~enough~~.)

This is a fairly comprehensive task code runner. It is set up to work for Perl 6 at this point, but can be easily tweaked to work with other languages. There is so much variation to the task requirements and calling conventions that it would be problematic to make a general purpose, language agnostic code runner so some configuration is necessary to make it work with other languages.

By default, this will download the Perl 6 section of any (every) task that has a Perl 6 example, extract the code blocks and attempt to run them. Many tasks require files or user interaction to proceed, others are not complete runnable code blocks (example code fragments), some tasks run forever. To try to deal with and compensate for this, this implementation can load a %resource hash that will: supply input files where necessary, skip unrunnable code fragments, limit long and/or infinite running blocks, supply user interaction code where possible, and skip blocks where user interaction is unavoidable.

There are several command line options to control its actions. See the README in the repository for details.

The complete implementation is too large and cumbersome to post in it's entirety here, only the main task retrieval and execution code is included.

Line 271:

Line 273:

For the whole ball of wax see [https://github.com/thundergnat/rc-run the rc-run github repository].

Run with no parameters to run every implemented task on Rosetta Code. Feed it a task name to only download / run that task.

Run with no parameters to run every implemented task on Rosetta Code. Feed it a task name to only download / run that task. Give it command line switches to adjust its behaviour.

Note: This is set up to run under Linux. It could be adapted for Windows (or OSX I suppose) fairly easily but I don't have access to those OSs, nor do I care to seek it.

Line 279:

Line 281:

use JSON::Fast;

use MONKEY-SEE-NO-EVAL;

my %*SUB-MAIN-OPTS = :named-anywhere;

unit sub MAIN( Str $run = '', Bool :f(:$force), Bool :l(:$local), Bool :r(:$remote) );

die 'You can select local or remote, but not both...' if $local && $remote;

my $client = HTTP::UserAgent.new;

my $url = 'http://rosettacode.org/mw';

# Language specific variables

my %l = ( # Language specific variables Adjust to suit

my $language = 'Perl_6'; # language

language => 'Perl_6', # language category name

exe => 'perl6', # executable name to run perl6 in a shell

my $header = 'Perl 6'; # header text

my ~~$exe~~ = '~~perl6~~'; # ~~executable~~ to ~~run~~ ~~perl6~~ in a ~~shell~~

ext => '.p6', # file extension for perl6 code

my ~~$ext~~ = '~~.p6~~'; # ~~file~~ ~~extension~~ ~~for~~ ~~perl6~~ ~~code~~

dir => 'perl6', # directory to save tasks to

header => 'Perl 6', # header text

# tags marking blocks of code - spaced out to placate wiki formatter

# and to avoid getting tripped up when trying to run _this_ task

tag => rx/<?after '<lang ' 'perl6' '>' > .*? <?before '</' 'lang>'>/,

);

my %c = ( # text colors

# weird break in lang tag to placate terminally confused wiki formatter and syntax highlighter

code => "\e[0;92m", # green

my $tag = rx/<?after '<lang perl6>'> .*? <?before '</' 'lang>'>/; # language entry regex

delim => "\e[0;93m", # yellow

cmd => "\e[1;96m", # cyan

warn => "\e[0;91m", # red

clr => "\e[0m", # clear formatting

);

my $view = 'xdg-open'; # image viewer, this will open default under Linux

my %resource = load-resources();

my $~~download~~ = True;

my $get-tasks = True;

my @tasks;

Line 301:

Line 319:

note 'Retrieving tasks';

if ~~@*ARGS~~ {

if $run {

if $run.IO.e and $run.IO.f {

@tasks = |@*ARGS;

~~$download~~ = ~~False~~;

@tasks = $run.IO.lines;

} else {

@tasks = ($run);

}

$get-tasks = False;

}

if $~~download~~ {

if $get-tasks {

if (("%l<language>.tasks".IO.modified//0 - now) > 86400 ) or $remote {

@tasks = mediawiki-query(

$url, 'pages',

:generator<categorymembers>,

:gcmtitle("Category:$language"),

:gcmtitle("Category:%l<language>"),

:gcmlimit<350>,

:~~rawcontinue()~~,

:gcmlimit<350>,

:~~prop<title>~~

:rawcontinue(),

:prop<title>

)»<title>.grep( * !~~ /^'Category:'/ );

)»<title>.grep( * !~~ /^'Category:'/ ).sort;

"%l<exe>.tasks".IO.spurt: @tasks.sort.join("\n");

} else {

@tasks = "%l<language>.tasks".IO.slurp;

}

Line 326:

Line 353:

say $skip + ++$, " $title";

my $name = $title.subst(/<-[-0..9A..Za..z]>/, '_', :g);

my $page = $client.get("{ $url }/index.php?title={ uri-escape $title }&action=raw").content;

my $taskdir = "./rc/%l<dir>/$name";

say "Whoops, can't find page: $url/$title :check spelling." and next if $page.elems == 0;

say "Getting code from: http://rosettacode.org/wiki/{ $title.subst(' ', '_', :g) }#$language";

my $modified = "$taskdir/name.txt".IO.e ?? "$taskdir/name.txt".IO.modified !! 0;

my $entry = $page.comb(/'=={{header|' $header '}}==' .+? [<?before \n'=='<-[={]>*'{{header'> || $] /).Str // whoops;

if $entry ~~~~ /^^ 'See [[' (.+?) '/' $language / {~~

my $entry;

if $remote or (($modified - now) > 86400 * 7) {

$entry = $client.get("{ $url }/index.php?title={ uri-escape $/[0].Str ~ '/' ~ $language }&action=raw").content;

my $page = $client.get("{ $url }/index.php?title={ uri-escape $title }&action=raw").content;

}

say %c<warn>, "Whoops, can't find page: $url/$title :check spelling.", %c<clr> and next if $page.elems == 0;

my $name = $title.subst(/<-[-0..9A..Za..z]>/, '_', :g);

say "Getting code from: http://rosettacode.org/wiki/{ $title.subst(' ', '_', :g) }#%l<language>";

my $header = %l<header>; # can't interpolate hash into regex

my $dir = mkdir "./rc/tasks/$name";

$entry = $page.comb(/'=={{header|' $header '}}==' .+? [<?before \n'=='<-[={]>*'{{header'> || $] /).Str // whoops;

my $lang = %l<language>; # can't interpolate hash into regex

spurt( "./rc/tasks/$name/$name.txt", $entry );

if $entry ~~ /^^ 'See [[' (.+?) '/' $lang / { # no code on main page, check sub page

$entry = $client.get("{ $url }/index.php?title={ uri-escape $/[0].Str ~ '/' ~ %l<language> }&action=raw").content;

}

mkdir $taskdir unless $taskdir.IO.d;

spurt( "$taskdir/$name.txt", $entry );

} else {

if "$taskdir/$name.txt".IO.e {

$entry = "$taskdir/$name.txt".IO.slurp;

say "Loading code from: $taskdir/$name.txt";

} else {

uh-oh("Task code $taskdir/$name.txt not found, check spelling or run remote.");

next;

}

my @blocks = $entry.comb: $tag;

my @blocks = $entry.comb: %l<tag>;

unless @blocks {

if %resource{"$name"}<skip> {

whoops unless %resource{"$name"}<skip> ~~ /'ok to skip'/;

say "Skipping $name: ", %resource{"$name"}<skip>, "\n" if %resource{"$name"}<skip>

whoops;

say "Skipping $name: ", %resource{"$name"}<skip>, "\n";

}

for @blocks.kv -> $k, $v {

my $n = +@blocks == 1 ?? '' !! $k;

spurt( "~~./rc/tasks/~~$~~name~~/$name$n$ext", $v );

spurt( "$taskdir/$name$n%l<ext>", $v );

~~say "Skipping $name$n: ",~~ %resource{"$name$n"}<skip>, ~~"\n"~~

if %resource{"$name$n"}<skip> && !$force {

~~and~~ ~~next~~ if ~~%resource{~~"$name$n"}<~~skip~~>;

dump-code ("$taskdir/$name$n%l<ext>");

if %resource{"$name$n"}<skip> ~~ /'broken'/ {

uh-oh(%resource{"$name$n"}<skip>);

} else {

say "Skipping $name$n: ", %resource{"$name$n"}<skip>, "\n"

}

next;

}

say "\nTesting $name$n";

run-it($~~name~~, "$name$n");

run-it($taskdir, "$name$n");

}

say '=' x 79;

Line 377:

Line 424:

sub run-it ($dir, $code) {

my $current = $*CWD;

chdir ~~"./rc/tasks/~~$dir/";

chdir $dir;

if %resource{$code}<file> -> $fn {

copy "./~~../..~~/resources/{$fn}", "./{$fn}"

copy "$current/rc/resources/{$fn}", "./{$fn}"

}

dump-code ("$code%l<ext>");

my @cmd = %resource{$code}<cmd> ?? |%resource{$code}<cmd> !! "$exe $code$ext";

check-modules("$code%l<ext>") if %l<language> eq 'Perl_6';

my @cmd = %resource{$code}<cmd> ?? |%resource{$code}<cmd> !! "%l<exe> $code%l<ext>\n";

for @cmd -> $cmd {

say "\nCommand line: $cmd";

say "\nCommand line: {%c<cmd>}$cmd",%c<clr>;

try ~~EVAL(~~shell $cmd);

try shell $cmd;

}

chdir $current;

say "\nDone $code";

}

sub dump-code ($fn) {

say "\n", %c<delim>, ('vvvvvvvv' xx 7).join(' CODE '), %c<clr>, "\n", %c<code>;

print $fn.IO.slurp;

say %c<clr>,"\n\n",%c<delim>,('^^^^^^^^' xx 7).join(' CODE '),%c<clr>;

}

Line 394:

Line 449:

sub clear { "\r" ~ ' ' x 100 ~ "\r" }

sub whoops { ~~note~~ "{'#' x 79}\n\nNo code found\nMay be bad markup\n\n{'#' x 79}"~~; ''~~ }

sub whoops { say %c<warn>,"{'#' x 79}\n\nNo code found\nMay be bad markup\n\n{'#' x 79}",%c<clr> }

sub uh-oh ($err) { put %c<warn>, "{'#' x 79}\n\n$err;\n\n{'#' x 79}", %c<clr> }

sub check-modules ($fn) {

my @use = $fn.IO.slurp.comb(/<?after $$ 'use '> \N+? <?before \h* ';'>/);

if +@use {

for @use -> $module {

next if $module eq any('v6','nqp') or $module.contains('MONKEY');

my $installed = $*REPO.resolve(CompUnit::DependencySpecification.new(:short-name($module)));

shell("zef install $module") unless $installed;

}

sub load-resources { () } # load resources for finer control