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