File Coverage

blib/lib/Mnet/Opts/Cli/Cache.pm
Criterion Covered Total %
statement 28 40 70.0
branch 3 16 18.7
condition 1 3 33.3
subroutine 8 10 80.0
pod 0 3 0.0
total 40 72 55.5


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