find-use, erweiterung.

- transitive Hülle von Abhängigkeiten berücksichtigen
- Ausgabe mit Term::ANSIColor eingefärbt zum besseren Verständnis

diff --git a/scripts/find-use.pl b/scripts/find-use.pl
index 97f5ad2..dbd30aa 100644 (file)
--- a/scripts/find-use.pl
+++ b/scripts/find-use.pl
@@ -1,11 +1,33 @@
 #!/usr/bin/perl -l
 use strict;
 #use warnings; # corelist and find throw tons of warnings
-use Module::CoreList;
 use File::Find;
+use Module::CoreList;
 use SL::InstallationCheck;
-
-my (%uselines, %modules, %supplied);
+use Term::ANSIColor;
+
+my (%uselines, %modules, %supplied, %requires);
+
+# since the information which classes belong to a cpan distribution is not
+# easily obtained, I'll just hard code the bigger ones we use here. the same
+# hash will be filled later with information gathered from the source files.
+%requires = (
+  'Rose::DB::Object' => {
+   'Rose::DB::Object::ConventionManager' => 1,
+   'Rose::DB::Object::Manager'           => 1,
+   'Rose::DB::Object::Metadata'          => 1,
+  },
+  'Rose::Object' => {
+    'Rose::Object::MakeMethods::Generic' => 1,
+  },
+  'Template' => {
+    'Template::Constants'                => 1,
+    'Template::Exception'                => 1,
+    'Template::Iterator'                 => 1,
+    'Template::Plugin'                   => 1,
+    'Template::Plugin::Filter'           => 1,
+  },
+);
 
 find(sub {
   return unless /(\.p[lm]|console)$/;
@@ -27,14 +49,15 @@ find(sub {
     next if  $useline =~ /^[\d.]+;/; # skip version requirements
     next if !$useline;
 
-    $uselines{$useline}++;
+    $uselines{$useline} ||= [];
+    push @{ $uselines{$useline} }, $File::Find::name;
   }
 }, '.');
 
 for my $useline (keys %uselines) {
   $useline =~ s/#.*//; # kill comments
 
-  # modules can be loaded implicit with use base qw(Module) or use parent
+  # modules can be loaded implicitly with use base qw(Module) or use parent
   # 'Module'. catch these:
   my ($module, $args) = $useline =~ /
     (?:
@@ -56,9 +79,32 @@ for my $useline (keys %uselines) {
                     : $version               ? sprintf '%2.6f', $version
                     : is_documented($module) ? 'required'
                     : '!missing';
+
+  # build requirement tree
+  for my $file (@{ $uselines{$useline} }) {
+    next if $file =~ /\.pl$/;
+    my $orig_module = modulize($file);
+    $requires{$orig_module} ||= {};
+    $requires{$orig_module}{$module}++;
+  }
+}
+
+# build transitive closure for documented dependancies
+my $changed = 1;
+while ($changed) {
+  $changed = 0;
+  for my $src_module (keys %requires) {
+    for my $dst_module (keys %{ $requires{$src_module} }) {
+      if (   $modules{$src_module} =~ /^required/
+          && $modules{$dst_module} eq '!missing') {
+        $modules{$dst_module} = "required"; # . ", via $src_module";
+        $changed = 1;
+      }
+    }
+  }
 }
 
-print sprintf "%8s : %s", $modules{$_}, $_
+print sprintf "%8s : %s", color_text($modules{$_}), $_
   for sort {
        $modules{$a} cmp $modules{$b}
     ||          $a  cmp $b
@@ -67,6 +113,7 @@ print sprintf "%8s : %s", $modules{$_}, $_
 sub modulize {
   for (my ($name) = @_) {
     s#^./modules/\w+/##;
+    s#^./##;
     s#.pm$##;
     s#/#::#g;
     return $_;
@@ -75,9 +122,26 @@ sub modulize {
 
 sub is_documented {
   my ($module) = @_;
-  return grep { $_->{name} eq $module } @SL::InstallationCheck::required_modules;
+  grep { $_->{name} eq $module } @SL::InstallationCheck::required_modules;
+}
+
+sub color_text {
+  my ($text) = @_;
+  return color(get_color($text)) . $text . color('reset');
 }
 
+sub get_color {
+  for (@_) {
+    return 'yellow' if /^5./ && $_ > 5.008;
+    return 'green'  if /^5./;
+    return 'green'  if /^included/;
+    return 'red'    if /^!missing/;
+    return 'yellow';
+  }
+}
+
+1;
+
 __END__
 
 =head1 NAME
@@ -87,18 +151,39 @@ find-use
 =head1 EXAMPLE
 
  # perl scipts/find-use.pl
- missing : Perl::Tags
- missing : Template::Constants
- missing : DBI
+ !missing : Perl::Tags
+ !missing : Template::Constants
+ !missing : DBI
 
 =head1 EXPLANATION
 
 This util is useful for package builders to identify all the CPAN dependencies
-we've made. It requires Module::CoreList (which is core, but is not in most
-stable releases of perl) to determine if a module is distributed with perl or
-not.  The output reports which version of perl the module is in.  If it reports
-0.000000, then the module is not in core perl, and needs to be installed before
-Lx-Office will operate.
+we have. It requires Module::CoreList (which is core since 5.9) to determine if
+a module is distributed with perl or not.  The output will be one of the
+following:
+
+=over 4
+
+=item VERSION
+
+If a version string is displayed, the module is core since this version.
+Everything up to 5.8 is alright. 5.10 (aka 5.010) is acceptable, but should be
+documented. Please do not use 5.12 core modules without adding an explicit
+requirement.
+
+=item included
+
+This module is included in C<modules/*>. Don't worry about it.
+
+=item required
+
+This module is documented in C<SL:InstallationCheck> to be necessary, or is a
+dependancy of one of these. Everything alright.
+
+= item !missing
+
+These modules are neither core, nor included, nor required. This is ok for
+developer tools, but should never occur for modules the actual program uses.
 
 =head1 AUTHOR