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   'URI' => {
  66     'URI::Escape'                        => 1,
  67   },
  68 );
  69
  70 GetOptions(
  71   'files-with-match|l' => \ my $l,
  72 );
  73
  74 chmod($FindBin::Bin . '/..');
  75
  76 find(sub {
  77   return unless /(\.p[lm]|console)$/;
  78
  79   # remember modules shipped with kivitendo
  80   $supplied{modulize($File::Find::name)}++
  81     if $File::Find::dir =~ m#modules/#;
  82
  83   open my $fh, '<', $_ or warn "can't open $_: $!";
  84   while (<$fh>) {
  85     chomp;
  86     next if !/^use /;
  87     next if /SL::/;
  88     next if /Support::Files/; # our own test support module
  89     next if /use (warnings|strict|vars|lib|constant|utf8)/;
  90     next if /^use (with|the)/;
  91
  92     my ($useline) = m/^use\s+(.*?)$/;
  93
  94     next if  $useline =~ /^[\d._]+;/; # skip version requirements
  95     next if !$useline;
  96
  97     $uselines{$useline} ||= [];
  98     push @{ $uselines{$useline} }, $File::Find::name;
  99   }
 100 }, '.');
 101
 102 for my $useline (keys %uselines) {
 103   $useline =~ s/#.*//; # kill comments
 104
 105   # modules can be loaded implicitly with use base qw(Module) or use parent
 106   # 'Module'. catch these:
 107   my ($module, $args) = $useline =~ /
 108     (?:
 109       (?:base|parent)
 110       \s
 111       (?:'|"|qw.)
 112     )?                 # optional parent block
 113     ([\w:]+)           # the module
 114     (.*)               # args
 115   /ix;
 116
 117   # some comments looks very much like use lines
 118   # try to get rid of them
 119   next if $useline =~ /^it like a normal Perl node/;   # YAML::Dump comment
 120   next if $useline =~ /^most and offer that in a small/; # YAML
 121
 122   my $version = Module::CoreList->first_release($module);
 123   $modules{$module} = { status => $supplied{$module}     ? 'included'
 124                                 : $version               ? sprintf '%2.6f', $version
 125                                 : is_required($module)   ? 'required'
 126                                 : is_optional($module)   ? 'optional'
 127                                 : is_developer($module)  ? 'developer'
 128                                 : '!missing',
 129                         files  => $uselines{$useline},
 130                       };
 131
 132   # build requirement tree
 133   for my $file (@{ $uselines{$useline} }) {
 134     next if $file =~ /\.pl$/;
 135     my $orig_module = modulize($file);
 136     $requires{$orig_module} ||= {};
 137     $requires{$orig_module}{$module}++;
 138   }
 139 }
 140
 141 # have all documented modules mentioned here
 142 $modules{$_->{name}} ||= { status => 'required' } for @SL::InstallationCheck::required_modules;
 143 $modules{$_->{name}} ||= { status => 'optional' } for @SL::InstallationCheck::optional_modules;
 144 $modules{$_->{name}} ||= { status => 'developer' } for @SL::InstallationCheck::developer_modules;
 145
 146 # build transitive closure for documented dependancies
 147 my $changed = 1;
 148 while ($changed) {
 149   $changed = 0;
 150   for my $src_module (keys %requires) {
 151     for my $dst_module (keys %{ $requires{$src_module} }) {
 152       if (   $modules{$src_module}
 153           && $modules{$dst_module}
 154           && $modules{$src_module}->{status} =~ /^(required|devel|optional)/
 155           && $modules{$dst_module}->{status} eq '!missing') {
 156         $modules{$dst_module}->{status} = "required"; # . ", via $src_module";
 157         $changed = 1;
 158       }
 159     }
 160   }
 161 }
 162
 163 do {
 164   print sprintf "%8s : %s", color_text($modules{$_}->{status}), $_;
 165   if ($l) {
 166     print " $_" for @{ $modules{$_}->{files} || [] };
 167   }
 168 } for sort {
 169        $modules{$a}->{status} cmp $modules{$b}->{status}
 170     ||                    $a  cmp $b
 171   } keys %modules;
 172
 173 sub modulize {
 174   for (my ($name) = @_) {
 175     s#^./modules/\w+/##;
 176     s#^./##;
 177     s#.pm$##;
 178     s#/#::#g;
 179     return $_;
 180   }
 181 }
 182
 183 sub is_required {
 184   my ($module) = @_;
 185   grep { $_->{name} eq $module } @SL::InstallationCheck::required_modules;
 186 }
 187
 188 sub is_optional {
 189   my ($module) = @_;
 190   grep { $_->{name} eq $module } @SL::InstallationCheck::optional_modules;
 191 }
 192
 193 sub is_developer {
 194   my ($module) = @_;
 195   grep { $_->{name} eq $module } @SL::InstallationCheck::developer_modules;
 196 }
 197
 198 sub color_text {
 199   my ($text) = @_;
 200   return color(get_color($text)) . $text . color('reset');
 201 }
 202
 203 sub get_color {
 204   for (@_) {
 205     return 'yellow' if /^5./ && $_ > 5.008;
 206     return 'green'  if /^5./;
 207     return 'green'  if /^included/;
 208     return 'red'    if /^!missing/;
 209     return 'yellow';
 210   }
 211 }
 212
 213 1;
 214
 215 __END__
 216
 217 =head1 NAME
 218
 219 find-use
 220
 221 =head1 EXAMPLE
 222
 223  # perl scipts/find-use.pl
 224  !missing : Perl::Tags
 225  !missing : Template::Constants
 226  !missing : DBI
 227
 228 =head1 EXPLANATION
 229
 230 This util is useful for package builders to identify all the CPAN dependencies
 231 we have. It requires Module::CoreList (which is core since 5.9) to determine if
 232 a module is distributed with perl or not.  The output will be one of the
 233 following:
 234
 235 =over 4
 236
 237 =item VERSION
 238
 239 If a version string is displayed, the module is core since this version.
 240 Everything up to 5.8 is alright. 5.10 (aka 5.010) is acceptable, but should be
 241 documented. Please do not use 5.12 core modules without adding an explicit
 242 requirement.
 243
 244 =item included
 245
 246 This module is included in C<modules/*>. Don't worry about it.
 247
 248 =item required
 249
 250 This module is documented in C<SL:InstallationCheck> to be necessary, or is a
 251 dependancy of one of these. Everything alright.
 252
 253 =item !missing
 254
 255 These modules are neither core, nor included, nor required. This is ok for
 256 developer tools, but should never occur for modules the actual program uses.
 257
 258 =back
 259
 260 =head1 AUTHOR
 261
 262 http://www.ledgersmb.org/ - The LedgerSMB team
 263 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 264
 265 =head1 LICENSE
 266
 267 Distributed under the terms of the GNU General Public License v2.
 268
 269 =cut