Puis-je obtenir dynamiquement une liste de fonctions ou de noms de fonctions à partir de n'importe quel module Perl?

Question

Je voudrais obtenir dynamiquement une liste des noms de fonctions (en tant que chaînes) ou des références de fonctions à partir de n'importe quel module Perl disponible sur mon système. Ceci inclurait des modules qui peuvent ou non avoir, par exemple, un tableau global @EXPORT_OK dans son espace de noms. Un tel exploit est-il possible? Comment l'arracher si c'est le cas?

Edit: De la lecture perlmod, je vois que %Some::Module:: sert de table de symboles pour Some::Module. Est-ce le bon endroit pour regarder? Si oui, comment est-ce que je peux réduire la table juste aux noms de fonction dans Some::Module?

Answer 1

Vous êtes sur la bonne voie. Pour Wittle sur la table pleine de symbole pour seulement les sous-marins, quelque chose comme cela peut être fait (Pointe du chapeau « Mastering Perl », ch 8, pour la version principale de l'emballage de ce):

use strict; # need to turn off refs when needed 
package X; 

sub x {1;}; 
sub y {1;}; 
our $y = 1; 
our $z = 2; 

package main; 

foreach my $entry (keys %X::) { 
    no strict 'refs'; 
    if (defined &{"X::$entry"}) { 
     print "sub $entry is defined\n" ; 
    } 
} 

# OUTPUT 
sub y is defined 
sub x is defined 

Answer 2

Vous pouvez trouver ce simple script pratique:

#!/usr/bin/env perl 
use strict; 
use warnings;  
use Data::Dumper; 

# dump of object's symbol table: 
foreach my $className (@ARGV) 
{ 
    print "symbols in $className:"; 

    eval "require $className"; 
    die "Can't load $className: $@" if $@; 

    no strict 'refs'; 
    print Dumper(\%{"main::${className}::"}); 
} 

Mais, si vous faites cela dans le code de production, j'utiliser Package::Stash à la place:

my @subs_in_foo = Package::Stash->new('Foo')->list_all_symbols('CODE'); 

Answer 3

J'utilise Perl 5.20 . Cela fonctionne sur ma machine:

use strict; 

package foo; 
    our $some_var; 
    sub func1 { return 'func1'} 
    sub func2 { return 'func2'} 

package main; 
    sub callable { 
     my ($x) = @_; 
     return defined(&$x); 
    } 

    while (my ($k, $v) = each(%foo::)) { 
     if (callable($v)) { 
     print("$k\n"); 
     } 
    } 

    # output: 
    # func1 
    # func2