I've got a method in a class:
method options(*#opt) {
if !#!valid-options {
my $out = (cmd 'bin/md2html -h').out;
my #matches = $out ~~ m:g/\s'--'(<-[\s]>+)/;
for #matches -> $opt {
push #!valid-options, $opt[0].Str;
}
}
for #opt -> $opt {
when !($opt (elem) #!valid-options) {
warn "'$opt' is not a valid option";
}
push #!options, '--' ~ $opt;
}
}
The method checks that the options to see if they are valid and, if they are, places them into an attribute.
I pass args into the options method like this, as words:
$obj.options: <ftables ftasklists github>;
This works. But it got me wondering if it was possible pass in the options as named flags like this:
$obj.options: :ftables, :ftasklists, :github
But since I don't know all the command's options ahead of time, I'd need to generate the named arguments dynamically. Is this possible? I tried this but had no luck:
# create a signature
my #params = Parameter.new(name => ':$option', type => Bool, :!default);
my $sig = Signature.new(:#params);
my &blah = -> $sig { say 'this works too' } ;
&blah(:option1);
Currently, there is no way to do that, short of using EVAL.
You can add a slurpy hash to any sub signature to catch all unexpected named arguments:
sub foo(*%_) { .say for %_.keys }
foo :bar, :baz; # bar baz
Creating your own signatures at runtime may become possible / easier when the RakuAST has landed.
Related
I have the following structure in the resources directory in a module I'm building:
resources
|-- examples
|-- Arrays
| |-- file
|-- Lists
|-- file1
|-- file2
I have the following code to collect and process these files:
use v6.d;
unit module Doc::Examples::Resources;
class Resource {
has Str $.name;
has Resource #.resources;
has Resource %.resource-index;
method resource-names() {
#.resources>>.name.sort
}
method list-resources() {
self.resource-names>>.say;
}
method is-resource(Str:D $lesson) {
$lesson ~~ any self.resource-names;
}
method get-resource(Str:D $lesson) {
if !self.is-resource($lesson) {
say "Sorry, that lesson does not exist.";
return;
}
return %.resource-index{$lesson};
}
}
class Lesson is Resource {
use Doc::Parser;
use Doc::Subroutines;
has IO $.file;
method new(IO:D :$file) {
my $name = $file.basename;
self.bless(:$name, :$file)
}
method parse() {
my #parsed = parse-file $.file.path;
die "Failed parse examples from $.file" if #parsed.^name eq 'Any';
for #parsed -> $section {
my $heading = $section<meta>[0] || '';
my $intro = $section<meta>[1] || '';
say $heading.uc ~ "\n" if $heading && !$intro;
say $heading.uc if $heading && $intro;
say $intro ~ "\n" if $intro;
for $section<code>.Array {
die "Failed parse examples from $.file, check it's syntax." if $_.^name eq 'Any';
das |$_>>.trim;
}
}
}
}
class Topic is Resource {
method new(IO:D :$dir) {
my $files = dir $?DISTRIBUTION.content("$dir");
my #lessons;
my $name = $dir.basename;
my %lesson-index;
for $files.Array -> $file {
my $lesson = Lesson.new(:$file);
push #lessons, $lesson;
%lesson-index{$lesson.name} = $lesson;
}
self.bless(:$name, resources => #lessons, resource-index => %lesson-index);
}
}
class LocalResources is Resource is export {
method new() {
my $dirs = dir $?DISTRIBUTION.content('resources/examples');
my #resources;
my %resource-index;
for $dirs.Array -> $dir {
my $t = Topic.new(:$dir);
push #resources, $t;
%resource-index{$t.name} = $t;
}
self.bless(:#resources, :%resource-index)
}
method list-lessons(Str:D $topic) {
self.get-resource($topic).list-lessons;
}
method parse-lesson(Str:D $topic, Str:D $lesson) {
self.get-resource($topic).get-resource($lesson).parse;
}
}
It works. However, I'm told that this is not reliable and there there is no guarantee that lines like my $files = dir $?DISTRIBUTION.content("$dir"); will work after the module is installed or will continue to work into the future.
So what are better options for bundling a library of text files with my module that can be accessed and found by the module?
Files under the resources directory will always be available as keys to the %?RESOURCES compile-time variable if you declare them in the META6.json file this way:
"resources": [
"examples/Array/file",
]
and so on.
I've settled on a solution. As pointed out by jjmerelo, the META6.json file contains a list of resources and, if you use the comma IDE, the list of resources is automatically generated for you.
From within the module's code, the list of resources can be accessed via the $?DISTRIBUTION variable like so:
my #resources = $?DISTRIBUTION.meta<resources>
From here, I can build up my list of resources.
One note on something I discovered: the $?DISTRIBUTION variable is not accessible from a test script. It has to be placed inside a module in the lib directory of the distribution and exported.
... Or how to change $<sigil>.Str value from token sigil { ... } idependently from the matched text. Yes I'm asking how to cheat grammars above (i.e. calling) me.
I am trying to write a Slang for Raku without sigil.
So I want the nogil token, matching anything <?> to return NqpMatch that stringifies: $<sigil>.Str to '$'.
Currently, my token sigil look like that
token sigil {
| <[$#%&]>
| <nogil> { say "Nogil returned: ", lk($/, 'nogil').Str; # Here It should print "$"
}
}
token nogil-proxy {
| '€'
| <?>
{log "No sigil:", get-stack; }
}
And the method with that should return a NQPMatch with method Str overwritten
method nogil {
my $cursor := self.nogil-proxy;
# .. This si where Nqp expertise would be nice
say "string is:", $cursor.Str; # here also it should print "$"
return $cursor;
}
Failed try:
$cursor.^cache_add('Str', sub { return '$'; } );
$cursor.^publish_method_cache;
for $cursor.^attributes { .name.say };
for $cursor.^methods { .name.say };
say $cursor.WHAT.Str;
nqp::setmethcacheauth($cursor, 0);
Currently, most of my tests work but I have problems in declarations without my (with no strict) like my-var = 42; because they are considered as method call.
#Arne-Sommer already made a post and an article. This is closely related. But this questions aims:
How can we customize the return value of a compile-time token and not how to declare it.
Intro: The answer, pointed by #JonathanWorthington:
Brief: Use the mixin meta function. (And NOT the but requiring compose method.)
Demo:
Create a NQPMatch object by retrieving another token: here the token sigil-my called by self.sigil-my.
Use ^mixin with a role
method sigil { return self.sigil-my.^mixin(Nogil::StrGil); }
Context: full reproducible code:
So you can see what type are sigil-my and Nogil::StrGil. But I told you: token (more than method) and role (uninstantiable classes).
role Nogil::StrGil {
method Str() {
return sigilize(callsame);
}
}
sub EXPORT(|) {
# Save: main raku grammar
my $main-grammar = $*LANG.slang_grammar('MAIN');
my $main-actions = $*LANG.slang_actions('MAIN');
role Nogil::NogilGrammar {
method sigil {
return self.sigil-my.^mixin(Nogil::StrGil);
}
}
token sigil-my { | <[$#%&]> | <?> }
# Mix
my $grammar = $main-grammar.^mixin(Nogil::NogilGrammar);
my $actions = $main-actions.^mixin(Nogil::NogilActions);
$*LANG.define_slang('MAIN', $grammar, $actions);
# Return empty hash -> specify that we’re not exporting anything extra
return {};
}
Note: This opens the door to mush more problems (also pointed by jnthn question comments) -> -0fun !
I'm attempting to run a series of shell commands in parallel in Perl6, using Perl5's Parallel::ForkManager
This is an almost exact translation of working Perl5 code.
CONTROL {
when CX::Warn {
note $_;
exit 1;
}
}
use fatal;
role KeyRequired {
method AT-KEY (\key) {
die "Key {key} not found" unless self.EXISTS-KEY(key);
nextsame;
}
}
use Parallel::ForkManager:from<Perl5>;
sub run_parallel (#cmd) {
my $manager = Parallel::ForkManager(8).new();
for (#cmd) -> $command {
$manager.start and $manager.next;
my $proc = shell $command, :out, :err;
if $proc.exitcode != 0 {
put "$command failed";
put $proc.out.slurp;
put $proc.err.slurp;
die;
}
$manager.finish;
}
$manager.wait_all_children;#necessary after all lists
}
my #cmd;
my Str $dir = 'A/1';
for dir($dir, test => /\.vcf\.gz$/) -> $vcf {
#cmd.append: "aws s3 cp $vcf s3://s3dir/$dir/"
}
put #cmd.elems;
run_parallel(#cmd);
Basically, I'm trying to parallelize tedious shell commands.
However, this mysterious error comes up:
Cannot invoke this object (REPR: P6opaque; Parallel::ForkManager) in
sub run_parallel at 2.aws_cp.p6 line 18 in block at
2.aws_cp.p6 line 39
Why is Perl6 saying this? what is wrong? how can I get these commands to run?
Perhaps there is a more native/idiomatic way to run shell commands in parallel in Perl6?
You probably want to look at using Proc::Async which runs external commands asynchronously in threads without forking separate instances of the code to do it.
Perl5's Parallel::ForkManager probably won't work in Perl6 because of how Inline::Perl5 is implemented.
Inline::Perl5 embeds the Perl5 compiler/runtime inside of Perl6.
Parallel::ForkManager expects that Perl5 was run by itself.
If you ever did get it to do something other than generate an error it would probably screw up the Perl6 runtime. The main problem is the use of fork. For more information about why fork is a a problem see the article Bart Wiegmans (brrt) wrote about it: “A future for fork(2)”
Perl6 already has a similar feature that is easier to use.
sub run_parallel (#cmd) {
my #children = do for (#cmd) -> $command {
start {
my $proc = shell $command, :out, :err;
if $proc.exitcode != 0 {
put "$command failed";
put $proc.out.slurp;
put $proc.err.slurp;
die;
}
}
}
await #children;
}
start is a prefix that tells the runtime to start running the following code sometime in the near future. It returns a Promise.
await takes a list of Promises and returns a list of their results.
start basically calls Promise.start which is similar to:
sub start ( &code ) {
my $promise = Promise.new;
my $vow = $promise.vow;
$*SCHEDULER.cue(
{ $vow.keep(code(|c)) },
:catch(-> $ex { $vow.break($ex); }) );
$promise
}
So it will use the globally available thread pool in $*SCHEDULER. If you want to use a separate one you could.
sub run_parallel (#cmd) {
my $*SCHEDULER = ThreadPoolScheduler.new(max_threads => 8);
my #children = do for (#cmd) -> $command {
start {
my $proc = shell $command, :out, :err;
if $proc.exitcode != 0 {
put "$command failed";
put $proc.out.slurp;
put $proc.err.slurp;
die;
}
}
}
await #children;
}
It would make more sense to use Proc::Async for this though.
In my Perl 6 script, I want to do a (preferably non-blocking) check of standard input to see if data is available. If this is the case, then I want to process it, otherwise I want to do other stuff.
Example (consumer.p6):
#!/usr/bin/perl6
use v6.b;
use fatal;
sub MAIN() returns UInt:D {
while !$*IN.eof {
if some_fancy_check_for_STDIN() { #TODO: this needs to be done.
for $*IN.lines -> $line {
say "Process '$line'";
}
}
say "Do something Else.";
}
say "I'm done.";
return 0;
}
As a STDIN-Generator I wrote another Perl6 script (producer.p6):
#!/usr/bin/perl6
use v6.b;
use fatal;
sub MAIN() returns UInt:D {
$*OUT.say("aaaa aaa");
sleep-until now+2;
$*OUT.say("nbbasdf");
sleep-until now+2;
$*OUT.say("xxxxx");
sleep-until now+2;
return 0;
}
If consumer.p6 works as expected, it should produce the following output, if called via ./producer.p6 | ./consumer.p6:
Process 'aaaa aaa'
Do something Else.
Process 'nbbasdf'
Do something Else.
Process 'xxxxx'
Do something Else.
I'm done.
But actually, it produces the following output (if the if condition is commented out):
Process 'aaaa aaa'
Process 'nbbasdf'
Process 'xxxxx'
Do something Else.
I'm done.
You are using an old version of Perl 6, as v6.b is from before the official release of the language.
So some of what I have below may need a newer version to work.
Also why are you using sleep-until now+2 instead of sleep 2?
One way to do this is to turn the .lines into a Channel, then you can use .poll.
#!/usr/bin/env perl6
use v6.c;
sub MAIN () {
# convert it into a Channel so we can poll it
my $lines = $*IN.Supply.lines.Channel;
my $running = True;
$lines.closed.then: {$running = False}
while $running {
with $lines.poll() -> $line {
say "Process '$line'";
}
say "Do something Else.";
sleep ½;
}
say "I'm done.";
}
Note that the code above blocks at the my $lines = … line currently; so it doesn't start doing something until the first line comes in. To get around that you could do the following
my $lines = supply {
# unblock the $*IN.Supply.lines call
whenever start $*IN.Supply {
whenever .lines { .emit }
}
}.Channel;
As seen in my code below, I am using apache to serve my Perl web server. I need Perl to have multple routes for my client as seen in my %dispatch. If I figure one out I'm sure the rest will be very similar. If we look at my Subroutine sub resp_index, how can I modify this to link to my index.html file located in my root: /var/www/perl directory?
/var/www/perl/perlServer.pl:
#!/usr/bin/perl
{
package MyWebServer;
use HTTP::Server::Simple::CGI;
use base qw(HTTP::Server::Simple::CGI);
my %dispatch = (
'/index.html' => \&resp_index,
# ...
);
sub handle_request {
my $self = shift;
my $cgi = shift;
my $path = $cgi->path_info();
my $handler = $dispatch{$path};
if (ref($handler) eq "CODE") {
print "HTTP/1.0 200 OK\r\n";
$handler->($cgi);
} else {
print "HTTP/1.0 404 Not found\r\n";
print $cgi->header,
$cgi->start_html('Not found'),
$cgi->h1('Not found'),
$cgi->end_html;
}
}
sub resp_index {
my $cgi = shift; # CGI.pm object
return if !ref $cgi;
my $who = $cgi->param('name');
print $cgi->header,
$cgi->start_html("index"),
$cgi-h1("THIS IS INDEX"),
$cgi->end_html;
}
}
my $pid = MyWebServer->new()->background();
print "Use 'kill $pid' to stop server.\n";
I think what you're asking is how do you serve a file from your web server? Open it and print it, like any other file.
use autodie;
sub resp_index {
my $cgi = shift;
return if !ref $cgi;
print $cgi->header;
open my $fh, "<", "/var/www/perl/index.html";
print <$fh>;
}
Unless this is an exercise, really, really, REALLY don't write your own web framework. It's going to be slow, buggy, and insecure. Consider a small routing framework like Dancer.
For example, mixing documents like index.html and executable code like perlServer.pl in the same directory invites a security hole. Executable code should be isolated in their own directory so they can be given wholly different permissions and stronger protection.
Let's talk about this line...
return if !ref $cgi;
This line is hiding an error. If your functions are passed the wrong argument, or no argument, it will silently return and you (or the person using this) will have no idea why nothing happened. This should be an error...
use Carp;
croak "resp_index() was not given a CGI object" if !ref $cgi;
...but really you should use one of the existing function signature modules such as Method::Signatures.
use Method::Signatures;
func resp_index(CGI $cgi) {
...
}