Brad.Walker has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to get some Perl code to work but can't seem to see my problem. My issue is a variant of the recipe 12.16 in Perl Cookbook.

Specifically, I'm trying to get a reference to a function that might not exist in a Perl package. I know that I can use the Exporter module to probably make this work, but I've invested some time into trying to figure this out and would like to see if I can make it work.

What I have is: 

        eval {
                no strict "refs";

                require "$fqn_file";

                local $SIG{'__DIE__'};
                $ref = \&{$foo . "::f_preferred"};
        };
        warn $@ if $@;

[download]
But, I keep getting $ref set to a value even though f_preferred is not defined. What I would like is for it to return "undef" in this case.

Any help is much appreciated..

-brad w.

Replies are listed 'Best First'.
Re: referring to packages indirectly
by BrowserUk (Patriarch) on Oct 11, 2006 at 15:07 UTC

    Because symbol tables are hashes, a reference to a non-existant subroutine will auto-vivify that subroutine name into the symbol table, albeit with no (useful) code attached. To achieve your aim you should test for the existance of the subroutine within the package. 

    eval {
    no strict "refs";

    require "$fqn_file";

    local $SIG{'__DIE__'};
    $ref = exists ${ $foo . '::' }{ 'f_preferred' } 
         ? \&{$foo . "::f_preferred"} 
         : undef;
};
warn $@ if $@;

    [download]

    Note. That's still not foolproof because if the package contains a forward reference to the sub 

    sub f_preferred;

    [download]

    But no body, the symbol will exist in the stash, and it's value will be set to a CODE(0xhhhhhhh) reference, but an attempt to call it will fail with 'undefined subroutine'.

    I've never worked out where the code reference for declared, but un-bodied (and autovivified) subs, points?

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]

      Grab the CODE slot of the typeglob if you want to check if a function is defined. The existance of any of the package variables $f_preferred, @f_preferred, %f_preferred, etc will cause exists to return true, so exists is not suitable. 

      my $pkg      = ...;
my $mod_file = ...;

# require always returns true or an exception.
eval { require $mod_file }
   or warn $@;

my $sym = do { no strict 'refs';  ${ "${pkg}::" }{ 'f_preferred' } };
my $ref = *$sym{CODE};

      [download]

      If the function hasn't been declared, or if the function has been declared (sub func;) but not defined (sub func { ... }), then $ref will be undef.

      Update: Rephrased for increased clarity. Code unchanged.

[reply]
[d/l]
[select]
Re: referring to packages indirectly
by cephas (Pilgrim) on Oct 11, 2006 at 15:29 UTC 
    $ref = *{${ $foo . '::'}{f_preferred}}{CODE};

    [download]

    This specifically grabs the CODE section of the typeglob.
[reply]
[d/l]
Re: referring to packages indirectly
by kwaping (Priest) on Oct 11, 2006 at 15:26 UTC
    This minor modification worked for me: 
    eval {
        no strict "refs";

        require "$fqn_file";

        local $SIG{'__DIE__'};
        ###$ref = $foo->can('f_preferred') ? \&{$foo . "::f_preferred"
+} : undef;
        $ref = $foo->can('f_preferred');
};

    [download]
    Read up on UNIVERSAL for more info.

    Update: I too needed to read up on UNIVERSAL, as can does exactly what the OP was looking for without my redundant ternary operator.

    ---
    It's all fine and dandy until someone has to look at the code.
[reply]
[d/l]
[select]

      Be careful with that, as can() searches all parent classes for the subroutine. That might not be what you want.

[reply]
[d/l]

Back to Seekers of Perl Wisdom