File Coverage

blib/lib/App/Sqitch/Config.pm
Criterion Covered Total %
statement 63 63 100.0
branch 12 14 85.7
condition 9 20 45.0
subroutine 23 23 100.0
pod 13 13 100.0
total 120 133 90.2


line stmt bran cond sub pod time code
1             package App::Sqitch::Config;
2              
3 54     54   853185 use 5.010;
  54         243  
4 54     54   4000 use Moo;
  54         39060  
  54         500  
5 54     54   31222 use strict;
  54         114  
  54         1493  
6 54     54   270 use warnings;
  54         131  
  54         2908  
7 54     54   2132 use Path::Class;
  54         148342  
  54         4745  
8 54     54   1964 use Locale::TextDomain qw(App-Sqitch);
  54         76038  
  54         453  
9 54     54   108810 use App::Sqitch::X qw(hurl);
  54         124  
  54         453  
10 54     54   74459 use Config::GitLike 1.15;
  54         1852968  
  54         2401  
11 54     54   504 use utf8;
  54         111  
  54         499  
12              
13             extends 'Config::GitLike';
14              
15             our $VERSION = 'v1.6.1'; # 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 home_dir {
24 18 50 33 18 1 1108 $^O eq 'MSWin32' && "$]" < '5.016' ? $ENV{HOME} || $ENV{USERPROFILE} : (glob('~'))[0]
      0        
25             }
26              
27             sub user_dir {
28 5     5 1 1361 my $hd = home_dir;
29 5 50       29 hurl config => __("Could not determine home directory") if not $hd;
30 5         65 return dir $hd, '.sqitch';
31             }
32              
33             sub system_dir {
34 7   33 7 1 1267 dir $SYSTEM_DIR || do {
35             require Config;
36             $Config::Config{prefix}, 'etc', 'sqitch';
37             };
38             }
39              
40             sub system_file {
41 7     7 1 1002 my $self = shift;
42             return file $ENV{SQITCH_SYSTEM_CONFIG}
43 7   66     127 || $self->system_dir->file( $self->confname );
44             }
45              
46 74     74 1 1703051 sub global_file { shift->system_file }
47              
48             sub user_file {
49 5     5 1 24586 my $self = shift;
50             return file $ENV{SQITCH_USER_CONFIG}
51 5   66     113 || $self->user_dir->file( $self->confname );
52             }
53              
54             sub local_file {
55 16 100   16 1 2904 return file $ENV{SQITCH_CONFIG} if $ENV{SQITCH_CONFIG};
56 14         431 return file shift->confname;
57             }
58              
59 14     14 1 4145 sub dir_file { shift->local_file }
60              
61             # Section keys always have the top section lowercase, and subsections are
62             # left as-is.
63             sub _skey($) {
64 725   50 725   2111 my $key = shift // return '';
65 725         2482 my ($sec, $sub, $name) = Config::GitLike::_split_key($key);
66 725 100       48703 return lc $key unless $sec;
67 629         1485 return lc($sec) . '.' . join '.', grep { defined } $sub, $name;
  1258         3517  
68             }
69              
70             sub get_section {
71 725     725 1 331706 my ( $self, %p ) = @_;
72 725 100       3033 $self->load unless $self->is_loaded;
73 725         43160 my $section = _skey $p{section};
74 725         18090 my $data = $self->data;
75             return {
76             map {
77             ( split /[.]/ => $self->initial_key("$section.$_") )[-1],
78 463         1997 $data->{"$section.$_"}
79             }
80 725         4690 grep { s{^\Q$section.\E([^.]+)$}{$1} } keys %{$data}
  4992         41039  
  725         3259  
81             };
82             }
83              
84             sub initial_key {
85 463     463 1 1653 my $key = shift->original_key(shift);
86 463 100       59917 return ref $key ? $key->[0] : $key;
87             }
88              
89             sub initialized {
90 6     6 1 350260 my $self = shift;
91 6 100       77 $self->load unless $self->is_loaded;
92 6         16068 return $self->{_initialized};
93             }
94              
95             sub load_dirs {
96 3     3 1 26278 my $self = shift;
97 3         32 local $self->{__loading_dirs} = 1;
98 3         79 $self->SUPER::load_dirs(@_);
99             }
100              
101             sub load_file {
102 243     243 1 1684553 my $self = shift;
103 243   66     4888 $self->{_initialized} ||= $self->{__loading_dirs};
104 243         2411 $self->SUPER::load_file(@_);
105             }
106              
107             1;
108              
109             =head1 Name
110              
111             App::Sqitch::Config - Sqitch configuration management
112              
113             =head1 Synopsis
114              
115             my $config = App::Sqitch::Config->new;
116             say scalar $config->dump;
117              
118             =head1 Description
119              
120             This class provides the interface to Sqitch configuration. It inherits from
121             L<Config::GitLike>, and therefore provides the complete interface of that
122             module.
123              
124             =head1 Interface
125              
126             =head2 Class Methods
127              
128             =head3 C<home_dir>
129              
130             my $hd = App::Sqitch->home_dir;
131              
132             Returns the likely path to the user's hone directory.
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_dir>
139              
140             Returns the path to the system configuration directory, which is
141             F<$(prefix)/etc/sqitch/templates>. Call C<sqitch --etc-path> to find out
142             where, exactly (e.g., C<$(sqitch --etc-path)/sqitch.plan>).
143              
144             =head2 Instance Methods
145              
146             =head3 C<confname>
147              
148             Returns the configuration file base name, which is F<sqitch.conf>.
149              
150             =head3 C<system_file>
151              
152             Returns the path to the system configuration file. The value returned will be
153             the contents of the C<$SQITCH_SYSTEM_CONFIG> environment variable, if it's
154             defined, or else F<$(prefix)/etc/sqitch/templates>. Call C<sqitch --etc-path>
155             to find out where, exactly (e.g., C<$(sqitch --etc-path)/sqitch.plan>).
156              
157             =head3 C<global_file>
158              
159             An alias for C<system_file()> for use by the parent class.
160              
161             =head3 C<user_file>
162              
163             Returns the path to the user configuration file. The value returned will be
164             the contents of the C<$SQITCH_USER_CONFIG> environment variable, if it's
165             defined, or else C<~/.sqitch/sqitch.conf>.
166              
167             =head3 C<local_file>
168              
169             Returns the path to the local configuration file, which is just
170             F<./sqitch.conf>, unless C<$SQITCH_CONFIG> is set, in which case its value
171             will be returned.
172              
173             =head3 C<dir_file>
174              
175             An alias for C<local_file()> for use by the parent class.
176              
177             =head3 C<initialized>
178              
179             say 'Project not initialized' unless $config->initialized;
180              
181             Returns true if the project configuration file was found, and false if it was
182             not. Useful for detecting when a command has been run from a directory with no
183             Sqitch configuration.
184              
185             =head3 C<get_section>
186              
187             my $core = $config->get_section(section => 'core');
188             my $pg = $config->get_section(section => 'engine.pg');
189              
190             Returns a hash reference containing only the keys within the specified
191             section or subsection.
192              
193             =head3 C<add_comment>
194              
195             Adds a comment to the configuration file.
196              
197             =head3 C<initial_key>
198              
199             my $key = $config->initial_key($data_key);
200              
201             Given the lowercase key from the loaded data, this method returns it in its
202             original case. This is like C<original_key>, only in the case where there are
203             multiple keys (for multivalue keys), only the first key is returned.
204              
205             =head1 See Also
206              
207             =over
208              
209             =item * L<Config::GitLike>
210              
211             =item * L<App::Sqitch::Command::config>
212              
213             =item * L<sqitch-config>
214              
215             =back
216              
217             =head1 Author
218              
219             David E. Wheeler <david@justatheory.com>
220              
221             =head1 License
222              
223             Copyright (c) 2012-2026 David E. Wheeler, 2012-2021 iovation Inc.
224              
225             Permission is hereby granted, free of charge, to any person obtaining a copy
226             of this software and associated documentation files (the "Software"), to deal
227             in the Software without restriction, including without limitation the rights
228             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
229             copies of the Software, and to permit persons to whom the Software is
230             furnished to do so, subject to the following conditions:
231              
232             The above copyright notice and this permission notice shall be included in all
233             copies or substantial portions of the Software.
234              
235             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
236             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
237             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
238             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
239             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
240             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
241             SOFTWARE.
242              
243             =cut