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

Is it possible to call a subroutine in the main package from a Perl module? I want to implement a dispatch table in the module, but have been trying for two days to figure out how to call the subroutine by reference (and I even tried calling it with a name in a variable).

package ProcessData; use strict; no strict "refs"; use Carp qw(croak); sub new { my ($pkg) = $_[0]; bless { _dispatch_table => {}, }, $pkg; } sub add_subroutine { if($_[1] && $_[2]) { if(ref($_[2]) eq "CODE") { ${$_[0]->{_dispatch_table}}{$_[1]} = $_[2]; } else { croak "The reference passed to add_subroutine() is not a C +ODE reference. "; } } else { croak "Insufficient arguments passed to add_subroutine(). "; } } sub process_data { if($_[1] && $_[2]) { #I've tried: ${$_[0]->{_dispatch_table}}{$_[1]}->($_[2]); #and tried ${${$_[0]->{_dispatch_table}}{$_[1]}}->($_[2]); #and some pretty odd other comibnations ... do stuff with the data ... } else { croak "Insufficient arguments passed to process_data(). "; } } sub process_locations { $_[0]->process_data("locations"); } test.pl use strict; use ProcessData; my $pd = ProcessData->new(); #Add references to the dispatch table. $pd->add_subroutine("dates", \&get_dates); $pd->add_subroutine("locations" \&get_locations); $pd->add_subroutine("contact_list", \&contact_list); $pd->process_locations;

This is a simplified code example, I'm trying to lean how to do this with a dispatch table. It's not something real ... yet... which is good ... because I haven't been able to Goolge an answer yet.

Replies are listed 'Best First'.
Re: Is it possible to call a package::main subroutine from a module?
by BrowserUk (Patriarch) on Mar 21, 2016 at 22:11 UTC

    Does this help?

    { package x; my $subref; sub set{ $subref = shift }; sub call{ $subref->( @_ ) }; };; sub test{ print "This is sub test() with args:[ @_ ]"; };; x::set( \&test );; x::call( 1, 2.0, 'three' );; This is sub test() with args:[ 1 2 three ]

    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". I knew I was on the right track :)
    In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Is it possible to call a package::main subroutine from a module?
by AnomalousMonk (Archbishop) on Mar 22, 2016 at 02:06 UTC

    Since I don't really know what you're doing, I've made minimal changes to your OPed code (but even so, please pay close attention to the Anonymonk's wise advice here and here). Try something like this:

    c:\@Work\Perl>perl -wMstrict -le "{ package ProcessData; ;; use warnings; use strict; use Carp qw(croak); ;; sub new { my ($pkg) = $_[0]; bless { _dispatch_table => {}, }, $pkg; } ;; sub add_subroutine { if($_[1] && $_[2]) { if(ref($_[2]) eq \"CODE\") { ${$_[0]->{_dispatch_table}}{$_[1]} = $_[2]; } else { croak qq{non-CODE reference '$_[2]' passed to add_subroutine( +)}; } } else { croak \"Insufficient arguments passed to add_subroutine(). \"; } } ;; sub process_data { my $self = shift; ;; die qq{no dispatch given} unless @_; my $dispatch = shift; die qq{unknown dispatch '$dispatch'} unless exists $self->{_dispatch_table}{$dispatch}; ;; return $self->{_dispatch_table}{$dispatch}->(@_); } ;; sub process_locations { my $self = shift; return $self->process_data('locations', @_); } ;; } ;; use warnings; use strict; ;; my $pd = ProcessData->new(); ;; $pd->add_subroutine('locations', \&get_locations); ;; $pd->process_locations(qw(here there everywhere)); ;; sub get_locations { print qq{we got stuff: @_} } " we got stuff: here there everywhere


    Give a man a fish:  <%-{-{-{-<

Re: Is it possible to call a package::main subroutine from a module?
by Anonymous Monk on Mar 21, 2016 at 22:42 UTC

    First, a couple of things: Always use warnings;. Avoid using $_[0] etc. directly unless you know why you need to, instead do sub foo { my ($x,$y,$z) = @_; ... }. Don't turn off strict for the whole module, just do it in as small a scope as possible. (And in fact, in this case, you don't even need to turn it off at all, since you're not accessing subroutines via their name, you're accessing them via a code reference, e.g. \&get_locations.)

    In general, you probably should study perlreftut and perlref. The way to call a code reference is $coderef->($arg1, $arg2, ...), where $coderef can also be a complex dereference consisting of hashes, arrays, and calls to other code references.

    # ---8<--- ProcessData.pm ---8<--- package ProcessData; use warnings; use strict; use Carp; sub new { my ($class) = @_; my $self = { _dispatch_table => {} }; return bless $self, $class; } sub add_subroutine { @_==3 or croak "Insufficient arguments passed to add_subroutine(). +"; my ($self,$name,$code) = @_; croak "The reference passed to add_subroutine() is not a CODE refe +rence." unless ref $code eq "CODE"; $self->{_dispatch_table}{$name} = $code; } sub process_data { @_==2 or croak "Insufficient arguments passed to process_data()."; my ($self,$name) = @_; $self->{_dispatch_table}{$name}->(); } sub process_locations { my ($self) = @_; $self->process_data("locations"); } 1; # ---8<--- test.pl ---8<--- use warnings; use strict; use ProcessData; my $pd = ProcessData->new(); $pd->add_subroutine("locations", \&get_locations); $pd->process_locations; sub get_locations { print "get_locations...\n" }

      Thank you. I'll try this out.

      Can you tell me why it's better to use sub foo { my ($x,$y,$z) = @_; ... } instead of $_[0] ?

      I've been using $_[0] for twenty years and never heard of an issue with it ... but then I can be thick sometimes.

        It's not always a Bad Thing to use $_[0] directly, but there are several really good reasons not to. I'll let Perl::Critic::Policy::Subroutines::RequireArgUnpacking explain:

        Subroutines that use @_ directly instead of unpacking the arguments to local variables first have two major problems. First, they are very hard to read. If you're going to refer to your variables by number instead of by name, you may as well be writing assembler code! Second, @_ contains aliases to the original variables! If you modify the contents of a @_ entry, then you are modifying the variable outside of your subroutine. For example:

        sub print_local_var_plus_one { my ($var) = @_; print ++$var; } sub print_var_plus_one { print ++$_[0]; } my $x = 2; print_local_var_plus_one($x); # prints "3", $x is still 2 print_var_plus_one($x); # prints "3", $x is now 3 ! print $x; # prints "3"

        This is spooky action-at-a-distance and is very hard to debug if it's not intentional and well-documented (like chop or chomp).