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