File Coverage

blib/lib/App/Sqitch/Config.pm
Criterion Covered Total %
statement 62 62 100.0
branch 12 14 85.7
condition 9 20 45.0
subroutine 22 22 100.0
pod 12 12 100.0
total 117 130 90.0


line stmt bran cond sub pod time code
1             package App::Sqitch::Config;
2              
3 53     53   774305 use 5.010;
  53         262  
4 53     53   3197 use Moo;
  53         58438  
  53         377  
5 53     53   23479 use strict;
  53         126  
  53         985  
6 53     53   255 use warnings;
  53         104  
  53         1305  
7 53     53   2168 use Path::Class;
  53         137146  
  53         3115  
8 53     53   2168 use Locale::TextDomain qw(App-Sqitch);
  53         60738  
  53         324  
9 53     53   96083 use App::Sqitch::X qw(hurl);
  53         137  
  53         342  
10 53     53   50246 use Config::GitLike 1.15;
  53         1574044  
  53         1970  
11 53     53   482 use utf8;
  53         132  
  53         458  
12              
13             extends 'Config::GitLike';
14              
15             our $VERSION = 'v1.4.0'; # VERSION
16              
17             has '+confname' => ( default => 'sqitch.conf' );
18             has '+encoding' => ( default => 'UTF-8' );
19              
20             # Set by ./Build; see Module::Build::Sqitch for details.
21             my $SYSTEM_DIR = q{/usr/local/etc/sqitch};
22              
23             sub user_dir {
24 5 50 33 5 1 2391 my $hd = $^O eq 'MSWin32' && "$]" < '5.016' ? $ENV{HOME} || $ENV{USERPROFILE} : (glob('~'))[0];
      0        
25 5 50       51 hurl config => __("Could not determine home directory") if not $hd;
26 5         66 return dir $hd, '.sqitch';
27             }
28              
29             sub system_dir {
30 7   33 7 1 1185 dir $SYSTEM_DIR || do {
31             require Config;
32             $Config::Config{prefix}, 'etc', 'sqitch';
33             };
34             }
35              
36             sub system_file {
37 7     7 1 919 my $self = shift;
38             return file $ENV{SQITCH_SYSTEM_CONFIG}
39 7   66     132 || $self->system_dir->file( $self->confname );
40             }
41              
42 74     74 1 721907 sub global_file { shift->system_file }
43              
44             sub user_file {
45 5     5 1 19708 my $self = shift;
46             return file $ENV{SQITCH_USER_CONFIG}
47 5   66     121 || $self->user_dir->file( $self->confname );
48             }
49              
50             sub local_file {
51 16 100   16 1 1748 return file $ENV{SQITCH_CONFIG} if $ENV{SQITCH_CONFIG};
52 14         416 return file shift->confname;
53             }
54              
55 14     14 1 3287 sub dir_file { shift->local_file }
56              
57             # Section keys always have the top section lowercase, and subsections are
58             # left as-is.
59             sub _skey($) {
60 723   50 723   2003 my $key = shift // return '';
61 723         2070 my ($sec, $sub, $name) = Config::GitLike::_split_key($key);
62 723 100       46187 return lc $key unless $sec;
63 629         1786 return lc($sec) . '.' . join '.', grep { defined } $sub, $name;
  1258         3251  
64             }
65              
66             sub get_section {
67 723     723 1 279600 my ( $self, %p ) = @_;
68 723 100       2624 $self->load unless $self->is_loaded;
69 723         21047 my $section = _skey $p{section};
70 723         14274 my $data = $self->data;
71             return {
72             map {
73             ( split /[.]/ => $self->initial_key("$section.$_") )[-1],
74 463         1926 $data->{"$section.$_"}
75             }
76 723         4823 grep { s{^\Q$section.\E([^.]+)$}{$1} } keys %{$data}
  4936         36364  
  723         2917  
77             };
78             }
79              
80             sub initial_key {
81 463     463 1 1530 my $key = shift->original_key(shift);
82 463 100       54185 return ref $key ? $key->[0] : $key;
83             }
84              
85             sub initialized {
86 6     6 1 10010 my $self = shift;
87 6 100       41 $self->load unless $self->is_loaded;
88 6         21809 return $self->{_initialized};
89             }
90              
91             sub load_dirs {
92 3     3 1 18123 my $self = shift;
93 3         78 local $self->{__loading_dirs} = 1;
94 3         121 $self->SUPER::load_dirs(@_);
95             }
96              
97             sub load_file {
98 243     243 1 1093069 my $self = shift;
99 243   66     5224 $self->{_initialized} ||= $self->{__loading_dirs};
100 243         2293 $self->SUPER::load_file(@_);
101             }
102              
103             1;
104              
105             =head1 Name
106              
107             App::Sqitch::Config - Sqitch configuration management
108              
109             =head1 Synopsis
110              
111             my $config = App::Sqitch::Config->new;
112             say scalar $config->dump;
113              
114             =head1 Description
115              
116             This class provides the interface to Sqitch configuration. It inherits from
117             L<Config::GitLike>, and therefore provides the complete interface of that
118             module.
119              
120             =head1 Interface
121              
122             =head2 Instance Methods
123              
124             =head3 C<confname>
125              
126             Returns the configuration file base name, which is F<sqitch.conf>.
127              
128             =head3 C<system_dir>
129              
130             Returns the path to the system configuration directory, which is
131             F<$(prefix)/etc/sqitch/templates>. Call C<sqitch --etc-path> to find out
132             where, exactly (e.g., C<$(sqitch --etc-path)/sqitch.plan>).
133              
134             =head3 C<user_dir>
135              
136             Returns the path to the user configuration directory, which is F<~/.sqitch/>.
137              
138             =head3 C<system_file>
139              
140             Returns the path to the system configuration file. The value returned will be
141             the contents of the C<$SQITCH_SYSTEM_CONFIG> environment variable, if it's
142             defined, or else F<$(prefix)/etc/sqitch/templates>. Call C<sqitch --etc-path>
143             to find out where, exactly (e.g., C<$(sqitch --etc-path)/sqitch.plan>).
144              
145             =head3 C<global_file>
146              
147             An alias for C<system_file()> for use by the parent class.
148              
149             =head3 C<user_file>
150              
151             Returns the path to the user configuration file. The value returned will be
152             the contents of the C<$SQITCH_USER_CONFIG> environment variable, if it's
153             defined, or else C<~/.sqitch/sqitch.conf>.
154              
155             =head3 C<local_file>
156              
157             Returns the path to the local configuration file, which is just
158             F<./sqitch.conf>, unless C<$SQITCH_CONFIG> is set, in which case its value
159             will be returned.
160              
161             =head3 C<dir_file>
162              
163             An alias for C<local_file()> for use by the parent class.
164              
165             =head3 C<initialized>
166              
167             say 'Project not initialized' unless $config->initialized;
168              
169             Returns true if the project configuration file was found, and false if it was
170             not. Useful for detecting when a command has been run from a directory with no
171             Sqitch configuration.
172              
173             =head3 C<get_section>
174              
175             my $core = $config->get_section(section => 'core');
176             my $pg = $config->get_section(section => 'engine.pg');
177              
178             Returns a hash reference containing only the keys within the specified
179             section or subsection.
180              
181             =head3 C<add_comment>
182              
183             Adds a comment to the configuration file.
184              
185             =head3 C<initial_key>
186              
187             my $key = $config->initial_key($data_key);
188              
189             Given the lowercase key from the loaded data, this method returns it in its
190             original case. This is like C<original_key>, only in the case where there are
191             multiple keys (for multivalue keys), only the first key is returned.
192              
193             =head1 See Also
194              
195             =over
196              
197             =item * L<Config::GitLike>
198              
199             =item * L<App::Sqitch::Command::config>
200              
201             =item * L<sqitch-config>
202              
203             =back
204              
205             =head1 Author
206              
207             David E. Wheeler <david@justatheory.com>
208              
209             =head1 License
210              
211             Copyright (c) 2012-2023 iovation Inc., David E. Wheeler
212              
213             Permission is hereby granted, free of charge, to any person obtaining a copy
214             of this software and associated documentation files (the "Software"), to deal
215             in the Software without restriction, including without limitation the rights
216             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
217             copies of the Software, and to permit persons to whom the Software is
218             furnished to do so, subject to the following conditions:
219              
220             The above copyright notice and this permission notice shall be included in all
221             copies or substantial portions of the Software.
222              
223             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
224             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
225             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
226             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
227             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
228             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
229             SOFTWARE.
230              
231             =cut