File Coverage

blib/lib/CTK/Plugin/Config.pm
Criterion Covered Total %
statement 28 28 100.0
branch 1 2 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 1 1 100.0
total 40 43 93.0


line stmt bran cond sub pod time code
1             package CTK::Plugin::Config;
2 2     2   14 use strict;
  2         4  
  2         57  
3 2     2   11 use utf8;
  2         5  
  2         11  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::Plugin::Config - Configuration plugin
10              
11             =head1 VERSION
12              
13             Version 1.01
14              
15             =head1 SYNOPSIS
16              
17             use CTK;
18             use CTK::ConfGenUtil;
19              
20             my $ctk = CTK->new(
21             plugins => "config",
22             configfile => "test.conf",
23             root => ".",
24             confopts => {... Config::General options ...},
25             );
26             print $ctk->config("foo");
27             print value($ctk->config(), "myinc/Test/val2")
28              
29             =head1 DESCRIPTION
30              
31             Configuration plugin
32              
33             =over 8
34              
35             =item B
36              
37             Specifies absolute or relative path to config-file
38              
39             See L
40              
41             =item B
42              
43             Options of L
44              
45             =item B
46              
47             Specifies absolute or relative path to config-dir. Root dir of project
48              
49             See L and L
50              
51             =back
52              
53             =head1 METHODS
54              
55             =over 8
56              
57             =item B
58              
59             my $value = $ctk->conf("key");
60              
61             Returns config value by key
62              
63             See L
64              
65             =item B
66              
67             my $value = $ctk->config("key");
68              
69             Returns config value by key
70              
71             my $config = $ctk->config();
72              
73             Returns config-structure as hash-ref
74              
75             See L
76              
77             =item B
78              
79             die $ctk->configobj->error unless $ctk->configobj->status;
80              
81             Returns config-object
82              
83             =back
84              
85             =head2 init
86              
87             Initializer method. Internal use only
88              
89             =head1 HISTORY
90              
91             See C file
92              
93             =head1 DEPENDENCIES
94              
95             L, L, L
96              
97             =head1 TO DO
98              
99             See C file
100              
101             =head1 BUGS
102              
103             * none noted
104              
105             =head1 SEE ALSO
106              
107             L, L, L
108              
109             =head1 AUTHOR
110              
111             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
112              
113             =head1 COPYRIGHT
114              
115             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
116              
117             =head1 LICENSE
118              
119             This program is free software; you can redistribute it and/or
120             modify it under the same terms as Perl itself.
121              
122             See C file and L
123              
124             =cut
125              
126 2     2   154 use vars qw/ $VERSION /;
  2         6  
  2         110  
127             $VERSION = '1.01';
128              
129 2     2   10 use base qw/CTK::Plugin/;
  2         4  
  2         503  
130              
131 2     2   742 use CTK::Configuration;
  2         8  
  2         374  
132              
133             sub init {
134 2     2 1 4 my $self = shift; # It is CTK object!
135 2         13 my $args = $self->origin;
136 2         5 my $options = $args->{confopts};
137              
138 2 50 33     13 my $config = CTK::Configuration->new(
139             config => $self->configfile,
140             confdir => $self->root,
141             ($options && ref($options) eq 'HASH') ? (options => $options) : (),
142             );
143 2         5 $self->{config} = $config;
144 2         7 return 1;
145             }
146              
147             __PACKAGE__->register_method(
148             method => "configobj",
149 3     3   11 callback => sub { shift->{config} });
150              
151             __PACKAGE__->register_method(
152             method => "config",
153             callback => sub {
154 1     1   3 my $self = shift;
155 1         2 my $config = $self->{config};
156 1         4 return $config->conf(@_);
157             });
158              
159             __PACKAGE__->register_method(
160             method => "conf",
161             callback => sub {
162 1     1   233 my $self = shift;
163 1         3 my $config = $self->{config};
164 1         4 return $config->get(@_);
165             });
166              
167             1;
168              
169             __END__