File Coverage

blib/lib/Passwd/Keyring/Auto/Config.pm
Criterion Covered Total %
statement 58 94 61.7
branch 10 44 22.7
condition 3 9 33.3
subroutine 13 14 92.8
pod 0 5 0.0
total 84 166 50.6


line stmt bran cond sub pod time code
1             package Passwd::Keyring::Auto::Config;
2 7     7   33 use Moo;
  7         13  
  7         42  
3 7     7   5272 use File::HomeDir;
  7         147267  
  7         468  
4 7     7   3194 use Config::Tiny;
  7         5628  
  7         182  
5 7     7   4863 use Path::Tiny;
  7         91613  
  7         491  
6 7     7   56 use Carp;
  7         10  
  7         394  
7 7     7   3306 use namespace::clean;
  7         72352  
  7         40  
8              
9             =head1 NAME
10              
11             Passwd::Keyring::Auto::Config - config file support
12              
13             =head1 DESCRIPTION
14              
15             Configuration file allows user to configure his or her keyring backend
16             selection criteria.
17              
18             Internal object, not intended to be used directly.
19              
20             =cut
21              
22             # Explicit location if specified
23             has 'location' => (is=>'ro');
24             has 'debug' => (is=>'ro');
25              
26             # Actual location (may be non-existant if that's default)
27             has 'config_location' => (is=>'lazy');
28              
29             # Config object
30             has '_config_obj' => (is=>'lazy');
31              
32              
33             sub force($$) {
34 4     4 0 12 my ($self, $app) = @_;
35 4         17 my $force = $self->_read_param("force", $app);
36 4         18 return $force;
37             }
38              
39             sub forbid($$) {
40 4     4 0 9 my ($self, $app) = @_;
41 4         11 my $forbid = $self->_read_param("forbid", $app);
42 4         50 return $forbid;
43             }
44              
45             sub prefer($$) {
46 4     4 0 9 my ($self, $app) = @_;
47 4         13 my $prefer = $self->_read_param("prefer", $app);
48 4         36 return $prefer;
49             }
50              
51             sub backend_args($$$) {
52 4     4 0 38 my ($self, $app_name, $backend_name) = @_;
53 4         95 my $cfg_obj = $self->_config_obj;
54 4         31 my %reply;
55 4         6 my $dflt = $cfg_obj->{_};
56 4         19 foreach my $key (keys %$dflt) {
57 0 0       0 if($key =~ /^$backend_name\.(.*)/x) {
58 0         0 $reply{$1} = $dflt->{$key};
59             }
60             }
61 4 50 33     41 if( $app_name && exists $cfg_obj->{$app_name}) {
62 0         0 my $app = $cfg_obj->{$app_name};
63 0         0 foreach my $key (keys %$app) {
64 0 0       0 if($key =~ /^$backend_name\.(.*)/x) {
65 0         0 $reply{$1} = $app->{$key};
66             }
67             }
68             }
69 4 50       31 return wantarray ? %reply : \%reply;
70             }
71              
72             # Return listref of all overriden names
73             sub apps_with_overrides {
74 0     0 0 0 my $self = shift;
75 0         0 my $cfg_obj = $self->_config_obj;
76 0         0 my @apps = grep { /^[^_]/ } keys %$cfg_obj;
  0         0  
77 0         0 return [sort @apps];
78             }
79              
80             sub _read_param {
81 12     12   21 my ($self, $param, $app) = @_;
82              
83 12         26 my $debug = $self->debug;
84 12         187 my $cfg_obj = $self->_config_obj;
85              
86 12 50 33     116 if( $app && exists $cfg_obj->{$app} ) {
87 0         0 my $per_app_section = $cfg_obj->{$app};
88 0 0       0 if($per_app_section) {
89 0         0 my $per_app = $per_app_section->{$param};
90 0 0       0 if($per_app) {
91 0 0       0 print STDERR "[Passwd::Keyring] Per-app config value found for $param (for $app): $per_app\n" if $debug;
92 0         0 return $per_app;
93             }
94             }
95             }
96 12         24 my $default = $cfg_obj->{_}->{$param};
97 12 50       29 if($default) {
98 0 0       0 print STDERR "[Passwd::Keyring] Default config value found for $param: $default\n" if $debug;
99 0         0 return $default;
100             }
101 12 50       24 print STDERR "[Passwd::Keyring] No config value found for $param\n" if $debug;
102 12         24 return; # undef
103             }
104              
105             sub _build__config_obj {
106 4     4   1475 my ($self) = @_;
107              
108 4         16 my $path = $self->config_location;
109 4         6 my $config;
110 4 50 33     33 if($path && $path->exists) {
111             # print STDERR "[Passwd::Keyring] Reading config from $path\n" if $self->debug;
112 0 0       0 $config = Config::Tiny->read("$path", "utf8")
113             or croak("Can not read Passwd::Keyring config file from $path: $Config::Tiny::errstr");
114             # use Data::Dumper; print STDERR Dumper($config);
115             } else {
116 4         72 $config = Config::Tiny->new;
117             }
118 4         27 return $config;
119             }
120              
121             sub _build_config_location {
122 4     4   1343 my ($self) = @_;
123              
124 4         14 my $debug = $self->debug;
125              
126 4         12 my $loc = $self->location;
127 4 50       14 if($loc) {
128 0         0 my $path = path($loc);
129 0 0       0 unless($path->is_file) {
130 0         0 croak("File specified by config=> parameter ($path) does not exist");
131             }
132 0 0       0 if($debug) {
133 0         0 print STDERR "[Passwd::Keyring] Using config file specified by config=> parameter: $path\n";
134             }
135 0         0 return $path;
136             }
137              
138 4         10 my $env = $ENV{PASSWD_KEYRING_CONFIG};
139 4 50       12 if($env) {
140 0         0 my $path = path($env);
141 0 0       0 unless($path->is_file) {
142 0         0 croak("File specified by PASSWD_KEYRING_CONFIG environment variable ($path) does not exist");
143             }
144 0 0       0 if($debug) {
145 0         0 print STDERR "[Passwd::Keyring] Using config file specified by PASSWD_KEYRING_CONFIG environment variable: $path\n";
146             }
147 0         0 return $path;
148             }
149              
150 4         35 my $path = path(File::HomeDir->my_data)->child(".passwd-keyring.cfg");
151 4 50       673 if($path->is_file) {
152 0 0       0 if($debug) {
153 0         0 print STDERR "[Passwd::Keyring] Using default config file: $path\n";
154             }
155 0         0 return $path;
156             }
157              
158 4 50       200 if($debug) {
159 0         0 print STDERR "[Passwd::Keyring] Config file not specified by any means, and default config ($path) does not exist. Proceeding without config\n";
160             }
161              
162 4         19 return $path; # To preserve info where it is to be created, for example
163             }
164              
165             1;