Thanks for the code! :)
OK now I understand what you intended to say, but IMHO you are over-complicating things.
The rule is
- If $method is not a coderef, its string-value is used for a method lookup!
> As I said, the string overload is used.
No, if you bless a coderef, it'll still ignore the string-value. No matter if it was overloaded or not.
use strict;
use warnings;
use feature 'say';
BEGIN {
package Local::Farm;
sub new {
my ( $class ) = ( shift );
bless {}, $class;
}
sub cow_say {
say "Moo";
}
sub sheep_say {
say "Baa";
}
sub horse_say {
say "Neigh";
}
};
BEGIN {
package Local::Random::String;
use overload q[""] => 'to_string', fallback => 1;
use Data::Dump qw/pp dd/;
my @animal_say;
sub still_a_function {
say "still_a_function(". pp(\@_).")";
}
sub new {
my ( $class, @options ) = ( shift, @_ );
# @animal_say = @options;
# return bless [], $class;
return bless \&still_a_function, $class;
}
sub to_string {
my ( $self ) = ( shift );
my $ix = rand @animal_say;
$animal_say[$ix];
}
}
;
my $object = 'Local::Farm'->new();
my $method = 'Local::Random::String'->new( qw/ cow_say sheep_say / );
$object->$method for 1 .. 10;
-*- mode: compilation; default-directory: "d:/tmp/pm/" -*-
Compilation started at Thu Dec 10 11:17:21
C:/Perl_524/bin\perl.exe -w d:/tmp/pm/overload_string.pl
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
still_a_function([bless({}, "Local::Farm")])
Compilation finished at Thu Dec 10 11:17:22
| [reply] [d/l] [select] |
use strict;
use warnings;
use feature 'say';
my $method = [];
{
package Local::Class;
sub new {
my ( $class ) = ( shift );
bless {}, $class;
}
no strict 'refs';
*{"$method"} = sub { say for @$method };
};
my $object = 'Local::Class'->new();
@$method = ( "Hello", "world" );
$object->$method;
| [reply] [d/l] |
DB<199> $obj = bless {},"tmp"
DB<200> $tmp::{''} = sub { say "empty" }
DB<201> $meth = undef
DB<202> $obj->$meth
empty
DB<203>
| [reply] [d/l] [select] |