Projekt

Allgemein

Profil

Herunterladen (5,46 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/scripts/find-use.pl @ 2d1086df

165fae20 Sven Schöling
#!/usr/bin/perl -l
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;

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,
},
'Rose::Object' => {
'Rose::Object::MakeMethods::Generic' => 1,
},
'Template' => {
'Template::Constants' => 1,
'Template::Exception' => 1,
'Template::Iterator' => 1,
'Template::Plugin' => 1,
'Template::Plugin::Filter' => 1,
},
);
165fae20 Sven Schöling
find(sub {
return unless /(\.p[lm]|console)$/;

# remember modules shipped with Lx-Office
$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)/;

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
: is_documented($module) ? 'required'
: '!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}++;
}
}

# build transitive closure for documented dependancies
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}
&& $modules{$src_module}->{status} =~ /^required/
&& $modules{$dst_module}->{status} eq '!missing') {
$modules{$dst_module}->{status} = "required"; # . ", via $src_module";
e92ff87c Sven Schöling
$changed = 1;
}
}
}
165fae20 Sven Schöling
}

a31d5a20 Moritz Bunkus
print sprintf "%8s : %s (%s)", color_text($modules{$_}->{status}), $_, join(' ', @{ $modules{$_}->{files} || [] })
165fae20 Sven Schöling
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 $_;
}
}

sub is_documented {
my ($module) = @_;
e92ff87c Sven Schöling
grep { $_->{name} eq $module } @SL::InstallationCheck::required_modules;
}

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 : Perl::Tags
!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
dependancy of one of these. Everything alright.

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
d6fad186 Udo Spallek