Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

how to call a sub via variable in library

by glenn (Scribe)
on Nov 17, 2014 at 18:21 UTC ( [id://1107446]=perlquestion: print w/replies, xml ) Need Help??

glenn has asked for the wisdom of the Perl Monks concerning the following question:

So I created a library that contains the 'tests' I need to preform on different systems. It uses a thread pool and dissected versions of queue and semaphore. Anyhow I need some help with calling the sub from the thread as a library class. This was all working until I updated the library to use an object. Thank you for any help or insight.

COMMAND

Orginal non-OO: &{\&{$testname}}($system); updated as OO: $self->{&{\&{$testname}}}->($system); #system is hashr +ef

ERROR

=pod Nov 17 12:27:47, tests.pm , executetest , 128: + processing executetest Nov 17 12:27:47, tests.pm , executetest , 132: + Starting test [cleanupConfig] Nov 17 12:27:47, tests.pm , cleanupConfig , 1568: + Called from [tests::executetest] at [133] with options [] Nov 17 12:27:47, tests.pm , cleanupConfig , 1571, + WARNING: Use of uninitialized value $self in concatenation (.) or st +ring SELF: Nov 17 12:27:47, tests.pm , cleanupConfig , 1572, + FATAL WARNING: Can't call method "_idown" on an undefined value =cut

EXAMPLE CODE

use XML::Simple; my @xmlOptsO = (KeepRoot=>1, KeyAttr=>[]); use tests; my ($tests, @workers) = tests->new(); $tests->enqueue(XMLout("<system><job><step name='cleanup'><nextjob>0:1 +</nextjob></job></system>", @xmlOptsO)); #start my $system = $test->dequeue(); #complete
package tests; #constructor sub new { my $class = shift; #queues my @testStartQueue :shared; my $testStartLock :shared; my @testDoneQueue :shared; my $testDoneLock :shared; my %self :shared = ( 'testStartQueue' => \@testStartQueue, 'testStartLock' => \$testStartLock, 'testDoneQueue' => \@testDoneQueue, 'testDoneLock' => \$testDoneLock, ); bless(\%self, $class); my @workers; for (my $x = 0; $x < 5; $x++) { push(@workers, threads->create("executetest", \%self)); #testi +ng workers } return (\%self, @workers); } #TEST START----------------------------------------------------------- +-- sub enqueue { my $self = shift; return $self->_enqueue('testStartLock', 'testStartQueue', @_); } sub _tsdequeue { my $self = shift; return $self->_dequeue('testStartLock', 'testStartQueue', @_); } #TEST START----------------------------------------------------------- +-- #TEST DONE------------------------------------------------------------ +- sub _tdenqueue { my $self = shift; return $self->_enqueue('testDoneLock', 'testDoneQueue', @_); } sub dequeue { my $self = shift; return $self->_dequeue('testDoneLock', 'testDoneQueue', @_); } #TEST DONE------------------------------------------------------------ +- #Methods sub end { my $self = shift; lock ${$self->{'testStartLock'}}; lock(${$self->{'testDoneLock'}}); # No more data is coming $$self{'ENDED'} = 1; # Try to release at least one blocked thread cond_signal(${$self->{'testStartLock'}}); cond_signal(${$self->{'testDoneLock'}}); return; } sub _enqueue { my $self = shift; my $lock = shift; my $queue = shift; unless ($$self{'ENDED'}) { lock(${$self->{$lock}}); push(@{$self->{$queue}}, map { shared_clone($_) } @_) and cond +_signal(${$self->{$lock}}); } return } sub _dequeue { my $self = shift; my $lock = shift; my $queue = shift; lock(${$self->{$lock}}); my $count = @_ ? $self->_validate_count(shift) : 1; cond_wait(${$self->{$lock}}) while ((@{$self->{$queue}} < $count) +&& ! $$self{'ENDED'}); cond_signal(${$self->{$lock}}) if ((@{$self->{$queue}} > $count) | +| $$self{'ENDED'}); # Return single item return shift(@{$self->{$queue}}) if ($count == 1); # Return multiple items my @items; for (1..$count) { last if (! @{$self->{$queue}}); #this should only happen in th +e event there are either enough values or end has been called. push(@items, shift(@{$self->{$queue}})); } return @items; } #THREAD sub executetest { local *__ANON__ = 'executetest'; my $self = shift; print "SELF: $self\n"; logLine("Thread executetest [".threads->self->tid()."] start"); while (defined(my $system = $self->_tsdequeue())) { #test start qu +eue logLine("processing executetest"); my $test = (split(":",$system->{job}->[0]->{nextjob}->[0]))[0] +; #test number my $testname = $system->{job}->[0]->{step}->[$test]->{name}; # +test name logLine("Starting test [$testname]"); $system = $self->{&{\&{$testname}}}->($system); #test logLine("Completed test [$testname]"); $self->_tdenqueue($system); #test done queue } croak("Thread executetest [".threads->self->tid(). "] end\n"); return "executetest"; } sub logLine { print $_[0]."\n"; } #example test sub cleanup { $self = shift; #fails print "SELF: $self\n"; my $system = $_[0]; $self->logLine("MESSAGE"); #here there are actually semaphore call +s which fail b/c '$self' is "". return $system; }

Replies are listed 'Best First'.
Re: how to call a sub via variable in library
by davido (Cardinal) on Nov 17, 2014 at 18:56 UTC

    The simplest test case is 226 lines of code?

    The problem isn't "the whole thing", you specifically request assistance in calling a subroutine via a variable (presumably holding a sub ref). So boil the example code down to that portion of the problem so that we don't have to wade through 226 lines of code to see what you're asking about. 20-30 lines of code ought to be more than adequate.

    BrowserUk already made such a suggestion a year ago in Re^2: Advanced GUI with threads, to which you followed-up with a 427 line dump of code.


    Dave

    A reply falls below the community's threshold of quality. You may see it by logging in.
Re: how to call a sub via variable in library
by BrowserUk (Patriarch) on Nov 17, 2014 at 19:23 UTC

    I've been staring at this unholy construct $self->{&{\&{$testname}}}->($system); for about 15 minutes, And I still haven't a clue what it's meant to do.

    Perhaps you could fill in the blanks?

    1. $testname is a string containing the name of a subroutine?
    2. \&{ $testname }; returns a code reference to the named subroutine.
    3. &{ \&{ $testname } } invokes that coderef. Ie, a long winded and obfuscated way of doing: &$testname
    4. $self->{ &{ \&{ $testname } } } Uses the (if any) return code from the subroutine as a key into the object hash.
    5. $self->{ &{ \&{ $testname } } }->( ... ); who's associated value is another coderef, which it invokes ...
    6. $self->{ &{ \&{ $testname } } }->( $system ); passing one variable $system (which is apparently a hashref.)

    Unless you have pre-populated the object hash with a key matching every possible return value from every possible test name, and associated an appropriate coderef for all of those keys; that line isn't trying to do what you think it is. (And even if it is, the way it is written is unnecessarily complicated and obfuscate.)

    (And a brief glance at the rest of your code makes me think you're writing code you will not be able to maintain.)


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      I've been staring at this unholy construct $self->{&{\&{$testname}}}->($system); for about 15 minutes, And I still haven't a clue what it's meant to do.
      This is a very obscure and useless feature of Perl. Documented in strict
      $bar = \&{'foo'}; &$bar;
      is allowed so that "goto &$AUTOLOAD" would not break under stricture.

        That bit is obfuscated, but at least understandable.

        It's the invoking of a subroutine from the object hash keyed by the return code of that subroutine that I find completely unlikely.


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
      you have given the best understanding of which i did not even have... Although this is wrong here is what i want to accomplish: $self->&$testname($system). Execute sub '$testname' with '$system' as parameter in object '$self'. Could you help further with this???
        here is what i want to accomplish: $self->&$testname($system). Execute sub '$testname' with '$system' as parameter in object '$self'.

        Depends what do you mean by "... in object $self"?

        I see two possible interpretations of that:

        1. You simply want to execute the sub named in $testname (whilst incidentally running inside a method of object $self); in which case all you need is:
          $testname->( $system );

          You'll probably need no strict 'refs'; for that.

        2. Alternatively, you might mean that you want to invoke the method of object $self, who's name is held in $testname; in which case all you need is:
          $self->$testname( $system );

          Seems to work fine with full strict.


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
Re: how to call a sub via variable in library
by kennethk (Abbot) on Nov 17, 2014 at 19:04 UTC
    $self->{&{\&{$testname}}}->($system); #system is hashref
    ...
    Use of uninitialized value $self in concatenation (.) or string Can't call method "_idown" on an undefined value Can't call method "_idown" on an undefined value
    The errors suggest that at some point you are invoking one of your methods without argument, thus $self is never initialized. Carp can be very helpful here for recovering the call stack where the error is actually happening, in the calling routine. You could also manually construct a relevant error using caller:
    sub method { my $self = shift or die join(", ", caller()), "\n"; ... }

    If I've misdiagnosed the issue (which is plausible given how complex your invocation is), you probably want to learn How can I visualize my complex data structure?.


    #11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

      $self is perhaps initialized, but
      no strict 'refs'; $self->{ &{$testcase} }
      (I mean, the original, obfuscated version) is probably undef... But I'm no going to read this code any futher, frankly.
        That was my original thought, and then I saw Use of uninitialized value $self in concatenation (.) or string That's why I think my $self = shift or confess '$self undef'; is probably the best bet. I should point out that the $self that is uninitialized may not be the $self in the grotesque expression above.

        #11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

Re: how to call a sub via variable in library
by kennethk (Abbot) on Nov 17, 2014 at 22:17 UTC
    COMMAND
    Orginal non-OO: &{\&{$testname}}($system); updated as OO: $self->{&{\&{$testname}}}->($system); #system is hashr +ef
    With the updated post above, it becomes clear that BrowserUk's suggestion is correct. The code:
    &{\&{$testname}}($system);
    translates to $testname->($system); with a hack to get around the ban on Symbolic references. Essentially, you have a scalar storing the name of that routine, which then calls that function with the argument $system. To change that to a method call on $self, you would want
    $self->$testname($system);
    as documented in Method Names as Strings in perlobj.

    #11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

Re: how to call a sub via variable in library
by Anonymous Monk on Nov 17, 2014 at 20:19 UTC
    $self->{&{\&{$testname}}}->($system);

    I don't know, maybe my tone in this thread was too harsh. But this line really made my head hurt. Understanding it requires the reader to remember several lines among the thousands of pages of Perl's documentation. Anyway, that line is better written as:

    my $key = do { no strict 'refs'; $testcase->(); # symbolic (string) reference }; $self->{$key}->($system);
    That will make it much easier to debug.
Re: how to call a sub via variable in library
by Anonymous Monk on Nov 17, 2014 at 18:58 UTC
    $self->{&{\&{$testname}}}->($system);
    Damn that's really hard to parse. Is that the same as  $self->{&{$testname}}->($system)? I guess, you're using ref and deref to silence the strictures? Instead of no strict 'refs'?

    What does that do?

Re: how to call a sub via variable in library
by glenn (Scribe) on Nov 17, 2014 at 19:33 UTC
    I know its long, did it in a hurry. I'll try and minimize once I'm back in the office. Thing is, it kinda has to be that deep to get the error; it should atleast be working except for the problem... as I did say, before making the library an object (referencing simplifer) it worked. Tring to use the previous call with slimply adding $self->ref did not work. Not using no strict refs. Full code has strict and warnings. I think the problem my be, in part, creating the threads.
Re: how to call a sub via variable in library
by glenn (Scribe) on Nov 18, 2014 at 01:15 UTC

    Thank you all for your input and responses. I got to spend a full day working reading perl documentation and learning exactly what does not work ;). Here is what I found and what worked....

    Worked

    my $coderef = \&{$testname}; $system = $coderef->($self, $system); #test

    should have worked based on documentation but doesnt

    $self->$testname($system);

    I'm sorry that I did not get the example code down smaller and will try to do so so any future finders might understand more easily. Y'alls help is a life saver.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1107446]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (4)
As of 2024-03-19 07:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found