File Coverage

lib/App/Isa/Splain.pm
Criterion Covered Total %
statement 40 51 78.4
branch 8 14 57.1
condition 1 6 16.6
subroutine 10 14 71.4
pod 3 3 100.0
total 62 88 70.4


line stmt bran cond sub pod time code
1 3     3   29359 use 5.006; # our
  3         9  
2 3     3   15 use strict;
  3         4  
  3         67  
3 3     3   19 use warnings;
  3         4  
  3         192  
4              
5             package App::Isa::Splain;
6              
7             our $VERSION = '0.002001';
8              
9             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
10              
11             # ABSTRACT: Visualize Module Hierarchies on the command line
12              
13 3     3   1341 use Module::Load qw( load );
  3         2294  
  3         16  
14 3     3   152 use Carp qw( croak );
  3         4  
  3         178  
15 3     3   1028 use Devel::Isa::Explainer qw( explain_isa );
  3         7  
  3         323  
16              
17             # Perl critic is broken. This is not a void context.
18             ## no critic (BuiltinFunctions::ProhibitVoidMap)
19 3     3   23 use constant 1.03 ( { map { ( ( sprintf '_E%x', $_ ), ( sprintf ' E<%s#%d>', __PACKAGE__, $_ ) ) } 1 .. 3 } );
  3         59  
  3         10  
  9         287  
20              
21 3     3   25 use namespace::clean;
  3         4  
  3         11  
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33             sub new {
34 2     2 1 5 my ( $class, @args ) = @_;
35 2 50       14 my (%args) = ref $args[0] ? %{ $args[0] } : @args;
  0         0  
36 2         12 return bless \%args, $class;
37             }
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50             sub new_from_ARGV {
51 2 50   2 1 40 my (@args) = defined $_[1] ? @{ $_[1] } : @ARGV;
  2         8  
52 2         4 my $module;
53             my @load_modules;
54 2         8 while ( @args ) {
55 3         5 my $argument = shift @args;
56 3 100 33     27 if ( not defined $module and $argument !~ /\A-/sx ) {
57 2         4 $module = $argument;
58 2         7 next;
59             }
60 1 50       6 if( $argument =~ /\A-M(.*)\z/sx ) {
61 1         4 push @load_modules, $1;
62 1         5 next;
63             }
64 0         0 croak 'Unexpected argument ' . $argument . _E3;
65             }
66 2 50       7 defined $module or croak 'Expected a module name, got none' . _E1;
67 2 100       19 return $_[0]->new( module => $module, load_modules => [ @load_modules ? @load_modules : $module ] );
68             }
69              
70 0     0     sub _load_modules { return @{ $_[0]->{load_modules} } }
  0            
71 0     0     sub _module { return $_[0]->{module} }
72 0   0 0     sub _output { return ( $_[0]->{output} || *STDOUT ) }
73              
74              
75              
76              
77              
78              
79              
80             sub run {
81 0     0 1   my ($self) = @_;
82 0           load $_ for $self->_load_modules;
83             croak "Could not print to output handle: $! $^E" . _E2
84 0 0         unless print { $self->_output } explain_isa( $self->_module );
  0            
85              
86 0           return 0;
87             }
88              
89             1;
90              
91             __END__