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