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