scripts/find-use.pl

   1 #!/usr/bin/perl -l
   2
   3 BEGIN {
   4   use FindBin;
   5
   6   unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML).
   7   push   (@INC, $FindBin::Bin . '/..');                  # '.' will be removed from @INC soon.
   8   push   (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version.
   9 }
  10
  11 use strict;
  12 #use warnings; # corelist and find throw tons of warnings
  13 use File::Find;
  14 use Module::CoreList;
  15 use SL::InstallationCheck;
  16 use Term::ANSIColor;
  17 use Getopt::Long;
  18
  19 my (%uselines, %modules, %supplied, %requires);
  20
  21 # since the information which classes belong to a cpan distribution is not
  22 # easily obtained, I'll just hard code the bigger ones we use here. the same
  23 # hash will be filled later with information gathered from the source files.
  24 %requires = (
  25   'DateTime' => {
  26     'DateTime::Duration'                 => 1,
  27     'DateTime::Infinite'                 => 1,
  28   },
  29   'Rose::DB::Object' => {
  30    'Rose::DB::Object::ConventionManager' => 1,
  31    'Rose::DB::Object::Manager'           => 1,
  32    'Rose::DB::Object::Metadata'          => 1,
  33    'Rose::DB::Object::Helpers'           => 1,
  34    'Rose::DB::Object::Util'              => 1,
  35    'Rose::DB::Object::Constants'         => 1,
  36   },
  37   'Rose::Object' => {
  38     'Rose::Object::MakeMethods::Generic' => 1,
  39   },
  40   'Template' => {
  41     'Template::Constants'                => 1,
  42     'Template::Exception'                => 1,
  43     'Template::Iterator'                 => 1,
  44     'Template::Plugin'                   => 1,
  45     'Template::Plugin::Filter'           => 1,
  46     'Template::Plugin::HTML'             => 1,
  47     'Template::Stash'                    => 1,
  48   },
  49   'Devel::REPL' => {
  50     'namespace::clean'                   => 1,
  51   },
  52   'Email::MIME' => {
  53     'Email::MIME::Creator'               => 1,
  54   },
  55   'Test::Harness' => {
  56     'TAP::Parser'                        => 1,
  57     'TAP::Parser::Aggregator'            => 1,
  58   },
  59   'Archive::Zip' => {
  60     'Archive::Zip::Member'               => 1,
  61   },
  62   'HTML::Parser' => {
  63     'HTML::Entities'                     => 1,
  64   },
  65 );
  66
  67 GetOptions(
  68   'files-with-match|l' => \ my $l,
  69 );
  70
  71 chmod($FindBin::Bin . '/..');
  72
  73 find(sub {
  74   return unless /(\.p[lm]|console)$/;
  75
  76   # remember modules shipped with kivitendo
  77   $supplied{modulize($File::Find::name)}++
  78     if $File::Find::dir =~ m#modules/#;
  79
  80   open my $fh, '<', $_ or warn "can't open $_: $!";
  81   while (<$fh>) {
  82     chomp;
  83     next if !/^use /;
  84     next if /SL::/;
  85     next if /Support::Files/; # our own test support module
  86     next if /use (warnings|strict|vars|lib|constant|utf8)/;
  87     next if /^use (with|the)/;
  88
  89     my ($useline) = m/^use\s+(.*?)$/;
  90
  91     next if  $useline =~ /^[\d._]+;/; # skip version requirements
  92     next if !$useline;
  93
  94     $uselines{$useline} ||= [];
  95     push @{ $uselines{$useline} }, $File::Find::name;
  96   }
  97 }, '.');
  98
  99 for my $useline (keys %uselines) {
 100   $useline =~ s/#.*//; # kill comments
 101
 102   # modules can be loaded implicitly with use base qw(Module) or use parent
 103   # 'Module'. catch these:
 104   my ($module, $args) = $useline =~ /
 105     (?:
 106       (?:base|parent)
 107       \s
 108       (?:'|"|qw.)
 109     )?                 # optional parent block
 110     ([\w:]+)           # the module
 111     (.*)               # args
 112   /ix;
 113
 114   # some comments looks very much like use lines
 115   # try to get rid of them
 116   next if $useline =~ /^it like a normal Perl node/;   # YAML::Dump comment
 117   next if $useline =~ /^most and offer that in a small/; # YAML
 118
 119   my $version = Module::CoreList->first_release($module);
 120   $modules{$module} = { status => $supplied{$module}     ? 'included'
 121                                 : $version               ? sprintf '%2.6f', $version
 122                                 : is_required($module)   ? 'required'
 123                                 : is_optional($module)   ? 'optional'
 124                                 : is_developer($module)  ? 'developer'
 125                                 : '!missing',
 126                         files  => $uselines{$useline},
 127                       };
 128
 129   # build requirement tree
 130   for my $file (@{ $uselines{$useline} }) {
 131     next if $file =~ /\.pl$/;
 132     my $orig_module = modulize($file);
 133     $requires{$orig_module} ||= {};
 134     $requires{$orig_module}{$module}++;
 135   }
 136 }
 137
 138 # have all documented modules mentioned here
 139 $modules{$_->{name}} ||= { status => 'required' } for @SL::InstallationCheck::required_modules;
 140 $modules{$_->{name}} ||= { status => 'optional' } for @SL::InstallationCheck::optional_modules;
 141 $modules{$_->{name}} ||= { status => 'developer' } for @SL::InstallationCheck::developer_modules;
 142
 143 # build transitive closure for documented dependancies
 144 my $changed = 1;
 145 while ($changed) {
 146   $changed = 0;
 147   for my $src_module (keys %requires) {
 148     for my $dst_module (keys %{ $requires{$src_module} }) {
 149       if (   $modules{$src_module}
 150           && $modules{$dst_module}
 151           && $modules{$src_module}->{status} =~ /^(required|devel|optional)/
 152           && $modules{$dst_module}->{status} eq '!missing') {
 153         $modules{$dst_module}->{status} = "required"; # . ", via $src_module";
 154         $changed = 1;
 155       }
 156     }
 157   }
 158 }
 159
 160 do {
 161   print sprintf "%8s : %s", color_text($modules{$_}->{status}), $_;
 162   if ($l) {
 163     print " $_" for @{ $modules{$_}->{files} || [] };
 164   }
 165 } for sort {
 166        $modules{$a}->{status} cmp $modules{$b}->{status}
 167     ||                    $a  cmp $b
 168   } keys %modules;
 169
 170 sub modulize {
 171   for (my ($name) = @_) {
 172     s#^./modules/\w+/##;
 173     s#^./##;
 174     s#.pm$##;
 175     s#/#::#g;
 176     return $_;
 177   }
 178 }
 179
 180 sub is_required {
 181   my ($module) = @_;
 182   grep { $_->{name} eq $module } @SL::InstallationCheck::required_modules;
 183 }
 184
 185 sub is_optional {
 186   my ($module) = @_;
 187   grep { $_->{name} eq $module } @SL::InstallationCheck::optional_modules;
 188 }
 189
 190 sub is_developer {
 191   my ($module) = @_;
 192   grep { $_->{name} eq $module } @SL::InstallationCheck::developer_modules;
 193 }
 194
 195 sub color_text {
 196   my ($text) = @_;
 197   return color(get_color($text)) . $text . color('reset');
 198 }
 199
 200 sub get_color {
 201   for (@_) {
 202     return 'yellow' if /^5./ && $_ > 5.008;
 203     return 'green'  if /^5./;
 204     return 'green'  if /^included/;
 205     return 'red'    if /^!missing/;
 206     return 'yellow';
 207   }
 208 }
 209
 210 1;
 211
 212 __END__
 213
 214 =head1 NAME
 215
 216 find-use
 217
 218 =head1 EXAMPLE
 219
 220  # perl scipts/find-use.pl
 221  !missing : Perl::Tags
 222  !missing : Template::Constants
 223  !missing : DBI
 224
 225 =head1 EXPLANATION
 226
 227 This util is useful for package builders to identify all the CPAN dependencies
 228 we have. It requires Module::CoreList (which is core since 5.9) to determine if
 229 a module is distributed with perl or not.  The output will be one of the
 230 following:
 231
 232 =over 4
 233
 234 =item VERSION
 235
 236 If a version string is displayed, the module is core since this version.
 237 Everything up to 5.8 is alright. 5.10 (aka 5.010) is acceptable, but should be
 238 documented. Please do not use 5.12 core modules without adding an explicit
 239 requirement.
 240
 241 =item included
 242
 243 This module is included in C<modules/*>. Don't worry about it.
 244
 245 =item required
 246
 247 This module is documented in C<SL:InstallationCheck> to be necessary, or is a
 248 dependancy of one of these. Everything alright.
 249
 250 =item !missing
 251
 252 These modules are neither core, nor included, nor required. This is ok for
 253 developer tools, but should never occur for modules the actual program uses.
 254
 255 =back
 256
 257 =head1 AUTHOR
 258
 259 http://www.ledgersmb.org/ - The LedgerSMB team
 260 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 261
 262 =head1 LICENSE
 263
 264 Distributed under the terms of the GNU General Public License v2.
 265
 266 =cut