How can I load a OO-style module dynamically?
#!/usr/bin/env perl6
use v6;
my $r = prompt ':';
if $r {
require Text::CSV; # Error:
my $csv = Text::CSV.new; # Could not find symbol '&CSV'
} else {
require File::Temp <&tempfile>;
my ( $filename , $filehandle ) = tempfile; # this works
}
As explained in the perl6 doco here, you can dynamically load the module but;
To import symbols you must define them at compile time.
So, the code in the else clause works because of the explicit request to import <&tempfile>.
The closest thing to getting the code in the if clause to work that I can see is this (which is mostly taken from that earlier doco reference):
use v6.c ;
sub load-a-module($name) {
require ::($name) ;
my $instance = ::($name).new() ;
return $instance ;
}
my $module = "Text::CSV" ;
my $csv = load-a-module $module ;
say $csv.WHAT ;
# say $csv.^methods ; # if you really want to be convinced
# outputs: (CSV)
Related
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.
I'm trying to read a gz file line by line in Perl6, however, I'm getting blocked:
How to read gz file line by line in Perl6 however, this method, reading everything into :out uses far too much RAM to be usable except on very small files.
I don't understand how to use Perl6's Compress::Zlib to get everything line by line, although I opened an issue on their github https://github.com/retupmoca/P6-Compress-Zlib/issues/17
I'm trying Perl5's Compress::Zlib to translate this code, which works perfectly in Perl5:
use Compress::Zlib;
my $file = "data.txt.gz";
my $gz = gzopen($file, "rb") or die "Error reading $file: $gzerrno";
while ($gz->gzreadline($_) > 0) {
# Process the line read in $_
}
die "Error reading $file: $gzerrno" if $gzerrno != Z_STREAM_END ;
$gz->gzclose() ;
to something like this using Inline::Perl5 in Perl6:
use Compress::Zlib:from<Perl5>;
my $file = 'chrMT.1.vcf.gz';
my $gz = Compress::Zlib::new(gzopen($file, 'r');
while ($gz.gzreadline($_) > 0) {
print $_;
}
$gz.gzclose();
but I can't see how to translate this :(
I'm confused by Lib::Archive example https://github.com/frithnanth/perl6-Archive-Libarchive/blob/master/examples/readfile.p6 I don't see how I can get something like item 3 here
There should be something like
for $file.IO.lines(gz) -> $line { or something like that in Perl6, if it exists, I can't find it.
How can I read a large file line by line without reading everything into RAM in Perl6?
Update Now tested, which revealed an error, now fixed.
Solution #2
use Compress::Zlib;
my $file = "data.txt.gz" ;
my $handle = try open $file or die "Error reading $file: $!" ;
my $zwrap = zwrap($handle, :gzip) ;
for $zwrap.lines {
.print
}
CATCH { default { die "Error reading $file: $_" } }
$handle.close ;
I've tested this with a small gzipped text file.
I don't know much about gzip etc. but figured this out based on:
Knowing P6;
Reading Compress::Zlib's README and choosing the zwrap routine;
Looking at the module's source code, in particular the signature of the zwrap routine our sub zwrap ($thing, :$zlib, :$deflate, :$gzip);
And trial and error, mainly to guess that I needed to pass the :gzip adverb.
Please comment on whether my code works for you. I'm guessing the main thing is whether it's fast enough for the large files you have.
A failed attempt at solution #5
With solution #2 working I would have expected to be able to write just:
use Compress::Zlib ;
.print for "data.txt.gz".&zwrap(:gzip).lines ;
But that fails with:
No such method 'eof' for invocant of type 'IO::Path'
This is presumably because this module was written before the reorganization of the IO classes.
That led me to #MattOates' IO::Handle like object with .lines ? issue. I note no response and I saw no related repo at https://github.com/MattOates?tab=repositories.
I am focusing on the Inline::Perl5 solution that you tried.
For the call to $gz.gzreadline($_): it seems like gzreadline tries to return the line read from the zip file by modifying its input argument $_ (treated as an output argument, but it is not a true Perl 5 reference variable[1]), but the modified value is not returned to the Perl 6 script.
Here is a possoble workaround:
Create a wrapper module in the curent directory, e.g. ./MyZlibWrapper.pm:
package MyZlibWrapper;
use strict;
use warnings;
use Compress::Zlib ();
use Exporter qw(import);
our #EXPORT = qw(gzopen);
our $VERSION = 0.01;
sub gzopen {
my ( $fn, $mode ) = #_;
my $gz = Compress::Zlib::gzopen( $fn, $mode );
my $self = {gz => $gz};
return bless $self, __PACKAGE__;
}
sub gzreadline {
my ( $self ) = #_;
my $line = "";
my $res = $self->{gz}->gzreadline($line);
return [$res, $line];
}
sub gzclose {
my ( $self ) = #_;
$self->{gz}->gzclose();
}
1;
Then use Inline::Perl5 on this wrapper module instead of Compress::Zlib. For example ./p.p6:
use v6;
use lib:from<Perl5> '.';
use MyZlibWrapper:from<Perl5>;
my $file = 'data.txt.gz';
my $mode = 'rb';
my $gz = gzopen($file, $mode);
loop {
my ($res, $line) = $gz.gzreadline();
last if $res == 0;
print $line;
}
$gz.gzclose();
[1]
In Perl 5 you can modify an input argument that is not a reference, and the change will be reflected in the caller. This is done by modifying entries in the special #_ array variable. For example: sub quote { $_[0] = "'$_[0]'" } $str = "Hello"; quote($str) will quote $str even if $str is not passed by reference.
I have a mod_perl PerlAuthzHandler authorizing access to directories served by Apache2. In terms of controlling access it is working well.
A side effect, though, is that it seems to be preventing POST form variables from being available to PHP apps in the protected locations. At least when I comment out the PerlAuthzHandler and reload Apache the PHP app functions again. I think either the full environment is not being inherited by Perl or Perl is sending a cleansed environment on.
Is it possible to ensure that all POST variables are available to the PHP application after authorization?
Details
User authentication is managed by simplesamlphp on this box, the SP, and ADFS, the IdP. The addition to the simplesamlphp installation is the use of PerlAuthzHandler.
Apache configuration
The Apache configuration for the location in question looks like this:
<Location /activity>
ErrorDocument 401 "/simplesaml/authmemcookie.php"
AuthName "MCLAnet"
AuthType Cookie
Require valid-user
PerlSetvar Auth_memCookie_SessionTableSize "40"
PerlAuthzHandler My::simple
PerlSetVar VALID_GROUP_EXPR "status-acad or staff-g"
</Location>
Authorization handler
The authorization handler retrieves group memberships recorded in setting up the session and compared to a VALID_GROUP_EXPRESSION in the PerlSetVar:
#! /usr/bin/perl
package My::simple;
# Version 1.0 MCLA CSS
use Apache2::Access ();
use Apache2::RequestUtil ();
# load modules that are going to be used
use Data::Dumper;
use CGI qw(:standard);
use CGI::Cookie;
use Cache::Memcached;
use PHP::Serialization qw(serialize unserialize);
# compile (or import) constants
use Apache2::Const -compile => qw(OK FORBIDDEN);
$debug=0;
$debug_file="/tmp/xxx";
dmp('prerun',('test'));
sub handler {
my $r = shift;
my $user = $r->user;
dmp('0 user',$user);
# ------------------------ get valid group(s) for this session
my $valid_group_expr=$r->dir_config("VALID_GROUP_EXPR");
dmp('1 valid group list',$valid_group_expr);
# -- get the session cooke to retrieve the session <ID>
$query = new CGI;
# fetch existing cookies
my %cookies = CGI::Cookie->fetch;
# dmp('Cookies',%cookies);
my $ID = $cookies{'SimpleSAMLSessionID'}->value;
dmp('2 SimpleSAMLSessionID value',$ID);
my $SessionID='simpleSAMLphp.session.' . $ID;
# -- use the session ID to look up the value of memcached key simpleSAMLphp.session.<ID>
my $cache = new Cache::Memcached {
'servers' => ['127.0.0.1:11211'],
'compress_threshold' => 10_000,
};
# Get the value from cache:
my $value = $cache->get($SessionID);
# dmp('mamcache value',($value));
# -- use the value data to find the groups
my $hashref = unserialize($value);
# dmp('mamcache unserialized',($hashref));
my %hash = %{ $hashref };
%hash = % { $hash {'data'}{chr(0) . 'SimpleSAML_Session' . chr(0) . 'authData'}{'default-sp'}{'Attributes'} };
my #groups = # { $hash{'groups'} };
dmp("3 Comparing $valid_group_expr to", \#groups);
my $result=evaluate($valid_group_expr,#groups);
if ($result) {
dmp("this guy oK",$result);
return Apache2::Const::HTTP_OK;
}
dmp("blowing this guy off",$result);
$r->log_reason("Not a member of group " . $valid_group_expr);
return Apache2::Const::FORBIDDEN;
# return Apache2::Const::HTTP_FORBIDDEN;
# return Apache2::Const::HTTP_OK;
# return Apache2::Const::DECLINED;
}
# ======================= utility functions
# evaluate returns the boolean value of the expression $expr
# after substituting membership information in #groups
#
# valid operators are
#
# &&, and, AND logical AND
# ||, or, OR logical OR
# !, NOT, not logical NOT
#
# expression must be infix and precidence can be indicated by ()
sub evaluate {
my ($expr,#groups)=#_;
# print "$expr\n";
# print Dumper(\%group_hash);
# operator tokens
my %token_hash = (
'(' => '(',
')' => ')',
'AND' => '&&',
'and' => '&&',
'or' => '||',
'OR' => '||',
'!' => '!',
'not' => '!',
'NOT' => '!',
) ;
# add the group array into the token hash as TRUEs
foreach $v (#groups) {
$v=~s/ /_/g;
$token_hash{$v} = 1;
}
dmp('merged hash',\%token_hash);
# merge the two hashes into %token_hash
# foreach my $tkey ( keys %group_hash) { $token_hash{$tkey} = $group_hash{$tkey}; }
# print Dumper(\%token_hash);
$expr=~s/\(/ ( /g;
$expr=~s/\)/ ) /g;
$expr=~s/\!/ ! /g;
# print "$expr\n";
my #expr_hash=split (/ /,$expr);
$expr='';
foreach my $t (#expr_hash) {
if ($t ne '') {
if (exists ($token_hash{$t})) { $t = $token_hash{$t} } else {$t = 0;}
$expr = $expr . "$t ";
}
}
dmp("expression",$expr);
my $result=0;
my $assignment="\$result = $expr;";
dmp("assignment",$assignment);
eval($assignment);
dmp("result",$result);
return $result;
}
# debug dump structure funcion
sub dmp {
if ($debug == 1) {
my ($label,#value) = #_;
my $temp = Dumper(#value);
open (T, ">>$debug_file"); # || die "Can't open $debug_file: $!\n";
print T "$label: $temp\n";
close (T);
}
}
1;
Failing PHP script
The simple PHP form below displays no value when the Perl authorization is enabled. If I comment out the PerlAuthzHandler line both $_POST'[submit'] and $_POST['in1'] are set.
<?php
if (isset($_POST['submit'])) { print_r($_POST); }
$form=<<<EOT
<form name="test" action="y.php" method="post">
<input name="in1">
<input type="submit" name="submit">
</form>
EOT;
print $form;
?>
Again, authentication (simplesamlphp/ADFS) and authorization both work as expected. The exception is that when authorization is used no $_POST variables are available.
RESOLUTION
As often happens the problem was of my own making. One of the kind monks at perlmonks.org pointed out that the Perl handler contained the line:
$query = new CGI;
Removing that did it. Since I was in fact only accessing but not changing anything there was no point to it and in fact $query was never used.
I have a problem with fixtures in yii2 , I just created all required file according to this document but it's not working.
let me explain , I have a module called Authyii and inside this module I have a model named User .
this is my directory structure :
my fixture file is like this :
namespace app\modules\Authyii\tests\fixtures;
use app\modules\Authyii\models;
use yii\test\ActiveFixture;
use yii\test\Fixture;
class UserFixture extends ActiveFixture
{
public $modelClass = 'app\modules\Aythyii\models\User';
public $tableName = 'authyii_user';
}
this is my command line :
but after I type 'yes' and command line says :
but when I check my database there is not new record inside authyii_user tables .
what I missed ?
File User.php id data dir must have table name authyii_user.php. In framework source code in file ActiveFixture.php line with code:
$dataFile = dirname($class->getFileName()) . '/data/'
. $this->getTableSchema()->fullName . '.php';
Best regards.
There is method getFixturesConfig() in \vendor\yiisoft\yii2\console\controllers\FixtureController.php
private function getFixturesConfig($fixtures)
{
$config = [];
foreach ($fixtures as $fixture) {
$isNamespaced = (strpos($fixture, '\\') !== false);
$fullClassName = $isNamespaced ? $fixture . 'Fixture' : $this->namespace . '\\' . $fixture . 'Fixture';
if (class_exists($fullClassName)) { // <<< I think you lose your UserFixture here
$config[] = $fullClassName;
}
}
return $config;
}
You should check what $fullClassName Yii expects it to be (for example logging or echoing it) and tweak your UserFixture's namespace accordingly.
For debugging purposes I'd like to Access the lexical scope of different subroutines with a specific Attribute set. That works fine. I get a Problem when the first variable stores a string, then I get a empty string. I do something like this:
$pad = $cv->PADLIST; # $cv is the coderef to the sub
#scatchpad = $pad->ARRAY; # getting the scratchpad
#varnames = $scratchpad[0]->ARRAY; # getting the variablenames
#varcontents = $scratchpad[1]->ARRAY; # getting the Content from the vars
for (0 .. $#varnames) {
eval {
my $name = $varnames[$_]->PV;
my $content;
# following line matches numbers, works so far
$content = $varcontent[$_]->IVX if (scalar($varcontent[$_]) =~ /PVIV=/);
# should match strings, but does give me undef
$content = B::perlstring($varcontent[$_]->PV) if (scalar($varcontent[$_]) =~ /PV=/);
print "DEBUGGER> Local variable: ", $name, " = ", $content, "\n";
}; # there are Special vars that throw a error, but i don't care about them
}
Like I said in the comment the eval is to prevent the Errors from the B::Special objects in the scratchpad.
Output:
Local variable: $test = 42
Local variable: $text = 0
The first Output is okay, the second should Output "TEXT" instead of 0.
What am I doing wrong?
EDIT: With a little bit of coding I got all values of the variables , but not stored in the same indexes of #varnames and #varcontents. So now is the question how (in which order) the values are stored in #varcontents.
use strict;
use warnings;
use B;
sub testsub {
my $testvar1 = 42;
my $testvar2 = 21;
my $testvar3 = "testval3";
print "printtest1";
my $testvar4 = "testval4";
print "printtest2";
return "returnval";
}
no warnings "uninitialized";
my $coderef = \&testsub;
my $cv = B::svref_2object ( $coderef );
my $pad = $cv->PADLIST; # get scratchpad object
my #scratchpad = $pad->ARRAY;
my #varnames = $scratchpad[0]->ARRAY; # get varnames out of scratchpad
my #varcontents = $scratchpad[1]->ARRAY; # get content array out of scratchpad
my #vars; # array to store variable names adn "undef" for special objects (print-values, return-values, etc.)
for (0 .. $#varnames) {
eval { push #vars, $varnames[$_]->PV; };
if ($#) { push #vars, "undef"; }
}
my #cont; # array to store the content of the variables and special objects
for (0 .. $#varcontents) {
eval { push #cont, $varcontents[$_]->IV; };
eval { push #cont, $varcontents[$_]->PV; };
}
print $vars[$_], "\t\t\t", $cont[$_], "\n" for (0 .. $#cont);
EDIT2: Added runnable script to demonstrate the issue: Variablenames and variablevalues are not stored in the same index of the two Arrays (#varnames and #varcontents).