File Coverage

blib/lib/Mnet/Opts/Cli/Cache.pm
Criterion Covered Total %
statement 25 37 67.5
branch 3 16 18.7
condition 1 3 33.3
subroutine 7 9 77.7
pod 0 3 0.0
total 36 68 52.9


line stmt bran cond sub pod time code
1             package Mnet::Opts::Cli::Cache;
2              
3             # purpose: functions to get/set cli opts, used internally by other Mnet modules
4              
5              
6              
7             # required modules
8             # importing symbols from Mnet::Log::Conditional causes compile errors,
9             # apparently because Mnet::Log::Conditional uses this module,
10             # it causes a catch-22 for imports to work before Exporter runs,
11             # workaround is call with path, example: Mnet::Log::Conditional::INFO()
12 2     2   11 use warnings;
  2         3  
  2         58  
13 2     2   9 use strict;
  2         3  
  2         31  
14 2     2   7 use Carp;
  2         4  
  2         81  
15 2     2   21 use Mnet::Log::Conditional;
  2         4  
  2         75  
16 2     2   763 use Mnet::Opts::Set;
  2         4  
  2         835  
17              
18              
19              
20             # init global vars used for cached cli opt hash ref and extra cli args list
21             # opts is undefined until Mnet::Opts::Cli::Cache::set() is called
22             INIT {
23 2     2   8 my $opts = undef;
24 2         12 my @extras = ();
25             }
26              
27              
28              
29             sub debug_error {
30              
31             # $value = $Mnet::Opts::Cli::Cache::debug_error()
32             # purpose: called from Mnet::Log to get cached --debug-error cli opt value
33              
34             # return --debug-error cli option value, if it exists
35 0 0   0 0 0 return undef if not exists $Mnet::Opts::Cli::Cache::opts->{debug_error};
36 0         0 return $Mnet::Opts::Cli::Cache::opts->{debug_error};
37             }
38              
39              
40              
41             sub set {
42              
43             # Mnet::Opts::Cli::Cache::set(\%opts, @extras)
44             # purpose: called from Mnet::Opts::Cli->new to cache cli opts and extra args
45             # \%opts: Mnet::Opts::Cli object parsed by Mnet::Opts::Cli->new
46             # @extras: extra cli arguments parsed by Mnet::Opts::Cli->new
47             # note: this is meant to be called from Mnet::Opts::Cli only
48              
49             # set global cache variables with input opts object and extra args
50             # output debug if unexpectantly called other than from Mnet::Opts::Cli
51 0     0 0 0 my ($opts, @extras) = (shift, @_);
52 0 0       0 if (not defined $opts) {
53 0         0 $Mnet::Opts::Cli::Cache::opts = undef;
54             } else {
55 0         0 $Mnet::Opts::Cli::Cache::opts = { %$opts };
56             }
57 0         0 @Mnet::Opts::Cli::Cache::extras = @extras;
58 0 0       0 Mnet::Log::Conditional::DEBUG("set called from ".caller)
59             if caller ne "Mnet::Opts::Cli";
60 0         0 return;
61             }
62              
63              
64              
65             sub get {
66              
67             # \%opts = Mnet::Opts::Cli::Cache::get(\%input);
68             # or (\%opts, @extras) = Mnet::Opts::Cli::Cache::get(\%input);
69             #
70             # purpose: return pragmas, subset of Mnet opts, extra cli args, and input opts
71             # opts subset: batch/debug/quiet/record/replay/quiet/silent/tee/test
72             # Mnet::Opts::Set pragmas are also included in returned opts hash
73             # input opts, if specified, are overlaid on top of these other options
74             #
75             # note: there's a couple of ways this function can be called, detailed below:
76             #
77             # \%opts = Mnet::Opts::Cli::Cache::get();
78             # no input defined, opts is undef if Mnet::Opts::Cli->new not yet called
79             # can also be called in list context, to return @ARGV values as @extras
80             #
81             # \%opts = Mnet::Opts::Cli::Cache::get(shift // {});
82             # common in subroutines, \%input hash ref is arg to sub, or set empty
83             # returns input opts merged over Mnet opts and Mnet::Opts::Set pragmas
84             # subroutines can inherit/override/use these Mnet log and test opts
85             # comes in handy for objects inheriting Mnet::Log methods, test code, etc
86             # can also be called in list context, to return parsed extra cli args
87             #
88             # note: this function is meant to be used by other Mnet modules only
89              
90             # read input options hash ref
91 16     16 0 20 my $input = shift;
92              
93             # return undef if Mnet::Opts::Cli was not used for cli option parsing
94 16 0 33     25 return undef if not $input and not $Mnet::Opts::Cli::Cache::opts;
95              
96             # init output opts from Mnet::Opts::Set pragmas, if any are loaded
97 16         33 my $opts = Mnet::Opts::Set::pragmas();
98              
99             # init output extra cli args, from ARGV if Mnet::Opts::Cli is not loaded
100 16         30 my @extras = @Mnet::Opts::Cli::Cache::extras;
101 16 50       34 @extras = @ARGV if not $INC{"Mnet/Opts/Cli.pm"};
102              
103             # next overlay output opts with Mnet opts read from Mnet::Opts::Cli->new
104             # opts with dashes would be a pain, because of need to xlate underscores
105 16 50       27 if ($INC{"Mnet/Opts/Cli.pm"}) {
106 0         0 foreach my $opt (keys %$Mnet::Opts::Cli::defined) {
107 0 0       0 if ($opt =~ /^(batch|debug|quiet|record|replay|silent|tee|test)$/) {
108 0         0 $opts->{$opt} = $Mnet::Opts::Cli::Cache::opts->{$opt};
109             }
110             }
111             }
112              
113             # finally overlay input options on top of any Mnet pragma and Mnet options
114 16         53 $opts->{$_} = $input->{$_} foreach keys %$input;
115              
116             # finished new method, return opts hash, and extra args in list context
117 16 50       42 return wantarray ? ($opts, @extras) : $opts
118             }
119              
120              
121              
122             # normal package return
123             1;
124