The Raku docs say that Code.assuming
Returns a Callable that implements the same behavior as the original, but has the values passed to .assuming already bound to the corresponding parameters.
What is the difference between using .assuming and wrapping the Code in an anonymous Block (or Sub) that calls the inner function with some parameters already bound?
For instance, in the code below, what is the difference between &surname-public (an example the docs provide for .assuming) and &surname-block;
sub longer-names ( $first, $middle, $last, $suffix ) {
say "Name is $first $middle $last $suffix";
}
my &surname-public = &longer-names.assuming( *, *, 'Public', * );
my &surname-block = -> $a,$b,$c { longer-names($a, $b, 'Public', $c) }
surname-public( 'Joe', 'Q.', 'Jr.'); # OUTPUT: «Name is Joe Q. Public Jr.»
surname-block( 'Joe', 'Q.', 'Jr.'); # OUTPUT: «Name is Joe Q. Public Jr.»
I see that .assuming saves a bit of length and could, in some contexts, be a bit clearer. But I strongly suspect that I'm missing some other difference.
There really isn't a difference.
While the code to implement .assuming() is almost 300 lines, the important bit is only about ten lines of code.
$f = EVAL sprintf(
'{ my $res = (my proto __PRIMED_ANON (%s) { {*} });
my multi __PRIMED_ANON (|%s(%s)) {
my %%chash := %s.hash;
$self(%s%s |{ %%ahash, %%chash });
};
$res }()',
$primed_sig, $capwrap, $primed_sig, $capwrap,
(flat #clist).join(", "),
(#clist ?? ',' !! '')
);
The rest of the code in .assuming is mostly about pulling information out of the signatures.
Let's take your code and insert it into that sprintf.
(Not exactly the same, but close enough for our purposes.)
{
my $res = (
# $primed_sig v----------------------v
my proto __PRIMED_ANON ($first, $middle, $suffix) { {*} }
);
# $capwrap vv
# $primed_sig v----------------------v
my multi __PRIMED_ANON (|__ ($first, $middle, $suffix)) {
# $capwrap vv
my %chash := __.hash;
# v---------------------------v #clist
$self(__[0], __[1], 'Public', __[2], |{ %ahash, %chash });
};
# return the proto
$res
}()
If we simplify it, and tailor it to your code
my &surname-public = {
my $res = (
my proto __PRIMED_ANON ($first, $middle, $suffix) { {*} }
);
my multi __PRIMED_ANON ( $first, $middle, $suffix ) {
longer-names( $first, $middle, 'Public', $suffix )
};
$res
}()
We can simplify it further by just using a pointy block.
my &surname-public = -> $first, $middle, $suffix {
longer-names( $first, $middle, 'Public', $suffix )
};
Also by just using single letter parameter names.
my &surname-public = -> $a,$b,$c { longer-names($a, $b, 'Public', $c) }
Like I said, there really isn't a difference.
In the future, it may be more beneficial to use .assuming(). After it gets rewritten to use RakuAST.
Related
This is my attempt to solve Challenge #2 of the weekly.
The challenge is very vague, so I decided to try to implement a scalar value with a memory. It's possible my understanding of how containers should work is flawed, but what I really don't understand, is, why say self.VAR.WHAT is a Proxy and not a HistoryProxy, even when I explicitly say so.
class HistoryProxy is Proxy
{
has #!history;
method HISTORY() { #!history };
method SAVE( $value ) { #!history.push($value) }
}
sub historic(::T $type, $value) {
my T $c-value = $value;
return-rw HistoryProxy.new(
FETCH => method () { $c-value },
STORE => method (T $new-value) {
say self.VAR.WHAT; # Why is this "Proxy" and not "HistoryProxy"?
self.VAR.SAVE( $c-value ); # Why does this not work?
$c-value = $new-value;
}
);
}
my $a := historic(Int, 10);
$a = 12;
$a = 14;
say $a.VAR.HISTORY; #should print [10, 12]
This does not help you get the functionality you want, but it does answer your specific questions for now:
say self.VAR.WHAT; # Why is this "Proxy" and not "HistoryProxy"?
I think this is because the Proxy class is currently not set up to be subclassed. Its new method basically does a Proxy.new instead of a self.new, so it misses the subclassing. Looking into that now.
self.VAR.SAVE( $c-value ); # Why does this not work?
self is always decontainerized. So you're always seeing the underlying value. If you want to have the actual object, you will need to change the signature of the method, e.g.:
STORE => method (\SELF: T $new-value) {
and then use:
SELF.VAR
But since the object isn't actually blessed as the subclass, this won't help you much anyway.
UPDATE: https://github.com/rakudo/rakudo/pull/3196 should allow subclassing of Proxy objects in the future.
UPDATE: with https://github.com/rakudo/rakudo/commit/d00674b31c this Pull Request got merged. It should become available in the 2019.11 Rakudo compiler release.
Thanks again Liz for adressing this so quickly. However, as i wrote on Github, while the subclassing works now, it seems to be impossible to initialize attributes of the subclass. This is fine for know, I can solve this with the get-position method.
Is this because Proxy is not a "proper" class, or am I overlooking something?
use Test;
class Scalar::History::Proxy is Proxy
{
has #!history;
has $!position = 0; # The assignment gets ignored ...
# ... so do these
submethod TWEAK( *#args )
{
say "Why oh why?";
}
submethod BUILD( *#args )
{
say "Do we never get called";
}
method get-position( \SELF: )
{
$!position // #!history.elems
}
method current-value( \SELF: )
{
#!history[ SELF.get-position ]
}
method get-history( \SELF: Bool :$all = False )
{
my $to-index = $all ?? #!history.elems - 1 !! SELF.get-position;
#!history[ ^$to-index ].Array
}
method reset-history( \SELF: )
{
#!history = ();
$!position = 0;
}
method forward-history( \SELF: $steps )
{
$!position = SELF.get-position + $steps;
$!position = #!history.elems - 1
if $!position >= #!history.elems;
$!position;
}
method rewind-history( \SELF: $steps )
{
$!position = SELF.get-position - $steps;
$!position = 0
if $!position < 0;
$!position;
}
method store-value( \SELF: $new-value, $register-duplicates )
{
# Forget stuff after rewind
if #!history.elems > SELF.get-position + 1
{
#!history.splice( SELF.get-position + 1 );
}
if !($new-value eqv SELF.current-value) || $register-duplicates
{
#!history.push( $new-value );
$!position = #!history.elems - 1;
}
}
}
class Scalar::History
{
method create( $value, ::T $type = Any, Bool :$register-duplicates = False )
{
return-rw Scalar::History::Proxy.new(
FETCH => method ( \SELF: ) {
SELF.current-value() },
STORE => method ( \SELF: T $new-value ) {
SELF.store-value( $new-value, $register-duplicates ); }
) = $value;
}
}
This passes all the tests I have
use Scalar::History;
use Test;
subtest 'untyped' =>
{
plan 2;
my $untyped := Scalar::History.create("a");
my $sub = sub foo() { * };
my $rx = rx/x/;
$untyped = $sub;
$untyped = $rx;
$untyped = 42;
ok( $untyped == 42, "Current value is correct" );
is-deeply( $untyped.VAR.get-history, ["a", $sub, $rx], "History is correct" );
}
subtest 'typed' =>
{
plan 3;
my $typed := Scalar::History.create("a", Str);
$typed = "b";
$typed = "42";
ok( $typed == "42", "Current value is correct" );
is-deeply( $typed.VAR.get-history, ["a", "b"], "History is correct" );
dies-ok( { $typed = 2; }, "Cannot assign invalid type" );
}
subtest 'duplicates' =>
{
plan 2;
my $with-duplicates := Scalar::History.create( "a", Str, :register-duplicates(True) );
$with-duplicates = "a";
$with-duplicates = "a";
is-deeply( $with-duplicates.VAR.get-history, ["a", "a"], "duplicates get registered" );
my $no-duplicates := Scalar::History.create( "a", Str );
$no-duplicates = "a";
$no-duplicates = "a";
is-deeply( $no-duplicates.VAR.get-history, [], "duplicates get ignored" );
}
subtest 'position/forward/backward' =>
{
plan 8;
my Int $int := Scalar::History.create(10, Int);
#say $int.VAR.get-position;
$int = 100 ;
$int = 1000 ;
ok( $int.VAR.get-position == 2, "current position is 2 after 3 assignments" );
$int.VAR.rewind-history(2);
ok( $int == 10, "current value is correct after rewind" );
$int.VAR.forward-history(1);
ok( $int == 100, "current value is correct after forward" );
$int.VAR.rewind-history(Inf);
ok( $int == 10, "current value equals start value after rewind to infinity" );
$int.VAR.forward-history(Inf);
ok( $int == 1000, "current value equals last known value after forward to infinity" );
$int.VAR.rewind-history(2);
is-deeply( $int.VAR.get-history, [], "history empty after rewind" );
is-deeply( $int.VAR.get-history(:all), [10, 100], "but still there if needed" );
$int = 101;
$int = 1001;
is-deeply( $int.VAR.get-history, [10, 101], "history gets truncated after rewind and assign" );
}
subtest 'behaviour' =>
{
plan 2;
sub add-one( Int $v ) { return $v + 1 }
my Int $int := Scalar::History.create(1, Int);
$int++;
$int = $int + 1;
$int = add-one( $int );
$int = 42;
is-deeply( $int.VAR.get-history, [1,2,3,4], "historic Int behaves like normal Int" ); # probably testing the language here, but meh
$int.VAR.reset-history();
is-deeply( $int.VAR.get-history(:all), [], "history can be reset" );
}
done-testing;
I'm translating a Python module to Perl 6, but can't find a method called urlopen, which could accept data:
from six.moves.urllib import request
req = request.Request(url, headers=headers)
if headers.get('Content-Type') == 'application/x-www-form-urlencoded':
data = oauth_query(args, via='quote_plus', safe='').encode()
elif 'form-data' in headers.get('Content-Type', ''): # multipart/form-data
data = args['form-data']
else:
data = None
resp = request.urlopen(req, data=data)
resp.json = lambda: json.loads(resp.read().decode() or '""')
return resp
oauth_query is a method that return a sorted string:
def oauth_query(args, via='quote', safe='~'):
return '&'.join('%s=%s' % (k, oauth_escape(v, via, safe)) for k, v in sorted(args.items()))
I translate the above code to Perl 6:
use WWW;
my $data = "";
if %headers{'Content-Type'} eq 'application/x-www-form-urlencoded' {
$data = oauth_query(%args);
} elsif %headers{'Content-Type'}.contains('form-data') {
$data = %args{'form-data'};
} else {
$data = Any;
}
my $res = get $url, |%headers; # but without data that contains Content-Type, it will
# Died with HTTP::MediaType::X::MediaTypeParser::IllegalMediaType
I want to return a resp as in Python. Any help is welcome!
I have reduced the program to the bare minimum; you will still have to take care of headers and the OAuth query, but this works
use WWW;
sub MAIN( :$have-data = 0 ) {
my $url='https://jsonplaceholder.typicode.com/posts/';
my %args=%(form-data => "userId=1&id=2");
my $data = "";
if $have-data {
$data = %args{'form-data'};
}
my $res;
if $data {
$res = post $url, $data;
} else {
$res= get $url~'1';
}
say $res;
}
Baseline is that urlopen in Python does get or post depending on whether there is data or not. In this case, I use a simple if for that purpose, since WWW is quite barebones and does not support that. I am using also a mock REST interface, so I have actually to change the URL depending on the data, which is also dummy data. You can call the program either with no argument or with
perl6 urlopen.p6 --have-data=1
and the mock server will return... something. It would be great if you contributed a module with a (somewhat) higher level than WWW, or to WWW itself. Hope this solves (kinda) your problem.
use Cro::HTTP::Client;
my $resp;
my $data = "";
if (%headers{'content-type'} // '') eq self.form_urlencoded {
$data = oauth_query(%args);
} elsif (%headers{'content-type'} // '').contains('form-data') { # multipart/form-data
$data = %args{'form-data'};
} else {
$data = "";
}
my $client = Cro::HTTP::Client.new(headers => |%headers);
if $data {
$resp = await $client.post: $url, body => |%args;
} else {
$resp = await $client.get: $url;
}
return $resp;
I can choose a multi based on some non-argument value but I have to have at least one argument so I can kludge the where in there:
our $*DEBUG = 1;
debug( 'This should print', 'Phrase 2' );
$*DEBUG = 0;
debug( 'This should not print' );
multi debug ( *#a where ? $*DEBUG ) { put #a }
multi debug ( *#a where ! $*DEBUG ) { True }
I seem to recall some trick someone used to dispatch among multis that took exactly no parameters. For example, I have a show-env routine I'd like to sprinkle around and that only does anything if I've set some debugging conditions. I could achieve it like I've shown but that's not very satisfying and it's not the clever thing I imagine I saw elsewhere:
our $*DEBUG = 1;
debug( 'This should print', 'Phrase 2' );
show-env();
$*DEBUG = 0;
debug( 'This should not print' );
show-env();
multi debug ( *#a where ? $*DEBUG ) { put #a }
multi debug ( *#a where ! $*DEBUG ) { True }
# use an unnamed capture | but insist it has 0 arguments
multi show-env ( | where { $_.elems == 0 and ? $*DEBUG } ) { dd %*ENV }
multi show-env ( | where { $_.elems == 0 and ! $*DEBUG } ) { True }
I could do something similar with optional named parameters but that's even less satisfying.
Of course, I could do just this in this simple example but this is no fun:
sub show-env () {
return True unless $*DEBUG;
dd %*ENV;
}
You could destructure the | with ().
my $*DEBUG = 1;
show-env();
$*DEBUG = 0;
show-env();
# use an unnamed capture | but insist it has 0 arguments by destructuring
multi show-env ( | () where ? $*DEBUG ) { dd %*ENV }
multi show-env ( | () where ! $*DEBUG ) { True }
show-env(42); # Cannot resolve caller show-env(42); …
Or you could have a proto declaration
proto show-env (){*}
multi show-env ( | where ? $*DEBUG ) { dd %*ENV }
multi show-env ( | where ! $*DEBUG ) { True }
show-env(42); # Calling show-env(Int) will never work with proto signature () …
A more elegant way to insist that the capture is empty is to specify it with an empty sub-signature:
multi show-env ( | () where ? $*DEBUG ) { dd %*ENV }
multi show-env ( | () where ! $*DEBUG ) { True }
Okay, I'm new to DBIx::Class. I have a one-to-many relationship set up, like so:
User -> has_many -> Addresses
Okay, good. I can do a query, and call it prefetching JOINed tables, like so:
Foo::DBIC->storage->debug(1); # output SQL to STDOUT
my $user = Foo::DBIC->resultset('Users')->search({}, {
prefetch => [ 'addresses' ],
join => [ 'addresses' ],
rows => 1
})->single;
for my $address ($user->addresses->all) {
say $address->zip_code;
}
Two tables, one SQL query (verified via debug). All is well.
Now, however, let's say I want to write an overload method or two in Foo::DBIC::Result::Users that returns a subset of addresses, based on certain criteria. Here's what I've added to the Users class:
sub home_addresses {
my $self = shift;
return $self->search_related('addresses', { address_type => 'home' });
}
sub business_addresses {
my $self = shift;
return $self->search_related('addresses', { address_type => 'business' });
}
I can call these overloads like so, and they work:
for my $address ($user->home_addresses->all) {
say $address->zip_code;
}
However, this ignores the fact that I've prefetched my join, and it performs ADDITIONAL QUERIES (as if I've not prefetched and joined anything).
So, my question is this: how do I define an overload method that returns a subset of a related table, but uses the already prefetched join? (just appending a WHERE clause to the prefetch)...
My problem is that if I have a lot of the overloaded methods returning related table subsets, my query count can blow up; especially if I'm calling them from within a loop.
I have reasons for doing this that are, of course, ugly. My real life schema is a lot, lot, lot messier than Users and Addresses, and I'm trying to abstract away ugly as best I can.
Thanks!
something like this for home_addresses might work:
sub home_addresses {
my $self = shift;
my $addresses = $self->addresses;
my $home_addresses;
while (my $row = $addresses->next()) {
push #$home_addresses, $row if $row->address_type() eq 'home';
}
my $home_rs = $addresses->result_source->resultset;
$home_rs->set_cache( $home_addresses );
$home_rs;
}
Alternatively, if there a lot of address types something like this:
sub addresses_by_type {
my $self = shift;
my $addresses = $self->addresses;
my $type;
my $rs_type;
while (my $row = $addresses->next()) {
push #{$type->{"".$row->address_type}},
$row;
}
for (keys %$type) {
my $new_rs = $addresses->result_source->resultset;
$new_rs->set_cache( $type->{$_} );
$rs_type->{$_} = $new_rs
}
return $rs_type
}
which you could access the 'home' addresses from like this:
while (my $r = $user->next) {
use Data::Dumper;
local $Data::Dumper::Maxdepth = 2;
print $r->username,"\n";
my $d = $r->addresses_by_type();
my $a = $d->{home};
while (defined $a and my $ar = $a->next) {
print $ar->address,"\n";
}
}
Could you try something like this:
sub home_addresses {
my $self = shift;
my $return = [];
my #addresses = $self->addresses->all();
foreach my $row (#addresses) {
push #$return, $row if $row->address_type() eq 'home';
}
return $return;
}
PHP 5 has error_get_last. Is there any way to completely or at least partially replicate the same functionality in PHP4.3?
Ripped from the PHP manual (courtesy of php at joert dot net):
<?php
if( !function_exists('error_get_last') ) {
set_error_handler(
create_function(
'$errno,$errstr,$errfile,$errline,$errcontext',
'
global $__error_get_last_retval__;
$__error_get_last_retval__ = array(
\'type\' => $errno,
\'message\' => $errstr,
\'file\' => $errfile,
\'line\' => $errline
);
return false;
'
)
);
function error_get_last() {
global $__error_get_last_retval__;
if( !isset($__error_get_last_retval__) ) {
return null;
}
return $__error_get_last_retval__;
}
}
?>
Yes it is, but you will have to do some programming, you need to attach error handler
$er_handler = set_error_handler("myErrorHandler");
but before this you need to write your "myErrorHandler"
function myErrorHandler($errNumber, $errString, $errFile, $errLine)
{
/*now add it to session so you can access it from anywhere, or if you have class with the static variable you can save it there */
$_SESSION["Error.LastError"] = $errNumber . '<br>' . $errString . '<br>' . $errFile . '<br>' . $errLine;
}
Now when error is occured you can get it by
if(isset($_SESSION["Error.LastError"]))
$str = $_SESSION["Error.LastError"];
now to replicate your method you need to create function
function get_last_error()
{
$str = "";
if(isset($_SESSION["Error.LastError"]))
$str = $_SESSION["Error.LastError"];
return $str;
}