kivitendo/scripts/find-use.pl @ 4a663bf8
| 165fae20 | Sven Schöling | #!/usr/bin/perl -l
|
||
| cff913a1 | Moritz Bunkus | |||
BEGIN {
|
||||
use FindBin;
|
||||
unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML).
|
||||
push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon.
|
||||
}
|
||||
| 165fae20 | Sven Schöling | use strict;
|
||
#use warnings; # corelist and find throw tons of warnings
|
||||
use File::Find;
|
||||
| e92ff87c | Sven Schöling | use Module::CoreList;
|
||
| 165fae20 | Sven Schöling | use SL::InstallationCheck;
|
||
| e92ff87c | Sven Schöling | use Term::ANSIColor;
|
||
| 31d232e6 | Sven Schöling | use Getopt::Long;
|
||
| e92ff87c | Sven Schöling | |||
my (%uselines, %modules, %supplied, %requires);
|
||||
# since the information which classes belong to a cpan distribution is not
|
||||
# easily obtained, I'll just hard code the bigger ones we use here. the same
|
||||
# hash will be filled later with information gathered from the source files.
|
||||
%requires = (
|
||||
| f2302099 | Sven Schöling | 'DateTime' => {
|
||
'DateTime::Duration' => 1,
|
||||
'DateTime::Infinite' => 1,
|
||||
},
|
||||
| e92ff87c | Sven Schöling | 'Rose::DB::Object' => {
|
||
'Rose::DB::Object::ConventionManager' => 1,
|
||||
'Rose::DB::Object::Manager' => 1,
|
||||
'Rose::DB::Object::Metadata' => 1,
|
||||
| 451688a8 | Jan Büren | 'Rose::DB::Object::Helpers' => 1,
|
||
'Rose::DB::Object::Util' => 1,
|
||||
| 096a80d2 | Geoffrey Richardson | 'Rose::DB::Object::Constants' => 1,
|
||
| e92ff87c | Sven Schöling | },
|
||
'Rose::Object' => {
|
||||
'Rose::Object::MakeMethods::Generic' => 1,
|
||||
},
|
||||
'Template' => {
|
||||
'Template::Constants' => 1,
|
||||
'Template::Exception' => 1,
|
||||
'Template::Iterator' => 1,
|
||||
'Template::Plugin' => 1,
|
||||
'Template::Plugin::Filter' => 1,
|
||||
| 26a34e33 | Sven Schöling | 'Template::Plugin::HTML' => 1,
|
||
| 451688a8 | Jan Büren | 'Template::Stash' => 1,
|
||
| e92ff87c | Sven Schöling | },
|
||
| 26a34e33 | Sven Schöling | 'Devel::REPL' => {
|
||
'namespace::clean' => 1,
|
||||
| 69f47310 | Sven Schöling | },
|
||
'Email::MIME' => {
|
||||
'Email::MIME::Creator' => 1,
|
||||
},
|
||||
'Test::Harness' => {
|
||||
'TAP::Parser' => 1,
|
||||
'TAP::Parser::Aggregator' => 1,
|
||||
},
|
||||
| 451688a8 | Jan Büren | 'Archive::Zip' => {
|
||
'Archive::Zip::Member' => 1,
|
||||
| 04affa34 | Sven Schöling | },
|
||
'HTML::Parser' => {
|
||||
'HTML::Entities' => 1,
|
||||
},
|
||||
| b3fadc52 | Sven Schöling | 'URI' => {
|
||
'URI::Escape' => 1,
|
||||
},
|
||||
| 7aa3654e | Sven Schöling | 'File::MimeInfo' => {
|
||
'File::MimeInfo::Magic' => 1,
|
||||
},
|
||||
| e92ff87c | Sven Schöling | );
|
||
| 165fae20 | Sven Schöling | |||
| 31d232e6 | Sven Schöling | GetOptions(
|
||
'files-with-match|l' => \ my $l,
|
||||
);
|
||||
| cff913a1 | Moritz Bunkus | chmod($FindBin::Bin . '/..');
|
||
| 165fae20 | Sven Schöling | find(sub {
|
||
return unless /(\.p[lm]|console)$/;
|
||||
| 008c2e15 | Moritz Bunkus | # remember modules shipped with kivitendo
|
||
| 165fae20 | Sven Schöling | $supplied{modulize($File::Find::name)}++
|
||
if $File::Find::dir =~ m#modules/#;
|
||||
open my $fh, '<', $_ or warn "can't open $_: $!";
|
||||
while (<$fh>) {
|
||||
chomp;
|
||||
next if !/^use /;
|
||||
next if /SL::/;
|
||||
next if /Support::Files/; # our own test support module
|
||||
next if /use (warnings|strict|vars|lib|constant|utf8)/;
|
||||
| ade508b5 | Geoffrey Richardson | next if /^use (with|the)/;
|
||
| 165fae20 | Sven Schöling | |||
my ($useline) = m/^use\s+(.*?)$/;
|
||||
| f2302099 | Sven Schöling | next if $useline =~ /^[\d._]+;/; # skip version requirements
|
||
| 165fae20 | Sven Schöling | next if !$useline;
|
||
| e92ff87c | Sven Schöling | $uselines{$useline} ||= [];
|
||
push @{ $uselines{$useline} }, $File::Find::name;
|
||||
| 165fae20 | Sven Schöling | }
|
||
}, '.');
|
||||
for my $useline (keys %uselines) {
|
||||
$useline =~ s/#.*//; # kill comments
|
||||
| e92ff87c | Sven Schöling | # modules can be loaded implicitly with use base qw(Module) or use parent
|
||
| 165fae20 | Sven Schöling | # 'Module'. catch these:
|
||
my ($module, $args) = $useline =~ /
|
||||
(?:
|
||||
(?:base|parent)
|
||||
\s
|
||||
(?:'|"|qw.)
|
||||
)? # optional parent block
|
||||
([\w:]+) # the module
|
||||
(.*) # args
|
||||
/ix;
|
||||
# some comments looks very much like use lines
|
||||
# try to get rid of them
|
||||
next if $useline =~ /^it like a normal Perl node/; # YAML::Dump comment
|
||||
next if $useline =~ /^most and offer that in a small/; # YAML
|
||||
my $version = Module::CoreList->first_release($module);
|
||||
| a31d5a20 | Moritz Bunkus | $modules{$module} = { status => $supplied{$module} ? 'included'
|
||
: $version ? sprintf '%2.6f', $version
|
||||
| 26a34e33 | Sven Schöling | : is_required($module) ? 'required'
|
||
: is_optional($module) ? 'optional'
|
||||
: is_developer($module) ? 'developer'
|
||||
| a31d5a20 | Moritz Bunkus | : '!missing',
|
||
files => $uselines{$useline},
|
||||
};
|
||||
| e92ff87c | Sven Schöling | |||
# build requirement tree
|
||||
for my $file (@{ $uselines{$useline} }) {
|
||||
next if $file =~ /\.pl$/;
|
||||
my $orig_module = modulize($file);
|
||||
$requires{$orig_module} ||= {};
|
||||
$requires{$orig_module}{$module}++;
|
||||
}
|
||||
}
|
||||
| 69f47310 | Sven Schöling | # have all documented modules mentioned here
|
||
$modules{$_->{name}} ||= { status => 'required' } for @SL::InstallationCheck::required_modules;
|
||||
$modules{$_->{name}} ||= { status => 'optional' } for @SL::InstallationCheck::optional_modules;
|
||||
$modules{$_->{name}} ||= { status => 'developer' } for @SL::InstallationCheck::developer_modules;
|
||||
| 299dba8f | Steven Schubiger | # build transitive closure for documented dependencies
|
||
| e92ff87c | Sven Schöling | my $changed = 1;
|
||
while ($changed) {
|
||||
$changed = 0;
|
||||
for my $src_module (keys %requires) {
|
||||
for my $dst_module (keys %{ $requires{$src_module} }) {
|
||||
| a31d5a20 | Moritz Bunkus | if ( $modules{$src_module}
|
||
&& $modules{$dst_module}
|
||||
| 26a34e33 | Sven Schöling | && $modules{$src_module}->{status} =~ /^(required|devel|optional)/
|
||
| a31d5a20 | Moritz Bunkus | && $modules{$dst_module}->{status} eq '!missing') {
|
||
$modules{$dst_module}->{status} = "required"; # . ", via $src_module";
|
||||
| e92ff87c | Sven Schöling | $changed = 1;
|
||
}
|
||||
}
|
||||
}
|
||||
| 165fae20 | Sven Schöling | }
|
||
| 31d232e6 | Sven Schöling | do {
|
||
print sprintf "%8s : %s", color_text($modules{$_}->{status}), $_;
|
||||
if ($l) {
|
||||
print " $_" for @{ $modules{$_}->{files} || [] };
|
||||
}
|
||||
} for sort {
|
||||
| a31d5a20 | Moritz Bunkus | $modules{$a}->{status} cmp $modules{$b}->{status}
|
||
|| $a cmp $b
|
||||
| 165fae20 | Sven Schöling | } keys %modules;
|
||
sub modulize {
|
||||
for (my ($name) = @_) {
|
||||
s#^./modules/\w+/##;
|
||||
| e92ff87c | Sven Schöling | s#^./##;
|
||
| 165fae20 | Sven Schöling | s#.pm$##;
|
||
s#/#::#g;
|
||||
return $_;
|
||||
}
|
||||
}
|
||||
| 26a34e33 | Sven Schöling | sub is_required {
|
||
| 165fae20 | Sven Schöling | my ($module) = @_;
|
||
| e92ff87c | Sven Schöling | grep { $_->{name} eq $module } @SL::InstallationCheck::required_modules;
|
||
}
|
||||
| 26a34e33 | Sven Schöling | sub is_optional {
|
||
my ($module) = @_;
|
||||
grep { $_->{name} eq $module } @SL::InstallationCheck::optional_modules;
|
||||
}
|
||||
sub is_developer {
|
||||
my ($module) = @_;
|
||||
grep { $_->{name} eq $module } @SL::InstallationCheck::developer_modules;
|
||||
}
|
||||
| e92ff87c | Sven Schöling | sub color_text {
|
||
my ($text) = @_;
|
||||
return color(get_color($text)) . $text . color('reset');
|
||||
| 165fae20 | Sven Schöling | }
|
||
| e92ff87c | Sven Schöling | sub get_color {
|
||
for (@_) {
|
||||
return 'yellow' if /^5./ && $_ > 5.008;
|
||||
return 'green' if /^5./;
|
||||
return 'green' if /^included/;
|
||||
return 'red' if /^!missing/;
|
||||
return 'yellow';
|
||||
}
|
||||
}
|
||||
1;
|
||||
| 165fae20 | Sven Schöling | __END__
|
||
| d6fad186 | Udo Spallek | =head1 NAME
|
||
find-use
|
||||
=head1 EXAMPLE
|
||||
| 165fae20 | Sven Schöling | # perl scipts/find-use.pl
|
||
| e92ff87c | Sven Schöling | !missing : Template::Constants
|
||
!missing : DBI
|
||||
| d6fad186 | Udo Spallek | |||
| 165fae20 | Sven Schöling | =head1 EXPLANATION
|
||
| d6fad186 | Udo Spallek | |||
| 165fae20 | Sven Schöling | This util is useful for package builders to identify all the CPAN dependencies
|
||
| e92ff87c | Sven Schöling | we have. It requires Module::CoreList (which is core since 5.9) to determine if
|
||
a module is distributed with perl or not. The output will be one of the
|
||||
following:
|
||||
=over 4
|
||||
=item VERSION
|
||||
If a version string is displayed, the module is core since this version.
|
||||
Everything up to 5.8 is alright. 5.10 (aka 5.010) is acceptable, but should be
|
||||
documented. Please do not use 5.12 core modules without adding an explicit
|
||||
requirement.
|
||||
=item included
|
||||
This module is included in C<modules/*>. Don't worry about it.
|
||||
=item required
|
||||
This module is documented in C<SL:InstallationCheck> to be necessary, or is a
|
||||
| 299dba8f | Steven Schubiger | dependency of one of these. Everything alright.
|
||
| e92ff87c | Sven Schöling | |||
| 79e5fc33 | Sven Schöling | =item !missing
|
||
| e92ff87c | Sven Schöling | |||
These modules are neither core, nor included, nor required. This is ok for
|
||||
developer tools, but should never occur for modules the actual program uses.
|
||||
| d6fad186 | Udo Spallek | |||
| 79e5fc33 | Sven Schöling | =back
|
||
| d6fad186 | Udo Spallek | =head1 AUTHOR
|
||
http://www.ledgersmb.org/ - The LedgerSMB team
|
||||
| 165fae20 | Sven Schöling | Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
|
||
| d6fad186 | Udo Spallek | |||
=head1 LICENSE
|
||||
| 1eeb6cbe | Udo Spallek | Distributed under the terms of the GNU General Public License v2.
|
||
| d6fad186 | Udo Spallek | |||
| 165fae20 | Sven Schöling | =cut
|