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 : Perl::Tags
 228  !missing : Template::Constants
 229  !missing : DBI
 230
 231 =head1 EXPLANATION
 232
 233 This util is useful for package builders to identify all the CPAN dependencies
 234 we have. It requires Module::CoreList (which is core since 5.9) to determine if
 235 a module is distributed with perl or not.  The output will be one of the
 236 following:
 237
 238 =over 4
 239
 240 =item VERSION
 241
 242 If a version string is displayed, the module is core since this version.
 243 Everything up to 5.8 is alright. 5.10 (aka 5.010) is acceptable, but should be
 244 documented. Please do not use 5.12 core modules without adding an explicit
 245 requirement.
 246
 247 =item included
 248
 249 This module is included in C<modules/*>. Don't worry about it.
 250
 251 =item required
 252
 253 This module is documented in C<SL:InstallationCheck> to be necessary, or is a
 254 dependancy of one of these. Everything alright.
 255
 256 =item !missing
 257
 258 These modules are neither core, nor included, nor required. This is ok for
 259 developer tools, but should never occur for modules the actual program uses.
 260
 261 =back
 262
 263 =head1 AUTHOR
 264
 265 http://www.ledgersmb.org/ - The LedgerSMB team
 266 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 267
 268 =head1 LICENSE
 269
 270 Distributed under the terms of the GNU General Public License v2.
 271
 272 =cut