File Coverage

lib/UR/Namespace/Command/Test/Use.pm
Criterion Covered Total %
statement 15 81 18.5
branch 0 24 0.0
condition n/a
subroutine 5 12 41.6
pod 0 6 0.0
total 20 123 16.2


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