File Coverage

blib/lib/App/RecordStream/OptionalRequire.pm
Criterion Covered Total %
statement 38 54 70.3
branch 7 8 87.5
condition n/a
subroutine 18 18 100.0
pod 0 4 0.0
total 63 84 75.0


line stmt bran cond sub pod time code
1             package App::RecordStream::OptionalRequire;
2              
3             =head1 NAME
4              
5             App::RecordStream::OptionalRequire
6              
7             =head1 AUTHOR
8              
9             Benjamin Bernard
10             Keith Amling
11              
12             =head1 DESCRIPTION
13              
14             Class for optionally requiring a set of modules
15              
16             =head1 SYNOPSIS
17              
18             BEGIN {
19             use App::RecordStream::OptionalRequire qw(optional_require);
20             optional_require(qw(Foo::Bar Biz::Zip));
21             }
22              
23             =cut
24              
25             our $VERSION = "4.0.25";
26              
27 53     53   58854 use strict;
  47         81  
  47         1032  
28 48     48   566 use warnings;
  45         76  
  45         10892  
29              
30             # Set to this 0 if you don't want the warnings printed
31             our $PRINT_WARNING = 1;
32              
33             my @missing_modules;
34              
35             sub import {
36 31     31   156 my $class = shift;
37 30         67 my $calling_package = (caller())[0];
38 30         59 return optional_use_with_caller($calling_package, @_);
39             }
40              
41             # For testing and calling outside of other things... CHECK will not work in this case...
42             sub optional_use {
43 4     4 0 2127 my $calling_package = (caller())[0];
44 3         13 return optional_use_with_caller($calling_package, @_);
45             }
46              
47             sub optional_use_with_caller {
48 33     34 0 45 my $calling_package = shift;
49              
50 34         143 my $loaded;
51              
52 33         51 $loaded = use_module($calling_package, @_);
53 33         49 my $module_name = $_[0];
54              
55 34 100       213 unless ( $loaded ) {
56 31 100       110 warn "$0 requires missing module $module_name\n" if ( $PRINT_WARNING );
57 31         54 push @missing_modules, $module_name;
58 32         1920 return 0;
59             }
60              
61 2         6 return 1;
62             }
63              
64             # CHECK runs after BEGIN blocks
65             sub require_done {
66 12 50   13 0 33 if ( @missing_modules ) {
67             # NB: The exact phrasing of this exception is checked for in multiple
68             # places. Please grep accordingly if you plan to change it below.
69 13         353 die "Please install missing modules above to use this script\n";
70             }
71             }
72              
73             sub use_module {
74 33     34 0 46 my $calling_package = shift;
75 33         40 my $module = shift;
76 34         169 my $args = join(' ', @_);
77 33 100       65 if ( $args ) {
78 8         12 $args = " qw($args)";
79             }
80              
81             # Must use use here to invoke import
82 34     7   1905 eval <
  6     1   1171  
  1     1   106  
  0     1   0  
  0     1   0  
  1     1   116  
  0     1   0  
  0     1   0  
  1     1   127  
  0     1   0  
  0     1   0  
  1         118  
  0         0  
  0         0  
  1         120  
  0         0  
  0         0  
  1         117  
  0         0  
  0         0  
  1         138  
  0         0  
  0         0  
  1         117  
  0            
  0            
83             package $calling_package;
84             use $module $args;
85             EVAL
86 33         119 return not $@;
87             }
88              
89             1;