Re^2: check a modules functions dependencies are met

[Anonymous Monk]

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;
  }
}

[irishBatman]

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