scripts/find-use.pl

   1 #!/usr/bin/perl -l
   2 use strict;
   3 #use warnings; # corelist and find throw tons of warnings
   4 use Module::CoreList;
   5 use File::Find;
   6 use SL::InstallationCheck;
   7
   8 my (%uselines, %modules, %supplied);
   9
  10 find(sub {
  11   return unless /(\.p[lm]|console)$/;
  12
  13   # remember modules shipped with Lx-Office
  14   $supplied{modulize($File::Find::name)}++
  15     if $File::Find::dir =~ m#modules/#;
  16
  17   open my $fh, '<', $_ or warn "can't open $_: $!";
  18   while (<$fh>) {
  19     chomp;
  20     next if !/^use /;
  21     next if /SL::/;
  22     next if /Support::Files/; # our own test support module
  23     next if /use (warnings|strict|vars|lib|constant|utf8)/;
  24
  25     my ($useline) = m/^use\s+(.*?)$/;
  26
  27     next if  $useline =~ /^[\d.]+;/; # skip version requirements
  28     next if !$useline;
  29
  30     $uselines{$useline}++;
  31   }
  32 }, '.');
  33
  34 for my $useline (keys %uselines) {
  35   $useline =~ s/#.*//; # kill comments
  36
  37   # modules can be loaded implicit with use base qw(Module) or use parent
  38   # 'Module'. catch these:
  39   my ($module, $args) = $useline =~ /
  40     (?:
  41       (?:base|parent)
  42       \s
  43       (?:'|"|qw.)
  44     )?                 # optional parent block
  45     ([\w:]+)           # the module
  46     (.*)               # args
  47   /ix;
  48
  49   # some comments looks very much like use lines
  50   # try to get rid of them
  51   next if $useline =~ /^it like a normal Perl node/;   # YAML::Dump comment
  52   next if $useline =~ /^most and offer that in a small/; # YAML
  53
  54   my $version = Module::CoreList->first_release($module);
  55   $modules{$module} = $supplied{$module}     ? 'included'
  56                     : $version               ? sprintf '%2.6f', $version
  57                     : is_documented($module) ? 'required'
  58                     : '!missing';
  59 }
  60
  61 print sprintf "%8s : %s", $modules{$_}, $_
  62   for sort {
  63        $modules{$a} cmp $modules{$b}
  64     ||          $a  cmp $b
  65   } keys %modules;
  66
  67 sub modulize {
  68   for (my ($name) = @_) {
  69     s#^./modules/\w+/##;
  70     s#.pm$##;
  71     s#/#::#g;
  72     return $_;
  73   }
  74 }
  75
  76 sub is_documented {
  77   my ($module) = @_;
  78   return grep { $_->{name} eq $module } @SL::InstallationCheck::required_modules;
  79 }
  80
  81 __END__
  82
  83 =head1 NAME
  84
  85 find-use
  86
  87 =head1 EXAMPLE
  88
  89  # perl scipts/find-use.pl
  90  missing : Perl::Tags
  91  missing : Template::Constants
  92  missing : DBI
  93
  94 =head1 EXPLANATION
  95
  96 This util is useful for package builders to identify all the CPAN dependencies
  97 we've made. It requires Module::CoreList (which is core, but is not in most
  98 stable releases of perl) to determine if a module is distributed with perl or
  99 not.  The output reports which version of perl the module is in.  If it reports
 100 0.000000, then the module is not in core perl, and needs to be installed before
 101 Lx-Office will operate.
 102
 103 =head1 AUTHOR
 104
 105 http://www.ledgersmb.org/ - The LedgerSMB team
 106 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 107
 108 =head1 LICENSE
 109
 110 Distributed under the terms of the GNU General Public License v2.
 111
 112 =cut
 113
 114