line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTML::Perlinfo::Modules; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
5
|
1
|
|
|
1
|
|
6
|
use File::Find; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
53
|
|
6
|
1
|
|
|
1
|
|
5
|
use File::Spec; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
40
|
|
7
|
1
|
|
|
1
|
|
6
|
use Carp (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
20
|
|
8
|
1
|
|
|
1
|
|
5
|
use Config qw(%Config); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
60
|
|
9
|
1
|
|
|
1
|
|
882
|
use CGI qw(escapeHTML); |
|
1
|
|
|
|
|
31264
|
|
|
1
|
|
|
|
|
6
|
|
10
|
1
|
|
|
1
|
|
158
|
use base qw(HTML::Perlinfo::Base); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
639
|
|
11
|
1
|
|
|
1
|
|
7
|
use HTML::Perlinfo::Common; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
775
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '1.19'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub new { |
17
|
|
|
|
|
|
|
|
18
|
0
|
|
|
0
|
0
|
|
my ($class, %params) = @_; |
19
|
0
|
0
|
|
|
|
|
$params{'title'} = exists $params{'title'} ? $params{'title'} : 'Perl Modules'; |
20
|
|
|
|
|
|
|
|
21
|
0
|
|
|
|
|
|
$class->SUPER::new(%params); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub module_color_check { |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
0
|
0
|
|
my ($module_name, $color_specs) = @_; |
28
|
0
|
0
|
0
|
|
|
|
if (defined $color_specs && ref($color_specs->[0]) eq 'ARRAY') { |
29
|
0
|
|
|
|
|
|
foreach (@{ $color_specs }) { |
|
0
|
|
|
|
|
|
|
30
|
0
|
0
|
|
|
|
|
return $_->[0] if (match_string($module_name,$_->[1])==1); |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
else { |
34
|
0
|
0
|
0
|
|
|
|
return $color_specs->[0] if (defined $color_specs && match_string($module_name,$color_specs->[1])==1); |
35
|
|
|
|
|
|
|
} |
36
|
0
|
|
|
|
|
|
return 0; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# get_modinfo |
40
|
|
|
|
|
|
|
# This sub was created for the files_in option. |
41
|
|
|
|
|
|
|
# Returns found_mod reference |
42
|
|
|
|
|
|
|
###################################### |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub get_files_in { |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
0
|
0
|
|
my ($file_path) = @_; |
47
|
|
|
|
|
|
|
|
48
|
0
|
0
|
0
|
|
|
|
return 0 unless $file_path && $file_path =~ m/\.pm$/; |
49
|
0
|
|
|
|
|
|
my $mod_info = module_info($file_path, undef); |
50
|
0
|
|
|
|
|
|
return $mod_info; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub sort_modules { |
56
|
|
|
|
|
|
|
|
57
|
0
|
|
|
0
|
0
|
|
my ($modules, $sort_by) = @_; |
58
|
0
|
|
|
|
|
|
my @sorted_modules; |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
if ($sort_by eq 'name') { |
|
|
0
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
foreach my $key (sort {lc $a cmp lc $b} keys %$modules) { |
|
0
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Check for duplicate modules |
63
|
0
|
0
|
|
|
|
|
if (ref($modules->{$key}) eq 'ARRAY') { |
64
|
0
|
|
|
|
|
|
foreach (@{ $modules->{$key} }) { |
|
0
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
push @sorted_modules, $_; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
else { |
69
|
0
|
|
|
|
|
|
push @sorted_modules, $modules->{$key}; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
elsif ($sort_by eq 'version') { |
74
|
0
|
|
|
|
|
|
foreach my $key (keys %$modules) { |
75
|
0
|
0
|
|
|
|
|
if (ref($modules->{$key}) eq 'ARRAY') { |
76
|
0
|
|
|
|
|
|
@{ $modules->{$key} } = sort {$a->{'version'} cmp $b->{'version'}}@{ $modules->{$key} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
for (@{ $modules->{$key}}) { |
|
0
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
push @sorted_modules, $_; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
else { |
82
|
0
|
|
|
|
|
|
push @sorted_modules, $modules->{$key}; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
0
|
|
|
|
|
|
@sorted_modules = sort {$a->{'version'} cmp $b->{'version'}}@sorted_modules; |
|
0
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
} |
87
|
0
|
|
|
|
|
|
return @sorted_modules; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub html_setup { |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
0
|
0
|
|
my ($self, $columns, $color_specs, $section, $full_page) = @_; |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
|
my $html; |
95
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
|
$html .= $self->print_htmlhead if $full_page; |
97
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
|
my %show_columns = ( |
99
|
|
|
|
|
|
|
'name' => 'Module name', |
100
|
|
|
|
|
|
|
'version' => 'Version', |
101
|
|
|
|
|
|
|
'path' => 'Location', |
102
|
|
|
|
|
|
|
'core' => 'Core', |
103
|
|
|
|
|
|
|
'desc' => 'Description' |
104
|
|
|
|
|
|
|
); |
105
|
|
|
|
|
|
|
|
106
|
0
|
0
|
|
|
|
|
$html .= $section ? print_section($section) : ''; |
107
|
0
|
0
|
0
|
|
|
|
$html .= print_color_codes($color_specs) if $color_specs && $color_specs->[2]; |
108
|
0
|
|
|
|
|
|
$html .= print_table_start(); |
109
|
0
|
|
|
|
|
|
$html .= print_table_header(scalar @$columns, map{ $show_columns{$_} }@$columns); |
|
0
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
return $html; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub module_info { |
114
|
0
|
|
|
0
|
0
|
|
my ($module_path, $show_only) = @_; |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
( $module_path ) = $module_path =~ /^(.*)$/; |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
my ($mod_name, $mod_version, $mod_desc); |
119
|
|
|
|
|
|
|
|
120
|
1
|
|
|
1
|
|
9
|
no warnings 'all'; # silence warnings |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2705
|
|
121
|
0
|
0
|
|
|
|
|
open(MOD, $module_path) or return 0; |
122
|
0
|
|
|
|
|
|
while () { |
123
|
|
|
|
|
|
|
|
124
|
0
|
0
|
|
|
|
|
unless ($mod_name) { |
125
|
0
|
0
|
|
|
|
|
if (/^ *package +(\S+);/) { |
126
|
0
|
|
|
|
|
|
$mod_name = $1; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
0
|
0
|
|
|
|
|
unless ($mod_version) { |
131
|
|
|
|
|
|
|
|
132
|
0
|
0
|
|
|
|
|
if (/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) { |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
my $line = substr $_, index($_, $1); |
135
|
0
|
|
|
|
|
|
my $eval = qq{ |
136
|
|
|
|
|
|
|
package HTML::Perlinfo::_version; |
137
|
|
|
|
|
|
|
no strict; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
local $1$2; |
140
|
|
|
|
|
|
|
\$$2=undef; do { |
141
|
|
|
|
|
|
|
$line |
142
|
|
|
|
|
|
|
}; \$$2 |
143
|
|
|
|
|
|
|
}; |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
( $eval ) = $eval =~ /^(.*)$/sm; |
146
|
0
|
|
|
|
|
|
$mod_version = eval($eval); |
147
|
|
|
|
|
|
|
# Again let us be nice here. |
148
|
0
|
0
|
0
|
|
|
|
$mod_version = 'unknown' if (not defined $mod_version) || ($@); |
149
|
0
|
|
|
|
|
|
$mod_version =~ s/^\s+|\s+$//; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
0
|
0
|
|
|
|
|
unless ($mod_desc) { |
154
|
0
|
0
|
|
|
|
|
if (/=head\d\s+NAME/) { |
155
|
0
|
|
|
|
|
|
local $/ = ''; |
156
|
0
|
|
|
|
|
|
local $_; |
157
|
0
|
|
|
|
|
|
chomp($_ = ); |
158
|
0
|
|
|
|
|
|
($mod_desc) = /^.*?-+\s*(.*?)$/ism; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
0
|
0
|
0
|
|
|
|
last if $mod_name && $mod_version && $mod_desc; |
|
|
|
0
|
|
|
|
|
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
close (MOD); |
167
|
0
|
0
|
0
|
|
|
|
return 0 if (! $mod_name || $show_only && ref $show_only && (match_string($mod_name, $show_only) == 0)); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
168
|
0
|
0
|
0
|
|
|
|
$mod_version = 'unknown' if !($mod_version) || ($mod_version !~ /^[\.\d+_]+$/); |
169
|
0
|
0
|
|
|
|
|
$mod_desc = escapeHTML($mod_desc) if $mod_desc; |
170
|
0
|
0
|
|
|
|
|
$mod_desc = "No description found" unless $mod_desc; |
171
|
0
|
|
|
|
|
|
return { 'name' => $mod_name, 'version' => $mod_version, 'desc' => $mod_desc }; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub print_color_codes { |
175
|
0
|
|
|
0
|
0
|
|
my $color_specs = shift; |
176
|
0
|
|
|
|
|
|
my ($html, $label); |
177
|
0
|
|
|
|
|
|
$html .= print_table_start(); |
178
|
0
|
|
|
|
|
|
$html .= print_table_header(1, "Module Color Codes"); |
179
|
0
|
|
|
|
|
|
$html .= print_table_color_start(); |
180
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
|
if (ref($color_specs->[0]) eq 'ARRAY') { |
182
|
0
|
|
|
|
|
|
my $count = 0; |
183
|
0
|
|
|
|
|
|
foreach (@{ $color_specs }) { |
|
0
|
|
|
|
|
|
|
184
|
0
|
0
|
|
|
|
|
$html .= " |
" if $count++ % 5 == 0;
185
|
0
|
|
0
|
|
|
|
$label = $_->[2] || $_->[1]; |
186
|
0
|
|
|
|
|
|
$html .= print_color_box($_->[0], $label); |
187
|
0
|
0
|
0
|
|
|
|
$html .= " |
" if (($count >= 5 && $count % 5 == 0)||($count >= @{$color_specs}));
|
0
|
|
0
|
|
|
|
|
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
else { |
191
|
0
|
|
0
|
|
|
|
$label = $color_specs->[2] || $color_specs->[1]; |
192
|
0
|
|
|
|
|
|
$html .= print_color_box($color_specs->[0], $label); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
$html .= print_table_color_end(); |
196
|
0
|
|
|
|
|
|
$html .= print_table_end(); |
197
|
0
|
|
|
|
|
|
return $html; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub print_module_results { |
201
|
|
|
|
|
|
|
|
202
|
0
|
|
|
0
|
0
|
|
my ($mod_dir, $mod_count, $from, $overall_total, $show_dir) = @_; |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
|
my ($html, $total_amount, $searched, @mod_dir, @bad_dir, %seen); |
205
|
|
|
|
|
|
|
|
206
|
0
|
0
|
|
|
|
|
if ($show_dir) { |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
|
$html .= print_table_start(); |
209
|
0
|
|
|
|
|
|
$html .= print_table_header(2, "Directory", "Number of Modules"); |
210
|
0
|
|
|
|
|
|
for my $dir (keys %{$mod_count}) { |
|
0
|
|
|
|
|
|
|
211
|
0
|
|
|
|
|
|
my $amount_found = $mod_count->{$dir}; |
212
|
0
|
0
|
|
|
|
|
push (@mod_dir, $dir) if $amount_found; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
for my $dir1 (@mod_dir) { |
216
|
0
|
|
|
|
|
|
for my $dir2 (@mod_dir) { |
217
|
0
|
0
|
0
|
|
|
|
if ($dir1 ne $dir2 && $dir2 =~ /^$dir1/) { |
218
|
0
|
|
|
|
|
|
push @bad_dir, $dir2; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
0
|
|
|
|
|
|
for my $top_dir (@mod_dir) { |
223
|
0
|
0
|
|
|
|
|
unless (grep{$_ eq $top_dir }@bad_dir) { |
|
0
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
|
$html .= print_table_row(2, add_link('local', File::Spec->canonpath($top_dir)), $mod_count->{$top_dir}); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
} |
227
|
0
|
|
|
|
|
|
$html .= print_table_end(); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
else { |
230
|
|
|
|
|
|
|
# Print out directories not in @INC |
231
|
0
|
0
|
0
|
|
|
|
@mod_dir = grep { -d $_ && -r $_ && !$seen{$_}++ } map {File::Spec->canonpath($_)}@INC; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
232
|
0
|
|
|
|
|
|
my @module_paths = grep { not exists $seen{$_} }@$mod_dir; |
|
0
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
|
234
|
0
|
0
|
|
|
|
|
if (@module_paths >= 1) { |
235
|
0
|
|
|
|
|
|
$html .= print_table_start(); |
236
|
0
|
|
|
|
|
|
$html .= print_table_header(3, "Directory", "Searched", "Number of Modules"); |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
for my $dir (map{ File::Spec->canonpath($_) }@module_paths) { |
|
0
|
|
|
|
|
|
|
239
|
0
|
0
|
|
|
|
|
$searched = (grep { $_ eq $dir } @$mod_dir) ? "yes" : "no"; |
|
0
|
|
|
|
|
|
|
240
|
0
|
0
|
|
|
|
|
my $amount_found = ($searched eq 'yes') ? $mod_count->{$dir} : 'unknown'; |
241
|
0
|
|
|
|
|
|
$html .= print_table_row(3, add_link('local', File::Spec->canonpath($dir)), $searched, $amount_found); |
242
|
|
|
|
|
|
|
} |
243
|
0
|
|
|
|
|
|
$html .= print_table_end(); |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
|
247
|
0
|
|
|
|
|
|
$html .= print_table_start(); |
248
|
0
|
|
|
|
|
|
$html .= print_table_header(3, "Include path (INC) directories", "Searched", "Number of Modules"); |
249
|
0
|
|
|
|
|
|
for my $dir (@mod_dir) { |
250
|
0
|
0
|
|
|
|
|
$searched = exists $mod_count->{$dir} ? 'yes' : 'no'; |
251
|
0
|
0
|
|
|
|
|
my $amount_found = ($searched eq 'yes') ? $mod_count->{$dir} : 'unknown'; |
252
|
0
|
|
|
|
|
|
$html .= print_table_row(3, add_link('local', File::Spec->canonpath($dir)), $searched, $amount_found); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
0
|
|
|
|
|
|
$html .= print_table_end(); |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
$html .= print_table_start(); |
259
|
|
|
|
|
|
|
#my $view = ($from eq 'all') ? 'installed' : |
260
|
|
|
|
|
|
|
# ($from eq 'core') ? 'core' : 'found'; |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
$html .= print_table_row(2, "Total modules", $overall_total); |
263
|
0
|
|
|
|
|
|
$html .= print_table_end(); |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
return $html; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub search_dir { |
270
|
|
|
|
|
|
|
|
271
|
0
|
|
|
0
|
0
|
|
my ($from, $show_only, $core_dir) = @_; |
272
|
|
|
|
|
|
|
|
273
|
0
|
|
|
|
|
|
my %seen = (); |
274
|
|
|
|
|
|
|
|
275
|
0
|
0
|
0
|
|
|
|
my @user_dir = (ref($from) eq 'ARRAY') && $show_only ne 'core' ? @{$from} : |
|
0
|
0
|
|
|
|
|
|
276
|
|
|
|
|
|
|
($show_only eq 'core') ? (@$core_dir) : $from; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# Make sure only unique entries and readable directories in @mod_dir |
279
|
0
|
0
|
0
|
|
|
|
my @mod_dir = grep { -d $_ && -r $_ && !$seen{$_}++ } map {File::Spec->canonpath($_)}@user_dir; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
280
|
0
|
0
|
|
|
|
|
if (@mod_dir != @user_dir) { |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# Looks like there might have been a problem with the directories given to us. |
283
|
|
|
|
|
|
|
# Or maybe not. @user_dir could have duplicate values and that's ok. |
284
|
|
|
|
|
|
|
# But let's still warn about any unreadable or non-directories given |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
my @debug; |
287
|
0
|
|
|
|
|
|
%seen = (); |
288
|
0
|
|
|
|
|
|
@user_dir = grep { !$seen{$_}++ } map {File::Spec->canonpath($_)}@user_dir; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
289
|
0
|
0
|
|
|
|
|
if (@user_dir > @mod_dir) { |
290
|
|
|
|
|
|
|
#%seen = map {$_ => undef} @mod_dir; |
291
|
0
|
|
|
|
|
|
%seen = (); |
292
|
0
|
|
|
|
|
|
@seen{@mod_dir} = (); |
293
|
0
|
|
|
|
|
|
my @difference = grep { !$seen{$_}++ }@user_dir; |
|
0
|
|
|
|
|
|
|
294
|
0
|
|
|
|
|
|
foreach my $element (@difference) { |
295
|
0
|
0
|
|
|
|
|
if (! -d $element) { |
|
|
0
|
|
|
|
|
|
296
|
0
|
0
|
|
|
|
|
if ( grep {$_ eq $element} map {File::Spec->canonpath($_)}@INC) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
warn "$element is in the Perl include path, but is not a directory"; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
else { |
300
|
0
|
|
|
|
|
|
warn "$element is not a directory"; |
301
|
|
|
|
|
|
|
} |
302
|
0
|
|
|
|
|
|
push @debug, $element; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
elsif (! -r $element) { |
305
|
0
|
0
|
|
|
|
|
if ( grep {$_ eq $element} map {File::Spec->canonpath($_)}@INC) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
warn "$element is in the Perl include path, but is not readable"; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
else { |
309
|
0
|
|
|
|
|
|
warn "$element is not a readable directory"; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
0
|
|
|
|
|
|
push @debug, $element; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
0
|
0
|
|
|
|
|
error_msg("Search directories are invalid") unless @mod_dir >= 1; |
319
|
|
|
|
|
|
|
|
320
|
0
|
|
|
|
|
|
return @mod_dir; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub get_input { |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
326
|
0
|
|
|
|
|
|
my $args = process_args(@_, \&check_module_args); |
327
|
0
|
|
|
|
|
|
my %input = (); |
328
|
0
|
|
0
|
|
|
|
$input{'files_in'} = $args->{'files_in'} || undef; |
329
|
0
|
|
0
|
|
|
|
$input{'sort_by'} = $args->{'sort_by'} || 'name'; |
330
|
0
|
|
0
|
|
|
|
$input{'from'} = $args->{'from'} || \@INC; |
331
|
0
|
|
0
|
|
|
|
$input{'show_only'} = $args->{'show_only'} || ""; |
332
|
0
|
|
|
|
|
|
$input{'color_specs'} = $args->{'color'}; |
333
|
0
|
|
|
|
|
|
$input{'link'} = $args->{'link'}; |
334
|
|
|
|
|
|
|
$input{'section'} = exists $args->{'section'} ? $args->{'section'} : |
335
|
0
|
0
|
|
|
|
|
$input{'show_only'} eq 'core' ? 'Core Perl modules installed' : ''; |
|
|
0
|
|
|
|
|
|
336
|
0
|
0
|
|
|
|
|
$input{'full_page'} = exists $args->{'full_page'} ? $args->{'full_page'} : $self->{'full_page'}; |
337
|
0
|
0
|
|
|
|
|
$input{'show_inc'} = exists $args->{'show_inc'} ? $args->{'show_inc'} : 1; |
338
|
0
|
0
|
|
|
|
|
$input{'show_dir'} = exists $args->{'show_dir'} ? $args->{'show_dir'} : 0; |
339
|
0
|
0
|
|
|
|
|
$input{'columns'} = exists $args->{'columns'} ? $args->{'columns'} : ['name','version','desc']; |
340
|
0
|
|
|
|
|
|
return %input; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub print_modules { |
344
|
|
|
|
|
|
|
|
345
|
0
|
|
|
0
|
1
|
|
my %input = get_input(@_); |
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
my ($found_mod, $mod_count, $overall_total, @mod_dir, @core_dir); |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# Check to see if a search is even needed |
350
|
0
|
0
|
|
|
|
|
if (defined $input{'files_in'}) { |
351
|
|
|
|
|
|
|
|
352
|
0
|
|
|
|
|
|
my @files = @{ $input{'files_in'} }; |
|
0
|
|
|
|
|
|
|
353
|
0
|
|
|
|
|
|
my %found_mod = (); |
354
|
|
|
|
|
|
|
|
355
|
0
|
|
|
|
|
|
foreach my $file_path (@files) { |
356
|
|
|
|
|
|
|
|
357
|
0
|
|
|
|
|
|
my $mod_info = get_files_in($file_path); |
358
|
0
|
0
|
|
|
|
|
next unless (ref $mod_info eq 'HASH'); |
359
|
0
|
|
|
|
|
|
$found_mod{$mod_info->{'name'}} = $mod_info; |
360
|
|
|
|
|
|
|
} |
361
|
0
|
0
|
|
|
|
|
return undef unless (keys %found_mod > 0); |
362
|
0
|
|
|
|
|
|
$found_mod = \%found_mod; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
else { |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# Get ready to search |
367
|
|
|
|
|
|
|
|
368
|
0
|
|
|
|
|
|
@core_dir = map{ File::Spec->canonpath($_) } |
369
|
|
|
|
|
|
|
($Config{installarchlib}, |
370
|
|
|
|
|
|
|
$Config{installprivlib}, |
371
|
|
|
|
|
|
|
$Config{archlib}, |
372
|
0
|
|
|
|
|
|
$Config{privlib}); |
373
|
|
|
|
|
|
|
|
374
|
0
|
|
|
|
|
|
@mod_dir = search_dir($input{'from'}, $input{'show_only'}, \@core_dir); |
375
|
|
|
|
|
|
|
|
376
|
0
|
|
|
|
|
|
($overall_total, $found_mod, $mod_count) = find_modules($input{'show_only'}, \@mod_dir); |
377
|
0
|
0
|
|
|
|
|
return undef unless $overall_total; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
|
my @sorted_modules = sort_modules($found_mod, $input{'sort_by'}); |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
my $html .= html_setup( $_[0], |
384
|
|
|
|
|
|
|
$input{'columns'}, |
385
|
|
|
|
|
|
|
$input{'color_specs'}, |
386
|
|
|
|
|
|
|
$input{'section'}, |
387
|
0
|
|
|
|
|
|
$input{'full_page'} |
388
|
|
|
|
|
|
|
); |
389
|
|
|
|
|
|
|
|
390
|
0
|
|
|
|
|
|
my $numberof_columns = scalar @{$input{'columns'}}; |
|
0
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
|
392
|
0
|
|
|
|
|
|
foreach my $module (@sorted_modules) { |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
$html .= print_table_row_color( $numberof_columns, |
395
|
|
|
|
|
|
|
module_color_check($module->{'name'}, $input{'color_specs'}), |
396
|
|
|
|
|
|
|
map{ |
397
|
0
|
0
|
|
|
|
|
if ($_ eq 'name') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
398
|
0
|
|
|
|
|
|
add_link('cpan', $module->{'name'}, $input{'link'}); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
elsif ($_ eq 'core') { |
401
|
0
|
0
|
|
|
|
|
(grep File::Spec->rel2abs($module->{'path'}) =~ /\Q$_/, (@core_dir)) ? 'yes' : 'no'; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
elsif ($_ eq 'path') { |
404
|
0
|
|
|
|
|
|
add_link('local', $module->{'path'}); |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
else { |
407
|
0
|
|
|
|
|
|
$module->{$_}; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
} @{$input{'columns'}} ); |
|
0
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
0
|
|
|
|
|
|
$html .= print_table_end(); |
414
|
|
|
|
|
|
|
|
415
|
0
|
0
|
0
|
|
|
|
unless (defined $input{'files_in'} && ref $input{'files_in'} eq 'ARRAY') { |
416
|
|
|
|
|
|
|
$html .= print_module_results( \@mod_dir, |
417
|
|
|
|
|
|
|
$mod_count, |
418
|
|
|
|
|
|
|
$input{'from'}, |
419
|
|
|
|
|
|
|
$overall_total, |
420
|
0
|
0
|
|
|
|
|
$input{'show_dir'}) if $input{'show_inc'}; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
0
|
0
|
|
|
|
|
$html .= " |