Correctly passing a routine into an object variable - class

I need to pass some code from an external program into a class.
In a generic module I have (for simplicity reduced to silliness)
class A {
has &.hl;
submethod BUILD( :&!hl ) {}
}
Elsewhere in a program, I have
use A;
my &hl = -> $st {
my $p = shell "hl $st", :in,:out;
$p.out.slurp
};
my $statement = 'my $raku-variable = "Helloooo";'
my $first = &hl($statement);
my A $a .= new(:&hl);
my $second = $a.hl( $statement );
$first will be processed and will contain the expected results.
At $second, I will get a runtime error
Too many positionals passed; expected 1 argument but got 2
Clearly the routine in the class is being provided both the invocant and the parameter $s.
Rewriting the class to provide a custom accessor:
class A {
has &!hl;
submethod BUILD( :&!hl ) {}
method process-it( Str $s --> Str ) { &!hl( $s ) }
}
# elsewhere
my $second = $a.process-it( $statement );
Then both $first and $second run without error and will contain the same results.
When hl is accessed inside the class, no invocant is added, but if it is not declared as &.hl then it is not visible outside the class.
My question is therefore: Is there another way to create a public object code variable that does not automagically add the invocant as a variable to the code? Other than creating a separate accessor method.
Here is short bash script hl for illustration
#! /bin/bash
echo '<div class="statement">'$1'</div>'
Here is a full Raku program
use v6.c;
class A {
has &!highlighter; # also tried with has &highlighter
submethod BUILD( :&!highlighter ) {}
method process-it( Str $s --> Str ) {
&!highlighter( $s )
}
}
sub MAIN() {
my #strings = 'my $v = "Hello World";', 'my $w = $v.raku;';
my $proc;
my $proc-supply;
my &highlighter = -> $s {
my $p = shell "./hl '$s' ", :in,:out;
$p.out.slurp
}
for #strings {
say .&highlighter
}
my A $a .= new(:&highlighter);
for #strings { say $a.highlighter($_) }
# own accessor
for #strings { say $a.process-it($_) }
}

has $!hl declares a private attribute. has $.hl declares a public attribute.
By public I mean it creates a method of the same name that returns it, and it adds it to the BUILD/gist/perl/Capture [sub]methods.
class A {
has &.hl;
}
This is effectively the same as:
class A {
has &!hl;
submethod BUILD ( :&!hl ){}
method hl (){ &!hl } # return the code object
method perl (){
"A.new(hl => $!hl.perl())"
}
method gist (){ self.perl }
method Capture () {
\( :&!hl )
}
}
So when you call A.hl it returns the code object that is stored in &!hl.
You can deal with this in a few ways.
Just call it “twice”.
$a.hl()(42)
$a.hl().(42)
$a.hl.(42)
Have an additional method that uses it.
method call-it ( |C ){
&!hl( |C )
}
$a.call-it( 42 )
my &hl = $a.hl;
Note that I used |C to avoid dealing with signatures entirely.
It might make sense for you to have a signature and deal with it like you have.
Override the automatically generated method by adding it yourself.
method hl ( |C ){
&!hl( |C )
}
$a.hl( 42 )
By overriding it, all of the other changes that making it a public attribute are still done for you.
So there will be no need to create a BUILD submethod.
When you override it, that means that is rw has no effect. It also means that
there is no way for outside code to retrieve the code object itself.
There are ways to deal with that if you need to.
If you don't ever need to return the value in &!hl then just leave it like it is above.
If the code object is never called with zero positional arguments.
multi method hl (){ &!hl }
multi method hl ( |C ){
&!hl( |C )
}
$a.hl; # returns the value in $!hl
$a.hl(); # returns the value in $!hl
$a.hl( 42 ); # calls &!hl(42)
Note that there is no way for a method to differentiate between .hl and .hl().
You could also use a named argument.
multi method hl ( :code($)! ){ &!hl }
multi method hl ( |C ){
&hl( |C )
}
$a.hl(:code); # returns the value in &!hl
$a.hl; # calls &!hl()
$a.hl(); # calls &!hl()
$a.hl( 42 ); # calls &!hl(42)
You could do nothing to make it easier to get the code object, and just have them use subsignature parsing to get the attribute.
(This is why the Capture method gets created for you)
class A {
has &.hl;
method hl ( |C ){
&!hl( |C )
}
}
sub get-hl ( A $ ( :&hl ) ){ &hl }
my &hl = get-hl($a);
my &hl = -> A $ ( :&hl ){ &hl }( $a );
my &hl = $a.Capture{'hl'};

TL;DR There is no way to directly access an attribute outside the source code of the class in which it is declared. The only way to provide access is via a separate public accessor method. This answer hopefully clears up confusion about this. Other answers lay out your options.
Why you get a Too many positionals passed; error message
The code has &!hl; declares an attribute, &!hl.
The code has &.hl; does the same but also generates a method, .hl that's a public accessor to the attribute with the same name. Like all such generated accessors, it expects a single argument, the invocant, and no others.
my $second = $a.hl( $statement )
This code calls the method hl. Raku passes the value on the left of the dot ($a) as a first argument -- the invocant. But you've also added a $statement argument. So it passes that too.
Hence the error message:
Too many positionals passed; expected 1 argument but got 2
When hl is accessed inside the class, no invocant is added
It's not because it's accessed inside the class. It's because you don't call it as a method:
method process-it( Str $s --> Str ) { &!hl( $s ) }
The &!hl( $s ) code is a sub style call of the routine held in the &!hl attribute. It gets one argument, $s.
Is there another way to create a public object code variable that does not automagically add the invocant as a variable to the code?
The problem is not that Raku is automagically adding an invocant.
Other than creating a separate accessor method.
There is no way to directly access an attribute outside the source code of the class in which it is declared. The only way to provide access is via a separate public accessor method. This answer hopefully clears up confusion about this. Other answers lay out your options.

The problem is that the accessor returns the attribute, that happens to be a Callable. Only then do you want to call the return value of the accessor with parameters. This is essentially what you're doing by creating your own accessor.
You don't have to actually create your own accessor. Just add a extra parentheses (indicating you're calling the accessor without any extra arguments), and then the parentheses for the values you actually want to pass:
class A {
has &.a = *.say; # quick way to make a Callable: { .say }
}
A.new.a()(42); # 42
Or if you don't like parentheses so much, consider the method invocation syntax, as timotimo pointed out:
A.new.a.(42); # 42

Related

Mixing roles into callables

Theoretically, you can mix in a role into an object in runtime. So I am trying to do this with a function:
my &random-f = -> $arg { "Just $arg" };
say random-f("boo");
role Argable {
method argh() {
self.CALL-ME( "argh" );
}
}
&random-f does Argable;
say random-f.argh;
Within the role, I use self to refer to the already defined function, and CALL-ME to actually call the function within the role. However, this results in the following error:
Too few positionals passed; expected 1 argument but got 0
in block <unit> at self-call-me.p6 line 5
I really have no idea who's expecting 1 argument. Theoretically, it should be the CALL-ME function, but who knows. Eliminating the self. yields a different error: CALL-ME used at line 11. Adding does Callable to Argable (after putting self back) results in the same error. Can this be done? Any idea of how?
There's two things incorrect in your code:
say random-f.argh; # *call* random-f and then call .argh on the result
You want to call .argh on the Callable so:
say &random-f.argh;
Secondly, you should just be able to call self: you can tweak this in the signature of the .argh method:
method argh(&self:) {
So the final code becomes:
my &random-f = -> $arg { "Just $arg" };
say random-f("boo");
role Argable {
method argh(&self:) {
self( "argh" );
}
}
&random-f does Argable;
say &random-f.argh;

How to check whether an attribute of an object has a value?

I get an error such as "can't call method 'xxxx' on an undefined value" when attempting to check if an object has been created (by the perl module Bio::Perl).
Is there a general way of checking if an attribute has a value or not? I would have liked to do something like:
if ($the_object->the_attribute) {
But as long as the attribute is "undef", calling the method will only give me the error message. I have not been able to find a solution to this problem - which is real, because the object is created by the Bio::Perl module, and some attributes may or may not be set. Maybe I should add that I am not particularly perl-objects-savvy.
edit:
Below is a relevant part of my code. The get_sequence() function is in the Bio::Perl module. On line 13, how can I make sure that there is a value (sequence in this case) before checking the length of it?
my #msgs;
my #sequence_objects;
my $maxlength = 0;
for ( #contigs ) {
my $seq_obj;
try {
$seq_obj = get_sequence( 'genbank', $_ );
}
catch Bio::Root::Exception with {
push #msgs, "Nothing found for $_ ";
};
if ( $seq_obj ) {
my $seq_length = length( $seq_obj->seq );
if ( $seq_length > $maxlength ) {
$maxlength = $seq_length;
}
push #sequence_objects, $seq_obj;
}
}
...
if ($the_object->the_attribute) {
This checks if the return value of the method the_attribute is true. True means that it's not 0, the empty string q{} or undef.
But you said you want to know whether the object exists.
Let's go over some basics first.
# | this variable contains an object
# | this arrow -> tells Perl to call the method on the obj
# | | this is a method that is called on $the_object
# | | |
if ($the_object->the_attribute) {
# ( )
# the if checks the return value of the expression between those parenthesis
It looks like you're confusing a few things.
First, your $the_object is supposed to be an object. It probably came from a call like this:
my $the_object = Some::Class->new;
Or maybe it was returned from some other function call. Maybe some other object returned it.
my $the_object = $something_else->some_property_that_be_another_obj
Now the_attribute is a method (that's like a function) that returns a specific piece of data in your object. Depending on the implementation of the class (the building plan of the object), if that attribute is not set (initialized), it might either just return undef, or some other value.
But the error message you are seeing is not related to the_attribute. If it was, you'd just not call the code in the block. The if check would catch it, and decide to go to else, or do nothing if there is no else.
Your error message says you are trying to call a method on something that is undef. We know you are calling the the_attribute accessor method on $the_object. So $the_object is undef.
The easiest way to check if something has a true value is to just put it in an if. But you already seem to know that.
if ($obj) {
# there is some non-false value in $obj
}
You've now checked that $obj is something that is true. So it could be an object. So you could now call your method.
if ($obj && $obj->the_attribute) { ... }
This will check the true-ness of $obj and only continue if there is something in $obj. If not, it will never call the right hand side of the && and you will not get an error.
But if you want to know whether $obj is an object that has a method, you can use can. Remember that attributes are just accessor methods to values stored inside the object.
if ($obj->can('the_attribute')) {
# $obj has a method the_attribute
}
But that can blow up if $obj is not there.
If you're not sure that $obj is really an object, you can use the Safe::Isa module. It provides a method $_call_if_object1 that you can use to safely call your method on your maybe-object.
$maybe_an_object->$_call_if_object(method_name => #args);
Your call would translate to.
my $the_attribute = $obj->$_call_if_object('the_attribute');
if ($the_attribute) {
# there is a value in the_attribute
}
The same way you can use $_isa and $_can from Safe::Isa.
1) Yes, the method starts with a $, it's really a variable. If you want to learn more about how and why this works, watch the talk You did what? by mst.

Object class name in perl

I am kinda beginner in perl and I need know how can I check object class name.
My code is:
foreach my $y (keys %$x) {
print "$y\t$x->{$y}\n";
}
with output:
154176568 [object HTMLImageElement]
146292140 [object HTMLDocument]
153907016 [object HTMLImageElement]
I need to print just keys that are HTMLImageElement objects.
Now, question is:
(1) How can I check the class name
(2) How can I get/print class name
In Perl all classes magically extend the UNIVERSAL package. It has a method called isa() that you can use to do this:
foreach my $y (keys %$x) {
if( $x->{$y}->isa('HTMLImageElement') ) {
print "$y\t$x->{$y}\n";
}
}
Looking at the source for JE, it looks like JE::Object::Proxy is a subclass of JE::Object, and JE::Object has a stringification method (use overload fallback => 1, ... '""' => 'to_string' ...).
So when you do print "$y\t$x->{$y}\n";, this is printing the result of stringifying $x->{$y}.
You can stringify the object by putting it in double quotes, so "$x->{$y}". This expression will then have values such as you saw being printed, e.g. '[object HTMLImageElement]'.
If you want to pick up only HTMLImageElement objects, then you could check for these using an expression like
"$x->{$y}" eq '[object HTMLImageElement]'
If you especially want to extract the string 'HTMLImageElement' from the stringified value, you could do that using a regexp, e.g.
("$x->{$y}" =~ m{^\[object (.*)\]$}so)[0]
THOUGH, looking at the source for JE::Object::Proxy, JE::Object::Proxy has a method class which might perhaps return the name of the class that the object is a proxy for. So you might be able to get the class name using $x->{$y}->class, and then be able to test that directly as in $x->{$y}->class eq 'HTMLImageElement'.
If you want a string indicating the class name, use ref($object). This will return the reference type for a variable, which for perl objects, ends up being the package of the blessed object.
If you want to simply check if a variable is an instance of a certain class, use the isa() method. For instance:
if ($obj->isa('Animal::Dog')) {
push #dogs, $obj;
}

How do you dynamically call a method of an object?

in Perl I know you can use eval and *{$func_name} to call functions dynamically but how do you do this with methods of an object?
for example
EZBakeOven
sub make_Cake { ... }
sub make_Donut { ... }
sub make_CupCake { ... }
sub make_Soup { ... }
sub make{
my($self,$item) = #_;
if( defined $self->make_$item ){ #call this func if it exists
$self->make_$item( temp => 300, with_eggs => true );
}
}
so that if I say something like
$self->make('Cake');
#or maybe I have to use the full method name
$self->make('make_Cake');
it will call
$self->make_Cake();
You should be able to do something like:
sub make {
my ($self, $item) = #_;
my $method = "make_$item";
$self->$method(whatever);
}
Edit: You might want to also use can() to make sure you're calling a method that can be called:
sub make {
my ($self, $item) = #_;
my $method = "make_$item";
if ($self->can($method)) {
$self->$method(whatever);
} else {
die "No such method $method";
}
}
Edit 2: Actually, now that I think about it, I'm not sure if you really can do that. Code I've written before does something like that, but it doesn't use an object, it uses a class (so you're calling a specific function in a class). It might work as well for objects, but I can't guarantee it.
As by #CanSpice suggested use can to check a methods existence in classes and objects.
can returns a reference to the method if it exists, undef otherwise.
You can use the returned reference to call the method directly.
The following example calls the method in package/class context. __PACKAGE__ returns the current package/class name.
if ( my $ref = __PACKAGE__->can("$method") ) {
&$ref(...);
}

How do I implement a dispatch table in a Perl OO module?

I want to put some subs that are within an OO package into an array - also within the package - to use as a dispatch table. Something like this
package Blah::Blah;
use fields 'tests';
sub new {
my($class )= #_;
my $self = fields::new($class);
$self->{'tests'} = [
$self->_sub1
,$self->_sub2
];
return $self;
}
_sub1 { ... };
_sub2 { ... };
I'm not entirely sure on the syntax for this?
$self->{'tests'} = [
$self->_sub1
,$self->_sub2
];
or
$self->{'tests'} = [
\&{$self->_sub1}
,\&{$self->_sub2}
];
or
$self->{'tests'} = [
\&{_sub1}
,\&{_sub2}
];
I don't seem to be able to get this to work within an OO package, whereas it's quite straightforward in a procedural fashion, and I haven't found any examples for OO.
Any help is much appreciated,
Iain
Your friend is can. It returns a reference to the subroutine if it exists, null otherwise. It even does it correctly walking up the OO chain.
$self->{tests} = [
$self->can('_sub1'),
$self->can('_sub2'),
];
# later
for $tn (0..$#{$self->{tests}}) {
ok defined $self->{tests}[$tn], "Function $tn is available.";
}
# and later
my $ref = $self->{tests}[0];
$self->$ref(#args1);
$ref = $self->{tests}[1];
$self->$ref(#args2);
Or, thanks to this question (which happens to be a variation of this question), you can call it directly:
$self->${\$self->{tests}[0]}(#args1);
$self->${\$self->{tests}[1]}(#args1);
Note that the \ gives us a reference to a the subref, which then gets dereferenced by the ${} after $self->. Whew!
To solve the timeliness issue brain d foy mentions, an alternative would be to simply make the {test} a subroutine itself, that returns a ref, and then you could get it at exactly the time you need it:
sub tests {
return [
$self->can('_sub1'),
$self->can('_sub2')
];
}
and then use it:
for $tn (0..$#{$self->tests()}) {
...
}
Of course, if you have to iterate over the refs anyway, you might as well just go straight for passing the reference out:
for my $ref (0..$#{$self->tests()}) {
$self->$ref(#args);
}
Although Robert P's answer might work for you, it has the problem of fixing the dispatch very early in the process. I tend to resolve the methods as late as I can, so I would leave the things in the tests array as method names until you want to use them:
$self->{tests} = [
qw( _sub1 _sub2 )
];
The strength of a dynamic language is that you can wait as long as you like to decide what's going to happen.
When you want to run them, you can go through the same process that Robert already noted. I'd add an interface to it though:
foreach my $method_name ( $obj->get_test_methods )
{
$obj->$method_name();
}
That might even be better as not tying the test to an existing method name:
foreach my $method_name ( $obj->get_test_methods )
{
$obj->run_test_named( $method_name );
}
That run_test_named could then be your dispatcher, and it can be very flexible:
sub run_test_named
{
my( $self, $name ) = #_;
# do anything you want, like in Robert's answer
}
Some things you might want to do:
Run a method on an object
Pass the object as an argument to something else
Temporarily override a test
Do nothing
etc, etc
When you separate what you decide to do from its implementation, you have a lot more freedom. Not only that, the next time you call the same test name, you can do something different.
use lib Alpha;
my $foo = Alpha::Foo->new; # indirect object syntax is deprecated
$foo->bar();
my %disp_table = ( bar => sub { $foo->bar() } );
$disp_table{bar}->(); # call it
You need a closure because you want to turn a method call into an ordinary subroutine call, so you have to capture the object you're calling the method on.
There are a few ways to do this. Your third approach is closest. That will store a reference to the two subs in the array. Then when you want to call them, you have to be sure to pass them an object as their first argument.
Is there a reason you are using the use fields construct?
if you want to create self contained test subs, you could do it this way:
$$self{test} = [
map {
my $code = $self->can($_); # retrieve a reference to the method
sub { # construct a closure that will call it
unshift #_, $self; # while passing $self as the first arg
goto &$code; # goto jumps to the method, to keep 'caller' working
}
} qw/_sub1 _sub2/
];
and then to call them
for (#{ $$self{test} }) {
eval {$_->(args for the test); 1} or die $#;
}