File Coverage

blib/lib/JMX/Jmx4Perl/Config.pm
Criterion Covered Total %
statement 41 56 73.2
branch 17 32 53.1
condition 3 11 27.2
subroutine 6 8 75.0
pod 4 4 100.0
total 71 111 63.9


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             package JMX::Jmx4Perl::Config;
3 4     4   35713 use Data::Dumper;
  4         6  
  4         307  
4              
5             my $HAS_CONFIG_GENERAL;
6              
7             BEGIN {
8 4     4   9 eval {
9 4         4867 require "Config/General.pm";
10             };
11 4 50       116590 $HAS_CONFIG_GENERAL = $@ ? 0 : 1;
12             }
13              
14             =head1 NAME
15              
16             JMX::Jmx4Perl::Config - Configuration file support for Jmx4Perl
17              
18             =head1 SYNOPSIS
19              
20             =over
21              
22             =item Configuration file format
23              
24             # ================================================================
25             # Sample configuration for jmx4perl
26              
27             # localhost is the name how this config could accessed
28            
29             # Options for JMX::Jmx4Perl->new, case is irrelevant
30             Url = http://localhost:8080/j4p
31             User = roland
32             Password = test
33             Product = JBoss
34              
35             # HTTP proxy for accessing the agent
36            
37             Url = http://proxy:8001
38             User = proxyuser
39             Password = ppaasswwdd
40            
41             # Target for running j4p in proxy mode
42            
43             Url service:jmx:iiop://....
44             User weblogic
45             Password weblogic
46            
47            
48              
49             =item Usage
50              
51             my $config = new JMX::Jmx4Perl::Config($config_file);
52              
53             =back
54              
55              
56             =head1 DESCRIPTION
57              
58              
59             =head1 METHODS
60              
61             =over
62              
63             =item $cfg = JMX::Jmx4Perl::Config->new($file_or_hash)
64              
65             Create a new configuration object with the given file name. If no file name is
66             given the configuration F<~/.j4p> is tried. In case the given file is a
67             directory, a file F is tried as configuration file.
68              
69             If the file does not exist, C will alway return C and
70             C will always return C
71              
72             If a hash is given as argument, this hash is used to extract the server
73             information.
74              
75             =cut
76              
77             sub new {
78 2     2 1 586 my $class = shift;
79 2         5 my $file_or_hash = shift;
80 2         10 my $self = {};
81 2         5 my $config = undef;;
82 2 50       8 if (!ref($file_or_hash)) {
    0          
83 2 100       14 my $file = $file_or_hash ? $file_or_hash : $ENV{HOME} . "/.j4p";
84 2 50       92 $file = $file . "/jmx4perl.cfg" if -d $file;
85 2 100       39 if (-e $file) {
    50          
86 1 50       3 if ($HAS_CONFIG_GENERAL) {
87 1     0   9 local $SIG{__WARN__} = sub {}; # Keep Config::General silent
88             # when including things twice
89 1         16 $config = {
90             new Config::General(-ConfigFile => $file,-LowerCaseNames => 1,
91             -UseApacheInclude => 1,-IncludeRelative => 1, -IncludeAgain => 0,
92             -IncludeGlob => 1, -IncludeDirectories => 1, -CComments => 0)->getall
93             };
94             } else {
95 0         0 warn "Configuration file $file found, but Config::General is not installed.\n" .
96             "Please install Config::General, for the moment we are ignoring the content of $file\n\n";
97             }
98             } elsif (-d $file) {
99            
100             }
101             } elsif (ref($file_or_hash) eq "HASH") {
102 0         0 $config = $file_or_hash;
103             } else {
104 0         0 die "Invalid argument ",$file_or_hash;
105             }
106 2 100       1445 if ($config) {
107 1         5 $self->{server_config} = &_extract_servers($config);
108 1         2 $self->{servers} = [ values %{$self->{server_config}} ];
  1         4  
109 1         3 map { $self->{$_} = $config->{$_ } } grep { $_ ne "server" } keys %$config;
  0         0  
  1         4  
110             #print Dumper($self);
111             }
112              
113 2   33     15 bless $self,(ref($class) || $class);
114 2         6 return $self;
115             }
116              
117             =item $exists = $config->server_config_exists($name)
118              
119             Check whether a configuration entry for the server with name $name
120             exist.
121              
122             =cut
123              
124             sub server_config_exists {
125 1     1 1 633 my $self = shift;
126 1   50     4 my $name = shift || die "No server name given to reference to get config for";
127 1         3 my $cfg = $self->get_server_config($name);
128 1 50       6 return defined($cfg) ? 1 : 0;
129             }
130              
131             =item $server_config = $config->get_server_config($name)
132              
133             Get the configuration for the given server or C
134             if no such configuration exist.
135              
136             =cut
137              
138             sub get_server_config {
139 2     2 1 3 my $self = shift;
140 2   50     6 my $name = shift || die "No server name given to reference to get config for";
141 2 50       10 return $self->{server_config} ? $self->{server_config}->{$name} : undef;
142             }
143              
144             =item $servers = $config->get_servers
145              
146             Get an arrayref to all configured servers or an empty arrayref.
147              
148             =cut
149              
150             sub get_servers {
151 0     0 1 0 my $self = shift;
152 0   0     0 return $self->{servers} || [];
153             }
154              
155             sub _extract_servers {
156 1     1   2 my $config = shift;
157 1         3 my $servers = $config->{server};
158 1         2 my $ret = {};
159 1 50       5 return $ret unless $servers;
160 1 50       6 if (ref($servers) eq "ARRAY") {
    50          
161             # Its a list of servers using old style (no named section, but with
162             # embedded 'name'
163 0         0 for my $s (@$servers) {
164 0 0       0 die "No name given for server config " . Dumper($s) . "\n" unless $s->{name};
165 0         0 $ret->{$s->{name}} = $s;
166             }
167 0         0 return $ret;
168             } elsif (ref($servers) eq "HASH") {
169 1         3 for my $name (keys %$servers) {
170 2 50       7 if (ref($servers->{$name}) eq "HASH") {
171             # A single, 'named' server section
172 2         5 $servers->{$name}->{name} = $name;
173             } else {
174             # It's a single server entry with 'old' style naming (e.g. no
175             # named section but a 'Name' property
176 0         0 my $ret = {};
177 0   0     0 my $name = $servers->{name} || die "Missing name for server section ",Dumper($servers);
178 0         0 $ret->{$name} = $servers;
179 0         0 return $ret;
180             }
181             }
182 1         4 return $servers;
183             } else {
184 0           die "Invalid configuration type ",ref($servers),"\n";
185             }
186             }
187              
188             =back
189              
190             =head1 LICENSE
191              
192             This file is part of jmx4perl.
193              
194             Jmx4perl is free software: you can redistribute it and/or modify
195             it under the terms of the GNU General Public License as published by
196             the Free Software Foundation, either version 2 of the License, or
197             (at your option) any later version.
198              
199             jmx4perl is distributed in the hope that it will be useful,
200             but WITHOUT ANY WARRANTY; without even the implied warranty of
201             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
202             GNU General Public License for more details.
203              
204             You should have received a copy of the GNU General Public License
205             along with jmx4perl. If not, see .
206              
207             A commercial license is available as well. Please contact roland@cpan.org for
208             further details.
209              
210             =head1 PROFESSIONAL SERVICES
211              
212             Just in case you need professional support for this module (or Nagios or JMX in
213             general), you might want to have a look at
214             http://www.consol.com/opensource/nagios/. Contact roland.huss@consol.de for
215             further information (or use the contact form at http://www.consol.com/contact/)
216              
217             =head1 AUTHOR
218              
219             roland@cpan.org
220              
221             =cut
222              
223             1;