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