File Coverage

blib/lib/App/GitHooks/Config.pm
Criterion Covered Total %
statement 31 31 100.0
branch 11 14 78.5
condition 5 9 55.5
subroutine 7 7 100.0
pod 3 3 100.0
total 57 64 89.0


line stmt bran cond sub pod time code
1             package App::GitHooks::Config;
2              
3 32     32   19120 use strict;
  32         47  
  32         930  
4 32     32   134 use warnings;
  32         43  
  32         1007  
5              
6             # External dependencies.
7 32     32   131 use Carp;
  32         35  
  32         2053  
8 32     32   905 use Config::Tiny;
  32         1038  
  32         12473  
9              
10              
11             =head1 NAME
12              
13             App::GitHooks::Config - Configuration manager for App::GitHooks.
14              
15              
16             =head1 VERSION
17              
18             Version 1.9.0
19              
20             =cut
21              
22             our $VERSION = '1.9.0';
23              
24              
25             =head1 SYNOPSIS
26              
27             my $config = App::GitHooks::Config->new();
28              
29             my $config = App::GitHooks::Config->new(
30             file => '...',
31             );
32              
33             my $value = $config->get( $section, $name );
34              
35              
36             =head1 METHODS
37              
38             =head2 new()
39              
40             Return a new C<App::GitHooks::Config> object.
41              
42             my $config = App::GitHooks::Config->new(
43             file => $file,
44             );
45              
46             Arguments:
47              
48             =over 4
49              
50             =item * file I<(optional)>
51              
52             A path to a config file to load into the object.
53              
54             =item * source I<(optional)>
55              
56             How the path of the config file to use was determined.
57              
58             =back
59              
60             =cut
61              
62             sub new
63             {
64 47     47 1 253 my ( $class, %args ) = @_;
65 47         116 my $file = delete( $args{'file'} );
66 47         108 my $source = delete( $args{'source'} );
67              
68 47 50       645 my $self = defined( $file )
69             ? Config::Tiny->read( $file )
70             : Config::Tiny->new();
71              
72 47         8012 bless( $self, $class );
73              
74             # Store meta-information for future reference.
75 47         462 $self->{'__source'} = $source;
76 47         115 $self->{'__path'} = $file;
77              
78 47         265 return $self;
79             }
80              
81              
82             =head2 get()
83              
84             Retrieve the value for a given section and key name.
85              
86             my $value = $config->get( $section, $name );
87              
88             Note that the C<App::GitHooks> configuration files are organized by sections,
89             with the main (default) section being '_'.
90              
91             =cut
92              
93             sub get
94             {
95 340     340 1 966 my ( $self, $section, $name ) = @_;
96              
97 340 50 33     1895 croak 'A section name is required as first argument'
98             if !defined( $section ) || ( $section eq '' );
99 340 50 33     1262 croak 'A key name is required as second argument'
100             if !defined( $name ) || ( $name eq '' );
101              
102             return defined( $self->{ $section } )
103 340 100       2618 ? $self->{ $section }->{ $name }
104             : undef;
105             }
106              
107              
108             =head2 get_regex()
109              
110             Retrieve the specified regex for a given section and key name.
111              
112             my $regex = $config->get_regex( $section, $name );
113              
114             Note that this is very much like C<get()>, except that it will treat the value as a regex and strip out outer '/' symbols so that the result is suitable for inclusion in a regex. For example:
115              
116             my $regex = $config->get_regex( $section, $name );
117             if ( $variable =~ /$regex/ )
118             {
119             ...
120             }
121              
122             =cut
123              
124             sub get_regex
125             {
126 25     25 1 260 my ( $self, $section, $name ) = @_;
127              
128 25         652 my $value = $self->get( $section, $name );
129             return undef
130 25 100 100     231 if !defined( $value ) || $value eq '';
131              
132 7         68 my ( $regex ) = $value =~ /^\s*\/(.*?)\/\s*$/;
133 7 100       53 croak "The key $name in the section $section is not a regex, use /.../ to delimit your expression"
134             if !defined( $regex );
135 6 100       48 croak "The key $name in the section $section does not specify a valid regex, it has unescaped '/' delimiters inside it"
136             if $regex =~ /(?<!\\)\//;
137              
138 5         22 return $regex;
139             }
140              
141              
142             =head1 BUGS
143              
144             Please report any bugs or feature requests through the web interface at
145             L<https://github.com/guillaumeaubert/App-GitHooks/issues/new>.
146             I will be notified, and then you'll automatically be notified of progress on
147             your bug as I make changes.
148              
149              
150             =head1 SUPPORT
151              
152             You can find documentation for this module with the perldoc command.
153              
154             perldoc App::GitHooks::Config
155              
156              
157             You can also look for information at:
158              
159             =over
160              
161             =item * GitHub's request tracker
162              
163             L<https://github.com/guillaumeaubert/App-GitHooks/issues>
164              
165             =item * AnnoCPAN: Annotated CPAN documentation
166              
167             L<http://annocpan.org/dist/app-githooks>
168              
169             =item * CPAN Ratings
170              
171             L<http://cpanratings.perl.org/d/app-githooks>
172              
173             =item * MetaCPAN
174              
175             L<https://metacpan.org/release/App-GitHooks>
176              
177             =back
178              
179              
180             =head1 AUTHOR
181              
182             L<Guillaume Aubert|https://metacpan.org/author/AUBERTG>,
183             C<< <aubertg at cpan.org> >>.
184              
185              
186             =head1 COPYRIGHT & LICENSE
187              
188             Copyright 2013-2017 Guillaume Aubert.
189              
190             This code is free software; you can redistribute it and/or modify it under the
191             same terms as Perl 5 itself.
192              
193             This program is distributed in the hope that it will be useful, but WITHOUT ANY
194             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
195             PARTICULAR PURPOSE. See the LICENSE file for more details.
196              
197             =cut
198              
199             1;