Extracteur d'arborescence

Dans l'article <44964e8e$0$9011$626a54ce@news.free.fr>,
nabotleon@hotmail_N0_SPAMZ.com a dit...

Je cherche un petit script ou programme permettant de construire
l'arborescence d'appels à des fonctions internes à un script perl ou
existant dans une librairie lié à ce script (Mais sans les appels aux
fonctions des libs Perl elles mêmes)

Quelque chose du genre :
[couic]

Ce que vous demandez n'est pas facile à faire car il faut 'parser' le code
du script et, comme chacun sait, "seul perl peut 'parser' du code Perl" (et
encore...).

Néanmoins, il existe le module PPI qui permet de 'parser' du code Perl
plutôt comme un texte que comme un programme. C'est souvent suffisant.
Voir la doc :

http://search.cpan.org/~adamk/PPI-1.115/lib/PPI.pm
et
http://www.perl.com/pub/a/2005/06/09/ppi.html

Le petit script démo suivant dépouille progressivement le code du script ou
du module donné jusqu'à obtenir son squelette.
À améliorer, adapter et modifier bien sûr.

HTH


#!/usr/bin/perl
use strict;
use warnings;
use PPI;

my $fichier = $0; # pour tester, on applique le script à lui-même

# on charge le document et on construit l'arbre
my $Document = PPI::Document->new($fichier);

# on élague ...
$Document->prune('Statement::End'); # le __END__ et ce qui suit
$Document->prune('Statement::Data'); # le __DATA__ et ce qui suit
$Document->prune('PPI::Statement::Include'); # les 'use' et 'include'
$Document->prune('PPI::Statement::Package'); # les 'package'
$Document->prune('Token::Comment'); # les commentaires
$Document->prune('Token::Pod'); # la doc format pod
$Document->prune('PPI::Token::Structure'); # les ';'
$Document->prune('PPI::Token::Symbol'); # les noms de variables
$Document->prune('PPI::Token::Regexp'); # les Regexps
$Document->prune('PPI::Token::Number'); # les nombres
$Document->prune('PPI::Token::Quote'); # les q{}, qq{}
$Document->prune('PPI::Token::QuoteLike'); # les qw{}, qx{}, qr{}
$Document->prune( &wanted ); # on fignole ...

sub wanted {
my ( $Document, $Element ) = @_;

# on enlève les opérateurs sauf '->' (pb de concaténation)
return 0 if $Element->content eq '->';
return 1 if $Element->isa('PPI::Token::Operator');

# on garde les caractères blancs
return 0 if $Element->isa('PPI::Token::Whitespace');

# on garde les 'sub'
return 0
if $Element->isa('PPI::Statement::Sub')
or $Element->parent->isa('PPI::Statement::Sub');

# on garde les mots non réservés par Perl
return 0 if !isa_reserved_word($Element);

# on enleve le reste
return 1;
}

print $Document; # on affiche le résultat
# $Document->save('test.txt'); # on sauve le résultat

# ------ Fonction auxiliaire
# Renvoie vrai/faux suivant que son argument est un mot réservé
# de Perl ou non.

sub isa_reserved_word {
eval { () = prototype "CORE::$_[0]" };
return !$@;
}

__END__


--
J-L.M.
http://www.bribes.org/perl