Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

check a modules functions dependencies are met

by irishBatman (Novice)
on Aug 25, 2011 at 12:02 UTC ( #922321=perlquestion: print w/ replies, xml ) Need Help??
irishBatman has asked for the wisdom of the Perl Monks concerning the following question:

I have a perl codebase that I am cleaning up.

I am shifting functions into new modules and need a robust check that I can run on each module that identifies all functions called within that module and shows the module the function is exported from, or if its export is missing.

I have tried scandeps but this does not give me the info I need.

All wisdom appreciated.

Comment on check a modules functions dependencies are met
Re: check a modules functions dependencies are met
by norbert.csongradi (Beadle) on Aug 25, 2011 at 12:27 UTC

      Thanks for the pointer, so Ive just tried Class::Inspector. It does give me a list of functions, but only those already selected to be imported

      for example if I comment out a use all the imported function names just disappear, but there is no list of all the functions that will be called by the module.

      What I really need i a list of all the function called but, not exported by other modules

      This is the code I used

      #!/usr/bin/perl -w use Class::Inspector; use SmruLogging; use Data::Dumper; # Is a class installed and/or loaded print Class::Inspector->installed( 'SmruLogging' )." = Installed\n"; print Class::Inspector->loaded( 'SmruLogging' ) ." = Loaded\n"; print "functions ".Dumper(Class::Inspector->functions( 'SmruLogging' ) +); print "function_refs ".Dumper(Class::Inspector->function_refs( 'SmruLo +gging' )); print "methods ".Dumper(Class::Inspector->methods( 'SmruLogging' )); print "subclasses ".Dumper(Class::Inspector->subclasses( 'SmruLogging' + ));
Re: check a modules functions dependencies are met
by zentara (Archbishop) on Aug 25, 2011 at 13:39 UTC

      sorry for the delay in reply, was on holiday. So I couldn't find anything that did what I required, so I created the following script

      so far it highlighted several issues with my code and It can be used to clean things up. I'm not sure how applicable it will be to others as im unsure how foolproof the parser is

      if anyone has any further wisdom, it would be much appreciated

      You should see an output like the following

      >./checkModules.pl -dir ../modules/ --Processing modules in subdirectories! --Found 27 modules, 168 subroutines with 127 exported. --Re reading each module searching for subroutines! --Warning processRemoteManifest used in dataStatusTransmission.pm but +not exported by manifestRoutines.pm
      #!/usr/bin/perl -w use strict; use Getopt::Long; my %hash; # initialise local variables $hash{HELP} = 0; $hash{MODCOUNT} = 0; $hash{SUBCOUNT} = 0; $hash{EXPCOUNT} = 0; $hash{DEBUG} = 0; $hash{INFO} = 0; my ( @moduleDirs, $dir ); GetOptions( ## process options "-help" => \$hash{HELP}, "-debug" => \$hash{DEBUG}, "-info" => \$hash{INFO}, "-dir=s" => \@moduleDirs, ); processModulesInDirectories( \%hash, \@moduleDirs ); # get sub and +exported subs! Check exported subs exist! processModulesAgainstSubRoutines( \%hash, \@moduleDirs ); # find al +l calls of exported subroutines printInfo( \%hash ) if $hash{INFO}; # print t +he function usage! print_hash_contents( \%hash, *STDOUT ) if $hash{DEBUG}; # Print t +o STDOUT ##----------------------------- Subroutines! sub printInfo { my ($hash) = @_; foreach my $module ( keys( %{ $$hash{MODULE} } ) ) { # get eac +h module print "--- $module\n"; foreach my $subroutine ( keys( %{ $$hash{MODULE}{$module}{EXP} } ) + ) { # then get it subroutines print "------ $$hash{MODULE}{$module}{EXP}{$subroutine} $subrout +ine {"; foreach my $called ( keys( %{ $$hash{MODULE}{$module}{SUB}{USED} +{$subroutine} } ) ) { print "$called "; } print "}\n"; } } } sub getDirContents { my ($dir) = @_; my @files; if ( -e $dir ) { my $status = opendir( BASEDIR, $dir ) or die "Cannot open director +y $dir\n"; @files = readdir(BASEDIR); close(BASEDIR); } return @files; } sub processModule { my ($file) = @_; my $string = ""; open( FILE, "$file" ) or warn "Could not open $file, in getFileCOnte +nts\n"; my $ignore = 0; while (<FILE>) { if (m/^=cut/) { $ignore = 0; } elsif (m/^=/) { $ignore = 1; } if ( !$ignore ) { s/\#.*$//g; ## remove all the s**t! s/^\s*sub\s+/ subSUBsubSub /; ## ease sub detection chomp; $string = $string . " " . $_; # breathing space } } close(FILE); return $string; } sub processModulesInDirectories { my ( $hash, $moduleDirs ) = @_; ## Get a list of all the subroutines from each perl module, keep a t +rack of the exported subs as well! print "--Processing modules in subdirectories!\n"; my $dir; foreach $dir (@moduleDirs) { if ( -e $dir ) { foreach my $file ( getDirContents($dir) ) { if ( $file =~ /pm$/ ) { $$hash{MODCOUNT}++; my $contents = processModule("$dir/$file"); + # get module contents! my @subs = ( $contents =~ m/subSUBsubSub\s+([a-zA-Z\-_0-9]+) +(?:{|\s)/g ); # get subroutines foreach (@subs) { # print "MODULE}{$file}{SUB}{$_\n"; $$hash{MODULE}{$file}{SUB}{$_} = 0; $$hash{SUBCOUNT}++; } my $match = $contents =~ m/\@EXPORT\s+=\s+qw\s*\(\s*([^\)]+) +/; # get export list if ($match) { my @exported = split /\s+/, $1; foreach (@exported) { # print "MODULE}{$file}{EXP}{$_\n"; $$hash{EXPCOUNT}++; $$hash{MODULE}{$file}{EXP}{$_} = 0; if ( !exists $$hash{MODULE}{$file}{SUB}{$_} ) { print("Warning - $_ is exported from $file but is not +defined as a subroutine!\n"); } } } } } } } print "\n--Found $$hash{MODCOUNT} modules, $$hash{SUBCOUNT} subrouti +nes with $$hash{EXPCOUNT} exported.\n\n"; } sub processModulesAgainstSubRoutines { my ( $hash, $moduleDirs ) = @_; print "--Re reading each module searching for subroutines!\n"; foreach my $module ( keys( %{ $$hash{MODULE} } ) ) { # get each m +odule foreach my $subroutine ( keys( %{ $$hash{MODULE}{$module}{SUB} } ) + ) { # then get it subroutines foreach my $dir (@moduleDirs) { if ( -e $dir ) { foreach my $file ( getDirContents($dir) ) { # now we iter +ate back through every file, looking for this subroutine if ( ( $file =~ /pm$/ ) and ( $file ne $module ) ) { # +did we find the subroutine my $contents = processModule("$dir/$file"); # +get module contents! my @array = ( $contents =~ m/$subroutine/g ); my $count = @array; if ( $count > 0 ) { $$hash{MODULE}{$module}{SUB}{USED}{$subroutine}{$file} + = $count; # store calls in that module if ( !exists( $$hash{MODULE}{$module}{EXP}{$subroutine +} ) ) { print "--Warning $subroutine used in $file but not e +xported by $module\n"; } else { $$hash{MODULE}{$module}{EXP}{$subroutine} += $count; + # track total calls of subroutine } } } } } } } } } ##-------------------------------------------------------------------- +---------- ## recursive hash print...You must pass references to this function, i +ts easy ## just the \ ## print_hash_contents(\%hash,\"out.txt"); # Print to a file called ou +t.txt ## print_hash_contents(\%hash,*STDOUT ); # Print to STDOUT ##-------------------------------------------------------------------- +---------- sub print_hash_contents { my ( $hash, $ofile ) = @_; my $write_to_file = 0; if ( $ofile !~ /STDOUT/ ) { open( OUTFILE, ">$$ofile" ) or die "Cannot open $$ofile\n"; print("print_hash_contents redirected to \"$$ofile\"\n"); $write_to_file = 1; $ofile = *OUTFILE; } else { print("##--------------------------------------------------------- +----\n"); } my @array = (); while ( ( my $key, my $value ) = each %{$hash} ) { push @array, $key; tunnel_hash( $$hash{$key}, 1, \@array, $ofile ); pop @array; } close(OUTFILE) if $write_to_file; } sub tunnel_hash { use strict; my ( $match, $depth, $array, $ofile ) = @_; return unless ref $match eq 'HASH'; foreach my $key2 ( keys %{$match} ) { push @$array, $key2; tunnel_hash( $match->{$key2}, $depth + 1, $array, $ofile ); if ( $match->{$key2} !~ /HASH/ ) { print( $ofile "\$\$hash" ); print( $ofile "{$_}" ) foreach (@$array); if ( $match->{$key2} =~ /[a-zA-Z]/ ) { print $ofile " = \"$match->{$key2}\";\n"; } else { print $ofile " = $match->{$key2};\n"; } } pop @$array; } }

        Note the print hash prints valid hash reference perl, that you can cut and paste

        Not sure where i picked this up in the past, but its awesome for debugging code with hash's

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (8)
As of 2014-09-20 13:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (159 votes), past polls