File Coverage

blib/lib/Modulino/Base.pm
Criterion Covered Total %
statement 17 43 39.5
branch 0 6 0.0
condition n/a
subroutine 6 11 54.5
pod 0 1 0.0
total 23 61 37.7


line stmt bran cond sub pod time code
1 1     1   1266 use v5.14;
  1         4  
2              
3             package Modulino::Base;
4 1     1   7 use utf8;
  1         3  
  1         8  
5 1     1   27 use strict;
  1         2  
  1         25  
6 1     1   5 no warnings;
  1         2  
  1         45  
7              
8              
9 1     1   6 use Carp;
  1         2  
  1         5036  
10              
11             our $VERSION = '1.004';
12              
13             =encoding utf8
14              
15             =head1 NAME
16              
17             Modulino::Base - Common stuff for the modulino demonstrations
18              
19             =head1 SYNOPSIS
20              
21             =cut
22              
23 0     0     sub _running_under_tester { !! $ENV{CPANTEST} }
24              
25             sub _running_as_app {
26 0     0     my $caller = scalar caller(1);
27 0 0         (defined $caller) && $caller ne 'main';
28             }
29              
30             # run directly
31             if( ! defined caller(0) ) {
32             carp sprintf "You cannot run %s directly!", __PACKAGE__;
33             }
34             # loaded from a module that was run directly
35             elsif( ! defined caller(1) ) {
36             my @caller = caller(0);
37             my $method = do {
38             if( _running_under_tester() ) { 'test' }
39             elsif( _running_as_app() ) { 'run' }
40             else { undef }
41             };
42              
43             if( $caller[0]->can( $method ) ) {
44             $caller[0]->$method( @ARGV );
45             }
46             elsif( __PACKAGE__->can( $method ) ) { # faking inheritance
47             __PACKAGE__->$method( $caller[0], @ARGV )
48             }
49             else {
50             carp "There is no $method() method defined in $caller[0]\n";
51             }
52             }
53              
54             sub test {
55 0     0 0   my( $class, $caller ) = @_;
56              
57 0           my @tests = do {
58 0 0         if( $caller->can( '_get_tests' ) ) {
59 0           $caller->_get_tests;
60             }
61             else {
62 0           $class->_get_tests( $caller );
63             }
64             };
65              
66 0           require Test::More;
67 0           Test::More::note( "Running $caller as a test" );
68 0           foreach my $test ( @tests ) {
69             Test::More::subtest( $test => sub {
70 0     0     my $rc = eval { $caller->$test(); 1 };
  0            
  0            
71 0 0         Test::More::diag( $@ ) unless defined $rc;
72 0           } );
73             }
74              
75 0           Test::More::done_testing();
76             }
77              
78             sub _get_tests {
79 0     0     my( $class, $caller ) = @_;
80 0           print "_get_tests class is [$class]\n";
81 1     1   15 no strict 'refs';
  1         2  
  1         144  
82 0           my $stub = $caller . '::';
83             my @tests =
84 0           grep { defined &{"$stub$_"} }
  0            
85 0           grep { 0 == index $_, '_test_' }
86 0           keys %{ "$stub" };
  0            
87              
88 0           @tests;
89             }
90              
91             1;