line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package UR::Namespace::Command::Test::Use; |
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
24
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
27
|
|
5
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
6
|
1
|
|
|
1
|
|
3
|
use UR; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
7
|
|
|
|
|
|
|
our $VERSION = "0.46"; # UR $VERSION; |
8
|
1
|
|
|
1
|
|
3
|
use Cwd; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
57
|
|
9
|
1
|
|
|
1
|
|
3
|
use YAML; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
620
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
class UR::Namespace::Command::Test::Use { |
12
|
|
|
|
|
|
|
is => "UR::Namespace::Command::RunsOnModulesInTree", |
13
|
|
|
|
|
|
|
has_optional => [ |
14
|
|
|
|
|
|
|
verbose => { is => 'Boolean', doc => 'List each explicitly.' }, |
15
|
|
|
|
|
|
|
summarize_externals => { is => 'Boolean', doc => 'List all modules used which are outside the namespace.' }, |
16
|
|
|
|
|
|
|
exec => { is => 'Text', doc => 'Execute the specified Perl _after_ using all of the modules.' }, |
17
|
|
|
|
|
|
|
] |
18
|
|
|
|
|
|
|
}; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub help_brief { |
21
|
0
|
|
|
0
|
0
|
|
"Tests each module for compile errors by 'use'-ing it. Also reports on any libs added to \@INC by any modules (bad!)." |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub help_synopsis { |
25
|
|
|
|
|
|
|
return <
|
26
|
|
|
|
|
|
|
ur test use |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
ur test use Some::Module Some::Other::Module |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
ur test use ./Module.pm Other/Module.pm |
31
|
|
|
|
|
|
|
EOS |
32
|
0
|
|
|
0
|
0
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub help_detail { |
35
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
36
|
0
|
|
|
|
|
|
my $text = <
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Tests each module by "use"-ing it. Failures are reported individually. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
Successes are only reported individualy if the --verbose option is specified. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
A count of total successes/failures is returned as a summary in all cases. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
EOS |
45
|
0
|
|
|
|
|
|
$text .= $self->_help_detail_footer; |
46
|
0
|
|
|
|
|
|
return $text; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub before { |
50
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
51
|
0
|
|
|
|
|
|
$self->{success} = 0; |
52
|
0
|
|
|
|
|
|
$self->{failure} = 0; |
53
|
0
|
|
|
|
|
|
$self->{used_libs} = {}; |
54
|
0
|
|
|
|
|
|
$self->{used_mods} = {}; |
55
|
0
|
|
|
|
|
|
$self->{failed_libs} = []; |
56
|
0
|
|
|
|
|
|
$self->{default_print_fh} = fileno(select); |
57
|
0
|
|
|
|
|
|
$self->SUPER::before(@_); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub for_each_module_file { |
61
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
62
|
0
|
|
|
|
|
|
my $module_file = shift; |
63
|
0
|
|
|
|
|
|
my $namespace_name = $self->namespace_name; |
64
|
0
|
|
|
|
|
|
my %libs_before = map { $_ => 1 } @INC; |
|
0
|
|
|
|
|
|
|
65
|
0
|
0
|
|
|
|
|
my %mods_before = %INC if $self->summarize_externals; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
local $SIG{__DIE__}; |
68
|
0
|
|
|
|
|
|
local $ENV{UR_DBI_MONITOR_SQL} = 1; |
69
|
0
|
|
|
|
|
|
local $ENV{APP_DBI_MONITOR_SQL} = 1; |
70
|
0
|
|
|
0
|
|
|
local *CORE::GLOBAL::exit = sub {}; |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
$self->debug_message("require $module_file"); |
73
|
0
|
|
|
|
|
|
eval "require '$module_file'"; |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
my %new_libs = map { $_ => 1 } grep { not $libs_before{$_} } @INC; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
my %new_mods = |
77
|
0
|
|
|
|
|
|
map { $_ => $module_file } |
78
|
0
|
|
|
|
|
|
grep { not $_ =~ /^$namespace_name\// } |
79
|
0
|
|
|
|
|
|
grep { not $mods_before{$_} } |
|
0
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
keys %INC; |
81
|
0
|
0
|
|
|
|
|
if (%new_libs) { |
82
|
0
|
|
|
|
|
|
$self->{used_libs}{$module_file} = \%new_libs; |
83
|
|
|
|
|
|
|
} |
84
|
0
|
0
|
|
|
|
|
if (%new_mods) { |
85
|
0
|
|
|
|
|
|
for my $mod (keys %new_mods) { |
86
|
0
|
|
|
|
|
|
$self->{used_mods}{$mod} = $module_file; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
0
|
0
|
|
|
|
|
if ($@) { |
|
|
0
|
|
|
|
|
|
90
|
0
|
|
|
|
|
|
print "$module_file FAILED:\n$@\n"; |
91
|
0
|
|
|
|
|
|
$self->{failure}++; |
92
|
0
|
|
|
|
|
|
push @{$self->{failed_libs}}, $module_file; |
|
0
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
} elsif (fileno(select) != $self->{default_print_fh}) { |
94
|
|
|
|
|
|
|
# un-steal the default file handle back |
95
|
0
|
|
|
|
|
|
select(STDOUT); |
96
|
0
|
|
|
|
|
|
print "$module_file FAILED DUE TO IMPROPER FILEHANDLE USE\n"; |
97
|
0
|
|
|
|
|
|
$self->{failure}++; |
98
|
0
|
|
|
|
|
|
push @{$self->{failed_libs}}, $module_file; |
|
0
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
else { |
101
|
0
|
0
|
|
|
|
|
print "$module_file OK\n" if $self->verbose; |
102
|
0
|
|
|
|
|
|
$self->{success}++; |
103
|
|
|
|
|
|
|
} |
104
|
0
|
|
|
|
|
|
return 1; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub after { |
108
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
109
|
0
|
|
|
|
|
|
$self->status_message("SUCCESS: $self->{success}"); |
110
|
0
|
|
|
|
|
|
$self->status_message("FAILURE: $self->{failure}"); |
111
|
|
|
|
|
|
|
|
112
|
0
|
0
|
|
|
|
|
if ($self->{failure} > 0) { |
113
|
0
|
|
|
|
|
|
$self->status_message("FAILED LIBS: " . YAML::Dump($self->{failed_libs})); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
0
|
0
|
|
|
|
|
if (%{ $self->{used_libs} }) { |
|
0
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
$self->status_message( |
118
|
|
|
|
|
|
|
"ROGUE LIBS: " |
119
|
|
|
|
|
|
|
. YAML::Dump($self->{used_libs}) |
120
|
0
|
|
|
|
|
|
) |
121
|
|
|
|
|
|
|
} |
122
|
0
|
0
|
|
|
|
|
if ($self->summarize_externals) { |
123
|
|
|
|
|
|
|
$self->status_message( |
124
|
|
|
|
|
|
|
"MODULES USED: " |
125
|
|
|
|
|
|
|
. YAML::Dump($self->{used_mods}) |
126
|
0
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
} |
128
|
0
|
0
|
|
|
|
|
if (my $src = $self->exec) { |
129
|
0
|
|
|
|
|
|
eval $src; |
130
|
0
|
0
|
|
|
|
|
$self->error_message($@) if $@; |
131
|
|
|
|
|
|
|
} |
132
|
0
|
0
|
|
|
|
|
return if $self->{failure}; |
133
|
0
|
|
|
|
|
|
return 1; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
1; |
137
|
|
|
|
|
|
|
|