debmon
/
jmx4perl
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Imported Upstream version 1.12

This commit is contained in:
Mario Fetka 2017-10-31 14:38:28 +01:00
commit ae1fc8494f
157 changed files with 35016 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

254
Build.PL Executable file
View File

@ -0,0 +1,254 @@
#!/usr/bin/perl
# Check for Module::Build at the right version or use or own bundled one
# if the available one does not fit.
my $Minimal_MB = 0.34;
my $Installed_MB =
`$^X -e "eval q{require Module::Build; print Module::Build->VERSION} or exit 1"`;
chomp $Installed_MB;
$Installed_MB = 0 if $?;
# Use our bundled copy of Module::Build if it's newer than the installed.
unshift @INC, "inc/Module-Build" if $Minimal_MB > $Installed_MB;
require Module::Build;
use strict;
use Data::Dumper;
my %REQS = (
"JSON" => "2.12",
"LWP::UserAgent" => 0,
"URI" => "1.35",
"Data::Dumper" => 0,
"Getopt::Long" => 0,
"Carp" => 0,
"Module::Find" => 0,
"Scalar::Util" => 0,
"base" => 0,
"Sys::SigAction" => 0,
"IO::Socket::Multicast" => 0 # opt
);
my %SCRIPTS = ();
# Ask for various installation options:
print <<EOT;
Jmx4Perl comes with a set of supporting scripts, which
are not necessarily required for using JMX::Jmx4Perl
programmatically.
EOT
my $msg = <<EOT;
jmx4perl
========
jmx4perl is a command line utility for accessing Jolokia agents
(www.jolokia.org). It can be used for script based exploration
and easy inspection of the JMX space.
Install 'jmx4perl' ? (y/n)
EOT
chomp $msg;
my $answer = y_n($msg,"y");
if ($answer) {
add_reqs(
"Crypt::Blowfish_PP" => 0 # opt
);
add_script("scripts/jmx4perl" => 1);
}
my $msg = <<EOT;
check_jmx4perl
==============
check_jmx4perl is a full featured Nagios Plugin (www.nagios.org) for
monitoring JEE and other Java-servers.
Install 'check_jmx4perl' ? (y/n)
EOT
chomp $msg;
my $answer = y_n($msg,"y");
if ($answer) {
add_reqs(
"Monitoring::Plugin" => "0.37", # req
"Text::ParseWords" => 0, # req
"Time::HiRes" => 0, # req
"Config::General" => "2.34",# req
"Pod::Usage" => 0, # opt
"Crypt::Blowfish_PP" => 0 # opt
);
add_script("scripts/check_jmx4perl" => 1);
}
$msg = <<EOT;
cacti_jmx4perl
==============
cacti_jmx4perl is a script which can be used as a Cacti
(www.cacti.net) plugin.
Install 'cacti_jmx4perl' ? (y/n)
EOT
chomp $msg;
$answer = y_n($msg,"y");
if ($answer) {
add_reqs(
"Monitoring::Plugin" => "0.37", # req
"Text::ParseWords" => 0, # req
"Config::General" => "2.34",# req
"Pod::Usage" => 0, # opt
"Crypt::Blowfish_PP" => 0 # opt
);
add_script("scripts/cacti_jmx4perl" => 1);
}
$msg = <<EOT;
j4psh
=====
j4psh is an interactive JMX shell with context sensitive command line
completion. It uses JMX::Jmx4Perl for connecting to the JMX backend
and has quite some Perl module dependencies.
Install 'j4psh' ? (y/n)
EOT
chomp $msg;
$answer = y_n($msg,"y");
if ($answer) {
add_reqs(
"Getopt::Long" => 0, # req, GetOptionsFromArray must be exported
"Term::ShellUI" => 0, # req
"Term::Clui" => 0, # req
"Term::Size" => "0.207", # opt
"Config::General" => "2.34",# opt
"File::SearchPath" => 0, # opt
"Crypt::Blowfish_PP" => 0 # opt
);
add_script("scripts/j4psh" => 1);
# check for Term::ReadLine::Gnu
my $has_gnu_readline = eval "require Term::ReadLine; require Term::ReadLine::Gnu; 1";
my $has_perl_readline = eval "require Term::ReadLine::Perl; 1";
if (!$has_gnu_readline) {
$msg = <<EOT;
Term::ReadLine::Gnu is the recommended readline module, but it is not
necessarily required. It needs a development variant of libreadline
installed along with header files.
Use Term::ReadLine::Gnu ? (y/n)
EOT
chomp $msg;
$answer = y_n($msg,"n");
if ($answer) {
add_reqs("Term::ReadLine::Gnu" => 0);
} elsif (!$has_perl_readline) {
add_reqs("Term::ReadLine::Perl" => 0,
"Term::ReadKey" => 0);
}
}
}
$msg = <<EOT;
jolokia
=======
jolokia is an utility which helps in downloading
and managing the Jolokia agents (www.jolokia.org), which
are required on the server side for using jmx4perl.
Install 'jolokia' ? (y/n)
EOT
chomp $msg;
$answer = y_n($msg,"y");
if ($answer) {
add_reqs(
"Archive::Zip" => 0, # req
"XML::LibXML" => 0, # req
"File::Temp" => 0, # req
"Digest::MD5" => 0, # opt
"Digest::SHA1" => 0, # opt
"XML::Twig" => 0, # opt
"Term::ProgressBar" => 0 # opt
);
add_script("scripts/jolokia" => 1);
my $has_openpgp = eval "require Crypt::OpenPGP; 1";
if (!$has_openpgp) {
my $check = `gpg --version`;
if ($?) {
$check = `gpg2 --version`;
if ($?) {
$msg = <<EOT;
jolokia uses PGP verification for the files downloaded, but neither
Crypt::OpenPGP nor GnuPG is installed. It is highly recommended to
install at least one of them. Installing Crypt::OpenPGP however can
be a pain due to its large set of dependencies.
Use Crypt::OpenPGP ? (y/n)
EOT
chomp $msg;
$answer = y_n($msg,"y");
if ($answer) {
add_reqs("Crypt::OpenPGP" => 0);
}
}
}
}
}
# Add extra requirements
sub add_reqs {
my %to_add = @_;
for my $k (keys %to_add) {
$REQS{$k} = $to_add{$k};
}
}
sub add_script {
my $script = shift;
$SCRIPTS{$script} = 1;
}
sub y_n {
Module::Build->y_n(@_);
}
# ================================================================================
my $build = Module::Build->new
(
dist_name => "jmx4perl",
dist_version_from => "lib/JMX/Jmx4Perl.pm",
dist_author => 'Roland Huss (roland@cpan.org)',
dist_abstract => 'Easy JMX access to Java EE applications',
#sign => 1,
installdirs => 'site',
license => 'gpl',
requires => \%REQS,
script_files => \%SCRIPTS,
build_requires => {
"Module::Build" => "0.34",
"Test::More" => "0",
},
configure_requires => { 'Module::Build' => 0.34 },
keywords => [ "JMX", "JEE", "Management", "Nagios", "Java", "Jolokia", "OSGi", "Mule" ],
);
$build->create_build_script;
# ===================================================================================

418
CHANGES Normal file
View File

@ -0,0 +1,418 @@
1.12 (2015-07-28)
- Configuration can be also a directory in wich case <dir>/jmx4perl.cfg is tried
(e.g. ~/.j4p/jmx4perl.cfg)
- Added Docker build
- Fix boolean values to be strings "true"/"false" when deserialized.
- Changed from "Nagios::Plugin" to "Monitoring::Plugin"
1.11 (2014-11-22)
- When within a MultiCheck a single check causes an exception, the
other checks are now still present in the output of check_jmx4perl
and the overall check has the status UNKNWON (#40)
- Minor fixes on the WebSphere Checks
- Fixed issue when calling check_jmx4perl for an operation without argument (RT##98166)
1.10 (2014-06-30)
- Added WebSphere checks
1.08 (2014-06-30)
- Fixed warning when using MBeanName (#31)
- Fixed BaseMBean and formatting
- Fixed relative checks when using MBean patterns
- Added formatter '%q' to include a ratio of value to base without
multiplying by 100 like for '%r'
- Disabled OpenPGPVerifier since it doesn't support the new digest
algorithms used for signing the Jolokia artefacts (#32)
- Don't set ssl_opts if on LWP < 6 (#28)
- Fixed BaseMBean and BaseAttribute config directives (#25)
- Fixed regexp for squeezing trailing slashes (RT#89108)
- Fixed check definition for 'wls_channel_connections (RT#89107)
- Changed check 'memory_gc_time' to be a relative check to measure the
relative amount taken for the GC. If you use this check (or a sub-check of this)
YOU NEED TO UPDATE YOUR THRESHOLDS (and regenerate the pn4p graphics) if you use this
check directly
- Fixed bug when using 0 thresholds in checks using parent checks (#38)
- Added support for '*' wildcard when navigation with cd for j4psh
- Fixed bug with check inheritance and check parameters which contain parantheses
- Added an option "MultiCheckPrefix" for "Checks" in order to specify the prefix
for multi checks
- Added config options "SummaryOk" and "SummaryFailure" for allowing to fine tune
multi check output (#24)
- "Argument" can be used in "Operation" config checks for providing arguments to
Nagios checks which are based on operations (#27)
1.07 (2013-04-16)
- Added more robust timeout for the Jmx4Perl Agent (requires Sys::SigAction)
- SSL Host key verification switched off when connecting via SSL
- Fixed issue with quoting in j4psh (#14)
- 'cat' in j4psh is now caseinsensitive when using wildcards (#18)
- Added BaseMBean, BaseAttribute and BasePath as alternative to Base f
or check_jmx4perl (#16)
- "jolokia" can do 'repack' and 'info' also when not being connected
to the internet (#20)
- Multi-Checks can now reference other Multi-Checks either via <MultiCheck>
or <Check> (#19)
- Added new option '--perfdata true|false' (PerData false in configuration) for
switching of performance data. Also, for string checks performance data is
switched off always. (#22)
- Added %y and %z as placeholder for configured CRITICAL and WARNING thresholds
for the output provided with "Label" in check_jmx4perl (#13)
1.06 (2012-10-13)
- A a scripting mode to check_jmx4perl which allows putting in arbitraty
Perl code for extracting the value to match against
- weblogic specific Nagios checks added
- Added name as optional parameter for Nagios checks in tomcat.cfg (thanks Wolfgang)
- When a multi checks fails, then the name of the check is added instead of its definition
key. This allows for better direct usage of predefined checks in own multi checks.
- If neither a CRITICAL nor a WARNING threshold is provided, then
the check always returns OK. This is especially useful when the
motivation is to only collect performance data.
1.05 (2012-04-22)
- Added Time::HiRes as dependency to check_jmx4perl
- Replaced XML::Tidy with XML::Twig and relaxed version number
requirement on Module::Build
- RT#72413: Fixed configuration in threads.cfg
- Updated documentation for 'jmx4perl' (--method and --legacy-escape
explained)
- Bundled Module::Build 0.34 in order to improve the installation
experience
- j4psh: Added 'pwd' command
- j4psh: Added options -a (attributes) and -o (operatiosn) to the 'ls'
command which now also supports wildcards for filtering
1.04 (2011-11-27)
- Fixed serious (and stupid) bug for jmx4perl and j4psh when printing
out scalar values.
1.03 (2011-11-23)
- Fixed stupid last minute bug.
1.02 (2011-11-23)
- Fix for threshold with 0 value in check_jmx4perl
- Fix automatic detection of the largest version number for Jolokia
agents in with the format 1.0.1 when downloading with 'jolokia'
- Fixed printing of boolean values for jmx4perl and j4psh for
complex data structures (finally)
- Added option '--option key=val' to jmx4perl and j4psh for tuning the
output format of these tools (known keys: format,booleans,indent)
- Added '--target' to j4psh so that it can operate against a JSR-160
proxy
1.01 (2011-10-25)
- Fixed 'jolokia' to load the new renamed jvm agent.
- Fixed issue when printing boolean values with jmx4perl
- Fixed issue with LWP as old as 5.805
- Bumped required version of Module::Build to 0.38 in order to cope
with messed up version number of XML::Tidy.
- j4psh works now with Getopt::Long before 2.38
1.00 (2011-10-3)
- Changed escaping as introduced by Jolokia 1.0. If talking with
Jolokia < 1.0, use the option '--legacy-escape' must be used if
using GET requests with MBeans containing / in the
name. JMX::Jmx4Perl knows this option as well
('legacy-escape'). j4psh does the detection automatically,
jmx4perl, check_jmx4perl and cacti_jmx4perl know about the new
configuration option.
- That's 1.0
0.95 (2011-8-21)
- Fixed Cacti output when labels contains spaces
- Tuned ancient Perl coding style (thanks, datamuc)
- Fixed problem with jolokia and PGP verification in non-english
environments.
- Fixed 'search' command which now really returns undef if nothing
is found (and not a ref to an empty array). That will also fix some
detectors when the 'info' command is used.
0.92 (2011-5-9)
- Fixed bug in pack specification (encryption) which is not available for
Perl 5.8 (and which broke Jmx4Perl for Perl 5.8)
0.91 (2011-5-6)
- Added --unknown-is-critical option to map all UNKNOWN to CRITICAL values (RT#67899)
- Added jmx4perl back to the build process, which was forgotten in 0.90
- Fixed bug RT#67815 which was caused by an invalid replacement of placeholder
for certain cases (i.e. is during parent check definition resolving
($0,$1) needs to be replaced by ($1,$2) which ended up falsely as ($2,$2)).
- Implemented --timeout option for check_jmx4perl, which is a pure HTTP timeout
for the communication between the Nagios checks and the Jolokia agent (RT#67821)
- Added a possibility to store encrypted passwords in the configuration file.
Please note, that this is *not* secure and only prevents casual attacks, since
the password needs to be symmetrically decrypted before passing it to the server.
In order to create an encrypted password, use 'jmx4perl encrypt <passwd>'.
- Fixed RT#67772 which prevented the proper count of failed checks for non-relative
checks within multi checks
0.90 (2011-4-11)
- Tuned Build.PL so that scripts can be added conditionally.
- Fixed normalization issue with negative delta check values.
- Support for new JSON serialization style of Jolokia 0.90 added.
(i.e numbers and booleans are not returned as plain strings anymore
but as Long, Double, true/false. Null is returned as JSON-null.
If you have trouble with boolean checks in check_jmx4perl, please
update to this jmx4perl version.
- Added 'jolokia' for downloading and managing Jolokia agents
- Removed jmx4perl Java agent source and agent since jmx4perl now uses
Jolokia as agents (www.jolokia.org)
- Added 'cacti_jmx4perl', a tool for gathering Cacti data (www.cacti.net)
It is heavily based on 'check_jmx4perl' (without threshold handling).
0.75 (2011-2-4)
- Fixed typo in POD documentation which prevented a successful
build in some situations
0.74 (2011-1-16)
- Fixed problem with multichecks including operation-checks with
arguments. Specifying them in a configuration has been falsely
ignored.
- Added '--method' command line option and 'Method' check
configuration option to check_jmx4perl for selecting the prefered
HTTP request method.
- Fixed normalization of time values (RT #63545)
- Improved default check_jmx4perl configuration (in hopefully a backward
compatible way)
- Multi check service summary now contains the name of failed services
- Fixed problems with a single '/' argument (RT #62915)
0.73 (2010-11-03)
- Fixed RT #61903 which occurs when the same check is referenced
multiple times (with potentially different parameters) in a
multicheck scenario.
- Fixed RT #62342: Perl warning when using operations and not --name
in check_jmx4perl
- Added --method to jmx4perl, config option 'method' for JMX::Jmx4Perl
in order to allow a default HTTP Method to use.
- Changed request command constant 'VERSION' to 'AGENT_VERSION' in
order to avoid conflicts with the usual versioning conventions for
Perl Modules. This is an API change, so in case you are using requests
with the constant VERSION you should change this to AGENT_VERSION
- Fixed issues when browsing with less in j4psh
- Extended config handling in j4psh to allow includes
0.72 (2010-9-24)
- Fixed problem with quotes in the config when using "Value"
and/or "Base".
- Adapted tomcat.cfg to be more flexible (e.g. replaced 'Catalina'
domain part by a wildcard).
- Fixed bug for merged MBeanServers when using multiple attributes
and/or MBean patterns for a READ request
- Fixed broken --target, --target-user and --target-password for
check_jmx4perl (same for --proxy and co.)
- Tuned output of complex data in j4psh
- Unwrap an MBeanException to use the target exception for an error
message
- Agent tested with Mule 3.0
0.71 (2010-8-16)
- Added 'ns' as unit (CpuThreadTime returns nano seconds)
- Fixed quoting of performance data in so far to let
Nagios::Plugin the complete control
- Fixed '--color' option and UseColor config directive
(section: <Shell>) to j4psh
- Added detection of a suitable pager for j4psh
- Fixed bug in server configuration when using old style syntax
0.70 (2010-7-10)
- Extended configuration syntax for check_jmx4perl as an alternative to
command line options
+ Parameterized checks
+ Default values for parameters
+ Multichecks (one HTTP request, many JMX requests)
+ Check-Inheritance
+ Predefined checks for certain environments (as sample configuration files)
+ Added null value check, can be tuned with --null
- Added '--value' as a shortcut for --mbean/--attribute/--value
- Better documentation for check_jmx4perl (30 extra pages)
- <Server> sections are now named blocks, taking the server name as block
name (similar to <Check>). The old syntax with an "Name" argument is
still support but must not be mixed with the new syntax.
- Path elements containing '/' can now be escaped with '\/'
- j4p-osgi-bundle including pax-web-bundle so only a single bundle
is needed for deploying (when no OSGi HttpService is installed)
- Relaxed version requirements on core and compendium OSGi classes
for j4p-osgi bundle.
- Changed access restrictions (j4p-access.xml):
+ <allow> and <deny>
+ Wildcards (*) for attribute and operation names
+ WARNING: Semantics of MBean specification has changed. Please
read the comments in j4p-access.xml.template
+ Add logging (level info) for printing out which security policy
is used
- Started to add a java client library
- j4psh beta version added
- Agent:
+ Switched from JUnit to TestNG for testing because of
support of testing groups
+ New servlet init parameter option 'mbeanQualifier' to allow
multiple j4p-servlet in a single application server
0.65 (2010-3-30)
- A JDK 6 java agent added for exporting the j4p protocol via
HTTP/JSON.
- Extended READ operation to support MBean patternames and multiple
attributes with a single request
- Renamed 'max_depth', 'max_list_size','max_objects' as processing
configuration parameters to 'maxDepth', 'maxCollectionSize' and
'maxObjects' respectively for consistencies sake.
- Bug fix: POST request respect these parameters as well now
- Added 'ignoreErrors' request option in order to allow a bulk read
to succeed even if single read fails. In this case, the valu will
- 'search' returns properly escaped MBean Names if unsafe characters
are used.
- For GET request, instead of pathinfo a query with parameter 'p'
can be used as alternative. This works around certain issues with
special path handling with certain app-servers (e.g. Tomcat).
- JMX::Jmx4Perl::Request and JMX::Jmx4Perl::Agent hardened in order
to be more smart with unsafe MBean Names and detect automatically
the most convenient HTTP Request method (if not explicitely set)
- Added more unit and integration tests.
- Added VERSION command to JMX::Jmx4Perl to get to agent and
protocol version
- Fixed error handling for bulk requests. Now each request object
will return an associated response object even in the error case.
- Fixed JMX::Jmx4Perl::info for IBM JVMs
- Added JMX::Jmx4Perl->parse_name() for splitting up a given MBean
object name into its parts
0.60 (2009-02-28)
- OSGi bundle (including dependencies) for exposing JSON export via
the OSGi HTTP-Service. It's in agent/modules/j4p-osgi.
- Refined error handling
- Removed legacy JDK 1.4 support. 0.36 is the one and only version
for which the JDK 1.4 backport has been tested to some amount.
- Added support for overloaded JMX operations for 'list' and 'exec'
- 'read' operation can now be used without attribute name in which
case the value of all attributes is returned. This can be used
directly with JMX::Jmx4Perl and the frontend jmx4perl.
- Support for Resin 3.1 added
- 'exec' operation can now deal with simple array arguments. Within
the perl modules, give an array ref for an array argument. This
gets translated to a comma separated list of values in the
string. For string array this works only with simle content
(i.e. no element containing a ',')
0.51 (2009-12-30)
- Quickfix for a badly packaged agent/j4p.war
0.50 (2009-12-24)
- Protocol of j4p.war has been extended to enable proxy mode
- Added '--target' to check_jmx4perl for using proxy mode
- Added '--target' to jmx4perl
- Added Mule agent. Use maven to build it in agent/modules/j4p-mule
- 'get_war' and 'get_mule_agent' as actions for Build.PL for
fetching java artifacts from the labs.consol.de maven repository.
- Cleaned up and updated Manual.pod
0.40 (2009-11-14)
- Extended protocol to allow for JSON requests via POST in addition
to pure URL based requests via GET
- Implemented bulk requests: JMX::Jmx4Perl->request() can now take a
list of JMX::Jmx4Perl::Request objects in which case it will
return a list of JMX::Jmx4Perl::Response objects (instead of a
single, scalar, response when used with a single request)
- Support for Glassfish V3 Preview, Jonas 5.1 and Jetty 7.0.0
0.36 (2009-10-30)
- Added <remote> to j4p-access.xml for restricting
access to certain hosts or subnets only.
- Added support for a JDK 1.4 agent war. The feature base for
this agent is frozen. It might even vanish in the future.
You need a JDK 1.4 agent for running within Weblogic 8.1
- Cleaned up j4p agent with help of sonar and associated
metric checkers like PMD, check_style and FindBugs.
- Added support for config files in jmx4perl and JMX::Jmx4Perl
which allows for shortcuts for agent URL as well as storing
user and credentials information.
- Fixed some bugs
0.35 (2009-08-15)
- Added example 'threadDump.pl'
- Fixed bug when serializing floats and doubles.
- check_jmx4perl:
* Added support for checking string and boolean values
* Escaping performance data
* Include units-of-measurement in the plugin output
* Custom labeling of plugin output
* Perfdata contains always absolute values, even when
used with --base
0.30 (2009-07-31)
- Fixed permission issue while running 'Build dist'
- Fixed URL generation for Websphere
- Added support for generic Bean serialization
- Added 'search' command to jmx4perl
- Fixed bug when using pathes with multiple components
- Added additional parameters 'max_depth', 'max_list_size' and
'max_objects' to restrict the size of the JSON answer. Protocol
has changed as well a bit.
- jmx4perl: URL now as first argument for easier workflow when using
bash history for repeated usage.
- Added support for restricting MBean access via a policy file
(j4p-access.xml)
0.21 (2009-07-03)
- Added '--proxy' for check_jmx4perl and jmx4perl
- check_jmx4perl:
+ Refactored to work within the embedded Nagios Perl interpreter
(ePN)
+ use relative values in the range from 0 to 100%
(for --critical and --warning) instead of [0..1]
+ Renamed '--base-value' to '--base' since it can take now
absolute values (numbers) or "mbean/alias/path" tuples as an
argument in addition to alias names.
+ Added '--operation' which allows for using return values of
operations as check values
+ Added ~ 50 integration tests
0.20 (2009-06-28)
- Support for writing attributes and executing operations
- Documentation fixes
- Tested for WebLogic 9. New initial support for Websphere 6.1 and
7.0
- New "version" command to j4p-agent
- New "search" j4p-agent command for querying for MBean names
- Added '--base-alias' to check_jmx4perl for using relative
thresholds
- Added '--delta' to check_jmx4perl for using an incremental
mode
- Cleaned up check_jmx4perl perfdata output
- Added own j4p-agent MBean for configuration management
(history tracking and debugging info)
- JMX::Jmx4Perl has new request short-cuts 'set_attribute' and
'execute'
- Renamed j4p-agent.war to j4p.war
- Started integration test suite below "it/" and "agent/modules/j4p-it"
for installing some test beans
- Cleaned up maven integration for the agent servlet
- Moved repository to git://github.com/rhuss/jmx4perl.git
0.16
- Switched off debugging in agent servlet
- Fixed syntax error when using 'jmx4perl -v attributes'
- Fixed Jetty Handler.
0.15
- Aliasing
- Autodetection
- Command line tool "jmx4perl"
* reading of attributes
* listing of all availabel attributes and operations.
* listing of all attribute values
* print server info
* print all available aliases
- Bug Fixes:
* Correct URL encoding for request URL
* Slash '/' needs to be custom encoded, since URI encoding doesn't
work for JBoss 4/5 due to a bug
- Tested to work on JBoss 4 & 5, Oracle WebLogic 10, Jonas 4, Geronimo 2,
Glassfish 2, Tomcat 4-6 and Jetty 5 & 6
0.1
- Initial release
- check_jmx4perl

910
LICENSE Normal file
View File

@ -0,0 +1,910 @@
jmx4perl is released under the GNU General Public License, Version 2
or later (see below).
Module::Build included for the best installation experience is released under the
same terms as Perl itself, i.e. GPL V1 or later or the Artistic License. The full
license for Module::Build is appended below.
==============================================================================
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.
===========================================================================
Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
1. Definitions.
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
===========================================================================
License for Module::Build:
--------------------------
This software is copyright (c) 2009 by Ken Williams <kwilliams@cpan.org> & Development questions, bug reports, and patches should be sent to the
Module-Build mailing list at <module-build@perl.org>..
This is free software; you can redistribute it and/or modify it under
the same terms as perl itself.
Terms of Perl itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2009 by Ken Williams <kwilliams@cpan.org> & Development questions, bug reports, and patches should be sent to the
Module-Build mailing list at <module-build@perl.org>..
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- The Artistic License 1.0 ---
This software is Copyright (c) 2009 by Ken Williams <kwilliams@cpan.org> & Development questions, bug reports, and patches should be sent to the
Module-Build mailing list at <module-build@perl.org>..
This is free software, licensed under:
The Artistic License 1.0
The Artistic License
Preamble
The intent of this document is to state the conditions under which a Package
may be copied, such that the Copyright Holder maintains some semblance of
artistic control over the development of the package, while giving the users of
the package the right to use and distribute the Package in a more-or-less
customary fashion, plus the right to make reasonable modifications.
Definitions:
- "Package" refers to the collection of files distributed by the Copyright
Holder, and derivatives of that collection of files created through
textual modification.
- "Standard Version" refers to such a Package if it has not been modified,
or has been modified in accordance with the wishes of the Copyright
Holder.
- "Copyright Holder" is whoever is named in the copyright or copyrights for
the package.
- "You" is you, if you're thinking about copying or distributing this Package.
- "Reasonable copying fee" is whatever you can justify on the basis of media
cost, duplication charges, time of people involved, and so on. (You will
not be required to justify it to the Copyright Holder, but only to the
computing community at large as a market that must bear the fee.)
- "Freely Available" means that no fee is charged for the item itself, though
there may be fees involved in handling the item. It also means that
recipients of the item may redistribute it under the same conditions they
received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications derived
from the Public Domain or from the Copyright Holder. A Package modified in such
a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided that
you insert a prominent notice in each changed file stating how and when you
changed that file, and provided that you do at least ONE of the following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or an
equivalent medium, or placing the modifications on a major archive site
such as ftp.uu.net, or by allowing the Copyright Holder to include your
modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict with
standard executables, which must also be provided, and provide a separate
manual page for each non-standard executable that clearly documents how it
differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or executable
form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where to
get the Standard Version.
b) accompany the distribution with the machine-readable source of the Package
with your modifications.
c) accompany any non-standard executables with their corresponding Standard
Version executables, giving the non-standard executables non-standard
names, and clearly documenting the differences in manual pages (or
equivalent), together with instructions on where to get the Standard
Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this Package. You
may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End

157
MANIFEST Normal file
View File

@ -0,0 +1,157 @@
Build.PL
CHANGES
config/common.cfg
config/jboss.cfg
config/jboss7.cfg
config/jetty.cfg
config/memory.cfg
config/threads.cfg
config/tomcat.cfg
config/weblogic.cfg
config/glassfish.cfg
config/metrics.cfg
config/wildfly.cfg
config/websphere.cfg
config/websphere/appstate.cfg
config/websphere/http.cfg
config/websphere/jca.cfg
config/websphere/jdbc.cfg
config/websphere/jms.cfg
config/websphere/threads.cfg
examples/jsr77.pl
examples/memory.pl
examples/memory.sh
examples/remote.pl
examples/threadDump.pl
inc/Module-Build/Module/Build.pm
inc/Module-Build/Module/Build/API.pod
inc/Module-Build/Module/Build/Authoring.pod
inc/Module-Build/Module/Build/Base.pm
inc/Module-Build/Module/Build/Compat.pm
inc/Module-Build/Module/Build/Config.pm
inc/Module-Build/Module/Build/ConfigData.pm
inc/Module-Build/Module/Build/Cookbook.pm
inc/Module-Build/Module/Build/Dumper.pm
inc/Module-Build/Module/Build/ModuleInfo.pm
inc/Module-Build/Module/Build/Notes.pm
inc/Module-Build/Module/Build/Platform/aix.pm
inc/Module-Build/Module/Build/Platform/Amiga.pm
inc/Module-Build/Module/Build/Platform/cygwin.pm
inc/Module-Build/Module/Build/Platform/darwin.pm
inc/Module-Build/Module/Build/Platform/Default.pm
inc/Module-Build/Module/Build/Platform/EBCDIC.pm
inc/Module-Build/Module/Build/Platform/MacOS.pm
inc/Module-Build/Module/Build/Platform/MPEiX.pm
inc/Module-Build/Module/Build/Platform/os2.pm
inc/Module-Build/Module/Build/Platform/RiscOS.pm
inc/Module-Build/Module/Build/Platform/Unix.pm
inc/Module-Build/Module/Build/Platform/VMS.pm
inc/Module-Build/Module/Build/Platform/VOS.pm
inc/Module-Build/Module/Build/Platform/Windows.pm
inc/Module-Build/Module/Build/PodParser.pm
inc/Module-Build/Module/Build/PPMMaker.pm
inc/Module-Build/Module/Build/Version.pm
inc/Module-Build/Module/Build/YAML.pm
it/check_jmx4perl/base.cfg
it/check_jmx4perl/base.pl
it/check_jmx4perl/checks.cfg
it/check_jmx4perl/multi_check.cfg
it/it.pl
it/t/01_version.t
it/t/02_http_header.t
it/t/10_base.t
it/t/30_naming.t
it/t/40_alias.t
it/t/50_check_base.t
it/t/51_check_relative.t
it/t/52_check_operation.t
it/t/53_check_non_numeric.t
it/t/54_check_unit.t
it/t/55_check_incremental.t
it/t/56_check_value.t
it/t/57_check_config.t
it/t/58_check_multi_config.t
it/t/59_check_timeout.t
it/t/60_bulk_request.t
it/t/70_overloaded_method.t
it/t/80_read.t
it/t/85_path_escaping.t
it/t/90_search.t
it/t/95_cors.t
it/t/83_write.t
it/t/84_exec.t
it/t/64_check_perfdata.t
lib/JMX/Jmx4Perl.pm
lib/JMX/Jmx4Perl/Agent.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/ArtifactHandler.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/DownloadAgent.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Logger.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Meta.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/ChecksumVerifier.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/GnuPGVerifier.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/MD5Verifier.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/OpenPGPVerifier.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/PGPKey.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/SHA1Verifier.pm
lib/JMX/Jmx4Perl/Agent/Jolokia/WebXmlHandler.pm
lib/JMX/Jmx4Perl/Agent/UserAgent.pm
lib/JMX/Jmx4Perl/Alias.pm
lib/JMX/Jmx4Perl/Alias/Object.pm
lib/JMX/Jmx4Perl/Config.pm
lib/JMX/Jmx4Perl/J4psh.pm
lib/JMX/Jmx4Perl/J4psh/Command.pm
lib/JMX/Jmx4Perl/J4psh/Command/Global.pm
lib/JMX/Jmx4Perl/J4psh/Command/MBean.pm
lib/JMX/Jmx4Perl/J4psh/Command/Server.pm
lib/JMX/Jmx4Perl/J4psh/CommandHandler.pm
lib/JMX/Jmx4Perl/J4psh/CompletionHandler.pm
lib/JMX/Jmx4Perl/J4psh/ServerHandler.pm
lib/JMX/Jmx4Perl/J4psh/Shell.pm
lib/JMX/Jmx4Perl/Manual.pod
lib/JMX/Jmx4Perl/Nagios/CactiJmx4Perl.pm
lib/JMX/Jmx4Perl/Nagios/CheckJmx4Perl.pm
lib/JMX/Jmx4Perl/Nagios/SingleCheck.pm
lib/JMX/Jmx4Perl/Nagios/MessageHandler.pm
lib/JMX/Jmx4Perl/Product/ActiveMQ.pm
lib/JMX/Jmx4Perl/Product/BaseHandler.pm
lib/JMX/Jmx4Perl/Product/Geronimo.pm
lib/JMX/Jmx4Perl/Product/Glassfish.pm
lib/JMX/Jmx4Perl/Product/Hadoop.pm
lib/JMX/Jmx4Perl/Product/JBoss.pm
lib/JMX/Jmx4Perl/Product/Jetty.pm
lib/JMX/Jmx4Perl/Product/Jonas.pm
lib/JMX/Jmx4Perl/Product/Resin.pm
lib/JMX/Jmx4Perl/Product/SpringDM.pm
lib/JMX/Jmx4Perl/Product/Terracotta.pm
lib/JMX/Jmx4Perl/Product/Tomcat.pm
lib/JMX/Jmx4Perl/Product/Unknown.pm
lib/JMX/Jmx4Perl/Product/Weblogic.pm
lib/JMX/Jmx4Perl/Product/Websphere.pm
lib/JMX/Jmx4Perl/Request.pm
lib/JMX/Jmx4Perl/Response.pm
lib/JMX/Jmx4Perl/Util.pm
LICENSE
MANIFEST This list of files
META.json
META.yml
README
scripts/cacti_jmx4perl
scripts/check_jmx4perl
scripts/j4psh
scripts/jmx4perl
scripts/jolokia
t/10_handler.t
t/20_alias.t
t/30_request.t
t/40_check_jmx4perl.t
t/50_config.t
t/60_parse_name.t
t/70_pod_syntax.t
it/t/99_discovery.t
t/j4p_test.cfg
t/lib/It.pm
t/lib/ProductTest/Test1Handler.pm
t/lib/ProductTest/Test2Handler.pm
docker/Dockerfile
docker/README.md

221
META.json Normal file
View File

@ -0,0 +1,221 @@
{
"abstract" : "Easy JMX access to Java EE applications",
"author" : [
"Roland Huss (roland@cpan.org)"
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.4211",
"license" : [
"gpl_1"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "jmx4perl",
"prereqs" : {
"build" : {
"requires" : {
"Module::Build" : "0.34",
"Test::More" : "0"
}
},
"configure" : {
"requires" : {
"Module::Build" : "0.34"
}
},
"runtime" : {
"requires" : {
"Archive::Zip" : "0",
"Carp" : "0",
"Config::General" : "2.34",
"Crypt::Blowfish_PP" : "0",
"Data::Dumper" : "0",
"Digest::MD5" : "0",
"Digest::SHA1" : "0",
"File::SearchPath" : "0",
"File::Temp" : "0",
"Getopt::Long" : "0",
"IO::Socket::Multicast" : "0",
"JSON" : "2.12",
"LWP::UserAgent" : "0",
"Module::Find" : "0",
"Monitoring::Plugin" : "0.37",
"Pod::Usage" : "0",
"Scalar::Util" : "0",
"Sys::SigAction" : "0",
"Term::Clui" : "0",
"Term::ProgressBar" : "0",
"Term::ShellUI" : "0",
"Term::Size" : "0.207",
"Text::ParseWords" : "0",
"Time::HiRes" : "0",
"URI" : "1.35",
"XML::LibXML" : "0",
"XML::Twig" : "0",
"base" : "0"
}
}
},
"provides" : {
"JMX::Jmx4Perl" : {
"file" : "lib/JMX/Jmx4Perl.pm",
"version" : "1.12"
},
"JMX::Jmx4Perl::Agent" : {
"file" : "lib/JMX/Jmx4Perl/Agent.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::ArtifactHandler" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/ArtifactHandler.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/DownloadAgent.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Logger" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Logger.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Logger::None" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Logger.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Meta" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Meta.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Verifier" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/ChecksumVerifier.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Verifier::GnuPGVerifier" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/GnuPGVerifier.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Verifier::MD5Verifier" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/MD5Verifier.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Verifier::OpenPGPVerifier" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/OpenPGPVerifier.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/PGPKey.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::Verifier::SHA1Verifier" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/SHA1Verifier.pm"
},
"JMX::Jmx4Perl::Agent::Jolokia::WebXmlHandler" : {
"file" : "lib/JMX/Jmx4Perl/Agent/Jolokia/WebXmlHandler.pm"
},
"JMX::Jmx4Perl::Agent::UserAgent" : {
"file" : "lib/JMX/Jmx4Perl/Agent/UserAgent.pm"
},
"JMX::Jmx4Perl::Alias" : {
"file" : "lib/JMX/Jmx4Perl/Alias.pm"
},
"JMX::Jmx4Perl::Alias::Object" : {
"file" : "lib/JMX/Jmx4Perl/Alias/Object.pm"
},
"JMX::Jmx4Perl::Config" : {
"file" : "lib/JMX/Jmx4Perl/Config.pm"
},
"JMX::Jmx4Perl::J4psh" : {
"file" : "lib/JMX/Jmx4Perl/J4psh.pm"
},
"JMX::Jmx4Perl::J4psh::Command" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/Command.pm"
},
"JMX::Jmx4Perl::J4psh::Command::Global" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/Command/Global.pm"
},
"JMX::Jmx4Perl::J4psh::Command::MBean" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/Command/MBean.pm"
},
"JMX::Jmx4Perl::J4psh::Command::Server" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/Command/Server.pm"
},
"JMX::Jmx4Perl::J4psh::CommandHandler" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/CommandHandler.pm"
},
"JMX::Jmx4Perl::J4psh::CompletionHandler" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/CompletionHandler.pm"
},
"JMX::Jmx4Perl::J4psh::ServerHandler" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/ServerHandler.pm"
},
"JMX::Jmx4Perl::J4psh::Shell" : {
"file" : "lib/JMX/Jmx4Perl/J4psh/Shell.pm"
},
"JMX::Jmx4Perl::Nagios::CactiJmx4Perl" : {
"file" : "lib/JMX/Jmx4Perl/Nagios/CactiJmx4Perl.pm"
},
"JMX::Jmx4Perl::Nagios::CheckJmx4Perl" : {
"file" : "lib/JMX/Jmx4Perl/Nagios/CheckJmx4Perl.pm"
},
"JMX::Jmx4Perl::Nagios::MessageHandler" : {
"file" : "lib/JMX/Jmx4Perl/Nagios/MessageHandler.pm"
},
"JMX::Jmx4Perl::Nagios::SingleCheck" : {
"file" : "lib/JMX/Jmx4Perl/Nagios/SingleCheck.pm"
},
"JMX::Jmx4Perl::Product::ActiveMQ" : {
"file" : "lib/JMX/Jmx4Perl/Product/ActiveMQ.pm"
},
"JMX::Jmx4Perl::Product::BaseHandler" : {
"file" : "lib/JMX/Jmx4Perl/Product/BaseHandler.pm"
},
"JMX::Jmx4Perl::Product::Geronimo" : {
"file" : "lib/JMX/Jmx4Perl/Product/Geronimo.pm"
},
"JMX::Jmx4Perl::Product::Glassfish" : {
"file" : "lib/JMX/Jmx4Perl/Product/Glassfish.pm"
},
"JMX::Jmx4Perl::Product::Hadoop" : {
"file" : "lib/JMX/Jmx4Perl/Product/Hadoop.pm"
},
"JMX::Jmx4Perl::Product::JBoss" : {
"file" : "lib/JMX/Jmx4Perl/Product/JBoss.pm"
},
"JMX::Jmx4Perl::Product::Jetty" : {
"file" : "lib/JMX/Jmx4Perl/Product/Jetty.pm"
},
"JMX::Jmx4Perl::Product::Jonas" : {
"file" : "lib/JMX/Jmx4Perl/Product/Jonas.pm"
},
"JMX::Jmx4Perl::Product::Resin" : {
"file" : "lib/JMX/Jmx4Perl/Product/Resin.pm"
},
"JMX::Jmx4Perl::Product::SpringDM" : {
"file" : "lib/JMX/Jmx4Perl/Product/SpringDM.pm"
},
"JMX::Jmx4Perl::Product::Terracotta" : {
"file" : "lib/JMX/Jmx4Perl/Product/Terracotta.pm"
},
"JMX::Jmx4Perl::Product::Tomcat" : {
"file" : "lib/JMX/Jmx4Perl/Product/Tomcat.pm"
},
"JMX::Jmx4Perl::Product::Unknown" : {
"file" : "lib/JMX/Jmx4Perl/Product/Unknown.pm"
},
"JMX::Jmx4Perl::Product::Weblogic" : {
"file" : "lib/JMX/Jmx4Perl/Product/Weblogic.pm"
},
"JMX::Jmx4Perl::Product::Websphere" : {
"file" : "lib/JMX/Jmx4Perl/Product/Websphere.pm"
},
"JMX::Jmx4Perl::Request" : {
"file" : "lib/JMX/Jmx4Perl/Request.pm"
},
"JMX::Jmx4Perl::Response" : {
"file" : "lib/JMX/Jmx4Perl/Response.pm"
},
"JMX::Jmx4Perl::Util" : {
"file" : "lib/JMX/Jmx4Perl/Util.pm"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://opensource.org/licenses/gpl-license.php"
]
},
"version" : "1.12"
}

150
META.yml Normal file
View File

@ -0,0 +1,150 @@
---
abstract: 'Easy JMX access to Java EE applications'
author:
- 'Roland Huss (roland@cpan.org)'
build_requires:
Module::Build: '0.34'
Test::More: '0'
configure_requires:
Module::Build: '0.34'
dynamic_config: 1
generated_by: 'Module::Build version 0.4211, CPAN::Meta::Converter version 2.150001'
license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: jmx4perl
provides:
JMX::Jmx4Perl:
file: lib/JMX/Jmx4Perl.pm
version: '1.12'
JMX::Jmx4Perl::Agent:
file: lib/JMX/Jmx4Perl/Agent.pm
JMX::Jmx4Perl::Agent::Jolokia::ArtifactHandler:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/ArtifactHandler.pm
JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/DownloadAgent.pm
JMX::Jmx4Perl::Agent::Jolokia::Logger:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Logger.pm
JMX::Jmx4Perl::Agent::Jolokia::Logger::None:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Logger.pm
JMX::Jmx4Perl::Agent::Jolokia::Meta:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Meta.pm
JMX::Jmx4Perl::Agent::Jolokia::Verifier:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier.pm
JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/ChecksumVerifier.pm
JMX::Jmx4Perl::Agent::Jolokia::Verifier::GnuPGVerifier:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/GnuPGVerifier.pm
JMX::Jmx4Perl::Agent::Jolokia::Verifier::MD5Verifier:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/MD5Verifier.pm
JMX::Jmx4Perl::Agent::Jolokia::Verifier::OpenPGPVerifier:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/OpenPGPVerifier.pm
JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/PGPKey.pm
JMX::Jmx4Perl::Agent::Jolokia::Verifier::SHA1Verifier:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/SHA1Verifier.pm
JMX::Jmx4Perl::Agent::Jolokia::WebXmlHandler:
file: lib/JMX/Jmx4Perl/Agent/Jolokia/WebXmlHandler.pm
JMX::Jmx4Perl::Agent::UserAgent:
file: lib/JMX/Jmx4Perl/Agent/UserAgent.pm
JMX::Jmx4Perl::Alias:
file: lib/JMX/Jmx4Perl/Alias.pm
JMX::Jmx4Perl::Alias::Object:
file: lib/JMX/Jmx4Perl/Alias/Object.pm
JMX::Jmx4Perl::Config:
file: lib/JMX/Jmx4Perl/Config.pm
JMX::Jmx4Perl::J4psh:
file: lib/JMX/Jmx4Perl/J4psh.pm
JMX::Jmx4Perl::J4psh::Command:
file: lib/JMX/Jmx4Perl/J4psh/Command.pm
JMX::Jmx4Perl::J4psh::Command::Global:
file: lib/JMX/Jmx4Perl/J4psh/Command/Global.pm
JMX::Jmx4Perl::J4psh::Command::MBean:
file: lib/JMX/Jmx4Perl/J4psh/Command/MBean.pm
JMX::Jmx4Perl::J4psh::Command::Server:
file: lib/JMX/Jmx4Perl/J4psh/Command/Server.pm
JMX::Jmx4Perl::J4psh::CommandHandler:
file: lib/JMX/Jmx4Perl/J4psh/CommandHandler.pm
JMX::Jmx4Perl::J4psh::CompletionHandler:
file: lib/JMX/Jmx4Perl/J4psh/CompletionHandler.pm
JMX::Jmx4Perl::J4psh::ServerHandler:
file: lib/JMX/Jmx4Perl/J4psh/ServerHandler.pm
JMX::Jmx4Perl::J4psh::Shell:
file: lib/JMX/Jmx4Perl/J4psh/Shell.pm
JMX::Jmx4Perl::Nagios::CactiJmx4Perl:
file: lib/JMX/Jmx4Perl/Nagios/CactiJmx4Perl.pm
JMX::Jmx4Perl::Nagios::CheckJmx4Perl:
file: lib/JMX/Jmx4Perl/Nagios/CheckJmx4Perl.pm
JMX::Jmx4Perl::Nagios::MessageHandler:
file: lib/JMX/Jmx4Perl/Nagios/MessageHandler.pm
JMX::Jmx4Perl::Nagios::SingleCheck:
file: lib/JMX/Jmx4Perl/Nagios/SingleCheck.pm
JMX::Jmx4Perl::Product::ActiveMQ:
file: lib/JMX/Jmx4Perl/Product/ActiveMQ.pm
JMX::Jmx4Perl::Product::BaseHandler:
file: lib/JMX/Jmx4Perl/Product/BaseHandler.pm
JMX::Jmx4Perl::Product::Geronimo:
file: lib/JMX/Jmx4Perl/Product/Geronimo.pm
JMX::Jmx4Perl::Product::Glassfish:
file: lib/JMX/Jmx4Perl/Product/Glassfish.pm
JMX::Jmx4Perl::Product::Hadoop:
file: lib/JMX/Jmx4Perl/Product/Hadoop.pm
JMX::Jmx4Perl::Product::JBoss:
file: lib/JMX/Jmx4Perl/Product/JBoss.pm
JMX::Jmx4Perl::Product::Jetty:
file: lib/JMX/Jmx4Perl/Product/Jetty.pm
JMX::Jmx4Perl::Product::Jonas:
file: lib/JMX/Jmx4Perl/Product/Jonas.pm
JMX::Jmx4Perl::Product::Resin:
file: lib/JMX/Jmx4Perl/Product/Resin.pm
JMX::Jmx4Perl::Product::SpringDM:
file: lib/JMX/Jmx4Perl/Product/SpringDM.pm
JMX::Jmx4Perl::Product::Terracotta:
file: lib/JMX/Jmx4Perl/Product/Terracotta.pm
JMX::Jmx4Perl::Product::Tomcat:
file: lib/JMX/Jmx4Perl/Product/Tomcat.pm
JMX::Jmx4Perl::Product::Unknown:
file: lib/JMX/Jmx4Perl/Product/Unknown.pm
JMX::Jmx4Perl::Product::Weblogic:
file: lib/JMX/Jmx4Perl/Product/Weblogic.pm
JMX::Jmx4Perl::Product::Websphere:
file: lib/JMX/Jmx4Perl/Product/Websphere.pm
JMX::Jmx4Perl::Request:
file: lib/JMX/Jmx4Perl/Request.pm
JMX::Jmx4Perl::Response:
file: lib/JMX/Jmx4Perl/Response.pm
JMX::Jmx4Perl::Util:
file: lib/JMX/Jmx4Perl/Util.pm
requires:
Archive::Zip: '0'
Carp: '0'
Config::General: '2.34'
Crypt::Blowfish_PP: '0'
Data::Dumper: '0'
Digest::MD5: '0'
Digest::SHA1: '0'
File::SearchPath: '0'
File::Temp: '0'
Getopt::Long: '0'
IO::Socket::Multicast: '0'
JSON: '2.12'
LWP::UserAgent: '0'
Module::Find: '0'
Monitoring::Plugin: '0.37'
Pod::Usage: '0'
Scalar::Util: '0'
Sys::SigAction: '0'
Term::Clui: '0'
Term::ProgressBar: '0'
Term::ShellUI: '0'
Term::Size: '0.207'
Text::ParseWords: '0'
Time::HiRes: '0'
URI: '1.35'
XML::LibXML: '0'
XML::Twig: '0'
base: '0'
resources:
license: http://opensource.org/licenses/gpl-license.php
version: '1.12'

148
README Normal file
View File

@ -0,0 +1,148 @@
Jmx4Perl
========
INTRODUCTION
Jmx4Perl provides an alternate way for accessing Java JEE Server
management interfaces which are based on JMX (Java Management
Extensions). It is an agent based approach, where a small Java
Webapplication deployed on the application server provides an
HTTP/JSON based access to JMX MBeans registered within the
application server.
HOW IT WORKS
For the agent mode a small Java Agent WAR (web archive) needs to be
deployed on the Java application server. This agent is provided by
the Jolokia project (www.jolokia.org). There is no need to add any
startup parameters to the application server and to open any
additional ports. All communication takes places via HTTP where JSON
objects are exchanged. Additionally, the agent benefits from the
security infrastructure in place which every application server
provides for web application. More information about the agent can
be found at http://www.jolokia.org
The Perl module JMX::Jmx4Perl accesses the deployed agent servlet
and transform the request's results from JSON into a simple Perl
object.
TOOLS
This distribution comes with several tools, which uses the
JMX::Jmx4Perl for accessing the server:
jmx4perl - Command line tool for gathering JMX information
check_jmx4perl - Full featured Nagios Plugin
j4psh - Interactive, readline based JMX shell with context
sensitive command completion
jolokia - Utility for downloading and managing Jolokia
agents.
INSTALLATION
The Perl part installs as any other module via Module::Build, which
you need to have installed. Using
perl Build.PL
./Build installdeps # If there are dependencies missing and you
# have Module::Build >= 0.36 installed.
./Build
./Build test
./Build install
will install the modules. It is highly recommended to install the
recommended dependent modules, too to get the full jmx4perl
power. The set of 'required' modules is kept small and guarantees
only that 'jmx4perl' and the modules around JMX::Jmx4Perl are
working properly. The other tools (check_jmx4perl, j4psh and
jolokia) require the recommended modules for proper working. Look
into Build.PL for which tool requires which module.
In order to download the Jolokia WAR agent into the local directory
as jolokia.war, use the following command
jolokia
This agent "jolokia.war" needs to be deployed on the JEE Server to
monitor. Please consult http://www.jolokia.org/agent.html for more
information how to install the agent. E.g. for Tomcat this war file
needs to be copied into the webapps directory.
To test it, you can use 'jmx4perl' with the URL of the deployed
agent:
jmx4perl http://<jeeserver>:<port>/jolokia
Consult 'man jmx4perl' for more information about this command
utility.
RESOURCES
* Jmx4perl's source is hosted on github.com. You can clone the
repository with git://github.com/rhuss/jmx4perl.git as URL
* Interesting articles around Jmx4Perl, JMX and Nagios can be found
at http://labs.consol.de Checkout the various post categories for
selecting a specific topic.
* www.jmx4perl.org is the canonical entry point for jmx4perl related
information.
NOTE
For you convenience, the latest Module::Build is included in this
distribution, so there is no need of a locally install Module::Build
for installing this suite. More information about Module::Build can
be found http://search.cpan.org/~dagolden/Module-Build/
LICENSE
Copyright (C) 2009-2011 Roland Huss (roland@cpan.org)
Jmx4perl is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. You can either apply the
GPL or obtain a commercial license for closed source
development. Please contact roland@cpan.org for further information.
PROFESSIONAL SERVICES
Just in case you need professional support for this module (or
Nagios, JMX or JEE in general), you might want to have a look at
http://www.consol.com/nagios-monitoring . Contact
roland.huss@consol.de for further information (or use the contact
form at http://www.consol.com/contact/ )
ACKNOWLEDGMENTS
Big thanks go to ...
* Gerhard Lausser, who initially pushed me to think harder
about a better way for monitoring JEE Servers with Nagios.
* Danijel Tasov for patching, patching, patching and keeping
an eye on contemporary perl styling.
* All bug reporters and blog commenters for helping me to
increase the overall quality (and for letting me know that
this is not software for the ivory tower)
BUGS
Please report any bugs and/or feature requests at
http://rt.cpan.org/Public/Bug/Report.html?Queue=jmx4perl
AUTHOR
roland@cpan.org

34
config/common.cfg Normal file
View File

@ -0,0 +1,34 @@
# Common check definitions which can be used
# as a base for more specific configurations
# This are mostly convenience, abstract checks
# which are meant to be mixed into more concrete
# checks
# =================================================
# A nice label to be used for relative values
<Check relative_base>
Label = %.2r% used (%.2v %u / %.2b %w)
# Default values for critical (90%) and warning (80%) thresholds
Critical = ${0:90}
Warning = ${1:80}
</Check>
# A incremental check for values per minute
# $0: used in label to specify what is counted
# per minute
<Check count_per_minute>
Label = %2.2f $0/minute
Delta = 60
</Check>
# A incremental check for values per hour
# $0: used in label to specify what is counted
# per hour
<Check count_per_hour>
Label = %2.2f $0/hour
Delta = 3600
</Check>

69
config/glassfish.cfg Normal file
View File

@ -0,0 +1,69 @@
# Glassfish specific checks
# ===========================
# =================
# JMS with Open MQ
# For even more metrics, please refer to http://docs.oracle.com/cd/E19316-01/820-6766/gcakw/index.html
# Number of messages within a queue
# $0: Name of queue
# $1: Critical (default: 1000)
# $2: Warning (default: 800)
<Check gf_omq_queue_count>
MBean = com.sun.messaging.jms.server:name="$0",subtype=Monitor,type=Destination,desttype=q
Attribute = NumMsgs
Name = JMS Queue $0 Count
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Number of messages held for a topic
# $0: Name of queue
# $1: Critical (default: 1000)
# $2: Warning (default: 800)
<Check gf_omq_topic_count>
MBean = com.sun.messaging.jms.server:name="$0",subtype=Monitor,type=Destination,desttype=t
Attribute = NumMsgs
Name = JMS Topic $0 Count
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Average number of consumers of a topic or queue
# $0: Name of queue or topic
# $1: Critical (default: 300)
# $2: Warning (default: 200)
<Check gf_omq_consumers_avg>
MBean = com.sun.messaging.jms.server:name="$0",subtype=Monitor,type=Destination,*
Attribute = AvgNumConsumers
Name = Average Number of consumers for $0
Critical = ${1:300}
Warning = ${2:200}
</Check>
# Active number of consumers of a topic or queue
# $0: Name of queue or topic
# $1: Critical (default: 300)
# $2: Warning (default: 200)
<Check gf_omq_consumers_active>
MBean = com.sun.messaging.jms.server:name="$0",subtype=Monitor,type=Destination,*
Attribute = NumActiveConsumers
Name = Number of consumers of $0
Critical = ${1:300}
Warning = ${2:200}
</Check>
# Size of all messages within a queue or topic
# $0: Name of queue or topic
# $1: Critical (default: 30 MB)
# $2: Warning (default: 20 MB)
<Check gf_omq_message_byte>
MBean = com.sun.messaging.jms.server:name="$0",subtype=Monitor,type=Destination,*
Attribute = TotalMsgBytes
Name = Size of messages in $0
Critical = ${1:30000000}
Warning = ${2:20000000}
</Check>

111
config/jboss.cfg Normal file
View File

@ -0,0 +1,111 @@
# JBoss specific checks
# ========================================================
# JBoss uses tomcat internally
include tomcat.cfg
# =======================================================
# Connection-Pools:
# Available connections in a connection pool for a data source
# Should be not 0
# $0: Datasource name
<Check jboss_cpool_available>
MBean = *:service=ManagedConnectionPool,name=$0
Attribute = AvailableConnectionCount
Name = $0 : Available connections
Critical = $1
Warning = $2
</Check>
# The reverse: Max. number of connections ever in use
# $0: Datasource name
<Check jboss_cpool_used_max>
MBean = *:service=ManagedConnectionPool,name=$0
Attribute = MaxConnectionsInUseCount
Name = $0 : Max. connections in use
Critical = $1
Warning = $2
</Check>
# Connections currently in use
# $0: Datasource name
<Check jboss_cpool_used>
MBean = *:service=ManagedConnectionPool,name=$0
Attribute = InUseConnectionCount
Name = $0 : Connections in use
Critical = $1
Warning = $2
</Check>
# Rate how often connections are created per minute
# $0: Datasource name
<Check jboss_cpool_creation_rate>
Use = count_per_minute("connections")
MBean = *:service=ManagedConnectionPool,name=$0
Attribute = ConnectionCreatedCount
Name = $0 : Connection creation rate
Critical = $1
Warning = $2
</Check>
# =============================================================
# Workmanager
# Ratio of threads used in the JBoss WorkManager
<Check jboss_threads>
Use = relative_base
Value = jboss.jca:service=WorkManagerThreadPool/Instance/poolSize
Base = jboss.jca:service=WorkManagerThreadPool/Instance/maximumPoolSize
Label = WorkManager Threads: $BASE
Name = WorkManager Threads
</Check>
<Check jboss_threads_2>
Use = relative_base
Value = jboss.threads:name=WorkManagerThreadPool/CurrentThreadCount
Base = jboss.threads:name=WorkManagerThreadPool/MaxThreads
Label = WorkManager Threads: $BASE
Name = WorkManager Threads
</Check>
# =============================================================
# JMS
# Rate how fast the number of messages in a JMS queue increases
# $0: Queue name
# $1: Critical (default: 1000)
# $2: Warning (default: 800)
<Check jboss_jms_queue_rate>
Use = count_per_minute("messages")
MBean = *:name=$0,service=Queue
Attribute = MessageCount
Name = JMS Queue $0 : Message count rate
</Check>
# Number of messages in a JMS queue
# $0: Queue name
# $1: Critical (default: 1000)
# $2: Warning (default: 800)
<Check jboss_jms_queue_count>
MBean = *:name=$0,service=Queue
Attribute = MessageCount
Name = JMS Queue $0 Count
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Number of messages in a JMS Topic
# $0: Topic name
# $1: Critical (default: 1000)
# $2: Warning (default: 800)
<Check jboss_jms_topic_count>
MBean = *:name=$0,service=Topic
Attribute = AllMessageCount
Name = JMS Topic $0 Count
Critical = ${1:1000}
Warning = ${2:800}
</Check>

203
config/jboss7.cfg Normal file
View File

@ -0,0 +1,203 @@
# JBoss 7 specific checks
# ========================================================
include "common.cfg"
# Please note that JBoss 7 changed (/wrt JBoss 6) completely with relation to the
# internal MBean structure
# Number of bytes received per minute for a connector
# $0: Name of connector (e.g. 'http-8080')
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_connector_received_rate>
Use = count_per_minute("bytes received")
Label = Connector $0 : $BASE
Name = ${3:bytes_received}
Value = jboss.as.expr:connector=$0,*/bytesReceived
Critical = ${1:104857600}
Warning = ${2:83886080}
</Check>
# Number of bytes sent per minute for a connector
# $0: Name of connector (e.g. 'http-8080')
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_connector_sent_rate>
Use = count_per_minute("bytes sent")
Label = Connector $0 : $BASE
Name = ${3:bytes_sent}
Value = jboss.as.expr:connector=$0,*/bytesSent
Critical = ${1:104857600}
Warning = ${2:83886080}
</Check>
# Increase of overall processing time per minute for a connector
# This checks calculates the processing time for a certain
# interval and scale it to a minute
# $0: Connector name
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_connector_processing_time>
Delta = 60
Label = Connector $0 : %2.0f ms request processing time / minute
Name = ${3:proc_time}
Value = jboss.as.expr:connector=$0,*/processingTime
Critical = ${1:50000}
Warning = ${2:40000}
</Check>
# Requests per minute for a connector
# $0: Connector name
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_connector_requests>
Use = count_per_minute("requests")
Label = Connector $0 : $BASE
Name = ${3:nr_requests}
Value = jboss.as.expr:connector=$0,*/requestCount
Critical = ${1:1000}
Warning = ${2:900}
</Check>
# Number of errors for a connector per minute.
# $0: Connector name
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_connector_error_count>
Value = jboss.as.expr:connector=$0,*/errorCount
Label = Connector $0: %d errors
Name = ${3:errors}
Critical = ${1:100}
Warning = ${2:90}
Delta = 60
</Check>
#################################################################
# Requests per minute for a servlet
# $0: Web-Module name
# $1: Servlet name
# $2: Critical (optional)
# $3: Warning (optional)
# $4: Name (optional)
<Check jboss7_servlet_requests>
MBean = jboss.as.expr:deployment=$0,servlet=$1,subdeployment=*,subsystem=web
Use = count_per_minute("requests")
Attribute = requestCount
Name = ${4:request}
Critical = ${2:6000}
Warning = ${3:5000}
</Check>
# Increase of overall processing time per minute for a servlet module
# This is calculate the processing time for a certain
# interval and extrapolate to a minute
# $0: Webmodule name
# $1: Servlet name
# $2: Critical (optional)
# $3: Warning (optional)
# $4: Name (optional)
<Check jboss7_servlet_processing>
MBean = jboss.as.expr:deployment=$0,servlet=$1,subdeployment=*,subsystem=web
Attribute = processingTime
Delta = 60
Label = %2.0f ms request processing time / minute
Name = ${3:proc_time}
Critical = ${2:50000}
Warning = ${3:40000}
</Check>
# ========================================================
# Session related checks
# Number of active sessions at this moment
# $0: Name of web-module
# $1: Critical (optional)
# $2: Warning (optional)
<Check jboss7_session_active>
MBean = *:deployment=$0,subsystem=web
Attribute = activeSessions
Name = ${3:sessions_active}
Label = $0: Active Sessions = %v
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Maximum number of active sessions so far
# $0: Name of web-module
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_session_active_max>
MBean = *:deployment=$0,subsystem=web
Attribute = maxActive
Name = ${3:sessions_max}
Label = $0: Max-Active Sessions = %v
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Number of sessions we rejected due to maxActive beeing reached
# $0: Name of web-module
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_session_rejected>
MBean = *:deployment=$0,subsystem=web
Attribute = rejectedSessions
Name = ${3:sessions_rejected}
Label = $0: Rejected Sessions = %v
Critical = ${1:500}
Warning = ${2:200}
</Check>
# Average time an expired session had been alive
# in seconds
# $0: Name of web-module
# $1: Critical (7200)
# $2: Warning (7200)
# $3: Name (optional)
<Check jboss7_session_average_lifetime>
MBean = *:deployment=$0,subsystem=web
Attribute = sessionAverageAliveTime
Name = ${3:sessions_avg_life}
Label = $0: Average session lifetime = %v
Critical = ${1:7200}
Warning = ${2:6400}
</Check>
# Longest time an expired session had been alive
# in seconds
# $0: Name of web-module
# $1: Critical (7200)
# $2: Warning (6400)
# $3: Name (optional)
<Check jboss7_session_max_lifetime>
MBean = *:deployment=$0,subsystem=web
Attribute = sessionMaxAliveTime
Name = ${3:sessions_max_life}
Label = $0: Maximum session lifetime = %v
Critical = ${1:7200}
Warning = ${2:6400}
</Check>
# Increase rate of sessions per minute
# $0: Name of web-module
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check jboss7_session_inc>
Use = count_per_minute("sessions")
MBean = *:deployment=$0,subsystem=web
Attribute = sessionCounter
Name = ${3:sessions_inc}
Critical = ${1:1000}
Warning = ${2:900}
</Check>

191
config/jetty.cfg Normal file
View File

@ -0,0 +1,191 @@
# Jetty specific checks
# ========================================================
include common.cfg
# Servlet running
# $0: Name of servlet
<Check jetty_servlet_running>
MBean = org.mortbay.jetty.servlet:name=$0,*
Attribute = running
String = 1
Label = $0 running
Name = $0 running
Critical = false
</Check>
# Servlet failed status
# $0: Name of servlet
<Check jetty_servlet_failed>
MBean = org.mortbay.jetty.servlet:name=$0,*
Attribute = failed
String = 1
Label = $0 failing
Name = $0 failed
Critical = true
</Check>
# Jetty is low on threads ?
<Check jetty_threads_low>
MBean = org.mortbay.thread:type=queuedthreadpool,*
Attribute = lowOnThreads
String = 1
Label = Low on threads
Name = LowOnThreads Flag
Critical = true
</Check>
# Ratio between created threads to maximum threads
# $0: Critical value (default: 90%)
# $1: Warning value (default: 80%)
<Check jetty_threads>
Use = relative_base($0,$1)
Value = org.mortbay.thread:type=queuedthreadpool,*/threads
Base = org.mortbay.thread:type=queuedthreadpool,*/maxThreads
Name = Jetty-Threads
</Check>
# Server is running
<Check jetty_server_running>
MBean = org.mortbay.jetty:type=server,*
Attribute = running
String = 1
Label = Server running
Name = Server running
Critical = false
</Check>
# Server failed
<Check jetty_server_failed>
MBean = org.mortbay.jetty:type=server,*
Attribute = failed
String = 1
Label = Server failing
Name = ServerFailedFlag
Critical = true
</Check>
# =====================================================================
# Sessions
# The maximum number of sessions ever created (overall, all webapps)
# $0: Critical
# $1: Warning
<Check jetty_sessions_max>
MBean = org.mortbay.jetty.servlet:type=hashsessionmanager,*
Attribute = maxSessions
Label = Max Sessions = %v
Name = MaxSessions
Critical = $0
Warning = $1
</Check>
# The current number of sessions (overall, all webapps)
# $0: Critical (default: 1000)
# $1: Warning (default: 800)
<Check jetty_sessions>
MBean = org.mortbay.jetty.servlet:type=hashsessionmanager,*
Attribute = sessions
Label = Sessions = %v
Name = Sessions
Critical = ${0:1000}
Warning = ${1:800}
</Check>
# =====================================================================
# Requests
# The overall requests / minute
# 'statsOn' has to be set to true in jetty.xml for letting jetty collects
# statistics information for the overall connector
# $0: Critical (default: 6000)
# $1: Warning (default: 5000)
<Check jetty_request_nio>
Use = count_per_minute("requests")
MBean = org.mortbay.jetty.nio:type=selectchannelconnector,*
Attribute = requests
Name = Requests
Critical = ${0:6000}
Warning = ${1:5000}
</Check>
# Number of accepted connections ('statsOn' must be set)
# $0: Critical (default: 6000)
# $1: Warning (default: 5000)
<Check jetty_connections>
Use = count_per_minute("connections")
MBean = org.mortbay.jetty.nio:type=selectchannelconnector,*
Attribute = connections
Name = Connections
Critical = ${0:6000}
Warning = ${1:5000}
</Check>
# Number of open connections ('statsOn' must be set)
# $0: Critical (default: 1000)
# $1: Warning (default: 900)
<Check jetty_connections_open>
MBean = org.mortbay.jetty.nio:type=selectchannelconnector,*
Attribute = connectionsOpen
Name = ConnectionsOpen
Label = Open connections = %v
Critical = ${0:1000}
Warning = ${1:900}
</Check>
# ========================================================================
# Add $JETTY_HOME/etc/jetty-stats.xml to the configuration for collecting per
# request duration statistics.
#
# See also http://communitymapbuilder.osgeo.org/display/JETTY/Statistics
# for details
# Average duration of a request in ms
# $0: Critical (default: 400ms)
# $1: Warning (default: 300ms)
<Check jetty_request_duration_average>
MBean = org.mortbay.jetty.handler:type=statisticshandler,*
Attribute = requestsDurationAve
Name = RequestDurationAverage
Label = Average Request Duration = %v ms
Critical = ${0:400}
Warning = ${1:300}
</Check>
# Maximum duration of any request in ms
# $0: Critical (default: 400ms)
# $1: Warning (default: 300ms)
<Check jetty_request_duration_max>
MBean = org.mortbay.jetty.handler:type=statisticshandler,*
Attribute = requestsDurationMax
Name = RequestDurationMaximum
Label = Maximum Request Duration = %v ms
Critical = ${0:1000}
Warning = ${1:900}
</Check>
# Number of Requests per minute
# $0: Critical (default: 6000)
# $1: Warning (default: 5000)
<Check jetty_request_rate>
Use = count_per_minute("requests")
MBean = org.mortbay.jetty.handler:type=statisticshandler,*
Attribute = requests
Name = Requests
Critical = ${0:6000}
Warning = ${1:5000}
</Check>
# Number of currently active requests
# $0: Critical (default: 1000)
# $1: Warning (default: 900)
<Check jetty_request_active>
MBean = org.mortbay.jetty.handler:type=statisticshandler,*
Attribute = requestsActive
Name = ActiveRequests
Label = Active Requests = %v
Critical = ${0:1000}
Warning = ${1:900}
</Check>

200
config/memory.cfg Normal file
View File

@ -0,0 +1,200 @@
# Memory checks
# ============================================
include common.cfg
# Base definition for memory relative checks
# (i.e. checks with a base value). Should
# not be used directly
<Check memory_relative_base>
Use = relative_base($0,$1)
Unit = B
BaseUnit = B
</Check>
# Relative Heap Memory used by the application. This
# is the ratio between used heap memory and the maximal
# available heap memory
# $0: Critical value (optional)
# $1: Warning value (optional)
<Check memory_heap>
Use = memory_relative_base($0,$1)
Value = java.lang:type=Memory/HeapMemoryUsage/used
Base = java.lang:type=Memory/HeapMemoryUsage/max
Label = Heap-Memory: $BASE
Name = Heap
MultiCheckPrefix
</Check>
# Relative non-heap memory. The JVM has memory other than the heap,
# referred to as non-heap memory. It stores per-class structures such
# as runtime constant pool, field and method data, and the code for
# methods and constructors, as well as interned Strings. More detailed
# information can be obtained from the pool checks defined below
# $0: Critical value (optional)
# $1: Warning value (optional)
<Check memory_non_heap>
Use = memory_relative_base
Value = java.lang:type=Memory/NonHeapMemoryUsage/used
Base = java.lang:type=Memory/NonHeapMemoryUsage/max
Label = Non-Heap-Memory: $BASE
Name = Non-Heap
MultiCheckPrefix
</Check>
# Java 8 Memory check for MetaSpace. Metaspace is typically unbounded
# and grows into native (OS) memory. Hence, an absolute thresshold is used
# here which by default is (C: 80M, W: 60M).
<Check memory_metaspace>
Unit = B
Label = %.2v %u meta space used
Value = java.lang:name=Metaspace,type=MemoryPool/Usage/used
Name = MetaSpace
Critical = ${0:83886080}
Warning = ${1:62914560}
MultiCheckPrefix
</Check>
# Java 8 Memory check for MetaSpace with an upper configued (-XX:MetaSpaceSize)
<Check memory_metaspace_relative>
Use = memory_relative_base
Value = java.lang:name=Metaspace,type=MemoryPool/Usage/used
Base = java.lang:name=Metaspace,type=MemoryPool/Usage/max
Label = MetaSpace: $BASE
Name = MetaSpace
MultiCheckPrefix
</Check>
# =============================================================
# Memory pool checks. These are specific to a Sun/Oracle JVM.
# Base definition for pool based checks
# $0: Label prefix and name to used
# $1: Critical value (optional)
# $2: Warning value (optional)
<Check memory_pool_base>
Use = memory_relative_base($1,$2)
Value = java.lang:type=MemoryPool,name=$0/Usage/used
Base = java.lang:type=MemoryPool,name=$0/Usage/max
Label = $0 : $BASE
Name = $0
</Check>
# Base definition for garbage collection count
# This checks count the number of garbage collections per
# minute
# $0: Name of garbage collector (used as Label as well)
# $1: Critical value (default: 30)
# $2: Warning value (default: 20)
<Check memory_gc_count_base>
Use = count_per_minute("GC count")
Value = java.lang:type=GarbageCollector,name=$0/CollectionCount
Label = $0 : $BASE
Name = $0 count
Critical = ${1:30}
Warning = ${2:20}
</Check>
# Base definition for garbage time measurements
# This checks measure the ratio the garbage collection takes from a minute
# (e.g. how many percent of a minute is used for garbage collecting)
# $0: Name of garbage collector (used as Label as well)
# $1: Critical value in percent (default: 20)
# $2: Warning value in percent (default: 10)
# WARNING: THIS CHECK HAS CHANGED IN 1.08. Remove the 'Base' and adapt the label
# to obtain the old behaviour.
<Check memory_gc_time_base>
Value = java.lang:type=GarbageCollector,name=$0/CollectionTime
Label = %2.2r% GC Overhead
Name = $0 time
Delta 60
# Next line switches on relative checking to get the percentual overhead
# for a garbage collection
Base = 60000
Critical = ${1:20}
Warning = ${2:10}
</Check>
# The paralled garbage collectors and memory
# pools switched on with -XX:+UseParallelGC.
# Used by 64bit server VMs by default.
<MultiCheck memory_pools_parallel>
Check = memory_pool_base("PS Eden Space",100,100)
Check = memory_pool_base("PS Survivor Space",100,100)
Check = memory_pool_base("PS Old Gen")
Check = memory_pool_base("PS Perm Gen")
</MultiCheck>
<MultiCheck memory_gc_count_parallel>
Check = memory_gc_count_base("PS Scavenge")
Check = memory_gc_count_base("PS MarkSweep")
</MultiCheck>
# Since 1.08: Relative time instead of absolute values.
<MultiCheck memory_gc_time_parallel>
Check = memory_gc_time_base("PS Scavenge")
Check = memory_gc_time_base("PS MarkSweep")
</MultiCheck>
# Garbage collectors and memory pools used for
# -XX:+UseConcMarkSweepGC and -XX:+UseParNewGC
# used by default by OS X, client vm.
<MultiCheck memory_pools_concurrent>
Check = memory_pool_base("Par Eden Space")
Check = memory_pool_base("Par Survivor Space")
Check = memory_pool_base("CMS Old Gen")
Check = memory_pool_base("CMS Perm Gen")
</MultiCheck>
<MultiCheck memory_gc_count_concurrent>
Check = memory_gc_count_base("ParNew")
Check = memory_gc_count_base("ConcurrentMarkSweep")
</MultiCheck>
# Since 1.08: Relative time instead of absolute values.
<MultiCheck memory_gc_time_concurrent>
Check = memory_gc_time_base("ParNew")
Check = memory_gc_time_base("ConcurrentMarkSweep")
</MultiCheck>
# Garbage collector and memory pools used
# when -XX:+UseSerialGC is used. Seems to be the default
# on linux for -client and -server VMs
<MultiCheck memory_pools_serial>
Check = memory_pool_base("Eden Space")
Check = memory_pool_base("Survivor Space")
Check = memory_pool_base("Tenured Gen")
Check = memory_pool_base("Perm Gen")
</MultiCheck>
<MultiCheck memory_gc_count_serial>
Check = memory_gc_count_base("Copy")
Check = memory_gc_count_base("MarkSweepCompact")
</MultiCheck>
# Since 1.08: Relative time instead of absolute values.
<MultiCheck memory_gc_time_serial>
Check = memory_gc_time_base("Copy")
Check = memory_gc_time_base("MarkSweepCompact")
</MultiCheck>
<Check memory_code_cache>
Use = memory_pool_base("Code Cache")
</Check>
# ================================================
# Collection of related checks.
# Overall view to the memory statistics
<MultiCheck memory>
Check memory_heap
Check memory_non_heap
</MultiCheck>

43
config/metrics.cfg Normal file
View File

@ -0,0 +1,43 @@
# Checks for Metrics (http://metrics.codahale.com/)
# =================================================
<Check metrics_base>
MBean = $0:type=$1,name=$2
Label = $0.$2 / $1
</Check>
#
#
#
<Check metrics_timer_base>
Use = metrics_base($1,$2,$3)
Attribute = $0
Label = $0 for $BASE : %v %u
Name = $0
Critical = $4
Warning = $5
Unit = ${6:ms}
</Check>
<MultiCheck metrics_timer_times>
Check metrics_timer_base("Mean",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("StdDev",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("Min",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("Max",$0,$1,$2,$3,$4,$5)
</MultiCheck>
<MultiCheck metrics_timer_percentile>
Check metrics_timer_base("50thPercentile",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("75thPercentile",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("95thPercentile",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("99thPercentile",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("999thPercentile",$0,$1,$2,$3,$4,$5)
</MultiCheck>
<MultiCheck metrics_timer_rate>
Check metrics_timer_base("MeanRate",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("OneMinuteRate",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("FiveMinuteRate",$0,$1,$2,$3,$4,$5)
Check metrics_timer_base("FifteenMinuteRate",$0,$1,$2,$3,$4,$5)
</MultiCheck>

37
config/threads.cfg Normal file
View File

@ -0,0 +1,37 @@
# Predefined checks for fetching thread statistics
# from MXBeans
# ==================================================
include common.cfg
# Check for a thread increase per minute
# $0 : Critical threshold (default: 60)
# $1 : Warning threshold (default: 30)
<Check thread_inc>
Use = count_per_minute("Threads")
Value = java.lang:type=Threading/ThreadCount
Name = Thread-Increase
Critical = ${0:~:60}
Warning = ${1:~:30}
</Check>
# Check for monitoring the total (absolute) count of threads
# active within an application
# $0 : Critical threshold (default: 1000)
# $1 : Warning threshold (default: 800)
<Check thread_count>
Value = java.lang:type=Threading/ThreadCount
Name = Thread-Count
Critical = ${0:1000}
Warning = ${1:800}
</Check>
# Find deadlocked Threads
<Check thread_deadlock>
MBean = java.lang:type=Threading
Operation = findDeadlockedThreads
Null = no deadlock
Name = Thread-Deadlock
String = 1
Critical = !no deadlock
</Check>

245
config/tomcat.cfg Normal file
View File

@ -0,0 +1,245 @@
# Tomcat specific checks
# ========================================================
include common.cfg
# Requests per minute for a servlet
# $0: Web-Module name
# $1: Servlet name
# $2: Critical (optional)
# $3: Warning (optional)
# $4: Name (optional)
<Check tc_servlet_requests>
MBean = *:j2eeType=Servlet,WebModule=$0,name=$1,*
Use = count_per_minute("requests")
Attribute = requestCount
Name = ${4:request}
Critical = ${2:6000}
Warning = ${3:5000}
</Check>
# Check whether an webmodule (can contain multiple servlets)
# is running
# $0: Webmodule name (sth like "//localhost/j4p")
# $1: Name (optional)
<Check tc_webmodule_running>
MBean = *:j2eeType=WebModule,name=$0,*
Attribute = state
String = 1
Label = $0 running
Name = ${1:running}
Critical = !1
</Check>
# Increase of overall processing time per minute for a web module
# This is calculate the processing time for a certain
# interval and extrapolate to a minute
# $0: Webmodule name
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_webmodule_processing>
MBean = *:j2eeType=WebModule,name=$0,*
Attribute = processingTime
Delta = 60
Label = %2.0f ms request processing time / minute
Name = ${3:proc_time}
Critical = ${1:50000}
Warning = ${2:40000}
</Check>
# ========================================================
# Session related checks
# Number of active sessions at this moment
# $0: Path name without leading slash
# $1: Critical (optional)
# $2: Warning (optional)
<Check tc_session_active>
MBean = *:path=/$0,type=Manager,*
Attribute = activeSessions
Name = ${3:sessions_active}
Label = $0: Active Sessions = %v
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Maximum number of active sessions so far
# $0: Path name without leading slash
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_session_active_max>
MBean = *:path=/$0,type=Manager,*
Attribute = maxActive
Name = ${3:sessions_max}
Label = $0: Max-Active Sessions = %v
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Number of sessions we rejected due to maxActive beeing reached
# $0: Path name without leading slash
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_session_rejected>
MBean = *:path=/$0,type=Manager,*
Attribute = rejectedSessions
Name = ${3:sessions_rejected}
Label = $0: Rejected Sessions = %v
Critical = ${1:500}
Warning = ${2:200}
</Check>
# Average time an expired session had been alive
# in seconds
# $0: Path name without leading slash
# $1: Critical (7200)
# $2: Warning (7200)
# $3: Name (optional)
<Check tc_session_average_lifetime>
MBean = *:path=/$0,type=Manager,*
Attribute = sessionAverageAliveTime
Name = ${3:sessions_avg_life}
Label = $0: Average session lifetime = %v
Critical = ${1:7200}
Warning = ${2:6400}
</Check>
# Longest time an expired session had been alive
# in seconds
# $0: Path name without leading slash
# $1: Critical (7200)
# $2: Warning (6400)
# $3: Name (optional)
<Check tc_session_max_lifetime>
MBean = *:path=/$0,type=Manager,*
Attribute = sessionMaxAliveTime
Name = ${3:sessions_max_life}
Label = $0: Maximum session lifetime = %v
Critical = ${1:7200}
Warning = ${2:6400}
</Check>
# Increase rate of sessions per minute
# $0: Path name without leading slash
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_session_inc>
Use = count_per_minute("sessions")
MBean = *:path=/$0,type=Manager,*
Attribute = sessionCounter
Name = ${3:sessions_inc}
Critical = ${1:1000}
Warning = ${2:900}
</Check>
# =============================================================
# Connector related checks
# Number of connector threads in relation to maximum
# allowed connector threads
# $0: Name of connector (e.g. 'http-8080')
# $1: Critical (optional)
# $2: Warning (optional)
<Check tc_connector_threads>
Use = relative_base($1,$2)
Label = Connector $0 : $BASE
Name = ${3:connector_threads}
Value = *:type=ThreadPool,name=$0/currentThreadsBusy
Base = *:type=ThreadPool,name=$0/maxThreads
</Check>
# Number of bytes received per minute for a connector
# $0: Name of connector (e.g. 'http-8080')
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_connector_received_rate>
Use = count_per_minute("bytes received")
Label = Connector $0 : $BASE
Name = ${3:bytes_received}
Value = *:type=GlobalRequestProcessor,name=$0/bytesReceived
Critical = ${1:104857600}
Warning = ${2:83886080}
</Check>
# Number of bytes sent per minute for a connector
# $0: Name of connector (e.g. 'http-8080')
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_connector_sent_rate>
Use = count_per_minute("bytes sent")
Label = Connector $0 : $BASE
Name = ${3:bytes_sent}
Value = *:type=GlobalRequestProcessor,name=$0/bytesSent
Critical = ${1:104857600}
Warning = ${2:83886080}
</Check>
# Increase of overall processing time per minute for a connector
# This checks calculates the processing time for a certain
# interval and scale it to a minute
# $0: Connector name
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_connector_processing_time>
Delta = 60
Label = Connector $0 : %2.0f ms request processing time / minute
Name = ${3:proc_time}
Value = *:type=GlobalRequestProcessor,name=$0/processingTime
Critical = ${1:50000}
Warning = ${2:40000}
</Check>
# Requests per minute for a connector
# $0: Connector name
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_connector_requests>
Use = count_per_minute("requests")
Label = Connector $0 : $BASE
Name = ${3:nr_requests}
Value = *:type=GlobalRequestProcessor,name=$0/requestCount
Critical = ${1:1000}
Warning = ${2:900}
</Check>
# Number of errors for a connector per minute.
# $0: Connector name
# $1: Critical (optional)
# $2: Warning (optional)
# $3: Name (optional)
<Check tc_connector_error_count>
Value = *:type=GlobalRequestProcessor,name=$0/errorCount
Label = Connector $0: %d errors
Name = ${3:errors}
Critical = ${1:100}
Warning = ${2:90}
Delta = 60
</Check>
# ==================================================================
# Relative DB Pool check (active connection vs. maximal available connections)
# Note that you need to register the datasource globally in order
# to access the Pool statistics (i.e. within the <GlobalResources> sections)
# See http://tomcat.apache.org/tomcat-6.0-doc/jndi-datasource-examples-howto.html
# for more information
# $0: JNDI-Name of datasource (e.g. jdbc/TestDB)
# $1: Critical value (optional)
# $2: Warning value (optional)
# $3: Name (optional)
<Check tc_datasource_connections>
Value = *:name="$0",type=DataSource,*/numActive
Base = *:name="$0",type=DataSource,*/maxActive
Name = ${3:dbpool_used}
Label = %.2r% DB connections used (%v %u active / %b %w max)
Critical = ${1:90}
Warning = ${2:80}
</Check>

95
config/weblogic.cfg Normal file
View File

@ -0,0 +1,95 @@
# Weblogic specific checks
# ========================================================
include common.cfg
<Check wls_channel_received_rate>
Use = count_per_minute("bytes received")
Label = Channel $0 : $BASE
Name = bytes_received
Value = *:Name=$0,Type=ServerChannelRuntime,*/BytesReceivedCount
Critical = ${1:104857600}
Warning = ${2:83886080}
</Check>
<Check wls_channel_sent_rate>
Use = count_per_minute("bytes sent")
Label = Channel $0 : $BASE
Name = bytes_sent
Value = *:Name=$0,Type=ServerChannelRuntime,*/BytesSentCount
Critical = ${1:104857600}
Warning = ${2:83886080}
</Check>
<Check wls_channel_connections>
Label = Channel $0 : %4.4v active connections
Name = connections
Value = *:Name=$0,Type=ServerChannelRuntime,*/ConnectionsCount
Critical = ${1:1000}
Warning = ${2:800}
</Check>
<Check wls_webapp_running>
Value = *:Type=WebAppComponentRuntime,ApplicationRuntime=$0,*/DeploymentState
String = 1
Label = $0 is running
Name = running
Critical = !1
</Check>
<Check wls_servlet_execution_avg>
Value = *:Type=ServletRuntime,ApplicationRuntime=$0,Name=$1,*/ExecutionTimeAverage
Label = $0 [$1] : Average execution time %d ms
Name = servlet_avg_execution_time
Critical = ${2:20000}
Warning = ${3:10000}
</Check>
<Check wls_ws_execution_avg>
Value = *:Type=WseeOperationRuntime,ApplicationRuntime=$0,Name=$1,*/ExecutionTimeAverage
Label = WS $0 [$1] : Average execution time %d ms
Name = ws_avg_execution_time
Critical = ${2:150000}
Warning = ${3:100000}
</Check>
<Check wls_ws_response_avg>
Value = *:Type=WseeOperationRuntime,ApplicationRuntime=$0,Name=$1,*/ResponseTimeAverage
Label = WS $0 [$1] : Average response time %d ms
Name = ws_avg_execution_time
Critical = ${2:150000}
Warning = ${3:100000}
</Check>
<Check wls_ws_response_error>
Value = *:Type=WseeOperationRuntime,ApplicationRuntime=$0,Name=$1,*/ResponseErrorCount
Label = WS $0 [$1] : Response error count %d
Name = ws_response_errors
Critical = ${2:10}
Warning = ${3:5}
</Check>
<Check wls_wmr_pending>
Value = *:Type=WorkManagerRuntime,ApplicationRuntime=$0,Name=$1,*/PendingRequests
Label = WorkManager $0 [$1] : Pending requests %d
Name = ws_wm_pending_requests
Critical = ${2:10}
Warning = ${3:5}
</Check>
<Check wls_wmr_threads_stuck>
Value = *:Type=WorkManagerRuntime,ApplicationRuntime=$0,Name=$1,*/StuckThreadCount
Label = WorkManager $0 [$1] : Stuck threads %d
Name = ws_wm_stuck_threads
Critical = ${2:10}
Warning = ${3:5}
</Check>
<Check wls_webapp_sessions>
Value = *:Type=WebAppComponentRuntime,ApplicationRuntime=$0,*/OpenSessionsCurrentCount
Label = Webapp $0 : Open sessions %d
Name = ws_webapp_sessions
Critical = ${1:2000}
Warning = ${2:1500}
</Check>

30
config/websphere.cfg Normal file
View File

@ -0,0 +1,30 @@
# Websphere Checks
# ----------------
# These checks are for WebSphere and has been tested for WebSphere >= 8.0
# (but should workd with older WebSphere servers as well).
# For most of the test it is required that a customzied Jolokia agent is used
# which provides simplified access to JSR-77 metrics.
#
# These agents can be obtained from the 'jolokia-extra' project: https://github.com/rhuss/jolokia-extra
# or downloaded from Maven central: http://central.maven.org/maven2/org/jolokia/extra/
# They all have an classifier "-jsr77" and the first three parts of the version specify
# the Jolokia core version included.
# E.g. "jolokia-extra-war-1.2.2.2-jsr77.war" contains Jolokia 1.2.2 (and is the second variant with
# the JSR-77 specifier)
# Most of these tests utilize the PMI subsystem of WebSphere.
# ===============================================================
# Including various checks. These config files are self contained,
# and for performance optimizations could be included separately if only
# some checks are needed.
include websphere/threads.cfg
include websphere/http.cfg
include websphere/jdbc.cfg
include websphere/jms.cfg
include websphere/jca.cfg
include websphere/appstate.cfg

13
config/websphere/appstate.cfg Normal file
View File

@ -0,0 +1,13 @@
# ---------------------------------------
# Check of the application state
#
# $0: application name
<Check was_application_state>
MBean WebSphere:j2eeType=J2EEApplication,J2EEName=${0},*
Attribute state
Critical = ${1:1}
Label = $0 : status = %v
Name = $0-state
</Check>

129
config/websphere/http.cfg Normal file
View File

@ -0,0 +1,129 @@
# ============================================
# HTTP Checks
include threads.cfg
# HTTP Thread Pool Utilization
# Check of relative pool size, i.e. the ratio between actual created threads
# to the number of maximal available threads.
<Check was_http_pool_size>
Use was_thread_pool_size('WebContainer',$0,$1)
</Check>
# Relative check of all active threads out of the threadpool for the web container
<Check was_http_pool_active>
Use was_thread_pool_active('WebContainer',$0,$1)
</Check>
# Web-Sessions
# Check for the number of session uses. The maximal number of sessions is not available
# and should be provided as argument to this check (default is 200).
#
# A unique part of the name contained in the 'mbeanIdentifier' key of the MBean
# must be used for the name (e.g. 'jolokia' for the Jolokia agent).
#
# $0: Unique part of the name of the web app (see above)
# $1: Maximum number of session (default: 200)
# $2: Critical (default: 90%)
# $3: Warning (default: 80%)
<Check was_http_session_count>
MBean WebSphere:type=SessionManager,mbeanIdentifier=*${0}*,*
Attribute stats
Path */*/statistics/LiveCount/current
# Base value as the number of maximal possible sessions
# (or if a proper MBean attribute is found, this could be inserted here)
Base ${1:200}
Critical ${2:90}
Warning ${3:80}
Label $0 : %.2r% sessions in use (%v / %b)
Name ${0}-http-sessions
</Check>
# HTTP Request Count
# Check for the number of requests per minute for a specific servlet.
#
# $0: Part of the servlet name (see above)
# $1: Critical as requests / minute (no default)
# $2: Warning as requests / minute (no default)
<Check was_http_request_count>
Use was_request_count($0,$1,$2)
MBean WebSphere:type=Servlet,mbeanIdentifier=*${0}*,*
</Check>
# Check for the number of requests per minute for a specific JSP
#
# $0: Part of the JSP name (see above)
# $1: Critical as requests / minute (1000)
# $2: Warning as requests / minute (800)
<Check was_jsp_request_count>
Use was_request_count($0,$1,$2)
MBean WebSphere:type=JSP,mbeanIdentifier=*${0}*,*
</Check>
# Base Check for requests counts (servlet or JSPs)
# $0: Part of the servlet name (see above)
# $1: Critical as requests / minute (1000)
# $2: Warning as requests / minute (800)
<Check was_request_count>
Attribute stats
Path */*/statistics/RequestCount/count
Delta 60
Critical ${1:1000}
Warning ${2:800}
Label $0 : %2.2q requests / minute
Name ${0}-request-count
</Check>
# HTTP Service Time
#
# Check of average processing time per request for a servlet.
#
# $0: Part of the servlet name (see above)
# $1: Critical (default: 10000ms)
# $2: Warning (default: 5000ms)
<Check was_http_service_time>
Use was_service_time($0,$1,$2)
MBean WebSphere:type=Servlet,mbeanIdentifier=*${0}*,*
BaseMBean WebSphere:type=Servlet,mbeanIdentifier=*${0}*,*
</Check>
# Check of average processing time per request for a JSP
#
# $0: Part of JSP name (see above)
# $1: Critical (default: 10000ms)
# $2: Warning (default: 5000ms)
<Check was_jsp_service_time>
Use was_service_time($0,$1,$2)
MBean WebSphere:type=JSP,mbeanIdentifier=*${0}*,*
BaseMBean WebSphere:type=JSP,mbeanIdentifier=*${0}*,*
</Check>
# Base check for total service time checks (suggestion for
# improvements: Currently the overall average is measured. It would be
# much better to use only the average till the last
# measurement. Therefore a "Delta" should be used (without
# normalization), but unfortunately the base value is not used as 'delta'
# yet.
<Check was_service_time>
Attribute stats
Path */*/statistics/ServiceTime/totalTime
BaseAttribute stats
BasePath */*/statistics/ServiceTime/count
Delta
# * 100 because the value is a 'relative' check typical used for percentages
Critical{1:1000000}
Warning ${2:500000}
Label %2.2q ms ∅ processing time per request (%v ms total for %b requests)
Name $0-request-processing-time
</Check>

43
config/websphere/jca.cfg Normal file
View File

@ -0,0 +1,43 @@
# ===============================================================
# JCA
# JCA connector pool usage
#
# ${0} : part of the JCA connector name
# ${1} : Managed Connection Factory Name (JCA)
# ${2} : Critical (default: 90 percent)
# ${3} : Warning (default: 80 percent)
<Check was_jca_percent_used>
MBean WebSphere:j2eeType=JCAResource,mbeanIdentifier=*${0}*,*
Attribute stats
Path */*/connectionPools/${1}/statistics/PercentUsed/current
Critical ${2:90}
Warning ${3:80}
Label $1 : %2.0f% connections used
Name jca-${1}-${0}-pool
</Check>
# Average waiting time until a JCA connector is available
#
# ${0} : part of the JCA resource name as it appears in the mbeanIdentifier
# ${1} : Managed Connection Factory Name (JCA)
# ${2} : Critical (default: 10s)
# ${3} : Warning (default: 5s)
<Check was_jca_wait_time>
MBean WebSphere:j2eeType=JCAResource,mbeanIdentifier=*${0}*,*
Attribute stats
Path */*/connectionPools/${1}/statistics/WaitTime/totalTime
BaseMBean WebSphere:j2eeType=JCAResource,mbeanIdentifier=${0},*
BaseAttribute stats
BasePath */*/connectionPools/${1}/statistics/WaitTime/count
Critical ${2:10000}
Warning ${3:5000}
Label $1: %2.2q ms ∅ wait time (%v ms total for %b requests)
Name jca-${1}-${0}-wait-time
</Check>

88
config/websphere/jdbc.cfg Normal file
View File

@ -0,0 +1,88 @@
# ==============================================================================
# JDBC Datasources
# JDBC Poolsize Check. This check requires two parameters at least:
# The name of th JDBC Provider and the data source name. It must be ensured that
# the pattern used in this check must result in a single data source only.
#
# In order to specify this even further, a fourth parameter can be used to
# match on part of the mbeanIdentifier.
#
# ${0} : Name of the JDBC Provider
# ${1} : DataSource Name
# ${2} : Critical (default: 90%)
# ${3} : Warning (default: 80%)
# ${4} : Part of mbeanIdentifier (default: *)
<Check was_jdbc_percent_used>
MBean WebSphere:j2eeType=JDBCResource,name=${0},mbeanIdentifier=${4:*},*
Attribute stats
Path */*/connectionPools/${1}/statistics/PercentUsed/current
Critical ${2:90}
Warning ${3:80}
Label $1 : %2.0f % DB Connections used
Name jdbc-$0-connections
</Check>
# Average wait time until a connection is obtained
# ${0} : Name of the JDBC Provider
# ${1} : Datasource name
# ${2} : Critical (default: 10s)
# ${3} : Warning (default: 5s)
# ${4} : Part of mbeanIdentifier (default: *)
<Check was_jdbc_wait_time>
MBean WebSphere:j2eeType=JDBCResource,name=${0},mbeanIdentifier=${4:*},*
Attribute stats
Path */*/connectionPools/${1}/statistics/WaitTime/totalTime
BaseMBean WebSphere:j2eeType=JDBCResource,name=${0},mbeanIdentifier=${4:*},*
BaseAttribute stats
BasePath */*/connectionPools/${1}/statistics/WaitTime/count
Critical ${2:10000}
Warning ${3:5000}
Label $1: %2.2q ms ∅ waiting time (%v ms total for %b requests)
Name jdbc-$0-average-wait-time
</Check>
# Check for the number of rolled back transactions
#
# $0: Part of the MBean identifier
# $1: Critical as rollback count / minute
# $2: Warning as rollback count / minute
<Check was_transaction_rollback_count>
Use was_transaction_count($0,"RolledbackCount",$1,$2)
</Check>
# Check for the number of active transactions
#
# $0: Part of the MBean identifier
# $1: Critical as rollback count / minute
# $2: Warning as rollback count / minute
<Check was_transaction_active_count>
Use was_transaction_count($0,"ActiveCount",$1,$2)
</Check>
# Base-Check for the number of transactions
#
# $0: Part of the MBean identifier
# $1: Attribute name
# $2: Critical as rollback count / minute
# $3: Warning as rollback count / minute
<Check was_transaction_count>
MBean WebSphere:type=TransactionService,mbeanIdentifier=*${0}*,*
Attribute stats
Path */*/statistics/${1}/count
Delta 60
Critical ${2:10}
Warning ${3:5}
Label $0 : %2.2q ${1} / minute
Name $1-$0-transaction
</Check>

44
config/websphere/jms.cfg Normal file
View File

@ -0,0 +1,44 @@
# =======================================================
# WebSphere JMS checks
# Check the number of message in a queue
#
# $0: Queue Name
# $1: Critical Threshold (default: 10)
# $2: Warning Threshold (default: 5)
<Check was_jms_depth>
MBean WebSphere:type=SIBQueuePoint,name=${0},*
Attribute depth
# Messages Thresshold
Critical ${1:10}
Warning ${2:5}
Label %v messages in queue ${0}
Name jms-{0}-queue
</Check>
# PMI metrics available over UI but not still via JMX ? -->
# Queues.QueueStats.LocalProducerAttachesCount
# Queues.QueueStats.LocalProducerCount
# Queues.QueueStats.LocalConsumerAttachesCount
# Queues.QueueStats.LocalConsumerCount
# Queues.QueueStats.TotalMessagesProducedCount
# Queues.QueueStats.BestEffortNonPersistentMessagesProducedCount
# Queues.QueueStats.ExpressNonPersistentMessagesProducedCount
# Queues.QueueStats.ReliableNonPersistentMessagesProducedCount
# Queues.QueueStats.ReliablePersistentMessagesProducedCount
# Queues.QueueStats.AssuredPersistentMessagesProducedCount
# Queues.QueueStats.TotalMessagesConsumedCount
# Queues.QueueStats.BestEffortNonPersistentMessagesConsumedCount
# Queues.QueueStats.ExpressNonPersistentMessagesConsumedCount
# Queues.QueueStats.ReliableNonPersistentMessagesConsumedCount
# Queues.QueueStats.ReliablePersistentMessagesConsumedCount
# Queues.QueueStats.AssuredPersistentMessagesConsumedCount
# Queues.QueueStats.ReportEnabledMessagesExpiredCount
# Queues.QueueStats.AggregateMessageWaitTime
# Queues.QueueStats.LocalMessageWaitTime
# Queues.QueueStats.LocalOldestMessageAge
# Queues.QueueStats.AvailableMessageCount
# Queues.QueueStats.UnavailableMessageCount

45
config/websphere/threads.cfg Normal file
View File

@ -0,0 +1,45 @@
# ============================================
# Thread Pool Checks
# Generic Thread-Pool Check for the size of a Thread-Pool
#
# $0: Name of ThreadPool (z.B. "WebContainer")
# $1: Critical (default: 90%)
# $2: Warning (default: 80%)
<Check was_thread_pool_size>
Use was_thread_pool($0,'PoolSize',$1,$2)
Label $0: %2.2r% threads used (%v / %b)
</Check>
# Generic Thread-Pool Check for the number of active threads
# within the thread pool
#
# $0: Name of ThreadPool (z.B. "WebContainer")
# $1: Critical (default: 90%)
# $2: Warning (default: 80%)
<Check was_thread_pool_active>
Use was_thread_pool($0,'ActiveCount',$1,$2,)
Label $0: %2.2r% active threads (%v / %b)
</Check>
# Base Check for thread-pools checks
# $0: Name of ThreadPool (z.B. "WebContainer")
# $1: Attribute (PoolSize or ActiveCount)
# $2: Critical (default: 90%)
# $3: Warning (default: 80%)
<Check was_thread_pool>
MBean WebSphere:name=${0},type=ThreadPool,*
Attribute stats
Path */*/statistics/${1}/current
BaseMBean WebSphere:name=${0},type=ThreadPool,*
BaseAttribute stats
BasePath */*/statistics/${1}/upperBound
Critical ${2:90}
Warning ${3:80}
Label = ${0}: %.2r% Threads [${1}] (%v / %b)
Name = ${0}-${1}-threadpool
</Check>

134
config/wildfly.cfg Normal file
View File

@ -0,0 +1,134 @@
# Wildfly (JBoss AS 8) specific checks
# ========================================================
include "common.cfg"
# Wildfly use Undertow instead of Tomcat as its servlet container,
# webapp specific metrics changed completely.
# Requests per minute for a servlet within a deployed war
# $0: Web-Module name (i.e. the WAR file name)
# $1: Servlet name
# $2: Critical (optional)
# $3: Warning (optional)
# $4: Descriptive name (optional)
<Check wildfly_war_servlet_requests>
MBean = jboss.as.expr:subsystem=undertow,deployment=$0,servlet=$1,*
Use = count_per_minute("requests")
Attribute = requestCount
Name = ${4:request}
Critical = ${2:6000}
Warning = ${3:5000}
</Check>
# Average request processing time for a servlet within a deployed war
# $0: Web-Module name (i.e. the WAR file name)
# $1: Servlet name
# $2: Critical (optional)
# $3: Warning (optional)
# $4: Descriptive name (optional)
<Check wildfly_war_servlet_request_time>
Value = jboss.as.expr:subsystem=undertow,deployment=$0,servlet=$1,*/totalRequestTime
Base = jboss.as.expr:subsystem=undertow,deployment=$0,servlet=$1,*/requestCount
Delta
Label = $0 : $1 : %2.2f ms average request time
Name = ${4:$0-$1-request-time}
Critical = ${2:6000}
Warning = ${3:5000}
</Check>
# Requests per minute for a servlet, deployed as part of an ear
# $0: EAR Module (name of the EAR file)
# $1: Web-Module name (i.e. the WAR file name within the EAR)
# $2: Servlet name
# $3: Critical (optional)
# $4: Warning (optional)
# $5: Descriptive name (optional)
<Check wildfly_ear_servlet_requests>
MBean = jboss.as.expr:subsystem=undertow,deployment=$0,subdeployment=$1,servlet=$2,*
Use = count_per_minute("requests")
Attribute = requestCount
Name = ${5:request}
Critical = ${3:6000}
Warning = ${2:5000}
</Check>
# Average request processing time, deployed as part of an ear
# $0: EAR Module name (i.e. the EAR file name)
# $1: Web-Module name (i.e. the WAR file name)
# $2: Servlet name
# $3: Critical (optional)
# $4: Warning (optional)
<Check wildfly_ear_servlet_request_time>
Value = jboss.as.expr:subsystem=undertow,deployment=$0,subdeployment=$1,servlet=$2,*/totalRequestTime
Base = jboss.as.expr:subsystem=undertow,deployment=$0,subdeployment=$1,servlet=$2,*/requestCount
Delta
Label = $0 : $1 : $2 : %2.2f ms average request time
Name = $0-$1-$2-request
Critical = ${3:6000}
Warning = ${4:5000}
</Check>
# Check whether the webapplications deployment is in status OK
# $0: Web-Module name (i.e. the WAR file name)
# $1: Name (optional)
<Check wildfly_deployment_status>
Value = jboss.as.expr:deployment=$0/status
String = 1
Critical = !OK
Label = $0 status
Name = ${1:status}
</Check>
# Check whether a webapplication is enabled
# $0: Web-Module name (i.e. the WAR file name)
# $1: Name (optional)
<Check wildfly_deployment_enabled>
Value = jboss.as.expr:deployment=$0/enabled
String = 1
Critical = !true
Label = $0 enabled
Name = ${1:enabled}
</Check>
# Check number of active session for a webapp, deployed as a war
# $0: Web-Module name (i.e. the WAR file name)
# $1: Critical (optional) (absolute number of active sessions allowed)
# $2: Warning (optional) (absolute number of active sessions allowed)
# $3: Descriptive name (optional)
<Check wildfly_war_webapp_active_sessions>
Value = jboss.as.expr:subsystem=undertow,deployment=$0/activeSessions
Label = %v active sessions
Name = ${3:active sessions}
Critical = ${1:1000}
Warning = ${2:800}
</Check>
# Check number of active session for a webapp, deployed as part of an ear
# $0: EAR Module (name of the EAR file)
# $1: Web-Module name (i.e. the WAR file name within the ear)
# $2: Critical (optional) (absolute number of active sessions allowed)
# $3: Warning (optional) (absolute number of active sessions allowed)
# $4: Descriptive name (optional)
<Check wildfly_ear_webapp_active_sessions>
Value = jboss.as.expr:subsystem=undertow,deployment=$0,subdeployment=$1/activeSessions
Label = %v active sessions
Name = ${4:active sessions}
Critical = ${2:1000}
Warning = ${3:800}
</Check>
# Check for available database connections
# $0: Name of datasource (e.g. "ExampleDS")
# $1: Critical value (optional, default: 1)
# $2: Warning value (optional, default: 5)
# $3: Name (optional)
<Check wildfly_datasource_connections>
Value = jboss.as.expr:data-source=${0},statistics=pool,subsystem=datasources/AvailableCount
Name = ${3:dbpool_available}
Label = %.2v DB connections available
Critical = ${1:1:}
Warning = ${2:5:}
</Check>

42
docker/Dockerfile Normal file
View File

@ -0,0 +1,42 @@
# ==================================================
# Dockerfile for jmx4perl Tools
# ==================================================
FROM alpine:3.2
ENV JMX4PERL_VERSION 1.12
RUN apk add --update \
build-base \
wget \
perl \
perl-dev \
readline \
readline-dev \
ncurses \
ncurses-dev \
libxml2-dev \
expat-dev \
gnupg1 \
&& cpan App::cpanminus < /dev/null \
&& cpanm install -n Term::ReadKey \
&& cpanm install \
JSON::XS \
Term::ReadLine::Gnu \
&& cpanm install ROLAND/jmx4perl-${JMX4PERL_VERSION}.tar.gz \
&& rm -rf /var/cache/apk/* \
&& apk del \
build-base \
perl-dev \
readline-dev \
ncurses-dev \
libxml2-dev \
expat-dev \
&& mkdir /jolokia
WORKDIR /jolokia
VOLUME /jolokia
CMD [ "jmx4perl", "--version" ]

43
docker/README.md Normal file
View File

@ -0,0 +1,43 @@
## Jmx4Perl Tools 1.12
This Docker image is intended to provided an easy access to the
[Jmx4Perl](http://www.jmx4perl.org) Tools, i.e.
* **[jmx4perl](http://search.cpan.org/~roland/jmx4perl/scripts/jmx4perl)** -- Command line
* **[j4psh](http://search.cpan.org/~roland/jmx4perl/scripts/j4psh)**
-- JMX shell
* **[jolokia](http://search.cpan.org/~roland/jmx4perl/scripts/jolokia)**
-- Jolokia agent management tool
* **[check_jmx4perl](http://search.cpan.org/~roland/jmx4perl/scripts/check_jmx4perl)**
-- Send Jolokia Requests from the command line
Please refer to the upstream tool documentation for details.
Examples:
````shell
# Get some basic information of the server
docker run --rm -it jolokia/jmx4perl jmx4perl http://localhost:8080/jolokia
# Download the current jolokia.war agent
docker run --rm -it -v `pwd`:/jolokia jolokia/jmx4perl jolokia
# Start an interactive JMX shell, server "tomcat" is defined in ~/.j4p/jmx4perl.config
docker run --rm -it -v ~/.j4p:/root/.j4p jolokia/jmx4perl j4psh tomcat
````
If you put your server definitions into `~/.j4p/jmx4perl.config` you
can use them by volume mounting them with `-v
~/.j4p:/root/.j4p`. For the management tool `jolokia` it is
recommended to mount the local directory with `-v $(pwd):/jolokia` so
that downloaded artefacts are stored in the current host directory
To simplify the usage, the following shell setup can be used:
````shell
function j4p_docker {
alias jmx4perl="docker run --rm -it -v ~/.j4p:/root/.j4p jolokia/jmx4perl jmx4perl"
alias jolokia="docker run --rm -it -v `pwd`:/jolokia jolokia/jmx4perl jolokia"
alias j4psh="docker run --rm -it -v ~/.j4p:/root/.j4p jolokia/jmx4perl j4psh"
}
````

158
examples/jsr77.pl Executable file
View File

@ -0,0 +1,158 @@
#!/usr/bin/perl
use JMX::Jmx4Perl;
use strict;
use Data::Dumper;
use Getopt::Std;
my %opts;
getopts('s',\%opts);
my $url = $ARGV[0] || die "No url given\n";
my $jmx = JMX::Jmx4Perl->new(url => $url,verbose => 0);
my $MODULE_HANDLER = init_handler($jmx);
my %VISITED = ();
my $product = $jmx->product;
print "Product: ",$product->name," ",$product->version,"\n";
print "JSR77 : ",$product->jsr77 ? "Yes" : "No","\n\n";
my $domains = $jmx->search("*:j2eeType=J2EEDomain,*");
$domains = [ "(none)" ] unless $domains;
# Special fix for geronimo which seems to have a problem with properly spelling
# the domain name
#push @$domains,"Geronimo:j2eeType=J2EEDomain,name=Geronimo" if grep { /^geronimo:/ } @$domains;
for my $d (@{$domains || []}) {
my $dn = $d eq "(none)" ? "*" : _print(1,$d,"Domain");
my $servers = $jmx->search("$dn:j2eeType=J2EEServer,*");
if (!$servers && $d eq "(none)") {
# That's probably not a real jsr77 container
# We are looking up all J2EEObject on our own without server and domain
my $objects = [ grep { /j2eeType/ } @{$jmx->search("*:*")} ];
print_modules(1,$objects);
} elsif (!$servers) {
print " == No servers defined for domain $dn ==\n";
} else {
for my $s (@{$servers || []}) {
my $sn = _print(2,$s,"Server");
for my $o (qw(deployedObjects resources javaVMs)) {
my $objects = $jmx->get_attribute($s,$o);
print_modules(3,$objects);
}
}
}
print "\n";
}
# Special JBoss handling, since it seems than deployed WARs (WebModules)
# don't appear below a server but stand on their own (despite the rules
# layed out in JSR77)
if ($product->id eq "jboss" || $product->id eq "weblogic") {
my $web_modules = $jmx->search("*:j2eeType=WebModule,*");
if ($web_modules) {
print "\n=============================================\nJBoss WebModules:\n";
my $new = [ grep { !$VISITED{$_} } @$web_modules ];
print_modules(1,$new);
}
}
sub init_handler {
my $jmx = shift;
return {
"J2EEApplication" => "modules",
"AppClientModule" => 0,
"ResourceAdapterModule" => "resourceAdapters",
"WebModule" => "servlets",
"Servlet" => 0,
"EJBModule" => "ejbs",
"MessageDrivenBean" => 0,
"EntityBean" => 0,
"StatelessSessionBean" => 0,
"StatefulSessionBean" => 0,
"JCAResource" => "connectionFactories",
"JCAConnectionFactory" => "managedConnectionFactory",
"JCAManagedConnectionFactory" => 0,
"JavaMailResource" => 0,
"JDBCResource" => "jdbcDataSources",
"JDBCDataSource" => "jdbcDriver",
"JDBCDriver" => 0,
"JMSResource" => 0,
"JNDIResource" => 0,
"JTAResource" => 0,
"RMI_IIOPResource" => 0,
"URLResource" => 0,
"JVM" => sub {
my ($l,$mod) = @_;
print " ",
join(", ",map { $jmx->get_attribute($mod,$_) } qw(javaVendor javaVersion node)),"\n";
},
# JBoss specific:
"ServiceModule" => 0,
"MBean" => 0
};
}
sub print_modules {
my ($l,$objects) = @_;
for my $k (sort keys %$MODULE_HANDLER) {
my @mods = grep { $_ =~ /j2eeType=$k/ } @$objects;
if (@mods) {
my $handler = $MODULE_HANDLER->{$k};
for my $mod (@mods) {
_print($l,$mod);
if (ref($handler) eq "CODE") {
$handler->($l,$mod);
} elsif ($handler && !ref($handler)) {
my $modules = $jmx->get_attribute($mod,$handler);
if ($modules) {
$modules = ref($modules) eq "ARRAY" ? $modules : [ $modules ];
# Fix for Jonas 4.1.2 with jetty, which includes the
# WebModule itself in the list of contained Servlets
$modules = [ grep { $_ !~ /j2eeType=$k/} @$modules ];
print_modules($l+1,$modules) if scalar(@$modules);
}
}
}
}
}
}
sub _print {
my ($i,$s,$t) = @_;
$VISITED{$s} = $s;
my $n = extract_name($s);
unless ($t) {
$t = $1 if $s =~ /j2eeType=(\w+)/;
}
my $can_stat = check_for_statistics($s);
print " " x $i,$t,": ",$n,($can_stat ? " [S] " : ""),"\n";
print " " x $i," " x length($t)," ",$s,"\n";
if ($opts{s} && $can_stat) {
eval {
my $ret = $jmx->get_attribute($s,"stats");
print Dumper($ret);
};
}
return $n;
}
sub check_for_statistics {
my $mbean = shift;
my $ret;
eval {
$ret = $jmx->get_attribute($mbean,"statisticsProvider");
};
return $@ ? undef : lc($ret) eq "true";
}
sub extract_name {
my $s = shift;
$s =~ /.*:.*name=([^,]+)/;
return $1;
}

11
examples/memory.pl Normal file
View File

@ -0,0 +1,11 @@
#!/usr/bin/perl
use JMX::Jmx4Perl;
use strict;
my $jmx = new JMX::Jmx4Perl(url => "http://localhost:8080/jolokia");
my $memory = $jmx->get_attribute("java.lang:type=Memory","HeapMemoryUsage");
my ($used,$max) = ($memory->{used},$memory->{max});
if ($memory->{used} / $memory->{max} > 0.9) {
print "Memory exceeds 90% (used: $used / max: $max = ",int($used * 100 / $max),"%)\n";
system("/etc/init.d/tomcat restart");
sleep(120);
}

13
examples/memory.sh Normal file
View File

@ -0,0 +1,13 @@
#!/bin/bash
base_url="http://localhost:9090/jolokia"
memory_url="${base_url}/read/java.lang:type=Memory/HeapMemoryUsage"
used=`wget -q -O - "${memory_url}/used" | sed 's/^.*"value":"\([0-9]*\)".*$/\1/'`
max=`wget -q -O - "${memory_url}/max" | sed 's/^.*"value":"\([0-9]*\)".*$/\1/'`
usage=$((${used}*100/${max}))
if [ $usage -gt 5 ]; then
echo "Memory exceeds 80% (used: $used / max: $max = ${usage}\%)";
exit 1;
else
exit 0;
fi

31
examples/remote.pl Normal file
View File

@ -0,0 +1,31 @@
#!/usr/bin/perl
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use JMX::Jmx4Perl::Alias;
use Data::Dumper;
use Time::HiRes qw(gettimeofday tv_interval);
my $jmx = new JMX::Jmx4Perl(url => "http://localhost:8888/jolokia-proxy",
target => {
url => "service:jmx:rmi:///jndi/rmi://bhut:9999/jmxrmi",
env => {
user => "monitorRole",
password => "consol",
}
}
);
my $req1 = new JMX::Jmx4Perl::Request(READ,{
mbean => "java.lang:type=Memory",
attribute => "HeapMemoryUsage",
}
);
my $req2 = new JMX::Jmx4Perl::Request(LIST);
my $req3 = new JMX::Jmx4Perl::Request(READ,{
mbean => "jboss.system:type=ServerInfo",
attribute => "HostAddress"
}
);
my $t0 = [gettimeofday];
my @resp = $jmx->request($req3);
print "Duration: ",tv_interval($t0,[gettimeofday]),"\n";
print Dumper(@resp);

102
examples/threadDump.pl Executable file
View File

@ -0,0 +1,102 @@
#!/usr/bin/perl
use Getopt::Long;
use JMX::Jmx4Perl;
use Data::Dumper;
use strict;
use warnings;
=head1 NAME
threadDump.pl - Print a thread dump of an JEE Server
=head1 SYNOPSIS
threadDumpl.pl -f org.jmx4perl http://localhost:8080/j4p
http-0.0.0.0-8080-1 (RUNNABLE):
....
sun.management.ThreadImpl.dumpThreads0(ThreadImpl.java:unknown)
org.jmx4perl.handler.ExecHandler.doHandleRequest(ExecHandler.java:77)
org.jmx4perl.handler.RequestHandler.handleRequest(RequestHandler.java:89)
org.jmx4perl.MBeanServerHandler.dispatchRequest(MBeanServerHandler.java:73)
org.jmx4perl.AgentServlet.callRequestHandler(AgentServlet.java:205)
org.jmx4perl.AgentServlet.handle(AgentServlet.java:152)
org.jmx4perl.AgentServlet.doGet(AgentServlet.java:129)
....
=head1 DESCRIPTION
For JEE Server running with Java 6, this simple script prints out a thread
dump, possibly filtered by package name. This is done by executing the MBean
C<java.lang:type=Threading>'s operation C<dumpAllThreads>.
=cut
my %opts = ();
my $result = GetOptions(\%opts,
"user|u=s","password|p=s",
"proxy=s",
"proxy-user=s","proxy-password=s",
"filter|f=s",
"verbose|v!",
"help|h!" => sub { Getopt::Long::HelpMessage() }
);
my $url = $ARGV[0] || die "No URL to j4p agent given\n";
my $jmx = new JMX::Jmx4Perl(url => $url,user => $opts{user},password => $opts{password},
proxy => $opts{proxy}, proxy_user => $opts{"proxy-user"});
my $dump;
eval {
$dump = $jmx->execute("java.lang:type=Threading","dumpAllThreads","false","false");
};
die "Cannot execute thread dump. Remember, $0 works only with Java >= 1.6\n$@\n" if $@;
my @filters = split ",",$opts{filter} if $opts{filter};
for my $thread (@$dump) {
print "-" x 75,"\n" if print_thread($thread);;
}
sub print_thread {
my $thread = shift;
my $st = get_stacktrace($thread->{stackTrace});
if ($st) {
print $thread->{threadName}," (",$thread->{threadState},"):\n";
print $st;
return 1;
} else {
return undef;
}
}
sub get_stacktrace {
my $trace = shift;
my $ret = "";
my $found = 0;
my $flag = 1;
my $last_line;
for my $l (@$trace) {
my $class = $l->{className};
if (!@filters || grep { $class =~ /^\Q$_\E/ } @filters) {
$ret .= $last_line if ($last_line && !$found);
$ret .= format_stack_line($l);
$found = 1;
$flag = 1;
} elsif ($flag) {
$flag = 0;
$ret .= " ....\n";
$last_line = format_stack_line($l);
}
}
return $found ? $ret : undef;
}
sub format_stack_line {
my $l = shift;
my $ret = " ".$l->{className}.".".$l->{methodName}."(".$l->{fileName}.":";
$ret .= $l->{lineNumber} > 0 ? $l->{lineNumber} : "unknown";
$ret .= ")\n";
return $ret;
}

1098
inc/Module-Build/Module/Build.pm Normal file
View File

File diff suppressed because it is too large Load Diff

1927
inc/Module-Build/Module/Build/API.pod Normal file
View File

File diff suppressed because it is too large Load Diff

323
inc/Module-Build/Module/Build/Authoring.pod Normal file
View File

@ -0,0 +1,323 @@
=head1 NAME
Module::Build::Authoring - Authoring Module::Build modules
=head1 DESCRIPTION
When creating a C<Build.PL> script for a module, something like the
following code will typically be used:
use Module::Build;
my $build = Module::Build->new
(
module_name => 'Foo::Bar',
license => 'perl',
requires => {
'perl' => '5.6.1',
'Some::Module' => '1.23',
'Other::Module' => '>= 1.2, != 1.5, < 2.0',
},
);
$build->create_build_script;
A simple module could get away with something as short as this for its
C<Build.PL> script:
use Module::Build;
Module::Build->new(
module_name => 'Foo::Bar',
license => 'perl',
)->create_build_script;
The model used by C<Module::Build> is a lot like the C<MakeMaker>
metaphor, with the following correspondences:
In Module::Build In ExtUtils::MakeMaker
--------------------------- ------------------------
Build.PL (initial script) Makefile.PL (initial script)
Build (a short perl script) Makefile (a long Makefile)
_build/ (saved state info) various config text in the Makefile
Any customization can be done simply by subclassing C<Module::Build>
and adding a method called (for example) C<ACTION_test>, overriding
the default 'test' action. You could also add a method called
C<ACTION_whatever>, and then you could perform the action C<Build
whatever>.
For information on providing compatibility with
C<ExtUtils::MakeMaker>, see L<Module::Build::Compat> and
L<http://www.makemaker.org/wiki/index.cgi?ModuleBuildConversionGuide>.
=head1 STRUCTURE
Module::Build creates a class hierarchy conducive to customization.
Here is the parent-child class hierarchy in classy ASCII art:
/--------------------\
| Your::Parent | (If you subclass Module::Build)
\--------------------/
|
|
/--------------------\ (Doesn't define any functionality
| Module::Build | of its own - just figures out what
\--------------------/ other modules to load.)
|
|
/-----------------------------------\ (Some values of $^O may
| Module::Build::Platform::$^O | define specialized functionality.
\-----------------------------------/ Otherwise it's ...::Default, a
| pass-through class.)
|
/--------------------------\
| Module::Build::Base | (Most of the functionality of
\--------------------------/ Module::Build is defined here.)
=head1 SUBCLASSING
Right now, there are two ways to subclass Module::Build. The first
way is to create a regular module (in a C<.pm> file) that inherits
from Module::Build, and use that module's class instead of using
Module::Build directly:
------ in Build.PL: ----------
#!/usr/bin/perl
use lib q(/nonstandard/library/path);
use My::Builder; # Or whatever you want to call it
my $build = My::Builder->new
(
module_name => 'Foo::Bar', # All the regular args...
license => 'perl',
dist_author => 'A N Other <me@here.net.au>',
requires => { Carp => 0 }
);
$build->create_build_script;
This is relatively straightforward, and is the best way to do things
if your My::Builder class contains lots of code. The
C<create_build_script()> method will ensure that the current value of
C<@INC> (including the C</nonstandard/library/path>) is propagated to
the Build script, so that My::Builder can be found when running build
actions. If you find that you need to C<chdir> into a different directories
in your subclass methods or actions, be sure to always return to the original
directory (available via the C<base_dir()> method before returning control
to the parent class. This is important to avoid data serialization problems.
For very small additions, Module::Build provides a C<subclass()>
method that lets you subclass Module::Build more conveniently, without
creating a separate file for your module:
------ in Build.PL: ----------
#!/usr/bin/perl
use Module::Build;
my $class = Module::Build->subclass
(
class => 'My::Builder',
code => q{
sub ACTION_foo {
print "I'm fooing to death!\n";
}
},
);
my $build = $class->new
(
module_name => 'Foo::Bar', # All the regular args...
license => 'perl',
dist_author => 'A N Other <me@here.net.au>',
requires => { Carp => 0 }
);
$build->create_build_script;
Behind the scenes, this actually does create a C<.pm> file, since the
code you provide must persist after Build.PL is run if it is to be
very useful.
See also the documentation for the L<Module::Build::API/"subclass()">
method.
=head1 PREREQUISITES
=head2 Types of prerequisites
To specify what versions of other modules are used by this
distribution, several types of prerequisites can be defined with the
following parameters:
=over 3
=item configure_requires
Items that must be installed I<before> configuring this distribution
(i.e. before running the F<Build.PL> script). This might be a
specific minimum version of C<Module::Build> or any other module the
F<Build.PL> needs in order to do its stuff. Clients like C<CPAN.pm>
or C<CPANPLUS> will be expected to pick C<configure_requires> out of the
F<META.yml> file and install these items before running the
C<Build.PL>.
If no configure_requires is specified, the current version of Module::Build
is automatically added to configure_requires.
=item build_requires
Items that are necessary for building and testing this distribution,
but aren't necessary after installation. This can help users who only
want to install these items temporarily. It also helps reduce the
size of the CPAN dependency graph if everything isn't smooshed into
C<requires>.
=item requires
Items that are necessary for basic functioning.
=item recommends
Items that are recommended for enhanced functionality, but there are
ways to use this distribution without having them installed. You
might also think of this as "can use" or "is aware of" or "changes
behavior in the presence of".
=item conflicts
Items that can cause problems with this distribution when installed.
This is pretty rare.
=back
=head2 Format of prerequisites
The prerequisites are given in a hash reference, where the keys are
the module names and the values are version specifiers:
requires => {
Foo::Module => '2.4',
Bar::Module => 0,
Ken::Module => '>= 1.2, != 1.5, < 2.0',
perl => '5.6.0'
},
The above four version specifiers have different effects. The value
C<'2.4'> means that B<at least> version 2.4 of C<Foo::Module> must be
installed. The value C<0> means that B<any> version of C<Bar::Module>
is acceptable, even if C<Bar::Module> doesn't define a version. The
more verbose value C<'E<gt>= 1.2, != 1.5, E<lt> 2.0'> means that
C<Ken::Module>'s version must be B<at least> 1.2, B<less than> 2.0,
and B<not equal to> 1.5. The list of criteria is separated by commas,
and all criteria must be satisfied.
A special C<perl> entry lets you specify the versions of the Perl
interpreter that are supported by your module. The same version
dependency-checking semantics are available, except that we also
understand perl's new double-dotted version numbers.
=head2 XS Extensions
Modules which need to compile XS code should list C<ExtUtils::CBuilder>
as a C<build_requires> element.
=head1 SAVING CONFIGURATION INFORMATION
Module::Build provides a very convenient way to save configuration
information that your installed modules (or your regression tests) can
access. If your Build process calls the C<feature()> or
C<config_data()> methods, then a C<Foo::Bar::ConfigData> module will
automatically be created for you, where C<Foo::Bar> is the
C<module_name> parameter as passed to C<new()>. This module provides
access to the data saved by these methods, and a way to update the
values. There is also a utility script called C<config_data>
distributed with Module::Build that provides a command line interface
to this same functionality. See also the generated
C<Foo::Bar::ConfigData> documentation, and the C<config_data>
script's documentation, for more information.
=head1 STARTING MODULE DEVELOPMENT
When starting development on a new module, it's rarely worth your time
to create a tree of all the files by hand. Some automatic
module-creators are available: the oldest is C<h2xs>, which has
shipped with perl itself for a long time. Its name reflects the fact
that modules were originally conceived of as a way to wrap up a C
library (thus the C<h> part) into perl extensions (thus the C<xs>
part).
These days, C<h2xs> has largely been superseded by modules like
C<ExtUtils::ModuleMaker>, and C<Module::Starter>. They have varying
degrees of support for C<Module::Build>.
=head1 AUTOMATION
One advantage of Module::Build is that since it's implemented as Perl
methods, you can invoke these methods directly if you want to install
a module non-interactively. For instance, the following Perl script
will invoke the entire build/install procedure:
my $build = Module::Build->new(module_name => 'MyModule');
$build->dispatch('build');
$build->dispatch('test');
$build->dispatch('install');
If any of these steps encounters an error, it will throw a fatal
exception.
You can also pass arguments as part of the build process:
my $build = Module::Build->new(module_name => 'MyModule');
$build->dispatch('build');
$build->dispatch('test', verbose => 1);
$build->dispatch('install', sitelib => '/my/secret/place/');
Building and installing modules in this way skips creating the
C<Build> script.
=head1 MIGRATION
Note that if you want to provide both a F<Makefile.PL> and a
F<Build.PL> for your distribution, you probably want to add the
following to C<WriteMakefile> in your F<Makefile.PL> so that C<MakeMaker>
doesn't try to run your F<Build.PL> as a normal F<.PL> file:
PL_FILES => {},
You may also be interested in looking at the C<Module::Build::Compat>
module, which can automatically create various kinds of F<Makefile.PL>
compatibility layers.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
Development questions, bug reports, and patches should be sent to the
Module-Build mailing list at <module-build@perl.org>.
Bug reports are also welcome at
<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>.
The latest development version is available from the Subversion
repository at <https://svn.perl.org/modules/Module-Build/trunk/>
=head1 SEE ALSO
perl(1), L<Module::Build>(3), L<Module::Build::API>(3),
L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3), L<YAML>(3)
F<META.yml> Specification:
L<http://module-build.sourceforge.net/META-spec-current.html>
L<http://www.dsmit.com/cons/>
L<http://search.cpan.org/dist/PerlBuildSystem/>
=cut

4653
inc/Module-Build/Module/Build/Base.pm Normal file
View File

File diff suppressed because it is too large Load Diff

578
inc/Module-Build/Module/Build/Compat.pm Normal file
View File

@ -0,0 +1,578 @@
package Module::Build::Compat;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
use File::Basename ();
use File::Spec;
use IO::File;
use Config;
use Module::Build;
use Module::Build::ModuleInfo;
use Data::Dumper;
my %convert_installdirs = (
PERL => 'core',
SITE => 'site',
VENDOR => 'vendor',
);
my %makefile_to_build =
(
TEST_VERBOSE => 'verbose',
VERBINST => 'verbose',
INC => sub { map {(extra_compiler_flags => $_)} Module::Build->split_like_shell(shift) },
POLLUTE => sub { (extra_compiler_flags => '-DPERL_POLLUTE') },
INSTALLDIRS => sub { (installdirs => $convert_installdirs{uc shift()}) },
LIB => sub {
my $lib = shift;
my %config = (
installprivlib => $lib,
installsitelib => $lib,
installarchlib => "$lib/$Config{archname}",
installsitearch => "$lib/$Config{archname}"
);
return map { (config => "$_=$config{$_}") } keys %config;
},
# Convert INSTALLVENDORLIB and friends.
(
map {
my $name = $_;
$name => sub {
my @ret = (config => lc($name) . "=" . shift );
print STDERR "# Converted to @ret\n";
return @ret;
}
} qw(
INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH
INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB
INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN
INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT
INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
)
),
# Some names they have in common
map {$_, lc($_)} qw(DESTDIR PREFIX INSTALL_BASE UNINST),
);
my %macro_to_build = %makefile_to_build;
# "LIB=foo make" is not the same as "perl Makefile.PL LIB=foo"
delete $macro_to_build{LIB};
sub create_makefile_pl {
my ($package, $type, $build, %args) = @_;
die "Don't know how to build Makefile.PL of type '$type'"
unless $type =~ /^(small|passthrough|traditional)$/;
my $fh;
if ($args{fh}) {
$fh = $args{fh};
} else {
$args{file} ||= 'Makefile.PL';
local $build->{properties}{quiet} = 1;
$build->delete_filetree($args{file});
$fh = IO::File->new("> $args{file}") or die "Can't write $args{file}: $!";
}
print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";
# Minimum perl version should be specified as "require 5.XXXXXX" in
# Makefile.PL
my $requires = $build->requires;
if ( my $minimum_perl = $requires->{perl} ) {
print {$fh} "require $minimum_perl;\n";
}
# If a *bundled* custom subclass is being used, make sure we add its
# directory to @INC. Also, lib.pm always needs paths in Unix format.
my $subclass_load = '';
if (ref($build) ne "Module::Build") {
my $subclass_dir = $package->subclass_dir($build);
if (File::Spec->file_name_is_absolute($subclass_dir)) {
my $base_dir = $build->base_dir;
if ($build->dir_contains($base_dir, $subclass_dir)) {
$subclass_dir = File::Spec->abs2rel($subclass_dir, $base_dir);
$subclass_dir = $package->unixify_dir($subclass_dir);
$subclass_load = "use lib '$subclass_dir';";
}
# Otherwise, leave it the empty string
} else {
$subclass_dir = $package->unixify_dir($subclass_dir);
$subclass_load = "use lib '$subclass_dir';";
}
}
if ($type eq 'small') {
printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
use Module::Build::Compat 0.02;
%s
Module::Build::Compat->run_build_pl(args => \@ARGV);
require %s;
Module::Build::Compat->write_makefile(build_class => '%s');
EOF
} elsif ($type eq 'passthrough') {
printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
unless (eval "use Module::Build::Compat 0.02; 1" ) {
print "This module requires Module::Build to install itself.\n";
require ExtUtils::MakeMaker;
my $yn = ExtUtils::MakeMaker::prompt
(' Install Module::Build now from CPAN?', 'y');
unless ($yn =~ /^y/i) {
die " *** Cannot install without Module::Build. Exiting ...\n";
}
require Cwd;
require File::Spec;
require CPAN;
# Save this 'cause CPAN will chdir all over the place.
my $cwd = Cwd::cwd();
CPAN::Shell->install('Module::Build::Compat');
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
or die "Couldn't install Module::Build, giving up.\n";
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
}
eval "use Module::Build::Compat 0.02; 1" or die $@;
%s
Module::Build::Compat->run_build_pl(args => \@ARGV);
my $build_script = 'Build';
$build_script .= '.com' if $^O eq 'VMS';
exit(0) unless(-e $build_script); # cpantesters convention
require %s;
Module::Build::Compat->write_makefile(build_class => '%s');
EOF
} elsif ($type eq 'traditional') {
my (%MM_Args, %prereq);
if (eval "use Tie::IxHash; 1") {
tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
tie %prereq, 'Tie::IxHash'; # Don't care if it fails here
}
my %name = ($build->module_name
? (NAME => $build->module_name)
: (DISTNAME => $build->dist_name));
my %version = ($build->dist_version_from
? (VERSION_FROM => $build->dist_version_from)
: (VERSION => $build->dist_version)
);
%MM_Args = (%name, %version);
%prereq = ( %{$build->requires}, %{$build->build_requires} );
%prereq = map {$_, $prereq{$_}} sort keys %prereq;
delete $prereq{perl};
$MM_Args{PREREQ_PM} = \%prereq;
$MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs;
$MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
$MM_Args{PL_FILES} = $build->PL_files || {};
if ($build->recursive_test_files) {
$MM_Args{TESTS} = join q{ }, $package->_test_globs($build);
}
local $Data::Dumper::Terse = 1;
my $args = Data::Dumper::Dumper(\%MM_Args);
$args =~ s/\{(.*)\}/($1)/s;
print $fh <<"EOF";
use ExtUtils::MakeMaker;
WriteMakefile
$args;
EOF
}
}
sub _test_globs {
my ($self, $build) = @_;
return map { File::Spec->catfile($_, '*.t') }
@{$build->rscan_dir('t', sub { -d $File::Find::name })};
}
sub subclass_dir {
my ($self, $build) = @_;
return (Module::Build::ModuleInfo->find_module_dir_by_name(ref $build)
|| File::Spec->catdir($build->config_dir, 'lib'));
}
sub unixify_dir {
my ($self, $path) = @_;
return join '/', File::Spec->splitdir($path);
}
sub makefile_to_build_args {
my $class = shift;
my @out;
foreach my $arg (@_) {
next if $arg eq '';
my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) :
die "Malformed argument '$arg'");
# Do tilde-expansion if it looks like a tilde prefixed path
( $val ) = Module::Build->_detildefy( $val ) if $val =~ /^~/;
if (exists $makefile_to_build{$key}) {
my $trans = $makefile_to_build{$key};
push @out, $class->_argvify( ref($trans) ? $trans->($val) : ($trans => $val) );
} elsif (exists $Config{lc($key)}) {
push @out, $class->_argvify( config => lc($key) . "=$val" );
} else {
# Assume M::B can handle it in lowercase form
push @out, $class->_argvify("\L$key" => $val);
}
}
return @out;
}
sub _argvify {
my ($self, @pairs) = @_;
my @out;
while (@pairs) {
my ($k, $v) = splice @pairs, 0, 2;
push @out, ("--$k", $v);
}
return @out;
}
sub makefile_to_build_macros {
my @out;
my %config; # must accumulate and return as a hashref
while (my ($macro, $trans) = each %macro_to_build) {
# On some platforms (e.g. Cygwin with 'make'), the mere presence
# of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined.
# Therefore we check length() too.
next unless exists $ENV{$macro} && length $ENV{$macro};
my $val = $ENV{$macro};
my @args = ref($trans) ? $trans->($val) : ($trans => $val);
while (@args) {
my ($k, $v) = splice(@args, 0, 2);
if ( $k eq 'config' ) {
if ( $v =~ /^([^=]+)=(.*)$/ ) {
$config{$1} = $2;
}
else {
warn "Couldn't parse config '$v'\n";
}
}
else {
push @out, ($k => $v);
}
}
}
push @out, (config => \%config) if %config;
return @out;
}
sub run_build_pl {
my ($pack, %in) = @_;
$in{script} ||= 'Build.PL';
my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : ();
print "# running $in{script} @args\n";
Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!";
}
sub fake_makefile {
my ($self, %args) = @_;
unless (exists $args{build_class}) {
warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
$args{build_class} = 'Module::Build';
}
my $class = $args{build_class};
my $perl = $class->find_perl_interpreter;
# VMS MMS/MMK need to use MCR to run the Perl image.
$perl = 'MCR ' . $perl if $self->_is_vms_mms;
my $noop = ($class->is_windowsish ? 'rem>nul' :
$self->_is_vms_mms ? 'Continue' :
'true');
my $filetype = $class->is_vmsish ? '.COM' : '';
my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
$unlink =~ s/\$/\$\$/g unless $class->is_vmsish;
my $maketext = <<"EOF";
all : force_do_it
$perl $Build
realclean : force_do_it
$perl $Build realclean
$unlink
distclean : force_do_it
$perl $Build distclean
$unlink
force_do_it :
@ $noop
EOF
foreach my $action ($class->known_actions) {
next if $action =~ /^(all|distclean|realclean|force_do_it)$/; # Don't double-define
$maketext .= <<"EOF";
$action : force_do_it
$perl $Build $action
EOF
}
if ($self->_is_vms_mms) {
# Roll our own .EXPORT as MMS/MMK don't honor that directive.
$maketext .= "\n.FIRST\n\t\@ $noop\n";
for my $macro (keys %macro_to_build) {
$maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n";
}
$maketext .= "\n";
}
else {
$maketext .= "\n.EXPORT : " . join(' ', keys %macro_to_build) . "\n\n";
}
return $maketext;
}
sub fake_prereqs {
my $file = File::Spec->catfile('_build', 'prereqs');
my $fh = IO::File->new("< $file") or die "Can't read $file: $!";
my $prereqs = eval do {local $/; <$fh>};
close $fh;
my @prereq;
foreach my $section (qw/build_requires requires/) {
foreach (keys %{$prereqs->{$section}}) {
next if $_ eq 'perl';
push @prereq, "$_=>q[$prereqs->{$section}{$_}]";
}
}
return unless @prereq;
return "# PREREQ_PM => { " . join(", ", @prereq) . " }\n\n";
}
sub write_makefile {
my ($pack, %in) = @_;
unless (exists $in{build_class}) {
warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
$in{build_class} = 'Module::Build';
}
my $class = $in{build_class};
$in{makefile} ||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile';
open MAKE, "> $in{makefile}" or die "Cannot write $in{makefile}: $!";
print MAKE $pack->fake_prereqs;
print MAKE $pack->fake_makefile(%in);
close MAKE;
}
sub _is_vms_mms {
return Module::Build->is_vmsish && ($Config{make} =~ m/MM[SK]/i);
}
1;
__END__
=for :stopwords passthrough
=head1 NAME
Module::Build::Compat - Compatibility with ExtUtils::MakeMaker
=head1 SYNOPSIS
# In a Build.PL :
use Module::Build;
my $build = Module::Build->new
( module_name => 'Foo::Bar',
license => 'perl',
create_makefile_pl => 'passthrough' );
...
=head1 DESCRIPTION
Because C<ExtUtils::MakeMaker> has been the standard way to distribute
modules for a long time, many tools (CPAN.pm, or your system
administrator) may expect to find a working F<Makefile.PL> in every
distribution they download from CPAN. If you want to throw them a
bone, you can use C<Module::Build::Compat> to automatically generate a
F<Makefile.PL> for you, in one of several different styles.
C<Module::Build::Compat> also provides some code that helps out the
F<Makefile.PL> at runtime.
=head1 METHODS
=over 4
=item create_makefile_pl($style, $build)
Creates a F<Makefile.PL> in the current directory in one of several
styles, based on the supplied C<Module::Build> object C<$build>. This is
typically controlled by passing the desired style as the
C<create_makefile_pl> parameter to C<Module::Build>'s C<new()> method;
the F<Makefile.PL> will then be automatically created during the
C<distdir> action.
The currently supported styles are:
=over 4
=item small
A small F<Makefile.PL> will be created that passes all functionality
through to the F<Build.PL> script in the same directory. The user must
already have C<Module::Build> installed in order to use this, or else
they'll get a module-not-found error.
=item passthrough
This is just like the C<small> option above, but if C<Module::Build> is
not already installed on the user's system, the script will offer to
use C<CPAN.pm> to download it and install it before continuing with
the build.
=item traditional
A F<Makefile.PL> will be created in the "traditional" style, i.e. it will
use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all.
In order to create the F<Makefile.PL>, we'll include the C<requires> and
C<build_requires> dependencies as the C<PREREQ_PM> parameter.
You don't want to use this style if during the C<perl Build.PL> stage
you ask the user questions, or do some auto-sensing about the user's
environment, or if you subclass C<Module::Build> to do some
customization, because the vanilla F<Makefile.PL> won't do any of that.
=back
=item run_build_pl(args => \@ARGV)
This method runs the F<Build.PL> script, passing it any arguments the
user may have supplied to the C<perl Makefile.PL> command. Because
C<ExtUtils::MakeMaker> and C<Module::Build> accept different arguments, this
method also performs some translation between the two.
C<run_build_pl()> accepts the following named parameters:
=over 4
=item args
The C<args> parameter specifies the parameters that would usually
appear on the command line of the C<perl Makefile.PL> command -
typically you'll just pass a reference to C<@ARGV>.
=item script
This is the filename of the script to run - it defaults to C<Build.PL>.
=back
=item write_makefile()
This method writes a 'dummy' F<Makefile> that will pass all commands
through to the corresponding C<Module::Build> actions.
C<write_makefile()> accepts the following named parameters:
=over 4
=item makefile
The name of the file to write - defaults to the string C<Makefile>.
=back
=back
=head1 SCENARIOS
So, some common scenarios are:
=over 4
=item 1.
Just include a F<Build.PL> script (without a F<Makefile.PL>
script), and give installation directions in a F<README> or F<INSTALL>
document explaining how to install the module. In particular, explain
that the user must install C<Module::Build> before installing your
module.
Note that if you do this, you may make things easier for yourself, but
harder for people with older versions of CPAN or CPANPLUS on their
system, because those tools generally only understand the
F<Makefile.PL>/C<ExtUtils::MakeMaker> way of doing things.
=item 2.
Include a F<Build.PL> script and a "traditional" F<Makefile.PL>,
created either manually or with C<create_makefile_pl()>. Users won't
ever have to install C<Module::Build> if they use the F<Makefile.PL>, but
they won't get to take advantage of C<Module::Build>'s extra features
either.
For good measure, of course, test both the F<Makefile.PL> and the
F<Build.PL> before shipping.
=item 3.
Include a F<Build.PL> script and a "pass-through" F<Makefile.PL>
built using C<Module::Build::Compat>. This will mean that people can
continue to use the "old" installation commands, and they may never
notice that it's actually doing something else behind the scenes. It
will also mean that your installation process is compatible with older
versions of tools like CPAN and CPANPLUS.
=back
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 COPYRIGHT
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
L<Module::Build>(3), L<ExtUtils::MakeMaker>(3)
=cut

59
inc/Module-Build/Module/Build/Config.pm Normal file
View File

@ -0,0 +1,59 @@
package Module::Build::Config;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Config;
sub new {
my ($pack, %args) = @_;
return bless {
stack => {},
values => $args{values} || {},
}, $pack;
}
sub get {
my ($self, $key) = @_;
return $self->{values}{$key} if ref($self) && exists $self->{values}{$key};
return $Config{$key};
}
sub set {
my ($self, $key, $val) = @_;
$self->{values}{$key} = $val;
}
sub push {
my ($self, $key, $val) = @_;
push @{$self->{stack}{$key}}, $self->{values}{$key}
if exists $self->{values}{$key};
$self->{values}{$key} = $val;
}
sub pop {
my ($self, $key) = @_;
my $val = delete $self->{values}{$key};
if ( exists $self->{stack}{$key} ) {
$self->{values}{$key} = pop @{$self->{stack}{$key}};
delete $self->{stack}{$key} unless @{$self->{stack}{$key}};
}
return $val;
}
sub values_set {
my $self = shift;
return undef unless ref($self);
return $self->{values};
}
sub all_config {
my $self = shift;
my $v = ref($self) ? $self->{values} : {};
return {%Config, %$v};
}
1;

201
inc/Module-Build/Module/Build/ConfigData.pm Normal file
View File

@ -0,0 +1,201 @@
package Module::Build::ConfigData;
use strict;
my $arrayref = eval do {local $/; <DATA>}
or die "Couldn't load ConfigData data: $@";
close DATA;
my ($config, $features, $auto_features) = @$arrayref;
sub config { $config->{$_[1]} }
sub set_config { $config->{$_[1]} = $_[2] }
sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
sub auto_feature_names { grep !exists $features->{$_}, keys %$auto_features }
sub feature_names {
my @features = (keys %$features, auto_feature_names());
@features;
}
sub config_names { keys %$config }
sub write {
my $me = __FILE__;
require IO::File;
# Can't use Module::Build::Dumper here because M::B is only a
# build-time prereq of this module
require Data::Dumper;
my $mode_orig = (stat $me)[2] & 07777;
chmod($mode_orig | 0222, $me); # Make it writeable
my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
seek($fh, 0, 0);
while (<$fh>) {
last if /^__DATA__$/;
}
die "Couldn't find __DATA__ token in $me" if eof($fh);
seek($fh, tell($fh), 0);
my $data = [$config, $features, $auto_features];
$fh->print( 'do{ my '
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
. '$x; }' );
truncate($fh, tell($fh));
$fh->close;
chmod($mode_orig, $me)
or warn "Couldn't restore permissions on $me: $!";
}
sub feature {
my ($package, $key) = @_;
return $features->{$key} if exists $features->{$key};
my $info = $auto_features->{$key} or return 0;
# Under perl 5.005, each(%$foo) isn't working correctly when $foo
# was reanimated with Data::Dumper and eval(). Not sure why, but
# copying to a new hash seems to solve it.
my %info = %$info;
require Module::Build; # XXX should get rid of this
while (my ($type, $prereqs) = each %info) {
next if $type eq 'description' || $type eq 'recommends';
my %p = %$prereqs; # Ditto here.
while (my ($modname, $spec) = each %p) {
my $status = Module::Build->check_installed_status($modname, $spec);
if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
if ( ! eval "require $modname; 1" ) { return 0; }
}
}
return 1;
}
=head1 NAME
Module::Build::ConfigData - Configuration for Module::Build
=head1 SYNOPSIS
use Module::Build::ConfigData;
$value = Module::Build::ConfigData->config('foo');
$value = Module::Build::ConfigData->feature('bar');
@names = Module::Build::ConfigData->config_names;
@names = Module::Build::ConfigData->feature_names;
Module::Build::ConfigData->set_config(foo => $new_value);
Module::Build::ConfigData->set_feature(bar => $new_value);
Module::Build::ConfigData->write; # Save changes
=head1 DESCRIPTION
This module holds the configuration data for the C<Module::Build>
module. It also provides a programmatic interface for getting or
setting that configuration data. Note that in order to actually make
changes, you'll have to have write access to the C<Module::Build::ConfigData>
module, and you should attempt to understand the repercussions of your
actions.
=head1 METHODS
=over 4
=item config($name)
Given a string argument, returns the value of the configuration item
by that name, or C<undef> if no such item exists.
=item feature($name)
Given a string argument, returns the value of the feature by that
name, or C<undef> if no such feature exists.
=item set_config($name, $value)
Sets the configuration item with the given name to the given value.
The value may be any Perl scalar that will serialize correctly using
C<Data::Dumper>. This includes references, objects (usually), and
complex data structures. It probably does not include transient
things like filehandles or sockets.
=item set_feature($name, $value)
Sets the feature with the given name to the given boolean value. The
value will be converted to 0 or 1 automatically.
=item config_names()
Returns a list of all the names of config items currently defined in
C<Module::Build::ConfigData>, or in scalar context the number of items.
=item feature_names()
Returns a list of all the names of features currently defined in
C<Module::Build::ConfigData>, or in scalar context the number of features.
=item auto_feature_names()
Returns a list of all the names of features whose availability is
dynamically determined, or in scalar context the number of such
features. Does not include such features that have later been set to
a fixed value.
=item write()
Commits any changes from C<set_config()> and C<set_feature()> to disk.
Requires write access to the C<Module::Build::ConfigData> module.
=back
=head1 AUTHOR
C<Module::Build::ConfigData> was automatically created using C<Module::Build>.
C<Module::Build> was written by Ken Williams, but he holds no
authorship claim or copyright claim to the contents of C<Module::Build::ConfigData>.
=cut
__DATA__
do{ my $x = [
{},
{},
{
'YAML_support' => {
'requires' => {
'YAML' => ' >= 0.35, != 0.49_01 '
},
'description' => 'Use YAML.pm to write META.yml files'
},
'manpage_support' => {
'requires' => {
'Pod::Man' => 0
},
'description' => 'Create Unix man pages'
},
'C_support' => {
'requires' => {
'ExtUtils::CBuilder' => '0.15'
},
'recommends' => {
'ExtUtils::ParseXS' => '1.02'
},
'description' => 'Compile/link C & XS code'
},
'HTML_support' => {
'requires' => {
'Pod::Html' => 0
},
'description' => 'Create HTML documentation'
}
}
];
$x; }

529
inc/Module-Build/Module/Build/Cookbook.pm Normal file
View File

@ -0,0 +1,529 @@
package Module::Build::Cookbook;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
=head1 NAME
Module::Build::Cookbook - Examples of Module::Build Usage
=head1 DESCRIPTION
C<Module::Build> isn't conceptually very complicated, but examples are
always helpful. The following recipes should help developers and/or
installers put together the pieces from the other parts of the
documentation.
=head1 BASIC RECIPES
=head2 Installing modules that use Module::Build
In most cases, you can just issue the following commands:
perl Build.PL
./Build
./Build test
./Build install
There's nothing complicated here - first you're running a script
called F<Build.PL>, then you're running a (newly-generated) script
called F<Build> and passing it various arguments.
The exact commands may vary a bit depending on how you invoke perl
scripts on your system. For instance, if you have multiple versions
of perl installed, you can install to one particular perl's library
directories like so:
/usr/bin/perl5.8.1 Build.PL
./Build
./Build test
./Build install
If you're on Windows where the current directory is always searched
first for scripts, you'll probably do something like this:
perl Build.PL
Build
Build test
Build install
On the old Mac OS (version 9 or lower) using MacPerl, you can
double-click on the F<Build.PL> script to create the F<Build> script,
then double-click on the F<Build> script to run its C<build>, C<test>,
and C<install> actions.
The F<Build> script knows what perl was used to run F<Build.PL>, so
you don't need to re-invoke the F<Build> script with the complete perl
path each time. If you invoke it with the I<wrong> perl path, you'll
get a warning or a fatal error.
=head2 Modifying Config.pm values
C<Module::Build> relies heavily on various values from perl's
C<Config.pm> to do its work. For example, default installation paths
are given by C<installsitelib> and C<installvendorman3dir> and
friends, C linker & compiler settings are given by C<ld>,
C<lddlflags>, C<cc>, C<ccflags>, and so on. I<If you're pretty sure
you know what you're doing>, you can tell C<Module::Build> to pretend
there are different values in F<Config.pm> than what's really there,
by passing arguments for the C<--config> parameter on the command
line:
perl Build.PL --config cc=gcc --config ld=gcc
Inside the C<Build.PL> script the same thing can be accomplished by
passing values for the C<config> parameter to C<new()>:
my $build = Module::Build->new
(
...
config => { cc => 'gcc', ld => 'gcc' },
...
);
In custom build code, the same thing can be accomplished by calling
the L<Module::Build/config> method:
$build->config( cc => 'gcc' ); # Set
$build->config( ld => 'gcc' ); # Set
...
my $linker = $build->config('ld'); # Get
=head2 Installing modules using the programmatic interface
If you need to build, test, and/or install modules from within some
other perl code (as opposed to having the user type installation
commands at the shell), you can use the programmatic interface.
Create a Module::Build object (or an object of a custom Module::Build
subclass) and then invoke its C<dispatch()> method to run various
actions.
my $build = Module::Build->new
(
module_name => 'Foo::Bar',
license => 'perl',
requires => { 'Some::Module' => '1.23' },
);
$build->dispatch('build');
$build->dispatch('test', verbose => 1);
$build->dispatch('install');
The first argument to C<dispatch()> is the name of the action, and any
following arguments are named parameters.
This is the interface we use to test Module::Build itself in the
regression tests.
=head2 Installing to a temporary directory
To create packages for package managers like RedHat's C<rpm> or
Debian's C<deb>, you may need to install to a temporary directory
first and then create the package from that temporary installation.
To do this, specify the C<destdir> parameter to the C<install> action:
./Build install --destdir /tmp/my-package-1.003
This essentially just prepends all the installation paths with the
F</tmp/my-package-1.003> directory.
=head2 Installing to a non-standard directory
To install to a non-standard directory (for example, if you don't have
permission to install in the system-wide directories), you can use the
C<install_base> or C<prefix> parameters:
./Build install --install_base /foo/bar
See L<Module::Build/"INSTALL PATHS"> for a much more complete
discussion of how installation paths are determined.
=head2 Installing in the same location as ExtUtils::MakeMaker
With the introduction of C<--prefix> in Module::Build 0.28 and
C<INSTALL_BASE> in C<ExtUtils::MakeMaker> 6.31 its easy to get them both
to install to the same locations.
First, ensure you have at least version 0.28 of Module::Build
installed and 6.31 of C<ExtUtils::MakeMaker>. Prior versions have
differing (and in some cases quite strange) installation behaviors.
The following installation flags are equivalent between
C<ExtUtils::MakeMaker> and C<Module::Build>.
MakeMaker Module::Build
PREFIX=... --prefix ...
INSTALL_BASE=... --install_base ...
DESTDIR=... --destdir ...
LIB=... --install_path lib=...
INSTALLDIRS=... --installdirs ...
INSTALLDIRS=perl --installdirs core
UNINST=... --uninst ...
INC=... --extra_compiler_flags ...
POLLUTE=1 --extra_compiler_flags -DPERL_POLLUTE
For example, if you are currently installing C<MakeMaker> modules with
this command:
perl Makefile.PL PREFIX=~
make test
make install UNINST=1
You can install into the same location with Module::Build using this:
perl Build.PL --prefix ~
./Build test
./Build install --uninst 1
=head3 C<prefix> vs C<install_base>
The behavior of C<prefix> is complicated and depends on
how your Perl is configured. The resulting installation locations
will vary from machine to machine and even different installations of
Perl on the same machine. Because of this, it's difficult to document
where C<prefix> will place your modules.
In contrast, C<install_base> has predictable, easy to explain
installation locations. Now that C<Module::Build> and C<MakeMaker> both
have C<install_base> there is little reason to use C<prefix> other
than to preserve your existing installation locations. If you are
starting a fresh Perl installation we encourage you to use
C<install_base>. If you have an existing installation installed via
C<prefix>, consider moving it to an installation structure matching
C<install_base> and using that instead.
=head2 Running a single test file
C<Module::Build> supports running a single test, which enables you to
track down errors more quickly. Use the following format:
./Build test --test_files t/mytest.t
In addition, you may want to run the test in verbose mode to get more
informative output:
./Build test --test_files t/mytest.t --verbose 1
I run this so frequently that I define the following shell alias:
alias t './Build test --verbose 1 --test_files'
So then I can just execute C<t t/mytest.t> to run a single test.
=head1 ADVANCED RECIPES
=head2 Making a CPAN.pm-compatible distribution
New versions of CPAN.pm understand how to use a F<Build.PL> script,
but old versions don't. If authors want to help users who have old
versions, some form of F<Makefile.PL> should be supplied. The easiest
way to accomplish this is to use the C<create_makefile_pl> parameter to
C<< Module::Build->new() >> in the C<Build.PL> script, which can
create various flavors of F<Makefile.PL> during the C<dist> action.
As a best practice, we recommend using the "traditional" style of
F<Makefile.PL> unless your distribution has needs that can't be
accomplished that way.
The C<Module::Build::Compat> module, which is part of
C<Module::Build>'s distribution, is responsible for creating these
F<Makefile.PL>s. Please see L<Module::Build::Compat> for the details.
=head2 Changing the order of the build process
The C<build_elements> property specifies the steps C<Module::Build>
will take when building a distribution. To change the build order,
change the order of the entries in that property:
# Process pod files first
my @e = @{$build->build_elements};
my ($i) = grep {$e[$_] eq 'pod'} 0..$#e;
unshift @e, splice @e, $i, 1;
Currently, C<build_elements> has the following default value:
[qw( PL support pm xs pod script )]
Do take care when altering this property, since there may be
non-obvious (and non-documented!) ordering dependencies in the
C<Module::Build> code.
=head2 Adding new file types to the build process
Sometimes you might have extra types of files that you want to install
alongside the standard types like F<.pm> and F<.pod> files. For
instance, you might have a F<Bar.dat> file containing some data
related to the C<Foo::Bar> module and you'd like for it to end up as
F<Foo/Bar.dat> somewhere in perl's C<@INC> path so C<Foo::Bar> can
access it easily at runtime. The following code from a sample
C<Build.PL> file demonstrates how to accomplish this:
use Module::Build;
my $build = Module::Build->new
(
module_name => 'Foo::Bar',
...other stuff here...
);
$build->add_build_element('dat');
$build->create_build_script;
This will find all F<.dat> files in the F<lib/> directory, copy them
to the F<blib/lib/> directory during the C<build> action, and install
them during the C<install> action.
If your extra files aren't located in the C<lib/> directory in your
distribution, you can explicitly say where they are, just as you'd do
with F<.pm> or F<.pod> files:
use Module::Build;
my $build = new Module::Build
(
module_name => 'Foo::Bar',
dat_files => {'some/dir/Bar.dat' => 'lib/Foo/Bar.dat'},
...other stuff here...
);
$build->add_build_element('dat');
$build->create_build_script;
If your extra files actually need to be created on the user's machine,
or if they need some other kind of special processing, you'll probably
want to subclass C<Module::Build> and create a special method to
process them, named C<process_${kind}_files()>:
use Module::Build;
my $class = Module::Build->subclass(code => <<'EOF');
sub process_dat_files {
my $self = shift;
... locate and process *.dat files,
... and create something in blib/lib/
}
EOF
my $build = $class->new
(
module_name => 'Foo::Bar',
...other stuff here...
);
$build->add_build_element('dat');
$build->create_build_script;
If your extra files don't go in F<lib/> but in some other place, see
L<"Adding new elements to the install process"> for how to actually
get them installed.
Please note that these examples use some capabilities of Module::Build
that first appeared in version 0.26. Before that it could
still be done, but the simple cases took a bit more work.
=head2 Adding new elements to the install process
By default, Module::Build creates seven subdirectories of the F<blib>
directory during the build process: F<lib>, F<arch>, F<bin>,
F<script>, F<bindoc>, F<libdoc>, and F<html> (some of these may be
missing or empty if there's nothing to go in them). Anything copied
to these directories during the build will eventually be installed
during the C<install> action (see L<Module::Build/"INSTALL PATHS">.
If you need to create a new custom type of installable element, e.g. C<conf>,
then you need to tell Module::Build where things in F<blib/conf/>
should be installed. To do this, use the C<install_path> parameter to
the C<new()> method:
my $build = Module::Build->new
(
...other stuff here...
install_path => { conf => $installation_path }
);
Or you can call the C<install_path()> method later:
$build->install_path(conf => $installation_path);
The user may also specify the path on the command line:
perl Build.PL --install_path conf=/foo/path/etc
The important part, though, is that I<somehow> the install path needs
to be set, or else nothing in the F<blib/conf/> directory will get
installed, and a runtime error during the C<install> action will
result.
See also L<"Adding new file types to the build process"> for how to
create the stuff in F<blib/conf/> in the first place.
=head1 EXAMPLES ON CPAN
Several distributions on CPAN are making good use of various features
of Module::Build. They can serve as real-world examples for others.
=head2 SVN-Notify-Mirror
L<http://search.cpan.org/~jpeacock/SVN-Notify-Mirror/>
John Peacock, author of the C<SVN-Notify-Mirror> distribution, says:
=over 4
=item 1. Using C<auto_features>, I check to see whether two optional
modules are available - SVN::Notify::Config and Net::SSH;
=item 2. If the S::N::Config module is loaded, I automatically
generate test files for it during Build (using the C<PL_files>
property).
=item 3. If the C<ssh_feature> is available, I ask if the user wishes
to perform the ssh tests (since it requires a little preliminary
setup);
=item 4. Only if the user has C<ssh_feature> and answers yes to the
testing, do I generate a test file.
I'm sure I could not have handled this complexity with EU::MM, but it
was very easy to do with M::B.
=back
=head2 Modifying an action
Sometimes you might need an to have an action, say C<./Build install>,
do something unusual. For instance, you might need to change the
ownership of a file or do something else peculiar to your application.
You can subclass C<Module::Build> on the fly using the C<subclass()>
method and override the methods that perform the actions. You may
need to read through C<Module::Build::Authoring> and
C<Module::Build::API> to find the methods you want to override. All
"action" methods are implemented by a method called "ACTION_" followed
by the action's name, so here's an example of how it would work for
the C<install> action:
# Build.PL
use Module::Build;
my $class = Module::Build->subclass(
class => "Module::Build::Custom",
code => <<'SUBCLASS' );
sub ACTION_install {
my $self = shift;
# YOUR CODE HERE
$self->SUPER::ACTION_install;
}
SUBCLASS
$class->new(
module_name => 'Your::Module',
# rest of the usual Module::Build parameters
)->create_build_script;
=head2 Adding an action
You can add a new C<./Build> action simply by writing the method for
it in your subclass. Use C<depends_on> to declare that another action
must have been run before your action.
For example, let's say you wanted to be able to write C<./Build
commit> to test your code and commit it to Subversion.
# Build.PL
use Module::Build;
my $class = Module::Build->subclass(
class => "Module::Build::Custom",
code => <<'SUBCLASS' );
sub ACTION_commit {
my $self = shift;
$self->depends_on("test");
$self->do_system(qw(svn commit));
}
SUBCLASS
=head2 Bundling Module::Build
Note: This section probably needs an update as the technology improves
(see contrib/bundle.pl in the distribution).
Suppose you want to use some new-ish features of Module::Build,
e.g. newer than the version of Module::Build your users are likely to
already have installed on their systems. The first thing you should
do is set C<configure_requires> to your minimum version of
Module::Build. See L<Module::Build::Authoring>.
But not every build system honors C<configure_requires> yet. Here's
how you can ship a copy of Module::Build, but still use a newer
installed version to take advantage of any bug fixes and upgrades.
First, install Module::Build into F<Your-Project/inc/Module-Build>.
CPAN will not index anything in the F<inc> directory so this copy will
not show up in CPAN searches.
cd Module-Build
perl Build.PL --install_base /path/to/Your-Project/inc/Module-Build
./Build test
./Build install
You should now have all the Module::Build .pm files in
F<Your-Project/inc/Module-Build/lib/perl5>.
Next, add this to the top of your F<Build.PL>.
my $Bundled_MB = 0.30; # or whatever version it was.
# Find out what version of Module::Build is installed or fail quietly.
# This should be cross-platform.
my $Installed_MB =
`$^X -e "eval q{require Module::Build; print Module::Build->VERSION} or exit 1";
# some operating systems put a newline at the end of every print.
chomp $Installed_MB;
$Installed_MB = 0 if $?;
# Use our bundled copy of Module::Build if it's newer than the installed.
unshift @INC, "inc/Module-Build/lib/perl5" if $Bundled_MB > $Installed_MB;
require Module::Build;
And write the rest of your F<Build.PL> normally. Module::Build will
remember your change to C<@INC> and use it when you run F<./Build>.
In the future, we hope to provide a more automated solution for this
scenario; see C<inc/latest.pm> in the Module::Build distribution for
one indication of the direction we're moving.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 COPYRIGHT
Copyright (c) 2001-2008 Ken Williams. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
perl(1), L<Module::Build>(3), L<Module::Build::Authoring>(3),
L<Module::Build::API>(3)
=cut

19
inc/Module-Build/Module/Build/Dumper.pm Normal file
View File

@ -0,0 +1,19 @@
package Module::Build::Dumper;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
# This is just a split-out of a wrapper function to do Data::Dumper
# stuff "the right way". See:
# http://groups.google.com/group/perl.module.build/browse_thread/thread/c8065052b2e0d741
use Data::Dumper;
sub _data_dump {
my ($self, $data) = @_;
return ("do{ my "
. Data::Dumper->new([$data],['x'])->Purity(1)->Terse(0)->Dump()
. '$x; }')
}
1;

471
inc/Module-Build/Module/Build/ModuleInfo.pm Normal file
View File

@ -0,0 +1,471 @@
# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
# vim:ts=8:sw=2:et:sta:sts=2
package Module::Build::ModuleInfo;
# This module provides routines to gather information about
# perl modules (assuming this may be expanded in the distant
# parrot future to look at other types of modules).
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use File::Spec;
use IO::File;
use Module::Build::Version;
my $PKG_REGEXP = qr{ # match a package declaration
^[\s\{;]* # intro chars on a line
package # the word 'package'
\s+ # whitespace
([\w:]+) # a package name
\s* # optional whitespace
; # semicolon line terminator
}x;
my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
([\$*]) # sigil - $ or *
(
( # optional leading package name
(?:::|\')? # possibly starting like just :: (Ì la $::VERSION)
(?:\w+(?:::|\'))* # Foo::Bar:: ...
)?
VERSION
)\b
}x;
my $VERS_REGEXP = qr{ # match a VERSION definition
(?:
\(\s*$VARNAME_REGEXP\s*\) # with parens
|
$VARNAME_REGEXP # without parens
)
\s*
=[^=~] # = but not ==, nor =~
}x;
sub new_from_file {
my $class = shift;
my $filename = File::Spec->rel2abs( shift );
return undef unless defined( $filename ) && -f $filename;
return $class->_init(undef, $filename, @_);
}
sub new_from_module {
my $class = shift;
my $module = shift;
my %props = @_;
$props{inc} ||= \@INC;
my $filename = $class->find_module_by_name( $module, $props{inc} );
return undef unless defined( $filename ) && -f $filename;
return $class->_init($module, $filename, %props);
}
sub _init {
my $class = shift;
my $module = shift;
my $filename = shift;
my %props = @_;
my( %valid_props, @valid_props );
@valid_props = qw( collect_pod inc );
@valid_props{@valid_props} = delete( @props{@valid_props} );
warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
my %data = (
module => $module,
filename => $filename,
version => undef,
packages => [],
versions => {},
pod => {},
pod_headings => [],
collect_pod => 0,
%valid_props,
);
my $self = bless(\%data, $class);
$self->_parse_file();
unless($self->{module} and length($self->{module})) {
my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
if($f =~ /\.pm$/) {
$f =~ s/\..+$//;
my @candidates = grep /$f$/, @{$self->{packages}};
$self->{module} = shift(@candidates); # punt
}
else {
if(grep /main/, @{$self->{packages}}) {
$self->{module} = 'main';
}
else {
$self->{module} = $self->{packages}[0] || '';
}
}
}
$self->{version} = $self->{versions}{$self->{module}}
if defined( $self->{module} );
return $self;
}
# class method
sub _do_find_module {
my $class = shift;
my $module = shift || die 'find_module_by_name() requires a package name';
my $dirs = shift || \@INC;
my $file = File::Spec->catfile(split( /::/, $module));
foreach my $dir ( @$dirs ) {
my $testfile = File::Spec->catfile($dir, $file);
return [ File::Spec->rel2abs( $testfile ), $dir ]
if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
if -e "$testfile.pm";
}
return;
}
# class method
sub find_module_by_name {
my $found = shift()->_do_find_module(@_) or return;
return $found->[0];
}
# class method
sub find_module_dir_by_name {
my $found = shift()->_do_find_module(@_) or return;
return $found->[1];
}
# given a line of perl code, attempt to parse it if it looks like a
# $VERSION assignment, returning sigil, full name, & package name
sub _parse_version_expression {
my $self = shift;
my $line = shift;
my( $sig, $var, $pkg );
if ( $line =~ $VERS_REGEXP ) {
( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
if ( $pkg ) {
$pkg = ($pkg eq '::') ? 'main' : $pkg;
$pkg =~ s/::$//;
}
}
return ( $sig, $var, $pkg );
}
sub _parse_file {
my $self = shift;
my $filename = $self->{filename};
my $fh = IO::File->new( $filename )
or die( "Can't open '$filename': $!" );
$self->_parse_fh($fh);
}
sub _parse_fh {
my ($self, $fh) = @_;
my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
my( @pkgs, %vers, %pod, @pod );
my $pkg = 'main';
my $pod_sect = '';
my $pod_data = '';
while (defined( my $line = <$fh> )) {
my $line_num = $.;
chomp( $line );
next if $line =~ /^\s*#/;
$in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
# Would be nice if we could also check $in_string or something too
last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
if ( $in_pod || $line =~ /^=cut/ ) {
if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
push( @pod, $1 );
if ( $self->{collect_pod} && length( $pod_data ) ) {
$pod{$pod_sect} = $pod_data;
$pod_data = '';
}
$pod_sect = $1;
} elsif ( $self->{collect_pod} ) {
$pod_data .= "$line\n";
}
} else {
$pod_sect = '';
$pod_data = '';
# parse $line to see if it's a $VERSION declaration
my( $vers_sig, $vers_fullname, $vers_pkg ) =
$self->_parse_version_expression( $line );
if ( $line =~ $PKG_REGEXP ) {
$pkg = $1;
push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
$vers{$pkg} = undef unless exists( $vers{$pkg} );
$need_vers = 1;
# VERSION defined with full package spec, i.e. $Module::VERSION
} elsif ( $vers_fullname && $vers_pkg ) {
push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
$need_vers = 0 if $vers_pkg eq $pkg;
unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
$vers{$vers_pkg} =
$self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
} else {
# Warn unless the user is using the "$VERSION = eval
# $VERSION" idiom (though there are probably other idioms
# that we should watch out for...)
warn <<"EOM" unless $line =~ /=\s*eval/;
Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
ignoring subsequent declaration on line $line_num.
EOM
}
# first non-comment line in undeclared package main is VERSION
} elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
$need_vers = 0;
my $v =
$self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
$vers{$pkg} = $v;
push( @pkgs, 'main' );
# first non-comment line in undeclared package defines package main
} elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
$need_vers = 1;
$vers{main} = '';
push( @pkgs, 'main' );
# only keep if this is the first $VERSION seen
} elsif ( $vers_fullname && $need_vers ) {
$need_vers = 0;
my $v =
$self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
$vers{$pkg} = $v;
} else {
warn <<"EOM";
Package '$pkg' already declared with version '$vers{$pkg}'
ignoring new version '$v' on line $line_num.
EOM
}
}
}
}
if ( $self->{collect_pod} && length($pod_data) ) {
$pod{$pod_sect} = $pod_data;
}
$self->{versions} = \%vers;
$self->{packages} = \@pkgs;
$self->{pod} = \%pod;
$self->{pod_headings} = \@pod;
}
{
my $pn = 0;
sub _evaluate_version_line {
my $self = shift;
my( $sigil, $var, $line ) = @_;
# Some of this code came from the ExtUtils:: hierarchy.
# We compile into $vsub because 'use version' would cause
# compiletime/runtime issues with local()
my $vsub;
$pn++; # everybody gets their own package
my $eval = qq{BEGIN { q# Hide from _packages_inside()
#; package Module::Build::ModuleInfo::_version::p$pn;
use Module::Build::Version;
no strict;
local $sigil$var;
\$$var=undef;
\$vsub = sub {
$line;
\$$var
};
}};
local $^W;
# Try to get the $VERSION
eval $eval;
warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
if $@;
(ref($vsub) eq 'CODE') or
die "failed to build version sub for $self->{filename}";
my $result = eval { $vsub->() };
die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@;
# Bless it into our own version class
$result = Module::Build::Version->new($result);
return $result;
}
}
############################################################
# accessors
sub name { $_[0]->{module} }
sub filename { $_[0]->{filename} }
sub packages_inside { @{$_[0]->{packages}} }
sub pod_inside { @{$_[0]->{pod_headings}} }
sub contains_pod { $#{$_[0]->{pod_headings}} }
sub version {
my $self = shift;
my $mod = shift || $self->{module};
my $vers;
if ( defined( $mod ) && length( $mod ) &&
exists( $self->{versions}{$mod} ) ) {
return $self->{versions}{$mod};
} else {
return undef;
}
}
sub pod {
my $self = shift;
my $sect = shift;
if ( defined( $sect ) && length( $sect ) &&
exists( $self->{pod}{$sect} ) ) {
return $self->{pod}{$sect};
} else {
return undef;
}
}
1;
__END__
=for :stopwords ModuleInfo
=head1 NAME
ModuleInfo - Gather package and POD information from a perl module file
=head1 DESCRIPTION
=over 4
=item new_from_file($filename, collect_pod => 1)
Construct a C<ModuleInfo> object given the path to a file. Takes an optional
argument C<collect_pod> which is a boolean that determines whether
POD data is collected and stored for reference. POD data is not
collected by default. POD headings are always collected.
=item new_from_module($module, collect_pod => 1, inc => \@dirs)
Construct a C<ModuleInfo> object given a module or package name. In addition
to accepting the C<collect_pod> argument as described above, this
method accepts a C<inc> argument which is a reference to an array of
of directories to search for the module. If none are given, the
default is @INC.
=item name()
Returns the name of the package represented by this module. If there
are more than one packages, it makes a best guess based on the
filename. If it's a script (i.e. not a *.pm) the package name is
'main'.
=item version($package)
Returns the version as defined by the $VERSION variable for the
package as returned by the C<name> method if no arguments are
given. If given the name of a package it will attempt to return the
version of that package if it is specified in the file.
=item filename()
Returns the absolute path to the file.
=item packages_inside()
Returns a list of packages.
=item pod_inside()
Returns a list of POD sections.
=item contains_pod()
Returns true if there is any POD in the file.
=item pod($section)
Returns the POD data in the given section.
=item find_module_by_name($module, \@dirs)
Returns the path to a module given the module or package name. A list
of directories can be passed in as an optional parameter, otherwise
@INC is searched.
Can be called as either an object or a class method.
=item find_module_dir_by_name($module, \@dirs)
Returns the entry in C<@dirs> (or C<@INC> by default) that contains
the module C<$module>. A list of directories can be passed in as an
optional parameter, otherwise @INC is searched.
Can be called as either an object or a class method.
=back
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
=head1 COPYRIGHT
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
perl(1), L<Module::Build>(3)
=cut

296
inc/Module-Build/Module/Build/Notes.pm Normal file
View File

@ -0,0 +1,296 @@
package Module::Build::Notes;
# A class for persistent hashes
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Data::Dumper;
use IO::File;
use Module::Build::Dumper;
sub new {
my ($class, %args) = @_;
my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
my $self = bless {
disk => {},
new => {},
file => $file,
%args,
}, $class;
}
sub restore {
my $self = shift;
my $fh = IO::File->new("< $self->{file}") or die "Can't read $self->{file}: $!";
$self->{disk} = eval do {local $/; <$fh>};
die $@ if $@;
$self->{new} = {};
}
sub access {
my $self = shift;
return $self->read() unless @_;
my $key = shift;
return $self->read($key) unless @_;
my $value = shift;
$self->write({ $key => $value });
return $self->read($key);
}
sub has_data {
my $self = shift;
return keys %{$self->read()} > 0;
}
sub exists {
my ($self, $key) = @_;
return exists($self->{new}{$key}) || exists($self->{disk}{$key});
}
sub read {
my $self = shift;
if (@_) {
# Return 1 key as a scalar
my $key = shift;
return $self->{new}{$key} if exists $self->{new}{$key};
return $self->{disk}{$key};
}
# Return all data
my $out = (keys %{$self->{new}}
? {%{$self->{disk}}, %{$self->{new}}}
: $self->{disk});
return wantarray ? %$out : $out;
}
sub _same {
my ($self, $x, $y) = @_;
return 1 if !defined($x) and !defined($y);
return 0 if !defined($x) or !defined($y);
return $x eq $y;
}
sub write {
my ($self, $href) = @_;
$href ||= {};
@{$self->{new}}{ keys %$href } = values %$href; # Merge
# Do some optimization to avoid unnecessary writes
foreach my $key (keys %{ $self->{new} }) {
next if ref $self->{new}{$key};
next if ref $self->{disk}{$key} or !exists $self->{disk}{$key};
delete $self->{new}{$key} if $self->_same($self->{new}{$key}, $self->{disk}{$key});
}
if (my $file = $self->{file}) {
my ($vol, $dir, $base) = File::Spec->splitpath($file);
$dir = File::Spec->catpath($vol, $dir, '');
return unless -e $dir && -d $dir; # The user needs to arrange for this
return if -e $file and !keys %{ $self->{new} }; # Nothing to do
@{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge
$self->_dump($file, $self->{disk});
$self->{new} = {};
}
return $self->read;
}
sub _dump {
my ($self, $file, $data) = @_;
my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
print {$fh} Module::Build::Dumper->_data_dump($data);
}
sub write_config_data {
my ($self, %args) = @_;
my $fh = IO::File->new("> $args{file}") or die "Can't create '$args{file}': $!";
printf $fh <<'EOF', $args{config_module};
package %s;
use strict;
my $arrayref = eval do {local $/; <DATA>}
or die "Couldn't load ConfigData data: $@";
close DATA;
my ($config, $features, $auto_features) = @$arrayref;
sub config { $config->{$_[1]} }
sub set_config { $config->{$_[1]} = $_[2] }
sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
sub auto_feature_names { grep !exists $features->{$_}, keys %%$auto_features }
sub feature_names {
my @features = (keys %%$features, auto_feature_names());
@features;
}
sub config_names { keys %%$config }
sub write {
my $me = __FILE__;
require IO::File;
# Can't use Module::Build::Dumper here because M::B is only a
# build-time prereq of this module
require Data::Dumper;
my $mode_orig = (stat $me)[2] & 07777;
chmod($mode_orig | 0222, $me); # Make it writeable
my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
seek($fh, 0, 0);
while (<$fh>) {
last if /^__DATA__$/;
}
die "Couldn't find __DATA__ token in $me" if eof($fh);
seek($fh, tell($fh), 0);
my $data = [$config, $features, $auto_features];
$fh->print( 'do{ my '
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
. '$x; }' );
truncate($fh, tell($fh));
$fh->close;
chmod($mode_orig, $me)
or warn "Couldn't restore permissions on $me: $!";
}
sub feature {
my ($package, $key) = @_;
return $features->{$key} if exists $features->{$key};
my $info = $auto_features->{$key} or return 0;
# Under perl 5.005, each(%%$foo) isn't working correctly when $foo
# was reanimated with Data::Dumper and eval(). Not sure why, but
# copying to a new hash seems to solve it.
my %%info = %%$info;
require Module::Build; # XXX should get rid of this
while (my ($type, $prereqs) = each %%info) {
next if $type eq 'description' || $type eq 'recommends';
my %%p = %%$prereqs; # Ditto here.
while (my ($modname, $spec) = each %%p) {
my $status = Module::Build->check_installed_status($modname, $spec);
if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
if ( ! eval "require $modname; 1" ) { return 0; }
}
}
return 1;
}
EOF
my ($module_name, $notes_name) = ($args{module}, $args{config_module});
printf $fh <<"EOF", $notes_name, $module_name;
=head1 NAME
$notes_name - Configuration for $module_name
=head1 SYNOPSIS
use $notes_name;
\$value = $notes_name->config('foo');
\$value = $notes_name->feature('bar');
\@names = $notes_name->config_names;
\@names = $notes_name->feature_names;
$notes_name->set_config(foo => \$new_value);
$notes_name->set_feature(bar => \$new_value);
$notes_name->write; # Save changes
=head1 DESCRIPTION
This module holds the configuration data for the C<$module_name>
module. It also provides a programmatic interface for getting or
setting that configuration data. Note that in order to actually make
changes, you'll have to have write access to the C<$notes_name>
module, and you should attempt to understand the repercussions of your
actions.
=head1 METHODS
=over 4
=item config(\$name)
Given a string argument, returns the value of the configuration item
by that name, or C<undef> if no such item exists.
=item feature(\$name)
Given a string argument, returns the value of the feature by that
name, or C<undef> if no such feature exists.
=item set_config(\$name, \$value)
Sets the configuration item with the given name to the given value.
The value may be any Perl scalar that will serialize correctly using
C<Data::Dumper>. This includes references, objects (usually), and
complex data structures. It probably does not include transient
things like filehandles or sockets.
=item set_feature(\$name, \$value)
Sets the feature with the given name to the given boolean value. The
value will be converted to 0 or 1 automatically.
=item config_names()
Returns a list of all the names of config items currently defined in
C<$notes_name>, or in scalar context the number of items.
=item feature_names()
Returns a list of all the names of features currently defined in
C<$notes_name>, or in scalar context the number of features.
=item auto_feature_names()
Returns a list of all the names of features whose availability is
dynamically determined, or in scalar context the number of such
features. Does not include such features that have later been set to
a fixed value.
=item write()
Commits any changes from C<set_config()> and C<set_feature()> to disk.
Requires write access to the C<$notes_name> module.
=back
=head1 AUTHOR
C<$notes_name> was automatically created using C<Module::Build>.
C<Module::Build> was written by Ken Williams, but he holds no
authorship claim or copyright claim to the contents of C<$notes_name>.
=cut
__DATA__
EOF
print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]);
}
1;

196
inc/Module-Build/Module/Build/PPMMaker.pm Normal file
View File

@ -0,0 +1,196 @@
package Module::Build::PPMMaker;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
# few tweaks based on the PPD spec at
# http://www.xav.com/perl/site/lib/XML/PPD.html
# The PPD spec is based on <http://www.w3.org/TR/NOTE-OSD>
sub new {
my $package = shift;
return bless {@_}, $package;
}
sub make_ppd {
my ($self, %args) = @_;
my $build = delete $args{build};
my @codebase;
if (exists $args{codebase}) {
@codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase});
} else {
my $distfile = $build->ppm_name . '.tar.gz';
print "Using default codebase '$distfile'\n";
@codebase = ($distfile);
}
my %dist;
foreach my $info (qw(name author abstract version)) {
my $method = "dist_$info";
$dist{$info} = $build->$method() or die "Can't determine distribution's $info\n";
}
$dist{version} = $self->_ppd_version($dist{version});
$self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}};
# TODO: could add <LICENSE HREF=...> tag if we knew what the URLs were for
# various licenses
my $ppd = <<"PPD";
<SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\">
<TITLE>$dist{name}</TITLE>
<ABSTRACT>$dist{abstract}</ABSTRACT>
@{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
<IMPLEMENTATION>
PPD
# TODO: We could set <IMPLTYPE VALUE="PERL" /> or maybe
# <IMPLTYPE VALUE="PERL/XS" /> ???
# We don't include recommended dependencies because PPD has no way
# to distinguish them from normal dependencies. We don't include
# build_requires dependencies because the PPM installer doesn't
# build or test before installing. And obviously we don't include
# conflicts either.
foreach my $type (qw(requires)) {
my $prereq = $build->$type();
while (my ($modname, $spec) = each %$prereq) {
next if $modname eq 'perl';
my $min_version = '0.0';
foreach my $c ($build->_parse_conditions($spec)) {
my ($op, $version) = $c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x;
# This is a nasty hack because it fails if there is no >= op
if ($op eq '>=') {
$min_version = $version;
last;
}
}
# Another hack - dependencies are on modules, but PPD expects
# them to be on distributions (I think).
$modname =~ s/::/-/g;
$ppd .= sprintf(<<'EOF', $modname, $self->_ppd_version($min_version));
<DEPENDENCY NAME="%s" VERSION="%s" />
EOF
}
}
# We only include these tags if this module involves XS, on the
# assumption that pure Perl modules will work on any OS. PERLCORE,
# unfortunately, seems to indicate that a module works with _only_
# that version of Perl, and so is only appropriate when a module
# uses XS.
if (keys %{$build->find_xs_files}) {
my $perl_version = $self->_ppd_version($build->perl_version);
$ppd .= sprintf(<<'EOF', $perl_version, $^O, $self->_varchname($build->config) );
<PERLCORE VERSION="%s" />
<OS NAME="%s" />
<ARCHITECTURE NAME="%s" />
EOF
}
foreach my $codebase (@codebase) {
$self->_simple_xml_escape($codebase);
$ppd .= sprintf(<<'EOF', $codebase);
<CODEBASE HREF="%s" />
EOF
}
$ppd .= <<'EOF';
</IMPLEMENTATION>
</SOFTPKG>
EOF
my $ppd_file = "$dist{name}.ppd";
my $fh = IO::File->new(">$ppd_file")
or die "Cannot write to $ppd_file: $!";
print $fh $ppd;
close $fh;
return $ppd_file;
}
sub _ppd_version {
my ($self, $version) = @_;
# generates something like "0,18,0,0"
return join ',', (split(/\./, $version), (0)x4)[0..3];
}
sub _varchname { # Copied from PPM.pm
my ($self, $config) = @_;
my $varchname = $config->{archname};
# Append "-5.8" to architecture name for Perl 5.8 and later
if ($] >= 5.008) {
my $vstring = sprintf "%vd", $^V;
$vstring =~ s/\.\d+$//;
$varchname .= "-$vstring";
}
return $varchname;
}
{
my %escapes = (
"\n" => "\\n",
'"' => '&quot;',
'&' => '&amp;',
'>' => '&gt;',
'<' => '&lt;',
);
my $rx = join '|', keys %escapes;
sub _simple_xml_escape {
$_[1] =~ s/($rx)/$escapes{$1}/go;
}
}
1;
__END__
=head1 NAME
Module::Build::PPMMaker - Perl Package Manager file creation
=head1 SYNOPSIS
On the command line, builds a .ppd file:
./Build ppd
=head1 DESCRIPTION
This package contains the code that builds F<.ppd> "Perl Package
Description" files, in support of ActiveState's "Perl Package
Manager". Details are here:
L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/>
=head1 AUTHOR
Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org>
=head1 COPYRIGHT
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
perl(1), Module::Build(3)
=cut

34
inc/Module-Build/Module/Build/Platform/Amiga.pm Normal file
View File

@ -0,0 +1,34 @@
package Module::Build::Platform::Amiga;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
1;
__END__
=head1 NAME
Module::Build::Platform::Amiga - Builder class for Amiga platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

33
inc/Module-Build/Module/Build/Platform/Default.pm Normal file
View File

@ -0,0 +1,33 @@
package Module::Build::Platform::Default;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
1;
__END__
=head1 NAME
Module::Build::Platform::Default - Stub class for unknown platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

34
inc/Module-Build/Module/Build/Platform/EBCDIC.pm Normal file
View File

@ -0,0 +1,34 @@
package Module::Build::Platform::EBCDIC;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
1;
__END__
=head1 NAME
Module::Build::Platform::EBCDIC - Builder class for EBCDIC platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

34
inc/Module-Build/Module/Build/Platform/MPEiX.pm Normal file
View File

@ -0,0 +1,34 @@
package Module::Build::Platform::MPEiX;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
1;
__END__
=head1 NAME
Module::Build::Platform::MPEiX - Builder class for MPEiX platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

152
inc/Module-Build/Module/Build/Platform/MacOS.pm Normal file
View File

@ -0,0 +1,152 @@
package Module::Build::Platform::MacOS;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
use ExtUtils::Install;
sub have_forkpipe { 0 }
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
# $Config{sitelib} and $Config{sitearch} are, unfortunately, missing.
foreach ('sitelib', 'sitearch') {
$self->config($_ => $self->config("install$_"))
unless $self->config($_);
}
# For some reason $Config{startperl} is filled with a bunch of crap.
(my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//;
$self->config(startperl => $sp);
return $self;
}
sub make_executable {
my $self = shift;
require MacPerl;
foreach (@_) {
MacPerl::SetFileInfo('McPL', 'TEXT', $_);
}
}
sub dispatch {
my $self = shift;
if( !@_ and !@ARGV ) {
require MacPerl;
# What comes first in the action list.
my @action_list = qw(build test install);
my %actions = map {+($_, 1)} $self->known_actions;
delete @actions{@action_list};
push @action_list, sort { $a cmp $b } keys %actions;
my %toolserver = map {+$_ => 1} qw(test disttest diff testdb);
foreach (@action_list) {
$_ .= ' *' if $toolserver{$_};
}
my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list);
return unless defined $cmd;
$cmd =~ s/ \*$//;
$ARGV[0] = ($cmd);
my $args = MacPerl::Ask('Any extra arguments? (ie. verbose=1)', '');
return unless defined $args;
push @ARGV, $self->split_like_shell($args);
}
$self->SUPER::dispatch(@_);
}
sub ACTION_realclean {
my $self = shift;
chmod 0666, $self->{properties}{build_script};
$self->SUPER::ACTION_realclean;
}
# ExtUtils::Install has a hard-coded '.' directory in versions less
# than 1.30. We use a sneaky trick to turn that into ':'.
#
# Note that we do it here in a cross-platform way, so this code could
# actually go in Module::Build::Base. But we put it here to be less
# intrusive for other platforms.
sub ACTION_install {
my $self = shift;
return $self->SUPER::ACTION_install(@_)
if eval {ExtUtils::Install->VERSION('1.30'); 1};
local $^W = 0; # Avoid a 'redefine' warning
local *ExtUtils::Install::find = sub {
my ($code, @dirs) = @_;
@dirs = map { $_ eq '.' ? File::Spec->curdir : $_ } @dirs;
return File::Find::find($code, @dirs);
};
return $self->SUPER::ACTION_install(@_);
}
1;
__END__
=head1 NAME
Module::Build::Platform::MacOS - Builder class for MacOS platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base> and override a few methods. Please see
L<Module::Build> for the docs.
=head2 Overridden Methods
=over 4
=item new()
MacPerl doesn't define $Config{sitelib} or $Config{sitearch} for some
reason, but $Config{installsitelib} and $Config{installsitearch} are
there. So we copy the install variables to the other location
=item make_executable()
On MacOS we set the file type and creator to MacPerl so it will run
with a double-click.
=item dispatch()
Because there's no easy way to say "./Build test" on MacOS, if
dispatch is called with no arguments and no @ARGV a dialog box will
pop up asking what action to take and any extra arguments.
Default action is "test".
=item ACTION_realclean()
Need to unlock the Build program before deleting.
=back
=head1 AUTHOR
Michael G Schwern <schwern@pobox.com>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

34
inc/Module-Build/Module/Build/Platform/RiscOS.pm Normal file
View File

@ -0,0 +1,34 @@
package Module::Build::Platform::RiscOS;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
1;
__END__
=head1 NAME
Module::Build::Platform::RiscOS - Builder class for RiscOS platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

73
inc/Module-Build/Module/Build/Platform/Unix.pm Normal file
View File

@ -0,0 +1,73 @@
package Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
sub is_executable {
# We consider the owner bit to be authoritative on a file, because
# -x will always return true if the user is root and *any*
# executable bit is set. The -x test seems to try to answer the
# question "can I execute this file", but I think we want "is this
# file executable".
my ($self, $file) = @_;
return +(stat $file)[2] & 0100;
}
sub _startperl { "#! " . shift()->perl }
sub _construct {
my $self = shift()->SUPER::_construct(@_);
# perl 5.8.1-RC[1-3] had some broken %Config entries, and
# unfortunately Red Hat 9 shipped it like that. Fix 'em up here.
my $c = $self->{config};
for (qw(siteman1 siteman3 vendorman1 vendorman3)) {
$c->{"install${_}dir"} ||= $c->{"install${_}"};
}
return $self;
}
# Open group says username should be portable filename characters,
# but some Unix OS working with ActiveDirectory wind up with user-names
# with back-slashes in the name. The new code below is very liberal
# in what it accepts.
sub _detildefy {
my ($self, $value) = @_;
$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username
[$1 ?
((getpwnam $1)[7] || "~$1") :
($ENV{HOME} || (getpwuid $>)[7])
]ex;
return $value;
}
1;
__END__
=head1 NAME
Module::Build::Platform::Unix - Builder class for Unix platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

482
inc/Module-Build/Module/Build/Platform/VMS.pm Normal file
View File

@ -0,0 +1,482 @@
package Module::Build::Platform::VMS;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
=head1 NAME
Module::Build::Platform::VMS - Builder class for VMS platforms
=head1 DESCRIPTION
This module inherits from C<Module::Build::Base> and alters a few
minor details of its functionality. Please see L<Module::Build> for
the general docs.
=head2 Overridden Methods
=over 4
=item _set_defaults
Change $self->{build_script} to 'Build.com' so @Build works.
=cut
sub _set_defaults {
my $self = shift;
$self->SUPER::_set_defaults(@_);
$self->{properties}{build_script} = 'Build.com';
}
=item cull_args
'@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing
people to write '@Build "foo"' we'll dispatch case-insensitively.
=cut
sub cull_args {
my $self = shift;
my($action, $args) = $self->SUPER::cull_args(@_);
my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;
die "Ambiguous action '$action'. Could be one of @possible_actions"
if @possible_actions > 1;
return ($possible_actions[0], $args);
}
=item manpage_separator
Use '__' instead of '::'.
=cut
sub manpage_separator {
return '__';
}
=item prefixify
Prefixify taking into account VMS' filepath syntax.
=cut
# Translated from ExtUtils::MM_VMS::prefixify()
sub _prefixify {
my($self, $path, $sprefix, $type) = @_;
my $rprefix = $self->prefix;
$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
# Translate $(PERLPREFIX) to a real path.
$rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
$sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
$self->log_verbose(" rprefix translated to $rprefix\n".
" sprefix translated to $sprefix\n");
if( length $path == 0 ) {
$self->log_verbose(" no path to prefixify.\n")
}
elsif( !File::Spec->file_name_is_absolute($path) ) {
$self->log_verbose(" path is relative, not prefixifying.\n");
}
elsif( $sprefix eq $rprefix ) {
$self->log_verbose(" no new prefix.\n");
}
else {
my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
my $vms_prefix = $self->config('vms_prefix');
if( $path_vol eq $vms_prefix.':' ) {
$self->log_verbose(" $vms_prefix: seen\n");
$path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
$path = $self->_catprefix($rprefix, $path_dirs);
}
else {
$self->log_verbose(" cannot prefixify.\n");
return $self->prefix_relpaths($self->installdirs, $type);
}
}
$self->log_verbose(" now $path\n");
return $path;
}
=item _quote_args
Command-line arguments (but not the command itself) must be quoted
to ensure case preservation.
=cut
sub _quote_args {
# Returns a string that can become [part of] a command line with
# proper quoting so that the subprocess sees this same list of args,
# or if we get a single arg that is an array reference, quote the
# elements of it and return the reference.
my ($self, @args) = @_;
my $got_arrayref = (scalar(@args) == 1
&& UNIVERSAL::isa($args[0], 'ARRAY'))
? 1
: 0;
# Do not quote qualifiers that begin with '/'.
map { if (!/^\//) {
$_ =~ s/\"/""/g; # escape C<"> by doubling
$_ = q(").$_.q(");
}
}
($got_arrayref ? @{$args[0]}
: @args
);
return $got_arrayref ? $args[0]
: join(' ', @args);
}
=item have_forkpipe
There is no native fork(), so some constructs depending on it are not
available.
=cut
sub have_forkpipe { 0 }
=item _backticks
Override to ensure that we quote the arguments but not the command.
=cut
sub _backticks {
# The command must not be quoted but the arguments to it must be.
my ($self, @cmd) = @_;
my $cmd = shift @cmd;
my $args = $self->_quote_args(@cmd);
return `$cmd $args`;
}
=item do_system
Override to ensure that we quote the arguments but not the command.
=cut
sub do_system {
# The command must not be quoted but the arguments to it must be.
my ($self, @cmd) = @_;
$self->log_info("@cmd\n");
my $cmd = shift @cmd;
my $args = $self->_quote_args(@cmd);
return !system("$cmd $args");
}
=item oneliner
Override to ensure that we do not quote the command.
=cut
sub oneliner {
my $self = shift;
my $oneliner = $self->SUPER::oneliner(@_);
$oneliner =~ s/^\"\S+\"//;
return "MCR $^X $oneliner";
}
=item _infer_xs_spec
Inherit the standard version but tweak the library file name to be
something Dynaloader can find.
=cut
sub _infer_xs_spec {
my $self = shift;
my $file = shift;
my $spec = $self->SUPER::_infer_xs_spec($file);
# Need to create with the same name as DynaLoader will load with.
if (defined &DynaLoader::mod2fname) {
my $file = $$spec{module_name} . '.' . $self->{config}->get('dlext');
$file =~ tr/:/_/;
$file = DynaLoader::mod2fname([$file]);
$$spec{lib_file} = File::Spec->catfile($$spec{archdir}, $file);
}
return $spec;
}
=item rscan_dir
Inherit the standard version but remove dots at end of name.
If the extended character set is in effect, do not remove dots from filenames
with Unix path delimiters.
=cut
sub rscan_dir {
my ($self, $dir, $pattern) = @_;
my $result = $self->SUPER::rscan_dir( $dir, $pattern );
for my $file (@$result) {
if (!_efs() && ($file =~ m#/#)) {
$file =~ s/\.$//;
}
}
return $result;
}
=item dist_dir
Inherit the standard version but replace embedded dots with underscores because
a dot is the directory delimiter on VMS.
=cut
sub dist_dir {
my $self = shift;
my $dist_dir = $self->SUPER::dist_dir;
$dist_dir =~ s/\./_/g unless _efs();
return $dist_dir;
}
=item man3page_name
Inherit the standard version but chop the extra manpage delimiter off the front if
there is one. The VMS version of splitdir('[.foo]') returns '', 'foo'.
=cut
sub man3page_name {
my $self = shift;
my $mpname = $self->SUPER::man3page_name( shift );
my $sep = $self->manpage_separator;
$mpname =~ s/^$sep//;
return $mpname;
}
=item expand_test_dir
Inherit the standard version but relativize the paths as the native glob() doesn't
do that for us.
=cut
sub expand_test_dir {
my ($self, $dir) = @_;
my @reldirs = $self->SUPER::expand_test_dir( $dir );
for my $eachdir (@reldirs) {
my ($v,$d,$f) = File::Spec->splitpath( $eachdir );
my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) );
$eachdir = File::Spec->catfile( $reldir, $f );
}
return @reldirs;
}
=item _detildefy
The home-grown glob() does not currently handle tildes, so provide limited support
here. Expect only UNIX format file specifications for now.
=cut
sub _detildefy {
my ($self, $arg) = @_;
# Apparently double ~ are not translated.
return $arg if ($arg =~ /^~~/);
# Apparently ~ followed by whitespace are not translated.
return $arg if ($arg =~ /^~ /);
if ($arg =~ /^~/) {
my $spec = $arg;
# Remove the tilde
$spec =~ s/^~//;
# Remove any slash following the tilde if present.
$spec =~ s#^/##;
# break up the paths for the merge
my $home = VMS::Filespec::unixify($ENV{HOME});
# In the default VMS mode, the trailing slash is present.
# In Unix report mode it is not. The parsing logic assumes that
# it is present.
$home .= '/' unless $home =~ m#/$#;
# Trivial case of just ~ by it self
if ($spec eq '') {
$home =~ s#/$##;
return $home;
}
my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
if ($hdir eq '') {
# Someone has tampered with $ENV{HOME}
# So hfile is probably the directory since this should be
# a path.
$hdir = $hfile;
}
my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
my @hdirs = File::Spec::Unix->splitdir($hdir);
my @dirs = File::Spec::Unix->splitdir($dir);
my $newdirs;
# Two cases of tilde handling
if ($arg =~ m#^~/#) {
# Simple case, just merge together
$newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
} else {
# Complex case, need to add an updir - No delimiters
my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir);
$newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs);
}
# Now put the two cases back together
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
}
return $arg;
}
=item find_perl_interpreter
On VMS, $^X returns the fully qualified absolute path including version
number. It's logically impossible to improve on it for getting the perl
we're currently running, and attempting to manipulate it is usually
lossy.
=cut
sub find_perl_interpreter {
return VMS::Filespec::vmsify($^X);
}
=item localize_file_path
Convert the file path to the local syntax
=cut
sub localize_file_path {
my ($self, $path) = @_;
$path = VMS::Filespec::vmsify($path);
$path =~ s/\.\z//;
return $path;
}
=item localize_dir_path
Convert the directory path to the local syntax
=cut
sub localize_dir_path {
my ($self, $path) = @_;
return VMS::Filespec::vmspath($path);
}
=item ACTION_clean
The home-grown glob() expands a bit too aggressively when given a bare name,
so default in a zero-length extension.
=cut
sub ACTION_clean {
my ($self) = @_;
foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) {
$self->delete_filetree($item);
}
}
# Need to look up the feature settings. The preferred way is to use the
# VMS::Feature module, but that may not be available to dual life modules.
my $use_feature;
BEGIN {
if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
$use_feature = 1;
}
}
# Need to look up the UNIX report mode. This may become a dynamic mode
# in the future.
sub _unix_rpt {
my $unix_rpt;
if ($use_feature) {
$unix_rpt = VMS::Feature::current("filename_unix_report");
} else {
my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
$unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
}
return $unix_rpt;
}
# Need to look up the EFS character set mode. This may become a dynamic
# mode in the future.
sub _efs {
my $efs;
if ($use_feature) {
$efs = VMS::Feature::current("efs_charset");
} else {
my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
$efs = $env_efs =~ /^[ET1]/i;
}
return $efs;
}
=back
=head1 AUTHOR
Michael G Schwern <schwern@pobox.com>
Ken Williams <kwilliams@cpan.org>
Craig A. Berry <craigberry@mac.com>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut
1;
__END__

34
inc/Module-Build/Module/Build/Platform/VOS.pm Normal file
View File

@ -0,0 +1,34 @@
package Module::Build::Platform::VOS;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
1;
__END__
=head1 NAME
Module::Build::Platform::VOS - Builder class for VOS platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

299
inc/Module-Build/Module/Build/Platform/Windows.pm Normal file
View File

@ -0,0 +1,299 @@
package Module::Build::Platform::Windows;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Config;
use File::Basename;
use File::Spec;
use IO::File;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
sub manpage_separator {
return '.';
}
sub have_forkpipe { 0 }
sub _detildefy {
my ($self, $value) = @_;
$value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x
if $ENV{HOME};
return $value;
}
sub ACTION_realclean {
my ($self) = @_;
$self->SUPER::ACTION_realclean();
my $basename = basename($0);
$basename =~ s/(?:\.bat)?$//i;
if ( lc $basename eq lc $self->build_script ) {
if ( $self->build_bat ) {
$self->log_info("Deleting $basename.bat\n");
my $full_progname = $0;
$full_progname =~ s/(?:\.bat)?$/.bat/i;
# Voodoo required to have a batch file delete itself without error;
# Syntax differs between 9x & NT: the later requires a null arg (???)
require Win32;
my $null_arg = (Win32::IsWinNT()) ? '""' : '';
my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");
my $fh = IO::File->new(">> $basename.bat")
or die "Can't create $basename.bat: $!";
print $fh $cmd;
close $fh ;
} else {
$self->delete_filetree($self->build_script . '.bat');
}
}
}
sub make_executable {
my $self = shift;
$self->SUPER::make_executable(@_);
foreach my $script (@_) {
# Native batch script
if ( $script =~ /\.(bat|cmd)$/ ) {
$self->SUPER::make_executable($script);
next;
# Perl script that needs to be wrapped in a batch script
} else {
my %opts = ();
if ( $script eq $self->build_script ) {
$opts{ntargs} = q(-x -S %0 --build_bat %*);
$opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9);
}
my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)};
if ( $@ ) {
$self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@");
} else {
$self->SUPER::make_executable($out);
}
}
}
}
# This routine was copied almost verbatim from the 'pl2bat' utility
# distributed with perl. It requires too much voodoo with shell quoting
# differences and shortcomings between the various flavors of Windows
# to reliably shell out
sub pl2bat {
my $self = shift;
my %opts = @_;
# NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate
$opts{ntargs} = '-x -S %0 %*' unless exists $opts{ntargs};
$opts{otherargs} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $opts{otherargs};
$opts{stripsuffix} = '/\\.plx?/' unless exists $opts{stripsuffix};
$opts{stripsuffix} = ($opts{stripsuffix} =~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E");
unless (exists $opts{out}) {
$opts{out} = $opts{in};
$opts{out} =~ s/$opts{stripsuffix}$//oi;
$opts{out} .= '.bat' unless $opts{in} =~ /\.bat$/i or $opts{in} =~ /^-$/;
}
my $head = <<EOT;
\@rem = '--*-Perl-*--
\@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl $opts{otherargs}
goto endofperl
:WinNT
perl $opts{ntargs}
if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
\@rem ';
EOT
$head =~ s/^\s+//gm;
my $headlines = 2 + ($head =~ tr/\n/\n/);
my $tail = "\n__END__\n:endofperl\n";
my $linedone = 0;
my $taildone = 0;
my $linenum = 0;
my $skiplines = 0;
my $start = $Config{startperl};
$start = "#!perl" unless $start =~ /^#!.*perl/;
my $in = IO::File->new("< $opts{in}") or die "Can't open $opts{in}: $!";
my @file = <$in>;
$in->close;
foreach my $line ( @file ) {
$linenum++;
if ( $line =~ /^:endofperl\b/ ) {
if (!exists $opts{update}) {
warn "$opts{in} has already been converted to a batch file!\n";
return;
}
$taildone++;
}
if ( not $linedone and $line =~ /^#!.*perl/ ) {
if (exists $opts{update}) {
$skiplines = $linenum - 1;
$line .= "#line ".(1+$headlines)."\n";
} else {
$line .= "#line ".($linenum+$headlines)."\n";
}
$linedone++;
}
if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
$line = "";
}
}
my $out = IO::File->new("> $opts{out}") or die "Can't open $opts{out}: $!";
print $out $head;
print $out $start, ( $opts{usewarnings} ? " -w" : "" ),
"\n#line ", ($headlines+1), "\n" unless $linedone;
print $out @file[$skiplines..$#file];
print $out $tail unless $taildone;
$out->close;
return $opts{out};
}
sub _quote_args {
# Returns a string that can become [part of] a command line with
# proper quoting so that the subprocess sees this same list of args.
my ($self, @args) = @_;
my @quoted;
for (@args) {
if ( /^[^\s*?!\$<>;|'"\[\]\{\}]+$/ ) {
# Looks pretty safe
push @quoted, $_;
} else {
# XXX this will obviously have to improve - is there already a
# core module lying around that does proper quoting?
s/"/\\"/g;
push @quoted, qq("$_");
}
}
return join " ", @quoted;
}
sub split_like_shell {
# As it turns out, Windows command-parsing is very different from
# Unix command-parsing. Double-quotes mean different things,
# backslashes don't necessarily mean escapes, and so on. So we
# can't use Text::ParseWords::shellwords() to break a command string
# into words. The algorithm below was bashed out by Randy and Ken
# (mostly Randy), and there are a lot of regression tests, so we
# should feel free to adjust if desired.
(my $self, local $_) = @_;
return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
my @argv;
return @argv unless defined() && length();
my $arg = '';
my( $i, $quote_mode ) = ( 0, 0 );
while ( $i < length() ) {
my $ch = substr( $_, $i , 1 );
my $next_ch = substr( $_, $i+1, 1 );
if ( $ch eq '\\' && $next_ch eq '"' ) {
$arg .= '"';
$i++;
} elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
$arg .= '\\';
$i++;
} elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
$quote_mode = !$quote_mode;
$arg .= '"';
$i++;
} elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
( $i + 2 == length() ||
substr( $_, $i + 2, 1 ) eq ' ' )
) { # for cases like: a"" => [ 'a' ]
push( @argv, $arg );
$arg = '';
$i += 2;
} elsif ( $ch eq '"' ) {
$quote_mode = !$quote_mode;
} elsif ( $ch eq ' ' && !$quote_mode ) {
push( @argv, $arg ) if $arg;
$arg = '';
++$i while substr( $_, $i + 1, 1 ) eq ' ';
} else {
$arg .= $ch;
}
$i++;
}
push( @argv, $arg ) if defined( $arg ) && length( $arg );
return @argv;
}
# system(@cmd) does not like having double-quotes in it on Windows.
# So we quote them and run it as a single command.
sub do_system {
my ($self, @cmd) = @_;
my $cmd = $self->_quote_args(@cmd);
my $status = system($cmd);
if ($status and $! =~ /Argument list too long/i) {
my $env_entries = '';
foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " }
warn "'Argument list' was 'too long', env lengths are $env_entries";
}
return !$status;
}
1;
__END__
=head1 NAME
Module::Build::Platform::Windows - Builder class for Windows platforms
=head1 DESCRIPTION
The sole purpose of this module is to inherit from
C<Module::Build::Base> and override a few methods. Please see
L<Module::Build> for the docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
=head1 SEE ALSO
perl(1), Module::Build(3)
=cut

40
inc/Module-Build/Module/Build/Platform/aix.pm Normal file
View File

@ -0,0 +1,40 @@
package Module::Build::Platform::aix;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use vars qw(@ISA);
@ISA = qw(Module::Build::Platform::Unix);
# This class isn't necessary anymore, but we can't delete it, because
# some people might still have the old copy in their @INC, containing
# code we don't want to execute, so we have to make sure an upgrade
# will replace it with this empty subclass.
1;
__END__
=head1 NAME
Module::Build::Platform::aix - Builder class for AIX platform
=head1 DESCRIPTION
This module provides some routines very specific to the AIX
platform.
Please see the L<Module::Build> for the general docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

39
inc/Module-Build/Module/Build/Platform/cygwin.pm Normal file
View File

@ -0,0 +1,39 @@
package Module::Build::Platform::cygwin;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use vars qw(@ISA);
@ISA = qw(Module::Build::Platform::Unix);
sub manpage_separator {
'.'
}
1;
__END__
=head1 NAME
Module::Build::Platform::cygwin - Builder class for Cygwin platform
=head1 DESCRIPTION
This module provides some routines very specific to the cygwin
platform.
Please see the L<Module::Build> for the general docs.
=head1 AUTHOR
Initial stub by Yitzchak Scott-Thoennes <sthoenna@efn.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

40
inc/Module-Build/Module/Build/Platform/darwin.pm Normal file
View File

@ -0,0 +1,40 @@
package Module::Build::Platform::darwin;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use vars qw(@ISA);
@ISA = qw(Module::Build::Platform::Unix);
# This class isn't necessary anymore, but we can't delete it, because
# some people might still have the old copy in their @INC, containing
# code we don't want to execute, so we have to make sure an upgrade
# will replace it with this empty subclass.
1;
__END__
=head1 NAME
Module::Build::Platform::darwin - Builder class for Mac OS X platform
=head1 DESCRIPTION
This module provides some routines very specific to the Mac OS X
platform.
Please see the L<Module::Build> for the general docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

39
inc/Module-Build/Module/Build/Platform/os2.pm Normal file
View File

@ -0,0 +1,39 @@
package Module::Build::Platform::os2;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use vars qw(@ISA);
@ISA = qw(Module::Build::Platform::Unix);
sub manpage_separator { '.' }
sub have_forkpipe { 0 }
1;
__END__
=head1 NAME
Module::Build::Platform::os2 - Builder class for OS/2 platform
=head1 DESCRIPTION
This module provides some routines very specific to the OS/2
platform.
Please see the L<Module::Build> for the general docs.
=head1 AUTHOR
Ken Williams <kwilliams@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut

106
inc/Module-Build/Module/Build/PodParser.pm Normal file
View File

@ -0,0 +1,106 @@
package Module::Build::PodParser;
use strict;
use vars qw($VERSION);
$VERSION = '0.34';
$VERSION = eval $VERSION;
use vars qw(@ISA);
sub new {
# Perl is so fun.
my $package = shift;
my $self;
# Try using Pod::Parser first
if (eval{ require Pod::Parser; 1; }) {
@ISA = qw(Pod::Parser);
$self = $package->SUPER::new(@_);
$self->{have_pod_parser} = 1;
} else {
@ISA = ();
*parse_from_filehandle = \&_myparse_from_filehandle;
$self = bless {have_pod_parser => 0, @_}, $package;
}
unless ($self->{fh}) {
die "No 'file' or 'fh' parameter given" unless $self->{file};
$self->{fh} = IO::File->new($self->{file}) or die "Couldn't open $self->{file}: $!";
}
return $self;
}
sub _myparse_from_filehandle {
my ($self, $fh) = @_;
local $_;
while (<$fh>) {
next unless /^=(?!cut)/ .. /^=cut/; # in POD
last if ($self->{abstract}) = /^ (?: [a-z:]+ \s+ - \s+ ) (.*\S) /ix;
}
my @author;
while (<$fh>) {
next unless /^=head1\s+AUTHORS?/ ... /^=/;
next if /^=/;
push @author, $_ if /\@/;
}
return unless @author;
s/^\s+|\s+$//g foreach @author;
$self->{author} = \@author;
return;
}
sub get_abstract {
my $self = shift;
return $self->{abstract} if defined $self->{abstract};
$self->parse_from_filehandle($self->{fh});
return $self->{abstract};
}
sub get_author {
my $self = shift;
return $self->{author} if defined $self->{author};
$self->parse_from_filehandle($self->{fh});
return $self->{author} || [];
}
################## Pod::Parser overrides ###########
sub initialize {
my $self = shift;
$self->{_head} = '';
$self->SUPER::initialize();
}
sub command {
my ($self, $cmd, $text) = @_;
if ( $cmd eq 'head1' ) {
$text =~ s/^\s+//;
$text =~ s/\s+$//;
$self->{_head} = $text;
}
}
sub textblock {
my ($self, $text) = @_;
$text =~ s/^\s+//;
$text =~ s/\s+$//;
if ($self->{_head} eq 'NAME') {
my ($name, $abstract) = split( /\s+-\s+/, $text, 2 );
$self->{abstract} = $abstract;
} elsif ($self->{_head} =~ /^AUTHORS?$/) {
push @{$self->{author}}, $text if $text =~ /\@/;
}
}
sub verbatim {}
sub interior_sequence {}
1;

686
inc/Module-Build/Module/Build/Version.pm Normal file
View File

@ -0,0 +1,686 @@
package Module::Build::Version;
use strict;
use vars qw($VERSION);
$VERSION = 0.77;
eval "use version $VERSION";
if ($@) { # can't locate version files, use our own
# Avoid redefined warnings if an old version.pm was available
delete $version::{$_} foreach keys %version::;
# first we get the stub version module
my $version;
while (<DATA>) {
s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
$version .= $_ if $_;
last if /^1;$/;
}
# and now get the current version::vpp code
my $vpp;
while (<DATA>) {
s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
$vpp .= $_ if $_;
last if /^1;$/;
}
# but we eval them in reverse order since version depends on
# version::vpp to already exist
eval $vpp; die $@ if $@;
$INC{'version/vpp.pm'} = 'inside Module::Build::Version';
eval $version; die $@ if $@;
$INC{'version.pm'} = 'inside Module::Build::Version';
}
# now we can safely subclass version, installed or not
use vars qw(@ISA);
@ISA = qw(version);
1;
__DATA__
# stub version module to make everything else happy
package version;
use 5.005_04;
use strict;
use vars qw(@ISA $VERSION $CLASS *declare *qv);
$VERSION = 0.77;
$CLASS = 'version';
push @ISA, "version::vpp";
local $^W;
*version::qv = \&version::vpp::qv;
*version::declare = \&version::vpp::declare;
*version::_VERSION = \&version::vpp::_VERSION;
if ($] > 5.009001 && $] <= 5.010000) {
no strict 'refs';
*{'version::stringify'} = \*version::vpp::stringify;
*{'version::(""'} = \*version::vpp::stringify;
*{'version::new'} = \*version::vpp::new;
}
# Preloaded methods go here.
sub import {
no strict 'refs';
my ($class) = shift;
# Set up any derived class
unless ($class eq 'version') {
local $^W;
*{$class.'::declare'} = \&version::declare;
*{$class.'::qv'} = \&version::qv;
}
my %args;
if (@_) { # any remaining terms are arguments
map { $args{$_} = 1 } @_
}
else { # no parameters at all on use line
%args =
(
qv => 1,
'UNIVERSAL::VERSION' => 1,
);
}
my $callpkg = caller();
if (exists($args{declare})) {
*{$callpkg."::declare"} =
sub {return $class->declare(shift) }
unless defined(&{$callpkg.'::declare'});
}
if (exists($args{qv})) {
*{$callpkg."::qv"} =
sub {return $class->qv(shift) }
unless defined(&{"$callpkg\::qv"});
}
if (exists($args{'UNIVERSAL::VERSION'})) {
local $^W;
*UNIVERSAL::VERSION = \&version::_VERSION;
}
if (exists($args{'VERSION'})) {
*{$callpkg."::VERSION"} = \&version::_VERSION;
}
}
1;
# replace everything from here to the end with the current version/vpp.pm
package version::vpp;
use strict;
use POSIX qw/locale_h/;
use locale;
use vars qw ($VERSION @ISA @REGEXS);
$VERSION = '0.77';
$VERSION = eval $VERSION;
push @REGEXS, qr/
^v? # optional leading 'v'
(\d*) # major revision not required
\. # requires at least one decimal
(?:(\d+)\.?){1,}
/x;
use overload (
'""' => \&stringify,
'0+' => \&numify,
'cmp' => \&vcmp,
'<=>' => \&vcmp,
'bool' => \&vbool,
'nomethod' => \&vnoop,
);
my $VERSION_MAX = 0x7FFFFFFF;
eval "use warnings";
if ($@) {
eval '
package warnings;
sub enabled {return $^W;}
1;
';
}
sub new
{
my ($class, $value) = @_;
my $self = bless ({}, ref ($class) || $class);
if ( ref($value) && eval('$value->isa("version")') ) {
# Can copy the elements directly
$self->{version} = [ @{$value->{version} } ];
$self->{qv} = 1 if $value->{qv};
$self->{alpha} = 1 if $value->{alpha};
$self->{original} = ''.$value->{original};
return $self;
}
my $currlocale = setlocale(LC_ALL);
# if the current locale uses commas for decimal points, we
# just replace commas with decimal places, rather than changing
# locales
if ( localeconv()->{decimal_point} eq ',' ) {
$value =~ tr/,/./;
}
if ( not defined $value or $value =~ /^undef$/ ) {
# RT #19517 - special case for undef comparison
# or someone forgot to pass a value
push @{$self->{version}}, 0;
$self->{original} = "0";
return ($self);
}
if ( $#_ == 2 ) { # must be CVS-style
$value = 'v'.$_[2];
}
$value = _un_vstring($value);
# exponential notation
if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
$value = sprintf("%.9f",$value);
$value =~ s/(0+)$//; # trim trailing zeros
}
# This is not very efficient, but it is morally equivalent
# to the XS code (as that is the reference implementation).
# See vutil/vutil.c for details
my $qv = 0;
my $alpha = 0;
my $width = 3;
my $saw_period = 0;
my $vinf = 0;
my ($start, $last, $pos, $s);
$s = 0;
while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
$s++;
}
if (substr($value,$s,1) eq 'v') {
$s++; # get past 'v'
$qv = 1; # force quoted version processing
}
$start = $last = $pos = $s;
# pre-scan the input string to check for decimals/underbars
while ( substr($value,$pos,1) =~ /[._\d,]/ ) {
if ( substr($value,$pos,1) eq '.' ) {
if ($alpha) {
Carp::croak("Invalid version format ".
"(underscores before decimal)");
}
$saw_period++;
$last = $pos;
}
elsif ( substr($value,$pos,1) eq '_' ) {
if ($alpha) {
require Carp;
Carp::croak("Invalid version format ".
"(multiple underscores)");
}
$alpha = 1;
$width = $pos - $last - 1; # natural width of sub-version
}
elsif ( substr($value,$pos,1) eq ','
and substr($value,$pos+1,1) =~ /[0-9]/ ) {
# looks like an unhandled locale
$saw_period++;
$last = $pos;
}
$pos++;
}
if ( $alpha && !$saw_period ) {
require Carp;
Carp::croak("Invalid version format ".
"(alpha without decimal)");
}
if ( $alpha && $saw_period && $width == 0 ) {
require Carp;
Carp::croak("Invalid version format ".
"(misplaced _ in number)");
}
if ( $saw_period > 1 ) {
$qv = 1; # force quoted version processing
}
$last = $pos;
$pos = $s;
if ( $qv ) {
$self->{qv} = 1;
}
if ( $alpha ) {
$self->{alpha} = 1;
}
if ( !$qv && $width < 3 ) {
$self->{width} = $width;
}
while ( substr($value,$pos,1) =~ /\d/ ) {
$pos++;
}
if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
my $rev;
while (1) {
$rev = 0;
{
# this is atoi() that delimits on underscores
my $end = $pos;
my $mult = 1;
my $orev;
# the following if() will only be true after the decimal
# point of a version originally created with a bare
# floating point number, i.e. not quoted in any way
if ( !$qv && $s > $start && $saw_period == 1 ) {
$mult *= 100;
while ( $s < $end ) {
$orev = $rev;
$rev += substr($value,$s,1) * $mult;
$mult /= 10;
if ( abs($orev) > abs($rev)
|| abs($rev) > abs($VERSION_MAX) ) {
if ( warnings::enabled("overflow") ) {
require Carp;
Carp::carp("Integer overflow in version");
}
$s = $end - 1;
$rev = $VERSION_MAX;
}
$s++;
if ( substr($value,$s,1) eq '_' ) {
$s++;
}
}
}
else {
while (--$end >= $s) {
$orev = $rev;
$rev += substr($value,$end,1) * $mult;
$mult *= 10;
if ( abs($orev) > abs($rev)
|| abs($rev) > abs($VERSION_MAX) ) {
if ( warnings::enabled("overflow") ) {
require Carp;
Carp::carp("Integer overflow in version");
}
$end = $s - 1;
$rev = $VERSION_MAX;
}
}
}
}
# Append revision
push @{$self->{version}}, $rev;
if ( substr($value,$pos,1) eq '.'
&& substr($value,$pos+1,1) =~ /\d/ ) {
$s = ++$pos;
}
elsif ( substr($value,$pos,1) eq '_'
&& substr($value,$pos+1,1) =~ /\d/ ) {
$s = ++$pos;
}
elsif ( substr($value,$pos,1) eq ','
&& substr($value,$pos+1,1) =~ /\d/ ) {
$s = ++$pos;
}
elsif ( substr($value,$pos,1) =~ /\d/ ) {
$s = $pos;
}
else {
$s = $pos;
last;
}
if ( $qv ) {
while ( substr($value,$pos,1) =~ /\d/ ) {
$pos++;
}
}
else {
my $digits = 0;
while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
if ( substr($value,$pos,1) ne '_' ) {
$digits++;
}
$pos++;
}
}
}
}
if ( $qv ) { # quoted versions always get at least three terms
my $len = scalar @{$self->{version}};
$len = 3 - $len;
while ($len-- > 0) {
push @{$self->{version}}, 0;
}
}
if ( substr($value,$pos) ) { # any remaining text
if ( warnings::enabled("misc") ) {
require Carp;
Carp::carp("Version string '$value' contains invalid data; ".
"ignoring: '".substr($value,$pos)."'");
}
}
# cache the original value for use when stringification
if ( $vinf ) {
$self->{vinf} = 1;
$self->{original} = 'v.Inf';
}
else {
$self->{original} = substr($value,0,$pos);
}
return ($self);
}
*parse = \&new;
sub numify
{
my ($self) = @_;
unless (_verify($self)) {
require Carp;
Carp::croak("Invalid version object");
}
my $width = $self->{width} || 3;
my $alpha = $self->{alpha} || "";
my $len = $#{$self->{version}};
my $digit = $self->{version}[0];
my $string = sprintf("%d.", $digit );
for ( my $i = 1 ; $i < $len ; $i++ ) {
$digit = $self->{version}[$i];
if ( $width < 3 ) {
my $denom = 10**(3-$width);
my $quot = int($digit/$denom);
my $rem = $digit - ($quot * $denom);
$string .= sprintf("%0".$width."d_%d", $quot, $rem);
}
else {
$string .= sprintf("%03d", $digit);
}
}
if ( $len > 0 ) {
$digit = $self->{version}[$len];
if ( $alpha && $width == 3 ) {
$string .= "_";
}
$string .= sprintf("%0".$width."d", $digit);
}
else # $len = 0
{
$string .= sprintf("000");
}
return $string;
}
sub normal
{
my ($self) = @_;
unless (_verify($self)) {
require Carp;
Carp::croak("Invalid version object");
}
my $alpha = $self->{alpha} || "";
my $len = $#{$self->{version}};
my $digit = $self->{version}[0];
my $string = sprintf("v%d", $digit );
for ( my $i = 1 ; $i < $len ; $i++ ) {
$digit = $self->{version}[$i];
$string .= sprintf(".%d", $digit);
}
if ( $len > 0 ) {
$digit = $self->{version}[$len];
if ( $alpha ) {
$string .= sprintf("_%0d", $digit);
}
else {
$string .= sprintf(".%0d", $digit);
}
}
if ( $len <= 2 ) {
for ( $len = 2 - $len; $len != 0; $len-- ) {
$string .= sprintf(".%0d", 0);
}
}
return $string;
}
sub stringify
{
my ($self) = @_;
unless (_verify($self)) {
require Carp;
Carp::croak("Invalid version object");
}
return exists $self->{original}
? $self->{original}
: exists $self->{qv}
? $self->normal
: $self->numify;
}
sub vcmp
{
require UNIVERSAL;
my ($left,$right,$swap) = @_;
my $class = ref($left);
unless ( UNIVERSAL::isa($right, $class) ) {
$right = $class->new($right);
}
if ( $swap ) {
($left, $right) = ($right, $left);
}
unless (_verify($left)) {
require Carp;
Carp::croak("Invalid version object");
}
unless (_verify($right)) {
require Carp;
Carp::croak("Invalid version object");
}
my $l = $#{$left->{version}};
my $r = $#{$right->{version}};
my $m = $l < $r ? $l : $r;
my $lalpha = $left->is_alpha;
my $ralpha = $right->is_alpha;
my $retval = 0;
my $i = 0;
while ( $i <= $m && $retval == 0 ) {
$retval = $left->{version}[$i] <=> $right->{version}[$i];
$i++;
}
# tiebreaker for alpha with identical terms
if ( $retval == 0
&& $l == $r
&& $left->{version}[$m] == $right->{version}[$m]
&& ( $lalpha || $ralpha ) ) {
if ( $lalpha && !$ralpha ) {
$retval = -1;
}
elsif ( $ralpha && !$lalpha) {
$retval = +1;
}
}
# possible match except for trailing 0's
if ( $retval == 0 && $l != $r ) {
if ( $l < $r ) {
while ( $i <= $r && $retval == 0 ) {
if ( $right->{version}[$i] != 0 ) {
$retval = -1; # not a match after all
}
$i++;
}
}
else {
while ( $i <= $l && $retval == 0 ) {
if ( $left->{version}[$i] != 0 ) {
$retval = +1; # not a match after all
}
$i++;
}
}
}
return $retval;
}
sub vbool {
my ($self) = @_;
return vcmp($self,$self->new("0"),1);
}
sub vnoop {
require Carp;
Carp::croak("operation not supported with version object");
}
sub is_alpha {
my ($self) = @_;
return (exists $self->{alpha});
}
sub qv {
my $value = shift;
my $class = 'version';
if (@_) {
$class = ref($value) || $value;
$value = shift;
}
$value = _un_vstring($value);
$value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
my $version = $class->new($value);
return $version;
}
*declare = \&qv;
sub is_qv {
my ($self) = @_;
return (exists $self->{qv});
}
sub _verify {
my ($self) = @_;
if ( ref($self)
&& eval { exists $self->{version} }
&& ref($self->{version}) eq 'ARRAY'
) {
return 1;
}
else {
return 0;
}
}
sub _un_vstring {
my $value = shift;
# may be a v-string
if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
my $tvalue = sprintf("v%vd",$value);
if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
# must be a v-string
$value = $tvalue;
}
}
return $value;
}
sub _VERSION {
my ($obj, $req) = @_;
my $class = ref($obj) || $obj;
no strict 'refs';
eval "require $class" unless %{"$class\::"}; # already existing
return undef if $@ =~ /Can't locate/ and not defined $req;
if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
require Carp;
Carp::croak( "$class defines neither package nor VERSION"
."--version check failed");
}
my $version = eval "\$$class\::VERSION";
if ( defined $version ) {
local $^W if $] <= 5.008;
$version = version::vpp->new($version);
}
if ( defined $req ) {
unless ( defined $version ) {
require Carp;
my $msg = $] < 5.006
? "$class version $req required--this is only version "
: "$class does not define \$$class\::VERSION"
."--version check failed";
if ( $ENV{VERSION_DEBUG} ) {
Carp::confess($msg);
}
else {
Carp::croak($msg);
}
}
$req = version::vpp->new($req);
if ( $req > $version ) {
require Carp;
if ( $req->is_qv ) {
Carp::croak(
sprintf ("%s version %s required--".
"this is only version %s", $class,
$req->normal, $version->normal)
);
}
else {
Carp::croak(
sprintf ("%s version %s required--".
"this is only version %s", $class,
$req->stringify, $version->stringify)
);
}
}
}
return defined $version ? $version->stringify : undef;
}
1; #this line is important and will help the module return a true value

161
inc/Module-Build/Module/Build/YAML.pm Normal file
View File

@ -0,0 +1,161 @@
package Module::Build::YAML;
use strict;
use vars qw($VERSION @EXPORT @EXPORT_OK);
$VERSION = "0.50";
@EXPORT = ();
@EXPORT_OK = qw(Dump Load DumpFile LoadFile);
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
return($self);
}
sub Dump {
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
my $yaml = "";
foreach my $item (@_) {
$yaml .= "---\n";
$yaml .= &_yaml_chunk("", $item);
}
return $yaml;
}
sub Load {
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
die "not yet implemented";
}
# This is basically copied out of YAML.pm and simplified a little.
sub DumpFile {
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
my $filename = shift;
local $/ = "\n"; # reset special to "sane"
my $mode = '>';
if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
($mode, $filename) = ($1, $2);
}
open my $OUT, "$mode $filename"
or die "Can't open $filename for writing: $!";
binmode($OUT, ':utf8') if $] >= 5.008;
print $OUT Dump(@_);
close $OUT;
}
# This is basically copied out of YAML.pm and simplified a little.
sub LoadFile {
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
my $filename = shift;
open my $IN, $filename
or die "Can't open $filename for reading: $!";
binmode($IN, ':utf8') if $] >= 5.008;
return Load(do { local $/; <$IN> });
close $IN;
}
sub _yaml_chunk {
my ($indent, $values) = @_;
my $yaml_chunk = "";
my $ref = ref($values);
my ($value, @allkeys, %keyseen);
if (!$ref) { # a scalar
$yaml_chunk .= &_yaml_value($values) . "\n";
}
elsif ($ref eq "ARRAY") {
foreach $value (@$values) {
$yaml_chunk .= "$indent-";
$ref = ref($value);
if (!$ref) {
$yaml_chunk .= " " . &_yaml_value($value) . "\n";
}
else {
$yaml_chunk .= "\n";
$yaml_chunk .= &_yaml_chunk("$indent ", $value);
}
}
}
else { # assume "HASH"
if ($values->{_order} && ref($values->{_order}) eq "ARRAY") {
@allkeys = @{$values->{_order}};
$values = { %$values };
delete $values->{_order};
}
push(@allkeys, sort keys %$values);
foreach my $key (@allkeys) {
next if (!defined $key || $key eq "" || $keyseen{$key});
$keyseen{$key} = 1;
$yaml_chunk .= "$indent$key:";
$value = $values->{$key};
$ref = ref($value);
if (!$ref) {
$yaml_chunk .= " " . &_yaml_value($value) . "\n";
}
else {
$yaml_chunk .= "\n";
$yaml_chunk .= &_yaml_chunk("$indent ", $value);
}
}
}
return($yaml_chunk);
}
sub _yaml_value {
my ($value) = @_;
# undefs become ~
return '~' if not defined $value;
# empty strings will become empty strings
return '""' if $value eq '';
# allow simple scalars (without embedded quote chars) to be unquoted
# (includes $%_+=-\;:,./)
return $value if $value !~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/;
# quote and escape strings with special values
return "'$value'"
if $value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/; # nothing but " or @ or < or > (email addresses)
$value =~ s/\n/\\n/g; # handle embedded newlines
$value =~ s/"/\\"/g; # handle embedded quotes
return qq{"$value"};
}
1;
__END__
=head1 NAME
Module::Build::YAML - Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed
=head1 SYNOPSIS
use Module::Build::YAML;
...
=head1 DESCRIPTION
Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed.
Currently, this amounts to the ability to write META.yml files when C<perl Build distmeta>
is executed via the Dump() and DumpFile() functions/methods.
=head1 AUTHOR
Stephen Adkins <spadkins@gmail.com>
=head1 COPYRIGHT
Copyright (c) 2006. Stephen Adkins. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See L<http://www.perl.com/perl/misc/Artistic.html>
=cut

19
it/check_jmx4perl/base.cfg Normal file
View File

@ -0,0 +1,19 @@
# ================================================
# Base definitions:
# Check for relative memory checks
<Check base_memory_relative>
Use = base_relative_threshold($0,$1)
Use = base_relative_label
Label = (base) $BASE
Unit = B
</Check>
<Check base_relative_threshold>
Critical = ${0:90}
Warning = ${1:80}
</Check>
<Check base_relative_label>
Label = (grandpa) %.2r% used (%.2v %u / %.2b %w)
</Check>

50
it/check_jmx4perl/base.pl Normal file
View File

@ -0,0 +1,50 @@
# Base functions for various check_jmx4perl checks
use strict;
use FindBin;
use JMX::Jmx4Perl::Alias;
use JMX::Jmx4Perl::Request;
use JMX::Jmx4Perl::Response;
sub exec_check_perl4jmx {
my @args;
for (@_) {
push @args,split;
}
my ($url,$user,$password,$product,$target,$target_user,$target_password) =
@ENV{"JMX4PERL_GATEWAY","JMX4PERL_USER",
"JMX4PERL_PASSWORD","JMX4PERL_PRODUCT","JMX4PERL_TARGET_URL","JMX4PERL_TARGET_USER","JMX4PERL_TARGET_PASSWORD"};
push @args,("--user",$user,"--password",$password) if $user;
push @args,("--product",$product) if $product;
push @args,("--url",$url);
push @args,("--target",$target) if $target;
push @args,("--target-user",$target_user,"--target-password",$target_password) if $target_user;
#push @args,"--legacy-escape";
#push @args,("--verbose");
my $cmd = "perl $FindBin::Bin/../../scripts/check_jmx4perl "
.join(" ",map { '"' . $_ . '"' } @args);
#print $cmd,"\n";
open (F,"$cmd 2>&1 |")
|| die "Cannot open check_jmx4perl: $!";
my $content = join "",<F>;
close F;
if ($? == -1) {
die "check_jmx4perl: failed to execute: $!\n";
}
elsif ($? & 127) {
die "check_jmx4perl child died with signal %d, %s coredump\n",
($? & 127), ($? & 128) ? 'with' : 'without';
}
return ($? >> 8,$content);
}
sub reset_history {
my $jmx = shift;
my ($mbean,$operation) = $jmx->resolve_alias(JMX4PERL_HISTORY_RESET);
my $req = new JMX::Jmx4Perl::Request(EXEC,$mbean,$operation,{target => undef});
my $resp = $jmx->request($req);
}
1;

195
it/check_jmx4perl/checks.cfg Normal file
View File

@ -0,0 +1,195 @@
# Include base configuration
include base.cfg
# ==================================================================
# Various parameterized checks
<Check outer_arg>
Use = memory_heap
Critical = 90
Label = $0 $BASE (Warning: %.2y, Critical: %.2z)
</Check>
# ==================================================================
# Predefined Checks
# Heap Memory
<Check memory_heap>
Use = base_memory_relative
Value = java.lang:type=Memory/HeapMemoryUsage/used
Base = java.lang:type=Memory/HeapMemoryUsage/max
Name = Heap Memory ${0:default_name}
Label = Heap-Memory: $BASE
</Check>
<Check memory_heap2>
Use = base_memory_relative
MBean = java.lang:type=Memory
Attribute = HeapMemoryUsage
Path = used
BaseMBean = java.lang:type=Memory
BaseAttribute = HeapMemoryUsage
BasePath = max
Name = Heap Memory ${0:default_name}
Label = Heap-Memory: $BASE
</Check>
<Check memory_heap_with_label>
Value = java.lang:type=Memory/HeapMemoryUsage/used
Name = $1
Label = $0
Critical = 1:
</Check>
# Perm Gen Memory (used for class definitions)
<Check memory_non_heap>
Use = base_memory_relative($0,$1)
Value = java.lang:type=Memory/NonHeapMemoryUsage/used
Base = java.lang:type=Memory/HeapMemoryUsage/max
Label = NonHeap Memory: $BASE
</Check>
# ===============================================
# Thread count
<Check thread_count>
Value = java.lang:type=Threading/ThreadCount
Name = ${0} $1 $2
Label = "thread_count: $0 $1 $2 : Value %f in range"
Critical = ${0}
Warning = $1
Method = POST
</Check>
<Check invalid_method>
Value = java.lang:type=Threading/ThreadCount
Name = $0 $1 $2
Critical = $0
Warning = $1
Method = Bla
</Check>
# Child
<Check def_placeholder_1>
Use thread_count(,2)
</Check>
<Check def_placeholder_2>
Use thread_count(${0},2)
</Check>
<Check def_placeholder_3>
Use thread_count
</Check>
# =========================================================
# Operation checks
<Check overloaded_operation>
MBean = jolokia.it:type=operation
Operation = overloadedMethod(java.lang.String)
Argument = ${0}
Critical = 5
Warning = :1
</Check>
# =========================================================
# Bug specific checks
# MBean with '#'
<Check hash_check>
MBean = jolokia/it:pid=[ServiceRegistryProvider\#(null)],type=ParticipantMonitor,id=*
Attribute = Ok
String = 1
Label = ServiceRegistryProvider is running
Name = Running
Critical = !OK
</Check>
# Scripting check
<Check script_check>
Script <<EOT
my $pools = $j4p->search("java.lang:type=MemoryPool,*");
my @matched_pools;
my $pattern = "${0}";
for my $pool (@$pools) {
push @matched_pools,$pool if $pool =~ /$pattern/;
}
return $j4p->get_attribute($matched_pools[0],"Usage","used");
EOT
Name script_check $0
Critical ${1:10}
Unit B
</Check>
<MultiCheck script_multi_check>
Check memory_heap(90,80)
Check script_check('Eden|Java',1000000000)
Check memory_non_heap(90,80)
Check script_check($0,1000000000)
Check thread_count(1000,2000,3000)
</MultiCheck>
# Double values below a threshold
<Check double_min>
Name = double_min
MBean = jolokia.it:type=attribute
Attribute = DoubleValueMin
Critical = 1
Warning = 2
</Check>
<Check double_max>
Name = double_max
MBean = jolokia.it:type=attribute
Attribute = DoubleValueMax
Critical = 1
Warning = 2
</Check>
<Check with_name>
Use = thread_count
Critical = $1
Name = $0
</Check>
<Check without_threshold>
Use = thread_count
</Check>
# =================================
# #81699
# Find deadlocked Threads
<Check thread_deadlock>
MBean = java.lang:type=Threading
Operation = findDeadlockedThreads
Null = no deadlock
Name = Thread-Deadlock
String = 1
Critical = !no deadlock
</Check>
<Check counter_operation>
MBean jolokia.it:type=operation
Operation fetchNumber
Argument ${0:inc}
Critical 3
Warning 2
</Check>
# 75062
<Check memory_without_perfdata>
Use = base_memory_relative($0,$1)
Value = java.lang:type=Memory/HeapMemoryUsage/used
Base = java.lang:type=Memory/HeapMemoryUsage/max
Name = Heap Memory ${0:default_name}
Label = Heap-Memory: $BASE
PerfData = ${2:No}
</Check>
<Check memory_with_perfdata>
Use = memory_without_perfdata(90,80,'yes')
</Check>

64
it/check_jmx4perl/multi_check.cfg Normal file
View File

@ -0,0 +1,64 @@
include checks.cfg
# =======================================================================
# Multi checks to check
<MultiCheck memory>
Check memory_non_heap
Check memory_heap
</MultiCheck>
<MultiCheck nested>
Check thread_count(400,,"'Thread-Count'")
# Multi-Check referenced via 'Check'
Check memory
</MultiCheck>
<MultiCheck with_inner_args>
Check thread_count(400)
Check memory_heap_with_label("HelloLabel","WithInnerArgs")
</MultiCheck>
<MultiCheck with_outer_args>
Check thread_count(400)
Check memory_heap_with_label("HelloLabel",$0)
</MultiCheck>
<MultiCheck failing_multi_check>
HtmlOutput
Check memory_non_heap(1,2)
Check memory_non_heap(30,20)
Check memory_heap(1,2)
</MultiCheck>
<MultiCheck error_multi_check>
Check memory_heap
Check kaputt
Check memory_heap(1,2)
</MultiCheck>
<Check kaputt>
MBean bla:type=blub
Attribute foobar
</Check>
<MultiCheck nested_with_args>
MultiCheck with_outer_args("NestedWithArgs")
</MultiCheck>
<MultiCheck nested_with_outer_args>
# MulitCheck referenced via Check
Check with_outer_args($0)
</MultiCheck>
<MultiCheck overloaded_multi_check>
Check overloaded_operation("blub")
</MultiCheck>
# Multicheck where the checks have different arguments
# but are otherwise the same checks.
<MultiCheck label_test>
Check with_name("bla",1)
Check with_name("blub",2)
</MultiCheck>

62
it/it.pl Executable file
View File

@ -0,0 +1,62 @@
#!/usr/bin/perl
use FindBin;
use lib "$FindBin::Bin/../lib";
use Getopt::Long;
use strict;
use TAP::Harness;
use Data::Dumper;
my $dir = $FindBin::Bin . "/t";
my ($gateway_url,$user,$password,$product,$target_url,$target_user,$target_password);
GetOptions("dir=s" => \$dir,
"url=s" => \$gateway_url,
"target=s" => \$target_url,
"target-user=s" => \$target_user,
"target-password=s" => \$target_password,
"user=s" => \$user,
"password=s" => \$password,
"product=s" => \$product);
die "No gateway url given. Please use option '--url' for pointing to the server with the agent installed\n" unless $gateway_url;
my @testfiles;
if (@ARGV) {
@testfiles = prepare_filenames(@ARGV);
} else {
opendir(D,$dir) || die "Cannot open test dir $dir : $!";
@testfiles = prepare_filenames(grep { /\.t$/ } map { $dir . "/" . $_ } readdir(D));
closedir D;
}
my $harness = new TAP::Harness
({
verbosity => 1,
timer => 1,
show_count => 0,
color => 1,
merge => 1,
jobs => 1,
lib => [ "$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib", "$FindBin::Bin" ]
});
$ENV{JMX4PERL_GATEWAY} = $gateway_url;
$ENV{JMX4PERL_TARGET_URL} = $target_url;
$ENV{JMX4PERL_TARGET_USER} = $target_user;
$ENV{JMX4PERL_TARGET_PASSWORD} = $target_password;
$ENV{JMX4PERL_USER} = $user;
$ENV{JMX4PERL_PASSWORD} = $password;
$ENV{JMX4PERL_PRODUCT} = $product;
$harness->runtests(@testfiles);
sub prepare_filenames {
my @files = @_;
my @ret = ();
for (@files) {
my $name = $_;
$name =~ s|.*/([^/]+)$|$1|;
push @ret,[ $_, $name ];
}
return @ret;
}

29
it/t/01_version.t Normal file
View File

@ -0,0 +1,29 @@
#!/usr/bin/perl
use It;
use Test::More tests => 1;
use strict;
use JMX::Jmx4Perl::Request;
use JMX::Jmx4Perl;
use Data::Dumper;
my $jmx = new It(verbose => 0)->jmx4perl;
my $resp = $jmx->request(new JMX::Jmx4Perl::Request(AGENT_VERSION));
my $value = $resp->{value};
my $version_exp = $JMX::Jmx4Perl::VERSION;
my ($base,$ext) = ($1,$3) if $version_exp =~ /^([\d.]+)(_(\d+))?$/;
$base = $base . ".0" unless $base =~ /^\d+\.\d+\.\d+$/;
$version_exp = $base . ($ext ? ".M" . $ext : "");
my $agent_version = $value->{agent};
if ($agent_version =~ /(\d+)\.(\d+)\.(\d+)(-SNAPSHOT)?/) {
$agent_version = "$1.$2$3";
}
#ok($agent_version >= $version_exp,"Jolokia-version " . $value->{agent} . " >= Jmx4Perl Version " . $version_exp);
print "Agent-Version:\n";
print Dumper($value);
ok($value->{protocol} > 0,"Protocol version " . $value->{protocol});
#print Dumper(\@resps);
my $resp = $jmx->request(new JMX::Jmx4Perl::Request(READ,"java.lang:type=Runtime","SystemProperties"));
$value = $resp->{value};
print "Java: ",$value->{'java.version'}," (",$value->{'java.vendor'},")\n";

14
it/t/02_http_header.t Normal file
View File

@ -0,0 +1,14 @@
use It;
use Data::Dumper;
use Test::More tests => 2;
my $it = new It(verbose => 0);
my $agent = $it->userAgent;
my $j4p = $it->jmx4perl;
my $resp = $agent->get($j4p->url() . "/version");
my $date = $resp->date;
my $expire = $resp->expires;
#print Dumper($resp);
#print "Date: $date\nExpires: $expire\n";
ok($expire <= $date,"expires must be less or equal date");
ok($resp->header('Expires') =~ /\w{3}, \d{1,2} \w{3} \d{4} \d{2}:\d{2}:\d{2} GMT/,"RFC-1123 Format matched");

25
it/t/10_base.t Normal file
View File

@ -0,0 +1,25 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
BEGIN { use_ok("JMX::Jmx4Perl"); }
my $jmx = new It()->jmx4perl;
my $product = $ENV{JMX4PERL_PRODUCT};
# Test autodetection
if ($product) {
my $jmx_auto = new JMX::Jmx4Perl(map { $_ => $jmx->cfg($_) } qw(url user password));
$jmx_auto->info;
is($jmx_auto->product->id,$product,"Autodetected proper server " . $product);
}
# Test info and detected handler
my $info = $jmx->info();
my $info_product = $1 if $info =~ /^Name:\s+(.*)/m;
my $info_version = $1 if $info =~ /^Version:\s+(.*)/m;
is($jmx->product->name,$info_product || "unknown","Product name match");
is($jmx->product->version,$info_version,"Product version match") if $info_version;

59
it/t/30_naming.t Normal file
View File

@ -0,0 +1,59 @@
# -*- mode: cperl -*-
use It;
use strict;
use warnings;
use Test::More qw(no_plan);
use File::Temp qw/tmpnam/;
use Data::Dumper;
BEGIN { use_ok("JMX::Jmx4Perl"); }
my $jmx = It->new(verbose => 0)->jmx4perl;
my $name_p = "jolokia.it:type=naming/,name=%s";
my @names =
(
"/slash-simple/",
"simple",
"/--/",
"with%3acolon",
"//server/client",
"service%3ajmx%3armi%3a///jndi/rmi%3a//bhut%3a9999/jmxrmi",
"name with space",
"n!a!m!e with !/!"
# "äöüßÄÖÜ"
);
my @searches =
(
[ "*:name=//server/client,*", qr#(jmx4perl|jolokia)\.it(\.hidden)?:.*name=//server/client# ]
);
# Basic check:
for my $name (@names) {
my $mbean = search($jmx,sprintf($name_p,$name));
my $scalar = $jmx->get_attribute($mbean,"Ok");
is($scalar,"OK",$name);
}
for my $s (@searches) {
my $r = $jmx->search($s->[0]);
#print Dumper($r);
ok($r->[0] =~ $s->[1],"Search " . $s->[0]);
}
sub search {
my $jmx = shift;
my $prefix = shift;
my $ret = $jmx->search($prefix . ",*");
#print Dumper($ret);
if (!defined($ret)) {
fail("Search " . $prefix . ",* gives no result");
exit;
}
is(scalar(@$ret),1,"One MBean found");
return $ret->[0];
}

20
it/t/40_alias.t Normal file
View File

@ -0,0 +1,20 @@
#!/usr/bin/perl
use It;
use Test::More tests => 2;
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
BEGIN { use_ok("JMX::Jmx4Perl::Alias"); }
my $jmx = new It()->jmx4perl;
my @aliases = JMX::Jmx4Perl::Alias->all;
eval {
for my $alias (@aliases) {
if ($jmx->supports_alias($alias) && $alias->type eq "attribute") {
#print $alias->alias,": ",$jmx->get_attribute($alias),"\n";
$jmx->get_attribute($alias);
}
}
};
ok(!$@,"Aliased called: $@");

40
it/t/50_check_base.t Normal file
View File

@ -0,0 +1,40 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>1)->jmx4perl;
my ($ret,$content);
# ====================================================
# Basic checks
my %s = (
":10000000000" => [ 0, "OK" ],
"0.2:" => [ 0, "OK" ],
":0.2" => [ 2, "CRITICAL" ],
"5:6" => [ 2, "CRITICAL" ]
);
for my $k (keys %s) {
($ret,$content) = exec_check_perl4jmx("--mbean java.lang:type=Memory --attribute HeapMemoryUsage",
"--path used -c $k");
#print Dumper($ret,$content);
is($ret,$s{$k}->[0],"Memory -c $k : $ret");
ok($content =~ /^$s{$k}->[1]/m,"Memory -c $k : " . $s{$k}->[1]);
}
# ====================================================
# Alias attribute checks
for my $k (keys %s) {
($ret,$content) = exec_check_perl4jmx("--alias MEMORY_HEAP_USED -c $k --method post");
#print Dumper($ret,$content);
is($ret,$s{$k}->[0],"MEMORY_HEAP_USED -c $k : $ret");
ok($content =~ /^$s{$k}->[1]/m,"MEMORY_HEAP_USED $k : " . $s{$k}->[1]);
}
($ret,$content) = exec_check_perl4jmx("--mbean java.lang:type=Memory --attribute HeapMemoryUsage --path used");
is($ret,0,"No warning and no critical is always success");
ok($content =~ /in range/,"Data has been povided");

37
it/t/51_check_relative.t Normal file
View File

@ -0,0 +1,37 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>0)->jmx4perl;
my ($ret,$content);
# ====================================================
# Relative value checks
my %s = (
":90" => [ 0, "OK" ],
"0.2:" => [ 0, "OK" ],
":0.2" => [ 1, "WARNING" ],
"81:82" => [ 1, "WARNING" ]
);
my @args = ();
for my $base (qw(MEMORY_HEAP_MAX java.lang:type=Memory/HeapMemoryUsage/max 1000000000)) {
push @args,"--alias MEMORY_HEAP_USED --base $base"
}
push @args,"--alias MEMORY_HEAP_USED --base-mbean java.lang:type=Memory --base-attribute=HeapMemoryUsage --base-path=max";
for my $arg (@args) {
for my $k (keys %s) {
($ret,$content) = exec_check_perl4jmx("$arg -w $k");
#print Dumper($ret,$content);
is($ret,$s{$k}->[0],"$arg -w $k : $ret");
ok($content =~ /^$s{$k}->[1]/,"$arg -w $k : " . $s{$k}->[1]);
}
}

45
it/t/52_check_operation.t Normal file
View File

@ -0,0 +1,45 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use It;
use FindBin;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>0)->jmx4perl;
my ($ret,$content);
# ====================================================
# Operation return value check
# A single slash argument
$jmx->execute("jolokia.it:type=operation","reset");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=operation --operation fetchNumber",
"-c 1 --name counter inc");
is($ret,0,"Initial operation");
ok($content =~ /counter=(\d+)/ && $1 eq "0","Initial operation returns 0");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=operation --operation fetchNumber",
"-c 1 --name counter inc");
is($ret,0,"Second operation");
ok($content =~ /counter=(\d+)/ && $1 eq "1","Second operation returns 1");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=operation --operation fetchNumber",
"-c 1 --name counter inc");
is($ret,2,"Third operation");
ok($content =~ /counter=(\d+)/ && $1 eq "2","Third operation returns 2");
my $config_file = $FindBin::Bin . "/../check_jmx4perl/checks.cfg";
($ret,$content) = exec_check_perl4jmx("--config $config_file --check counter_operation");
ok($content =~ /value (\d+)/ && $1 eq "3","Fourth operation return 3");
is($ret,1,"Fourth operation");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=operation --operation emptyStringArgumentCheck",
"-c 1 /");
#print Dumper($ret,$content);
is($ret,0,"Single slash argument (return code)");
ok($content =~ /false/,"Single slash argument (return message)");
$jmx->execute("jolokia.it:type=operation","reset");

59
it/t/53_check_non_numeric.t Normal file
View File

@ -0,0 +1,59 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>0)->jmx4perl;
my ($ret,$content);
# ====================================================
# Non-numerice Attributes return value check
# Boolean values
$jmx->execute("jolokia.it:type=attribute","reset");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute State --critical false");
#print ($ret,$content);
is($ret,0,"Boolean: OK");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute State --critical false");
is($ret,2,"Boolean: CRITICAL");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute State --critical false --warning true");
is($ret,1,"Boolean: WARNING");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute State --critical false --warning true");
is($ret,2,"Boolean (as String): CRITICAL");
# String values
$jmx->execute("jolokia.it:type=attribute","reset");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute String --critical Started");
is($ret,2,"String: CRITICAL");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute String --critical Started");
is($ret,0,"String: OK");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute String --critical !Started");
is($ret,0,"String: OK");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute String --critical !Started");
is($ret,2,"String: CRITICAL");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute String --critical Stopped --warning qr/art/");
is($ret,1,"String: WARNING");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute String --critical qr/^St..p\\wd\$/ --warning qr/art/");
is($ret,2,"String: CRITICAL");
# Check for a null value
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute Null --critical null");
is($ret,2,"null: CRITICAL");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute Null --critical null --null bla");
is($ret,0,"null: OK");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute Null --critical bla --null bla");
is($ret,2,"null: CRITICAL");
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute Null --critical !null --string");
is($ret,0,"null: OK");
# Check for a string array value
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=attribute --attribute StringArray --string --critical qr/Stopped/");
is($ret,2,"String Array: CRITICAL");
ok($content =~ /Stopped/,"Matches Threshhold");

50
it/t/54_check_unit.t Normal file
View File

@ -0,0 +1,50 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>0)->jmx4perl;
my ($ret,$content);
# ================================================================================
# Unit conversion checking
($ret,$content) = exec_check_perl4jmx
("--mbean jolokia.it:type=attribute --attribute Bytes --critical 10000:");
is($ret,0,"Bytes: OK");
ok($content =~ /3670016/,"Bytes: Perfdata");
ok($content !~ /3\.50 MB/,"Bytes: Output");
($ret,$content) = exec_check_perl4jmx
("--mbean jolokia.it:type=attribute --attribute Bytes --critical 10000: --unit B");
is($ret,0,"Bytes: OK");
ok($content =~ /3670016B/,"Bytes Unit: Perfdata");
ok($content =~ /3\.50 MB/,"Bytes Unit: Output");
($ret,$content) = exec_check_perl4jmx
("--mbean jolokia.it:type=attribute --attribute LongSeconds --critical :10000 ");
is($ret,2,"SecondsLong: CRITICAL");
ok($content =~ /172800/,"SecondsLong: Perfdata");
ok($content !~ /2 d/,"SecondsLong: Output");
($ret,$content) = exec_check_perl4jmx
("--mbean jolokia.it:type=attribute --attribute LongSeconds --critical :10000 --unit s");
is($ret,2,"SecondsLong: CRITICAL");
ok($content =~ /172800/,"SecondsLong: Perfdata");
ok($content =~ /2 d/,"SecondsLong: Output");
($ret,$content) = exec_check_perl4jmx
("--mbean jolokia.it:type=attribute --attribute SmallMinutes --critical :10000 --unit m");
#print Dumper($ret,$content);
is($ret,0,"SmallMinutes: OK");
ok($content =~ /10.00 ms/,"SmallMinutes: Output");
($ret,$content) = exec_check_perl4jmx
("--value jolokia.it:type=attribute/MemoryUsed --base jolokia.it:type=attribute/MemoryMax --critical 80 --unit B");
#print Dumper($ret,$content);
is($ret,0,"Relative Memory: OK");
ok($content =~ /1\.99 GB/,"Relative Memory: Output");

47
it/t/55_check_incremental.t Normal file
View File

@ -0,0 +1,47 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use JMX::Jmx4Perl::Alias;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose => 1)->jmx4perl;
my ($ret,$content);
# ====================================================
# Incremental value checks
reset_history($jmx);
my $membean = "--mbean java.lang:type=Memory --attribute HeapMemoryUsage";
my $cparams = $membean . " --path used --unit B --delta --name mem";
($ret,$content) = exec_check_perl4jmx($cparams);
is($ret,0,"Initial history fetch returns OK");
#print $content;
ok($content =~ /mem=(\d+)/ && $1 eq "0","Initial history fetch returns 0 mem delta");
my $max_mem = $jmx->get_attribute("java.lang:type=Memory", "HeapMemoryUsage","max");
my $c = abs(0.50 * $max_mem);
#print "Mem Max: $mem\n";
my $mem = $jmx->get_attribute("java.lang:type=Memory", "HeapMemoryUsage","used");
#print "Used Memory: $mem\n";
# Trigger Garbage collection
$jmx->execute("java.lang:type=Memory","gc");
for my $i (0 .. 2) {
$jmx->execute("java.lang:type=Memory","gc");
($ret,$content) = exec_check_perl4jmx($cparams . " -c -$c:$c");
is($ret,0,($i+1) . ". history fetch returns OK for -c $c");
ok($content =~ /mem=([\-\d]+)/ && $1 ne "0",($i+1) . ". history fetch return non null Mem-Delta ($1)");
#print Dumper($ret,$content);
print "Heap: ",$jmx->get_attribute("java.lang:type=Memory","HeapMemoryUsage","used"),"\n";
}
#print "$c: $content\n";
reset_history($jmx);

32
it/t/56_check_value.t Normal file
View File

@ -0,0 +1,32 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use JMX::Jmx4Perl::Alias;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>0)->jmx4perl;
my ($ret,$content);
# ====================================================
# Check for --value
($ret,$content) = exec_check_perl4jmx("--value java.lang:type=Memory/HeapMemoryUsage/used " .
"--base java.lang:type=Memory/HeapMemoryUsage/max " .
"--critical 90 ");
is($ret,0,"Memory with value OK");
ok($content =~ /^OK/,"Content contains OK");
# TODO: Check escaping
($ret,$content) = exec_check_perl4jmx("--value jolokia.it:name=\\/\\/server\\/client,type=naming\\//Ok " .
"--critical OK");
#print Dumper($ret,$content);
is($ret,2,"CRITICAL expected");
ok($content =~ m|jolokia.it:name=\\/\\/server\\/client,type=naming\\//Ok|,"Content contains MBean name");
($ret,$content) = exec_check_perl4jmx("--value jolokia.it:type=naming\\/,name=\\\"jdbc/testDB\\\"/Ok " .
"--critical OK");
is($ret,2,"CRITICAL expected");
ok($content =~ m|jolokia.it:type=naming\\/,name="jdbc/testDB"/Ok|,"Content contains weired MBean name");

113
it/t/57_check_config.t Normal file
View File

@ -0,0 +1,113 @@
use FindBin;
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use JMX::Jmx4Perl::Alias;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>1)->jmx4perl;
my ($ret,$content);
# ====================================================
# Configuration check
my $config_file = $FindBin::Bin . "/../check_jmx4perl/checks.cfg";
for my $check (qw(memory_heap memory_heap2)) {
($ret,$content) = exec_check_perl4jmx("--config $config_file --check $check");
is($ret,0,"$check: Memory with value OK");
ok($content =~ /\(base\)/,"$check: First level inheritance");
ok($content =~ /\(grandpa\)/,"$check: Second level inheritance");
ok($content !~ /\$\{1:default_name\}/,"$check: Default replacement");
ok($content =~ /default_name/,"$check: Default replacement");
}
($ret,$content) = exec_check_perl4jmx("--config $config_file --check blubber");
is($ret,3,"Unknown check");
ok($content =~ /blubber/,"Unknown check name contained");
# ========================================================================
# With arguments
($ret,$content) = exec_check_perl4jmx("--config $config_file --check outer_arg OuterArg");
#print Dumper($ret,$content);
is($ret,0,"OuterArg OK");
ok($content =~ /OuterArg/,"OuterArg replaced");
ok($content =~ /Warning: 80/,"Warning included in label");
ok($content =~ /Critical: 90/,"Critical included in label");
# No replacement
($ret,$content) = exec_check_perl4jmx("--config $config_file --check outer_arg");
is($ret,0,"OuterArg OK");
ok($content =~ /default_name/,"OuterArg not-replaced");
# ===========================================================================
# No default value
($ret,$content) = exec_check_perl4jmx("--config $config_file --check def_placeholder_1");
is($ret,1,"WARNING");
ok($content =~ /warning/i,"Warning expected");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check def_placeholder_1 1");
is($ret,1,"WARNING");
ok($content =~ /warning/i,"Warning expected");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check def_placeholder_2");
is($ret,1,"WARNING");
ok($content =~ /warning/i,"Warning expected");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check def_placeholder_2 1");
is($ret,2,"CRITICAL");
ok($content =~ /critical/i,"Critical expected");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check def_placeholder_2 1 2 Blubber");
is($ret,2,"CRITICAL");
ok($content =~ /critical/i,"Critical expected");
ok($content =~ /Blubber/,"Name replacement from command line");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check invalid_method 10 20");
is($ret,3,"UNKNOWN");
ok($content =~ /Unknown.*method/,"Unknown request method");
($ret,$content) = exec_check_perl4jmx("--config $config_file --method invalid --check thread_count 10 20");
is($ret,3,"UNKNOWN");
ok($content =~ /Unknown.*method/,"Unknown request method");
($ret,$content) = exec_check_perl4jmx("--config $config_file --method get --check thread_count 300 400");
#print Dumper($ret,$content);
is($ret,0,"OK");
ok($content =~ /in range/,"In range");
# =============================================================================
# With scripting
($ret,$content) = exec_check_perl4jmx("--config $config_file --check script_check Eden|Java");
#print Dumper($ret,$content);
is($ret,2);
ok($content =~ /threshold/i,"Script-Check: Threshold contained");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check script_multi_check Perm|non-heap");
ok($ret != 3);
#print Dumper($ret,$content);
ok($content =~ /Perm/,"Multi-Script-Check: Perm contained");
ok($content =~ /Eden/,"Multi-Script-Check: Eden contained");
ok($content =~ /thread_count/,"Multi-Script-Check: Thread_count contained");
# ===========================================================================
# Double values
($ret,$content) = exec_check_perl4jmx("--config $config_file --check double_min");
$content =~ /double_min=(.*?);/;
my $min = $1;
#print Dumper($min,$ret ,$content,$1);
is($min,"0.000000","Small double numbers are converted to floats");
# ===========================================================================
# Without Thresholds
($ret,$content) = exec_check_perl4jmx("--config $config_file --check without_threshold");
#print Dumper($content);

104
it/t/58_check_multi_config.t Normal file
View File

@ -0,0 +1,104 @@
use FindBin;
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use JMX::Jmx4Perl::Alias;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>1)->jmx4perl;
my ($ret,$content);
# ====================================================
# Configuration check
my $config_file = $FindBin::Bin . "/../check_jmx4perl/multi_check.cfg";
# Simple multicheck
($ret,$content) = exec_check_perl4jmx("--config $config_file --check memory");
#print ($ret,$content);
is($ret,0,"Memory with value OK");
ok($content =~ /\(base\)/,"First level inheritance");
ok($content =~ /\(grandpa\)/,"Second level inheritance");
ok($content =~ /Heap Memory/,"Heap Memory Included");
ok($content =~ /NonHeap Memory/,"NonHeap Memory included");
#print Dumper($ret,$content);
# Nested multichecks
($ret,$content) = exec_check_perl4jmx("--config $config_file --check nested");
#print Dumper($ret,$content);
is($ret,0,"Multicheck with value OK");
ok($content =~ /\(base\)/,"First level inheritance");
ok($content =~ /\(grandpa\)/,"Second level inheritance");
ok($content =~ /Thread-Count/,"Threads");
ok($content =~ /'Thread-Count'/,"Threads");
ok($content =~ /Heap Memory/,"Heap Memory Included");
ok($content =~ /NonHeap Memory/,"Non Heap Memory included");
# Multicheck with reference to checks with parameters
($ret,$content) = exec_check_perl4jmx("--config $config_file --check with_inner_args");
is($ret,0,"Multicheck with value OK");
ok($content =~ /HelloLabel/,"First param");
ok($content =~ /WithInnerArgs/,"WithInnerArgs");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check with_outer_args WithOuterArgs");
is($ret,0,"Multicheck with value OK");
ok($content =~ /HelloLabel/,"First param");
ok($content =~ /WithOuterArgs/,"WithOuterArgs");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check nested_with_args");
is($ret,0,"Multicheck with value OK");
ok($content =~ /HelloLabel/,"First param");
ok($content =~ /NestedWithArgs/,"NestedWithArgs");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check nested_with_outer_args NestedWithOuterArgs");
is($ret,0,"Multicheck with value OK");
ok($content =~ /HelloLabel/,"First param");
ok($content =~ /NestedWithOuterArgs/,"NestedWithOuterArgs");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check overloaded_multi_check");
#print Dumper($ret,$content);
is($ret,0,"Multicheck with argument for operation");
ok($content =~ /Value 1 in range/,"OperationWithArgument");
($ret,$content) = exec_check_perl4jmx("--config $config_file --check failing_multi_check");
#print Dumper($ret,$content);
is($ret,2,"Failing memory multicheck is CRITICAL");
ok($content =~ /memory_non_heap/,"Failed check name is contained in summary");
# Check labeling of failed tests
($ret,$content) = exec_check_perl4jmx("--config $config_file --check label_test");
#print "==========================================\n";
#print Dumper($ret,$content);
is($ret,2,"Should fail as critical");
my @lines = split /\n/,$content;
is($#lines,2,"3 lines has been returned");
ok($lines[0] =~ /bla/ && $lines[0] =~ /blub/,"Name of checks should be returned as critical values");
#print Dumper($ret,$content);
($ret,$content) = exec_check_perl4jmx("--config $config_file --check error_multi_check");
is($ret,3,"Should fail as UNKNOWN");
@lines = split /\n/,$content;
is($#lines,3,"4 lines has been returned");
ok($lines[1] =~ /kaputt/ && $lines[1] =~ /UNKNOWN/,"First line is UNKNOWN Check");
#print Dumper($ret,$content);
($ret,$content) = exec_check_perl4jmx("--unknown-is-critical --config $config_file --check error_multi_check");
is($ret,2,"Should fail as CRITICAL");
@lines = split /\n/,$content;
is($#lines,3,"4 lines has been returned");
ok($lines[0] =~ /kaputt/ && $lines[0] =~ /CRITICAL/,"First line is UNKNOWN Check");
#print Dumper($ret,$content);
# TODO:
# Unknown multicheck name
# Unknown nested multicheck name
# Unknown check name within a multi check
# No multicheck name

22
it/t/59_check_timeout.t Normal file
View File

@ -0,0 +1,22 @@
use FindBin;
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use JMX::Jmx4Perl::Alias;
use It;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose=>1)->jmx4perl;
my ($ret,$content);
my $time = time;
($ret,$content) = exec_check_perl4jmx("--mbean jolokia.it:type=operation --operation sleep --timeout 1 -c 1 2");
# print Dumper($ret,$content);
# print "Time ",time - $time,"\n";
ok($content =~ /timeout/i,"Timeout reached");
is($ret,3,"UNKNOWN status for timeouts");

22
it/t/60_bulk_request.t Normal file
View File

@ -0,0 +1,22 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use Data::Dumper;
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
my $jmx = new It(verbose => 0)->jmx4perl;
my @reqs = ( new JMX::Jmx4Perl::Request(READ,"java.lang:type=Memory", "HeapMemoryUsage", "used"),
new JMX::Jmx4Perl::Request(READ,"java.lang:type=Memory", "HeapMemoryUsage", "max"),
new JMX::Jmx4Perl::Request(READ,"java.lang:type=ClassLoading", "LoadedClassCount"),
new JMX::Jmx4Perl::Request(SEARCH,"*:type=Memory,*"));
my @resps = $jmx->request(@reqs);
is(scalar(@resps),4,"4 Responses");
for (my $i = 0 .. 3) {
is($resps[$i]->{request},$reqs[$i],"Request " . ($i+1));
}
#print Dumper(\@resps);

59
it/t/64_check_perfdata.t Normal file
View File

@ -0,0 +1,59 @@
use strict;
use warnings;
use Test::More qw(no_plan);
use Data::Dumper;
use JMX::Jmx4Perl::Alias;
use It;
use FindBin;
require "check_jmx4perl/base.pl";
my $jmx = It->new(verbose =>0)->jmx4perl;
my ($ret,$content);
# ====================================================
# Given as command line
($ret,$content) = exec_check_perl4jmx("--value java.lang:type=Memory/HeapMemoryUsage/used " .
"--base java.lang:type=Memory/HeapMemoryUsage/max " .
"--critical 90 " .
"--perfdata no");
ok($content !~ /\s*\|\s*/,"1: Content contains no perfdata");
($ret,$content) = exec_check_perl4jmx("--value java.lang:type=Memory/HeapMemoryUsage/used " .
"--base java.lang:type=Memory/HeapMemoryUsage/max " .
"--warn 80 " .
"--critical 90 " .
"--perfdata %");
ok($content =~ /\s*\|\s*/,"2: Content contains perfdata");
ok($content =~ /80;90/,"2a: Perfdata is relative");
print Dumper($ret,$content);
($ret,$content) = exec_check_perl4jmx("--mbean java.lang:type=Threading " .
"--operation findDeadlockedThreads " .
"--null 'nodeadlock' " .
"--string " .
"--critical '!nodeadlock'");
ok($content !~ /\s*\|\s*/,"3: Content contains no perfdata");
# ====================================================
# Given in config
my $config_file = $FindBin::Bin . "/../check_jmx4perl/checks.cfg";
($ret,$content) = exec_check_perl4jmx("--config $config_file " .
"--check thread_deadlock");
ok($content !~ /\s*\|\s*/,"4: Content contains no perfdata");
($ret,$content) = exec_check_perl4jmx("--config $config_file " .
"--check memory_without_perfdata");
#print Dumper($ret,$content);
ok($content !~ /\s*\|\s*/,"5: Content contains no perfdata");
($ret,$content) = exec_check_perl4jmx("--config $config_file " .
"--check memory_with_perfdata");
#print Dumper($ret,$content);
ok($content =~ /\s*\|\s*/,"6: Content contains perfdata");

33
it/t/70_overloaded_method.t Normal file
View File

@ -0,0 +1,33 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use Data::Dumper;
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
my $jmx = new It(verbose => 0)->jmx4perl;
my $req = new JMX::Jmx4Perl::Request(EXEC,"jolokia.it:type=operation", "overloadedMethod","bla");
my $resp = $jmx->request($req);
ok($resp->{error},"Error must be set");
$req = new JMX::Jmx4Perl::Request(EXEC,"jolokia.it:type=operation", "overloadedMethod()");
$resp = $jmx->request($req);
is($resp->{value},0,"No-Arg operation called");
$req = new JMX::Jmx4Perl::Request(EXEC,"jolokia.it:type=operation", "overloadedMethod(java.lang.String)","bla");
$resp = $jmx->request($req);
is($resp->{value},1,"First operation called");
$req = new JMX::Jmx4Perl::Request(EXEC,"jolokia.it:type=operation", "overloadedMethod(java.lang.String,int)","bla",1);
$resp = $jmx->request($req);
#print Dumper($resp);
is($resp->{value},2,"Second operation called");
$req = new JMX::Jmx4Perl::Request(EXEC,"jolokia.it:type=operation", "overloadedMethod([Ljava.lang.String;)","bla,blub");
$resp = $jmx->request($req);
#print Dumper($resp);
is($resp->{value},3,"Third operation called");
$req = new JMX::Jmx4Perl::Request(EXEC,"jolokia.it:type=operation", "overloadedMethod(java.lang.String,int,long)","bla",3,3);
$resp = $jmx->request($req);
ok($resp->{error},"No such method");
#print Dumper($resp);
#print Dumper(\@resps);

95
it/t/80_read.t Normal file
View File

@ -0,0 +1,95 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use Data::Dumper;
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
# Fetch all attributes
my $jmx = new It(verbose => 0)->jmx4perl;
my $req = new JMX::Jmx4Perl::Request(READ,"jolokia.it:type=attribute");
my $resp = $jmx->request($req);
my $value = $resp->{value};
#print Dumper($resp);
ok($value->{LongSeconds} == 60*60*24*2,"LongSeconds");
ok($value->{Bytes} == 3 * 1024 * 1024 + 1024 * 512,"Bytes");
ok(exists($value->{Null}) && !$value->{Null},"Null");
# Fetch an array ref of attributes
$jmx->execute("jolokia.it:type=attribute","reset");
my $req = new JMX::Jmx4Perl::Request(READ,"jolokia.it:type=attribute",["LongSeconds","State"],{method => "post"});
my $resp = $jmx->request($req);
my $value = $resp->{value};
#print Dumper($resp);
is(scalar(keys(%$value)),2,"2 Return values");
ok($value->{LongSeconds} == 60*60*24*2,"LongSeconds");
ok($value->{State},"State");
$jmx->execute("jolokia.it:type=attribute","reset");
my $value = $jmx->get_attribute("jolokia.it:type=attribute",["LongSeconds","State"]);
ok($value->{LongSeconds} == 60*60*24*2,"LongSeconds");
ok($value->{State},"State");
$jmx->execute("jolokia.it:type=attribute","reset");
# Fetch a pattern with a single attribute
my $value = $jmx->get_attribute("jolokia.it:*","LongSeconds");
ok($value->{"jolokia.it:type=attribute"}->{LongSeconds} == 60*60*24*2,"LongSeconds");
$jmx->execute("jolokia.it:type=attribute","reset");
# Fetch a pattern with all attributes
my $value = $jmx->get_attribute("jolokia.it:*",undef);
ok($value->{"jolokia.it:type=attribute"}->{LongSeconds} == 60*60*24*2,"LongSeconds");
$jmx->execute("jolokia.it:type=attribute","reset");
is($value->{"jolokia.it:type=operation"},undef,"Operation missing");
is($value->{"jolokia.it:type=attribute"}->{Bytes},3670016,"Bytes with pattern");
# Fetch a pattern with multiple attributes
my $value = $jmx->get_attribute("jolokia.it:*",["LongSeconds","State"]);
ok($value->{"jolokia.it:type=attribute"}->{LongSeconds} == 60*60*24*2,"LongSeconds");
ok($value->{"jolokia.it:type=attribute"}->{State},"State");
$jmx->execute("jolokia.it:type=attribute","reset");
my $value = $jmx->get_attribute("jolokia.it:type=attribute","ObjectName");
ok($value->{objectName} eq "bla:type=blub","object name simplified");
ok(!defined($value->{canonicalName}),"no superfluos parameters");
my $value = $jmx->get_attribute("jolokia.it:type=attribute","Set");
is(ref($value),"ARRAY","Set as array returned");
ok(scalar(grep("jolokia",@$value)),"contains 'jolokia'");
ok(scalar(grep("habanero",@$value)),"contains 'habanero'");
my $value = $jmx->get_attribute("jolokia.it:type=attribute","Utf8Content");
is($value,"☯","UTF-8 ☯ check passed");
my $value = $jmx->get_attribute("jolokia.it:type=attribute","Chili");
is($value,"AJI","Enum serialization passed");
# Fetch all attributes
$req = new JMX::Jmx4Perl::Request(READ,"jolokia.it.jsonmbean:type=plain");
$resp = $jmx->request($req);
$value = $resp->{value};
#print Dumper($resp);
is($resp->status,200);
# Check Tabular data
$value = $jmx->get_attribute("jolokia.it:type=tabularData","Table2","Value0.0/Value0.1");
is($value->{Column1},"Value0.0","First column");
is($value->{Column2},"Value0.1","Second column");
$req = new JMX::Jmx4Perl::Request(READ,"jolokia.it:type=tabularData","Table2","Value0.1/Value0.0");
$resp = $jmx->request($req);
#print Dumper($resp);
$value = $resp->{value};
is($value,undef,"Path with no value");
$value = $jmx->get_attribute("jolokia.it:type=mxbean","MapWithComplexKey");
is(scalar(keys %$value),2,"2 elements");
ok($value->{indexNames}->[0],"key");
is(@{$value->{values}},2,"2 values");
ok($value->{values}->[0]->{key}->{number} =~ /^(1|2)$/,"key match");
#print Dumper($value);

26
it/t/83_write.t Normal file
View File

@ -0,0 +1,26 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use Data::Dumper;
use strict;
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
# Write the object name ad re-read
my $jmx = new It(verbose => 0)->jmx4perl;
my $req = new JMX::Jmx4Perl::Request(WRITE,"jolokia.it:type=attribute","ObjectName","java.lang:type=Memory");
my $resp = $jmx->request($req);
#print Dumper(\$resp);
my $value = $resp->{value};
is($value->{objectName},"bla:type=blub","Set ObjectName: Old Name returned");
$value = $jmx->get_attribute("jolokia.it:type=attribute","ObjectName");
is($value->{objectName},"java.lang:type=Memory","Set ObjectName: New Name set");
$jmx->execute("jolokia.it:type=attribute","reset");

24
it/t/84_exec.t Normal file
View File

@ -0,0 +1,24 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use Data::Dumper;
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
# Fetch all attributes
my $jmx = new It(verbose => 0)->jmx4perl;
my $req = new JMX::Jmx4Perl::Request(EXEC,{ mbean => "jolokia.it:type=operation", operation => "mapArgument",arguments => [{ name => "Kyotake"}],method => "POST"} );
my $resp = $jmx->request($req);
my $value = $resp->{value};
is(ref($resp->{value}),"HASH","Response type");
is($resp->{value}->{name},"Kyotake","Response value");
$value = $jmx->execute("jolokia.it:type=operation","findTimeUnit","MINUTES");
is($value,"MINUTES","Enum serialization up and done");
$value = $jmx->execute("jolokia.it:type=operation","addBigDecimal",1,"1e3");
is($value,1001,"Adding big decimal");
#print Dumper($resp);

38
it/t/85_path_escaping.t Normal file
View File

@ -0,0 +1,38 @@
# -*- mode: cperl -*-
use It;
use strict;
use warnings;
use Test::More tests => 16;
use File::Temp qw/tmpnam/;
use Data::Dumper;
use JMX::Jmx4Perl::Request;
my $jmx = It->new(verbose => 0)->jmx4perl;
my ($req,$resp,$list);
for my $method ("post","get") {
$req = new JMX::Jmx4Perl::Request(READ,"jolokia.it:type=attribute","ComplexNestedValue","Blub/1/numbers/1",{method => $method});
$resp = $jmx->request($req);
is($resp->{value},23);
for my $path ("",undef,"/") {
$req = new JMX::Jmx4Perl::Request(READ,"jolokia.it:type=attribute","Map",$path,{method => $method});
$resp = $jmx->request($req);
is($resp->{value}->{fcn},"meister");
$req = new JMX::Jmx4Perl::Request(LIST,$path,{method => $method});
$resp = $jmx->request($req);
ok($resp->{value}->{'jolokia.it'});
}
$req = new JMX::Jmx4Perl::Request(LIST,"/java.lang/",{method => $method});
$resp = $jmx->request($req);
#print Dumper($resp);
}
$list = $jmx->list("jolokia.it/name=!/!/server!/client,type=naming!//attr");
is($list->{Ok}->{type},"java.lang.String");
#my $list = $jmx->list("jolokia.it");
$req = new JMX::Jmx4Perl::Request(LIST,"jolokia.it/name=!/!/server!/client,type=naming!//attr",{method => "POST"});
$resp = $jmx->request($req);
#print Dumper($resp);
is($resp->{value}->{Ok}->{type},"java.lang.String");

18
it/t/90_search.t Normal file
View File

@ -0,0 +1,18 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
use JMX::Jmx4Perl;
use JMX::Jmx4Perl::Request;
use Data::Dumper;
#use Test::More tests => $ENV{JMX4PERL_PRODUCT} ? 2 : 1;
# Check for escaped pattern:
my $jmx = It->new(verbose => 0)->jmx4perl;
my $mbeans = $jmx->search("jolokia.it:type=escape,*");
for my $m (@$mbeans) {
my $value = $jmx->get_attribute($m,"Ok");
is($value,"OK",$m);
}

90
it/t/95_cors.t Normal file
View File

@ -0,0 +1,90 @@
#!/usr/bin/perl
use It;
use Test::More (tests => 14);
use LWP::UserAgent;
use Data::Dumper;
use strict;
my $url = $ENV{JMX4PERL_GATEWAY} || $ARGV[0];
$url .= "/" unless $url =~ /\/$/;
my $origin = "http://localhost:8080";
my $ua = new LWP::UserAgent();
if ($ENV{JMX4PERL_USER}) {
my $netloc = $url;
$netloc =~ s|^.*/([^:]+:\d+).*$|$1|;
$ua->credentials($netloc,"jolokia",$ENV{JMX4PERL_USER},$ENV{JMX4PERL_PASSWORD});
}
$ua->default_headers()->header("Origin" => $origin);
# Test for CORS functionality. This is done without Jmx4Perl client library but
# with direct requests
# 1) Preflight Checks
my $req = new HTTP::Request("OPTIONS",$url);
my $resp = $ua->request($req);
#print Dumper($resp);
is($resp->header('Access-Control-Allow-Origin'),$origin,"Access-Control-Allow Origin properly set");
ok($resp->header('Access-Control-Allow-Max-Age') > 0,"Max Age set");
ok(!$resp->header('Access-Control-Allow-Request-Header'),"No Request headers set");
$req->header("Access-Control-Request-Headers","X-Extra, X-Extra2");
$req->header('X-Extra',"bla");
$resp = $ua->request($req);
is($resp->header('Access-Control-Allow-Headers'),'X-Extra, X-Extra2',"Allowed headers");
# 2) GET Requests with "Origin:"
$req = new HTTP::Request("GET",$url . "/read/java.lang:type=Memory/HeapMemoryUsage");
$resp = $ua->request($req);
verify_resp("GET",$resp);
# 3) POST Requests with "Origin:"
$req = new HTTP::Request("POST",$url);
$req->content(<<EOT);
{
"type" : "read",
"mbean" : "java.lang:type=Memory",
"attribute" : "HeapMemoryUsage",
"path" : "used"
}
EOT
$resp = $ua->request($req);
verify_resp("POST",$resp);
# 4) POST Request with "Origin:" and error
$req = new HTTP::Request("POST",$url);
$req->content(<<EOT);
{
"type" : "bla"
}
EOT
$resp = $ua->request($req);
verify_resp("POST-Error",$resp);
# 5) Try request splitting attack
my $ua2 = new LWP::UserAgent();
$req = new HTTP::Request("GET",$url . "/read/java.lang:type=Memory/HeapMemoryUsage");
$req->header("Origin","http://bla.com\r\n\r\nInjected content");
$resp = $ua2->request($req);
ok($resp->header('Access-Control-Allow-Origin') !~ /[\r\n]/,"No new lines included");
#print Dumper($resp);
# ---------------------------------------------
sub verify_resp {
my $pref = shift;
my $resp = shift;
is($resp->header('Access-Control-Allow-Origin'),$origin,"$pref: Access-Control-Allow Origin properly set");
ok(!$resp->header('Access-Control-Allow-Max-Age'),"$pref: No Max Age set");
ok(!$resp->header('Access-Control-Allow-Request-Header'),"$pref: No Request headers set");
}

35
it/t/99_discovery.t Normal file
View File

@ -0,0 +1,35 @@
#!/usr/bin/perl
use It;
use Test::More qw(no_plan);
use JMX::Jmx4Perl;
use Data::Dumper;
use strict;
my $jmx = new It(verbose => 0)->jmx4perl;
# Might find nothing, dependening on where it is run.
my $disc_class = urls(JMX::Jmx4Perl->discover_agents());
ok(defined($disc_class));
my $disc_obj = urls($jmx->discover_agents());
ok(defined($disc_obj));
my $agents_found = $jmx->execute("jolokia:type=Discovery","lookupAgents");
print Dumper($agents_found);
print Dumper($disc_class);
my $agent_urls = urls($agents_found);
for my $disc_p ($disc_class,$disc_obj) {
for my $k (keys %$disc_p) {
ok(defined($agent_urls->{$k}),"Agent URL " . $k . " detected");
}
}
sub urls {
my $agents = shift;
my $ret = {};
for my $agent (@$agents) {
$ret->{$agent->{url}}++;
}
return $ret;
}

1243
lib/JMX/Jmx4Perl.pm Normal file
View File

File diff suppressed because it is too large Load Diff

486
lib/JMX/Jmx4Perl/Agent.pm Normal file
View File

@ -0,0 +1,486 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent;
use JSON;
use URI::Escape qw(uri_escape_utf8);
use HTTP::Request;
use Carp;
use strict;
use vars qw($VERSION $DEBUG);
use base qw(JMX::Jmx4Perl);
use JMX::Jmx4Perl::Request;
use JMX::Jmx4Perl::Response;
use JMX::Jmx4Perl::Agent::UserAgent;
use Data::Dumper;
$VERSION = $JMX::Jmx4Perl::VERSION;
=head1 NAME
JMX::Jmx4Perl::Agent - JSON-HTTP based acess to a remote JMX agent
=head1 SYNOPSIS
my $agent = new JMX::Jmx4Perl(mode=>"agent", url => "http://jeeserver/j4p");
my $answer = $agent->get_attribute("java.lang:type=Memory","HeapMemoryUsage");
print Dumper($answer);
{
request => {
attribute => "HeapMemoryUsage",
name => "java.lang:type=Memory"
},
status => 200,
value => {
committed => 18292736,
init => 0,
max => 532742144,
used => 15348352
}
}
=head1 DESCRIPTION
This module is not used directly, but via L<JMX::Jmx4Perl>, which acts as a
proxy to this module. You can think of L<JMX::Jmx4Perl> as the interface which
is backed up by this module. Other implementations (e.g.
=head1 METHODS
=over 4
=item $jjagent = JMX::Jmx4Perl::Agent->new(url => $url, ....)
Creates a new local agent for a given url
=over
=item url => <url to JEE server>
The url where the agent is deployed. This is a mandatory parameter. The url
must include the context within the server, which is typically based on the
name of the war archive. Example: C<http://localhost:8080/j4p> for a drop
in deployment of the agent in a standard Tomcat's webapp directory.
=item timeout => <timeout>
Timeout in seconds after which a request should be stopped if it not suceeds
within this time. This parameter is given through directly to the underlying
L<LWP::UserAgent>
=item user => <user>, password => <password>
Credentials to use for the HTTP request
=item method => <method>
The HTTP method to use for contacting the agent. Must be either "GET" or
"POST". This method is used, if the request to send dosen't specify the method
and no other parameters forces a POST context.
=item proxy => { http => '<http_proxy>', https => '<https_proxy>', ... }
=item proxy => <http_proxy>
=item proxy => { url => <http_proxy> }
Optional proxy to use
=item proxy_user => <user>, proxy_password => <password>
Credentials to use for accessing the proxy
=item target
Add a target which is used for any request served by this object if not already
a target is present in the request. This way you can setup the default target
configuration if you are using the agent servlet as a proxy, e.g.
... target => { url => "service:jmx:...", user => "...", password => "..." }
=item legacy-escape
Before version 1.0 a quite strange escaping scheme is used, when the part of a
GET requests contains a slash (/). Starting with 1.0 this scheme has changed,
but in order to allow post 1.0 Jmx4perl clients acess pre 1.0 Jolokia agents,
this option can be set to true to switch to the old escape mechanism.
=back
=cut
# HTTP Parameters to be used for transmitting the request
my @PARAMS = ("maxDepth","maxCollectionSize","maxObjects","ignoreErrors");
# Regexp for detecting invalid chars which can not be used securily in pathinfos
my $INVALID_PATH_CHARS = qr/%(5C|3F|3B|2F)/i; # \ ? ; /
# Init called by parent package within 'new' for specific initialization. See
# above for the parameters recognized
sub init {
my $self = shift;
croak "No URL provided" unless $self->cfg('url');
my $ua = JMX::Jmx4Perl::Agent::UserAgent->new();
$ua->jjagent_config($self->{cfg});
#push @{ $ua->requests_redirectable }, 'POST';
$ua->timeout($self->cfg('timeout')) if $self->cfg('timeout');
#print "TO: ",$ua->timeout(),"\n";
$ua->agent("JMX::Jmx4Perl::Agent $VERSION");
# $ua->env_proxy;
my $proxy = $self->cfg('proxy');
if ($proxy) {
my $url = ref($proxy) eq "HASH" ? $proxy->{url} : $proxy;
if (ref($url) eq "HASH") {
for my $k (keys %$url) {
$ua->proxy($k,$url->{$k});
}
} else {
if ($self->cfg('url') =~ m|^(.*?)://|) {
# Set proxy for URL scheme used
$ua->proxy($1,$url);
} else {
$ua->proxy('http',$proxy);
}
}
}
$self->{ua} = $ua;
return $self;
}
=item $url = $agent->url()
Get the base URL for connecting to the agent. You cannot change the URL via this
method, it is immutable for a given agent.
=cut
sub url {
my $self = shift;
return $self->cfg('url');
}
=item $resp = $agent->request($request)
Implementation of the JMX request as specified in L<JMX::Jmx4Perl>. It uses a
L<HTTP::Request> sent via an L<LWP::UserAgent> for posting a JSON representation
of the request. This method shouldn't be called directly but via
L<JMX::Jmx4Perl>->request().
=cut
sub request {
my $self = shift;
my @jmx_requests = $self->cfg('target') ? $self->_update_targets(@_) : @_;
my $ua = $self->{ua};
my $http_req = $self->_to_http_request(@jmx_requests);
if ($self->{cfg}->{verbose}) {
print $http_req->as_string;
print "===========================================================\n";
}
#print Dumper($http_req);
my $http_resp = $ua->request($http_req);
my $json_resp = {};
if ($self->{cfg}->{verbose}) {
print $http_resp->as_string,"\n";
print "===========================================================\n";
}
eval {
$json_resp = from_json($http_resp->content());
};
my $json_error = $@;
if ($http_resp->is_error) {
return JMX::Jmx4Perl::Response->new
(
status => $http_resp->code,
value => $json_error ? $http_resp->content : $json_resp,
error => $json_error ? $self->_prepare_http_error_text($http_resp) :
ref($json_resp) eq "ARRAY" ? join "\n", map { $_->{error} } grep { $_->{error} } @$json_resp : $json_resp->{error},
stacktrace => ref($json_resp) eq "ARRAY" ? $self->_extract_stacktraces($json_resp) : $json_resp->{stacktrace},
request => @jmx_requests == 1 ? $jmx_requests[0] : \@jmx_requests
);
} elsif ($json_error) {
# If is not an HTTP-Error and deserialization fails, then we
# probably got a wrong URL and get delivered some server side
# document (with HTTP code 200)
my $e = $json_error;
$e =~ s/(.*)at .*?line.*$/$1/;
return JMX::Jmx4Perl::Response->new
(
status => 400,
error =>
"Error while deserializing JSON answer (Wrong URL ?)\n" . $e,
value => $http_resp->content
);
}
my @responses = ($self->_from_http_response($json_resp,@jmx_requests));
if (!wantarray && scalar(@responses) == 1) {
return shift @responses;
} else {
return @responses;
}
}
=item $encrypted = $agent->encrypt($plain)
Encrypt a password which can be used in configuration files in order to
obfuscate the clear text password.
=cut
sub encrypt {
return "[[" . &JMX::Jmx4Perl::Agent::UserAgent::encrypt(shift) . "]]";
}
# Create an HTTP-Request for calling the server
sub _to_http_request {
my $self = shift;
my @reqs = @_;
if ($self->_use_GET_request(\@reqs)) {
# Old, rest-style
my $url = $self->request_url($reqs[0]);
return HTTP::Request->new(GET => $url);
} else {
my $url = $self->cfg('url') || croak "No URL provided";
$url .= "/" unless $url =~ m|/$|;
my $request = HTTP::Request->new(POST => $url);
my $content = to_json(@reqs > 1 ? \@reqs : $reqs[0], { convert_blessed => 1 });
#print Dumper($reqs[0],$content);
$request->content($content);
return $request;
}
}
sub _use_GET_request {
my $self = shift;
my $reqs = shift;
if (@$reqs == 1) {
my $req = $reqs->[0];
# For proxy configs and explicite set POST request, get can not be
# used
return 0 if defined($req->get("target"));
#print Dumper($req);
for my $r ($req->method,$self->cfg('method')) {
return lc($r) eq "get" if defined($r);
}
# GET by default
return 1;
} else {
return 0;
}
}
# Create one or more response objects for a given request
sub _from_http_response {
my $self = shift;
my $json_resp = shift;
my @reqs = @_;
if (ref($json_resp) eq "HASH") {
return JMX::Jmx4Perl::Response->new(%{$json_resp},request => $reqs[0]);
} elsif (ref($json_resp) eq "ARRAY") {
die "Internal: Number of request and responses doesn't match (",scalar(@reqs)," vs. ",scalar(@$json_resp)
unless scalar(@reqs) == scalar(@$json_resp);
my @ret = ();
for (my $i=0;$i<@reqs;$i++) {
die "Internal: Not a hash --> ",$json_resp->[$i] unless ref($json_resp->[$i]) eq "HASH";
my $response = JMX::Jmx4Perl::Response->new(%{$json_resp->[$i]},request => $reqs[$i]);
push @ret,$response;
}
return @ret;
} else {
die "Internal: Not a hash nor an array but ",ref($json_resp) ? ref($json_resp) : $json_resp;
}
}
# Update targets if not set in request.
sub _update_targets {
my $self = shift;
my @requests = @_;
my $target = $self->_clone_target;
for my $req (@requests) {
$req->{target} = $target unless exists($req->{target});
# A request with existing but undefined target removes
# any default
delete $req->{target} unless defined($req->{target});
}
return @requests;
}
sub _clone_target {
my $self = shift;
die "Internal: No target set" unless $self->cfg('target');
my $target = { %{$self->cfg('target')} };
if ($target->{env}) {
$target->{env} = { %{$target->{env}}};
}
return $target;
}
=item $url = $agent->request_url($request)
Generate the URL for accessing the java agent based on a given request.
=cut
sub request_url {
my $self = shift;
my $request = shift;
my $url = $self->cfg('url') || croak "No base url given in configuration";
$url .= "/" unless $url =~ m|/$|;
my $type = $request->get("type");
my $req = $type . "/";
$req .= $self->_escape($request->get("mbean"));
if ($type eq READ) {
$req .= "/" . $self->_escape($request->get("attribute"));
$req .= $self->_extract_path($request->get("path"));
} elsif ($type eq WRITE) {
$req .= "/" . $self->_escape($request->get("attribute"));
$req .= "/" . $self->_escape($self->_null_escape($request->get("value")));
$req .= $self->_extract_path($request->get("path"));
} elsif ($type eq LIST) {
$req .= $self->_extract_path($request->get("path"));
} elsif ($type eq EXEC) {
$req .= "/" . $self->_escape($request->get("operation"));
for my $arg (@{$request->get("arguments")}) {
# Array refs are sticked together via ","
my $a = ref($arg) eq "ARRAY" ? join ",",@{$arg} : $arg;
$req .= "/" . $self->_escape($self->_null_escape($a));
}
} elsif ($type eq SEARCH) {
# Nothing further to append.
}
# Squeeze multiple slashes
$req =~ s|((?:!/)?/)/*|$1|g;
#print "R: $req\n";
if ($req =~ $INVALID_PATH_CHARS || $request->{use_query}) {
$req = "?p=$req";
}
my @params;
for my $k (@PARAMS) {
push @params, $k . "=" . $request->get($k)
if $request->get($k);
}
$req .= ($req =~ /\?/ ? "&" : "?") . join("&",@params) if @params;
return $url . $req;
}
# =============================================================================
# Return an (optional) path which must already be escaped
sub _extract_path {
my $self = shift;
my $path = shift;
return $path ? "/" . $path : "";
}
# Escaping is simple:
# ! --> !!
# / --> !/
# It is not done by backslashes '\' since often they get magically get
# translated into / when part of an URL
sub _escape {
my $self = shift;
my $input = shift;
if ($self->cfg('legacy-escape')) {
# Pre 1.0 escaping:
$input =~ s|(/+)|"/" . ('-' x length($1)) . "/"|eg;
$input =~ s|^/-|/^|; # The first slash needs to be escaped (first)
$input =~ s|-/$|+/|; # as well as last slash. They need a special
# escape, because two subsequent slashes get
# squeezed to one on the server side
} else {
# Simpler escaping since 1.0:
$input =~ s/!/!!/g;
$input =~ s/\//!\//g;
}
return URI::Escape::uri_escape_utf8($input,"^A-Za-z0-9\-_.!~*'()/"); # Added "/" to
# default
# set. See L<URI>
}
# Escape empty and undef values so that they can be detangled
# on the server side
sub _null_escape {
my $self = shift;
my $value = shift;
if (!defined($value)) {
return "[null]";
} elsif (! length($value)) {
return "\"\"";
} else {
return $value;
}
}
# Prepare some readable error text
sub _prepare_http_error_text {
my $self = shift;
my $http_resp = shift;
my $content = $http_resp->content;
my $error = "Error while fetching ".$http_resp->request->uri." :\n\n" . $http_resp->status_line . "\n";
chomp $content;
if ($content && $content ne $http_resp->status_line) {
my $error .= "=" x length($http_resp->status_line) . "\n\n";
my $short = substr($content,0,600);
$error .= $short . (length($short) < length($content) ? "\n\n... [truncated] ...\n\n" : "") . "\n"
}
return $error;
}
# Extract all stacktraces stored in the given array ref of json responses
sub _extract_stacktraces {
my $self = shift;
my $json_resp = shift;
my @ret = ();
for my $j (@$json_resp) {
push @ret,$j->{stacktrace} if $j->{stacktrace};
}
return @ret ? (scalar(@ret) == 1 ? $ret[0] : \@ret) : undef;
}
=back
=cut
# ===================================================================
# Specialized UserAgent for passing in credentials:
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut
1;

322
lib/JMX/Jmx4Perl/Agent/Jolokia/ArtifactHandler.pm Normal file
View File

@ -0,0 +1,322 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::ArtifactHandler;
=head1 NAME
JMX::Jmx4Perl::Agent::ArtifactHandler - Handler for extracting and manipulating
Jolokia artifacts
=head1 DESCRIPTION
This module is responsible for mangaging a singe JAR or WAR Archive. It
requires L<Archive::Zip> for proper operation.
I.e. this module can
=over
=item *
Extract jolokia-access.xml and web.xml from WAR/JAR archives
=item *
Check for the esistance of jolokia-access.xml
=item *
Update web.xml for WAR files
=back
=cut
use Data::Dumper;
use strict;
use vars qw($HAS_ARCHIVE_ZIP $GLOBAL_ERROR);
BEGIN {
$HAS_ARCHIVE_ZIP = eval "require Archive::Zip; Archive::Zip->import(qw(:ERROR_CODES)); 1";
if ($HAS_ARCHIVE_ZIP) {
Archive::Zip::setErrorHandler( sub {
$GLOBAL_ERROR = join " ",@_;
chomp $GLOBAL_ERROR;
} );
}
}
=head1 METHODS
=over 4
=item $handler = JMX::Jmx4Perl::Agent::Jolokia::ArtifactHandler->new(...)
Create a new handler with the following options:
file => $file : Path to archive to handle
logger => $logger : Logger to use
meta => $meta : Jolokia-Meta handler to extract the type of an archive
=cut
sub new {
my $class = shift;
my %args = @_;
my $file = $args{file};
my $self = { file => $file, logger => $args{logger}, meta => $args{meta}};
bless $self,(ref($class) || $class);
$self->_fatal("No Archive::Zip found. Please install it for handling Jolokia archives.") unless $HAS_ARCHIVE_ZIP;
$self->_fatal("No file given") unless $file;
$self->_fatal("No such file $file") unless -e $file;
return $self;
}
=item $info = $handler->info()
Extract information about an archive. Return value is a has with the following
keys:
"version" Agent's version
"type" Agent type (war, osgi, osgi-bundle, mule, jdk6)
"artifactId" Maven artifact id
"groupId" Maven group Id
=cut
sub info {
my $self = shift;
my $file = $self->{file};
my $jar = $self->_read_archive();
my @props = $jar->membersMatching('META-INF/maven/org.jolokia/.*?/pom.properties');
$self->_fatal("Cannot extract pom.properties from $file") unless @props;
for my $prop (@props) {
my ($content,$status) = $prop->contents;
$self->_fatal("Cannot extract pom.properties: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
my $ret = {};
for my $l (split /\n/,$content) {
next if $l =~ /^\s*#/;
my ($k,$v) = split /=/,$l,2;
$ret->{$k} = $v;
}
$self->_fatal("$file is not a Jolokia archive") unless $ret->{groupId} eq "org.jolokia" ;
my $type;
if ($self->{meta}->initialized()) {
$type = $self->{meta}->extract_type($ret->{artifactId});
} else {
$type = $self->_detect_type_by_heuristic($ret->{artifactId});
}
if ($type) {
$ret->{type} = $type;
return $ret;
}
}
return {};
}
=item $handler->add_policy($policy)
Add or update the policy given as string to this archive. Dependening on
whether it is a WAR or another agent, it is put into the proper place
For "war" agents, this is F<WEB-INF/classes/jolokia-access.xml>, for all others
it is F</jolokia-access.xml>
=cut
sub add_policy {
my $self = shift;
my $policy = shift;
my $file = $self->{file};
$self->_fatal("No such file $policy") unless -e $policy;
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
my $existing = $jar->removeMember($path);
my $res = $jar->addFile($policy,$path);
$self->_fatal("Cannot add $policy to $file as ",$path,": ",$GLOBAL_ERROR) unless $res;
my $status = $jar->overwrite();
$self->_fatal("Cannot write $file: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
$self->_info($existing ? "Replacing existing policy " : "Adding policy ","[em]",$path,"[/em]",$existing ? " in " : " to ","[em]",$file,"[/em]");
}
=item $handler->remove_policy()
Remove a policy file (no-op, when no policy is present)
=cut
sub remove_policy {
my $self = shift;
my $file = $self->{file};
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
my $existing = $jar->removeMember($path);
if ($existing) {
my $status = $jar->overwrite();
$self->_fatal("Cannot write $file: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
$self->_info("Removing policy","[em]",$path,"[/em]"," in ","[em]",$file,"[/em]");
} else {
$self->_info("No policy found, leaving ","[em]",$file,"[/em]"," untouched.");
}
}
=item $handler->has_policy()
Returns true (i.e. the path to the policy file) if a policy file is contained,
C<undef> otherwise.
=cut
sub has_policy {
my $self = shift;
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
return $jar->memberNamed($path) ? $path : undef;
}
=item $handler->get_policy()
Get the policy file as string or C<undef> if no policy is contained.
=cut
sub get_policy {
my $self = shift;
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
return $jar->contents($path);
}
=item $handler->extract_webxml()
Extract F<web.xml> from WAR agents, for other types, a fatal error is
raised. Return value is a string containing the web.xml.
=cut
sub extract_webxml {
my $self = shift;
my $type = $self->type;
$self->_fatal("web.xml can only be read from 'war' archives (not '",$type,"')") unless $type eq "war";
my $jar = $self->_read_archive();
return $jar->contents("WEB-INF/web.xml");
}
=item $handler->update_webxml($webxml)
Update F<web.xml> in WAR agents, for other types, a fatal error is
raised. Return value is a string containing the web.xml. C<$webxml> is the
descriptor as a string.
=cut
sub update_webxml {
my $self = shift;
my $webxml = shift;
my $type = $self->type;
$self->_fatal("web.xml can only be updated in 'war' archives (not '",$type,"')") unless $type eq "war";
my $jar = $self->_read_archive();
$jar->removeMember("WEB-INF/web.xml");
my $res = $jar->addString($webxml,"WEB-INF/web.xml");
$self->_fatal("Cannot update WEB-INF/web.xml: ",$GLOBAL_ERROR) unless $res;
my $status = $jar->overwrite();
$self->_fatal("Cannot write ",$self->{file},": ",$GLOBAL_ERROR) unless $status eq AZ_OK();
$self->_info("Updated ","[em]","web.xml","[/em]"," for ",$self->{file});
}
=item $handler->type()
Return the agent's type, which is one of "war", "osgi", "osgi-bundle", "mule"
or "jdk6"
=cut
sub type {
my $self = shift;
my $info = $self->info;
return $info->{type};
}
=back
=cut
# ========================================================================
sub _detect_type_by_heuristic {
my $self = shift;
my $artifact_id = shift;
return {
"jolokia-osgi" => "osgi",
"jolokia-mule" => "mule",
"jolokia-osgi-bundle" => "osgi-bundle",
"jolokia-jvm-jdk6" => "jdk6",
"jolokia-jvm" => "jvm",
"jolokia-war" => "war"
}->{$artifact_id};
}
sub _read_archive {
my $self = shift;
my $file = $self->{file};
my $jar = new Archive::Zip();
my $status = $jar->read($file);
$self->_fatal("Cannot read content of $file: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
return $jar;
}
sub _policy_path {
my $self = shift;
return ($self->type eq "war" ? "WEB-INF/classes/" : "") . "jolokia-access.xml";
}
sub _fatal {
my $self = shift;
$self->{logger}->error(@_);
die "\n";
}
sub _info {
my $self = shift;
$self->{logger}->info(@_);
}
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
The Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut
1;

150
lib/JMX/Jmx4Perl/Agent/Jolokia/DownloadAgent.pm Normal file
View File

@ -0,0 +1,150 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent;
use base qw(LWP::UserAgent);
use Data::Dumper;
use vars qw($HAS_PROGRESS_BAR $HAS_TERM_READKEY);
use strict;
BEGIN {
$HAS_PROGRESS_BAR = eval "require Term::ProgressBar; 1";
$HAS_TERM_READKEY = eval "require Term::ReadKey; 1";
}
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent - Specialized L<LWP::UserAgent>
adding some bells and whistles for downloading agents and other stuff.
=head1 DESCRIPTION
User agent for Jolokia artifact downloading. It decorates a regular User Agent
with a download bar and allows for proxy handling and authentication. For a
progress bar, the optional module L<Term::ProgressBar> must be installed.
=head1 METHODS
=over 4
=item $ua = JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent->new(%args)
Create a new user agent, a subclass fro L<LWP::UserAgent>
Options:
"http_proxy" HTTP Proxy to use
"https_proxy" HTTPS Proxy to use
"quiet" If true, dont show progressbar
"proxy_user" Proxy user for proxy authentication
"proxy_password" Proxy password for proxy authentication
=back
=cut
sub new {
my $class = shift;
my %cfg = ref($_[0]) eq "HASH" ? %{$_[0]} : @_;
my $self = LWP::UserAgent::new($class,%cfg);
bless $self,(ref($class) || $class);
# Proxy setting
$self->env_proxy;
$self->proxy("http",$cfg{http_proxy}) if $cfg{http_proxy};
$self->proxy("https",$cfg{https_proxy}) if $cfg{https_proxy};
$self->agent("Jolokia Download Agent/" . $JMX::Jmx4Perl::VERSION);
$self->{show_progress} = !$cfg{quiet};
return $self;
}
# Overwriting progress in order to show a progressbar or not
sub progress {
my($self, $status, $m) = @_;
return unless $self->{show_progress};
# Use default progress bar if no progress is given
unless ($HAS_PROGRESS_BAR) {
$self->SUPER::progress($status,$m);
return;
}
if ($status eq "begin") {
$self->{progress_bar} = undef;
} elsif ($status eq "end") {
my $progress = delete $self->{progress_bar};
my $next = delete $self->{progress_next};
$progress->update(1) if defined($next) && 1 >= $next;
} elsif ($status eq "tick") {
# Unknown length (todo: probably better switch to the default behaviour
# in SUPER::progress())
my $progress = $self->_progress_bar($m->filename,undef);
$progress->update();
} else {
# Status contains percentage
my $progress = $self->_progress_bar($m->filename,1);
# print $status," ",$HAS_PROGRESS_BAR,"\n";
$self->{progress_next} = $progress->update($status)
if $status >= $self->{progress_next};
}
}
sub _progress_bar {
my $self = shift;
my $name = shift;
my $count = shift;
my $progress = $self->{progress_bar};
unless ($progress) {
no strict;
local (%SIG);
$progress = new Term::ProgressBar({
name => " " . $name,
count => $count,
remove => 1,
ETA => linear,
!$HAS_TERM_READKEY ? (term_width => 120) : ()
}
);
#$progress->minor(1);
$progress->max_update_rate(1);
$self->{progress_bar} = $progress;
}
return $progress;
}
# Get an optional proxy user
sub get_basic_credentials {
my ($self, $realm, $uri, $isproxy) = @_;
if ($isproxy && $self->{proxy_user}) {
return ($self->{proxy_user},$self->{proxy_password});
} else {
return (undef,undef);
}
}
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
The Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut
1;

167
lib/JMX/Jmx4Perl/Agent/Jolokia/Logger.pm Normal file
View File

@ -0,0 +1,167 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Logger;
use vars qw($HAS_COLOR);
use strict;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Logger - Simple logging abstraction for the
Jolokia agent manager
=head1 DESCRIPTION
Simple Logger used throughout 'jolokia' and its associated modules for
output. It knows about coloring and a quiet mode, where no output is generated
at all.
=cut
BEGIN {
$HAS_COLOR = eval "require Term::ANSIColor; Term::ANSIColor->import(qw(:constants)); 1";
}
=head1 METHODS
=over 4
=item $logger = JMX::Jmx4Perl::Agent::Jolokia::Logger->new(quiet=>1,color=>1)
Creates a logger. Dependening on the options (C<quiet> and C<color>) output can
be supressed completely or coloring can be used. Coloring only works, if the
Module L<Term::ANSIColor> is available (which is checked during runtime).
=cut
sub new {
my $class = shift;
my $self = ref($_[0]) eq "HASH" ? $_[0] : { @_ };
my $quiet = delete $self->{quiet};
$HAS_COLOR &&= $self->{color};
# No-op logger
return new JMX::Jmx4Perl::Agent::Jolokia::Logger::None
if $quiet;
bless $self,(ref($class) || $class);
}
=item $log->debug("....");
Debug output
=cut
sub debug {
my $self = shift;
if ($self->{debug}) {
print "+ ",join("",@_),"\n";
}
}
=item $log->info("....","[em]","....","[/em]",...);
Info output. The tag "C<[em]>" can be used to higlight a portion of the
output. The tag must be provided in an extra element in the given list.
=cut
sub info {
my $self = shift;
my $text = $self->_resolve_color(@_);
my ($cs,$ce) = $HAS_COLOR ? (DARK . CYAN,RESET) : ("","");
print $cs . "*" . $ce . " " . $text . "\n";
}
=item $log->warn(...)
Warning output (printed in yellow)
=cut
sub warn {
my $self = shift;
my $text = join "",@_;
my ($cs,$ce) = $HAS_COLOR ? (YELLOW,RESET) : ("","");
print $cs. "! " . $text . $ce ."\n";
}
=item $log->warn(...)
Error output (printed in red)
=cut
sub error {
my $self = shift;
my $text = join "",@_;
my ($cs,$ce) = $HAS_COLOR ? (RED,RESET) : ("","");
print $cs . $text . $ce . "\n";
}
sub _resolve_color {
my $self = shift;
return join "",map {
if (lc($_) eq "[em]") {
$HAS_COLOR ? GREEN : ""
} elsif (lc($_) eq "[/em]") {
$HAS_COLOR ? RESET : ""
} else {
$_
}} @_;
}
=back
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
The Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut
package JMX::Jmx4Perl::Agent::Jolokia::Logger::None;
use base qw(JMX::Jmx4Perl::Agent::Jolokia::Logger);
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Logger::None - No-op logger
=head1 DESCRIPTION
No-op logger used when quiet mode is switched on. Doesn't print
out anything.
=cut
sub info { }
sub warn { }
sub error { }
sub debug { }
1;

379
lib/JMX/Jmx4Perl/Agent/Jolokia/Meta.pm Normal file
View File

@ -0,0 +1,379 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Meta;
use JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent;
use JMX::Jmx4Perl::Agent::Jolokia::Logger;
use JMX::Jmx4Perl::Agent::Jolokia::Verifier;
use JSON;
use Data::Dumper;
use base qw(LWP::UserAgent);
use strict;
my $JOLOKIA_META_URL = "http://www.jolokia.org/jolokia.meta";
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Meta - Fetches, caches and parses Meta data from
www.jolokia.org
=head1 DESCRIPTION
This class is responsible for fetching meta data about available agents from
Jolokia. It knows how to parse those meta data and caches it for subsequent
usage in the local file system.
=head1 METHODS
=over 4
=item $meta = JMX::Jmx4Perl::Agent::Jolokia::Meta->new(....)
Create a new meta object which handles downloading of Jolokia meta information
and caching this data.
=cut
sub new {
my $class = shift;
my $self = ref($_[0]) eq "HASH" ? $_[0] : { @_ };
# Dummy logging if none is provided
$self->{logger} = new JMX::Jmx4Perl::Agent::Jolokia::Logger::None unless $self->{logger};
$self->{verifier} = new JMX::Jmx4Perl::Agent::Jolokia::Verifier(logger => $self->{logger},ua_config => $self->{ua_config});
return bless $self,(ref($class) || $class);
}
=item $meta->load($force)
Load the meta data from the server or retrieve it from the cache. The data is
taken from the cache, if it is no older than $self->{cache_interval} seconds.
If $force is given and true, the data is always fetched fresh from the server.
This method return $self so that it can be used for chaining. Any error or
progress infos are given through to the C<log_handler> provided during
construction time. This method will return C<undef> if the data can't be
loaded.
=cut
sub load {
my ($self,$force) = @_;
$force = $self->{force_load} unless defined($force);
my $meta_json;
my $cached = undef;
if (!$force) {
$meta_json = $self->_from_cache;
$cached = 1 if $meta_json;
}
$meta_json = $self->_load_from_server unless $meta_json; # Throws an error
# if it can't be
# loaded
return undef unless $meta_json;
$self->_to_cache($meta_json) unless $cached;
$self->{_meta} = $meta_json;
return $self;
}
=item $meta->initialized()
Returns C<true> if the meta data has been initialized, either by loading it or
by using a cached data. If false the data can be loaded via L<load>
=cut
sub initialized {
my $self = shift;
return defined($self->{_meta});
}
=item $value = $meta->get($key)
Get a value from the meta data.
=cut
sub get {
my $self = shift;
my $key = shift;
$self->_fatal("No yet loaded") unless $self->{_meta};
return $self->{_meta}->{$key};
}
=item $jolokia_version = $meta->latest_matching_version($jmx4perl_version)
Get the latest matching Jolokia version for a given Jmx4Perl version
=cut
sub latest_matching_version {
my $self = shift;
my $jmx4perl_version = shift;
# Iterate over all existing versions, starting from the newest one,
# and return the first matching
my $version_info = $self->get("versions");
for my $v (sort { $self->compare_versions($b,$a) } grep { $_ !~ /-SNAPSHOT$/ } keys %$version_info) {
my $range = $version_info->{$v}->{jmx4perl};
if ($range) {
my $match = $self->_check_version($jmx4perl_version,$range);
#print "Match: $match for $range (j4p: $jmx4perl_version)\n";
return $v if $match;
}
}
return undef;
}
# Compare two version which can contain one, two or more digits. Returns <0,0 or
# >0 if the first version is smaller, equal or larger than the second version.
# It doesn't take into account snapshot
sub compare_versions {
my $self = shift;
my @first = _split_version(shift);
my @second = _split_version(shift);
my $len = $#first < $#second ? $#first : $#second;
for my $i (0 ... $len) {
next if $first[$i] == $second[$i];
return $first[$i] - $second[$i];
}
return $#first - $#second;
}
sub _split_version {
my $v = shift;
$v =~ s/-.*$//;
return split /\./,$v;
}
sub _check_version {
my $self = shift;
my $jmx4perl_version = shift;
my $range = shift;
my ($l,$l_v,$u_v,$u) = ($1,$2,$3,$4) if $range =~ /^\s*([\[\(])\s*([\d\.]+)\s*,\s*([\d\.]+)\s*([\)\]])\s*$/;
if ($l_v) {
my $cond = "\$a " . ($l eq "[" ? ">=" : ">"). $l_v . " && \$a" . ($u eq "]" ? "<=" : "<") . $u_v;
my $a = $jmx4perl_version;
return eval $cond;
}
return undef;
}
=item $meta->versions_compatible($jmx4perl_version,$jolokia_version)
Check, whether the Jolokia and Jmx4Perl versions are compaptible, i.e.
whether Jmx4Perl with the given version can interoperate with the given
Jolokia version
=cut
sub versions_compatible {
my $self = shift;
my $jmx4perl_version = shift;
my $jolokia_version = shift;
my $version_info = $self->get("versions");
my $range = $version_info->{$jolokia_version}->{jmx4perl};
if ($range) {
return $self->_check_version($jmx4perl_version,$range);
} else {
return undef;
}
}
=item $type = $meta->extract_type($artifact_name)
Extract the type for a given artifactId
=cut
sub extract_type {
my $self = shift;
my $artifact = shift;
my $mapping = $self->get("mapping");
for my $k (keys %$mapping) {
return $k if $mapping->{$k}->[0] eq $artifact;
}
return undef;
}
=item $meta->template_url($template_name,$version)
Download a template with the given name. The download URL is looked up
in the meta data. If a version is given, the template for this specific
version is returned (if present, if not the default template is returned).
If no version is given, the default template is returned. The downloaded
template is verified as any other downloaded artifact.
The template is returned as a string.
=cut
sub template_url {
my $self = shift;
my $template = shift;
my $version = shift;
my $url;
if ($version) {
my $version_info = $self->get("versions");
my $v_data = $version_info->{$version};
$self->_fatal("Cannot load template $template for version $version since $version is unknown")
unless $v_data;
my $templs = $v_data->{templates};
if ($templs) {
$url = $templs->{$template};
}
}
unless ($url) {
my $templs = $self->get("templates");
$self->_fatal("No templates defined in jolokia.meta") unless $templs;
$url = $templs->{$template};
}
return $url;
}
=back
=cut
# ===================================================================================
# Fetch from cache, but only if the cache file is older than $cache_interval
# seconds back in time
sub _from_cache {
my $self = shift;
my $cache_interval = $self->{cache_interval} || 12 * 60 * 60; # 12h by default
my $cache_file = $self->{cache_file} || $ENV{HOME} . "/.jolokia_meta";
my $mtime = (stat($cache_file))[9];
if ($mtime && $mtime >= time - $cache_interval) {
if (!open(F,$cache_file)) {
$self->_error("Cannot open $cache_file: $!");
return undef;
}
my $ret = join "",<F>;
close F;
$self->_debug("Loaded Jolokia meta data from cache");
return from_json($ret,{utf8 => 1});
} else {
return undef;
}
}
# Store to cache
sub _to_cache {
my $self = shift;
my $meta = shift;
my $cache_file = $self->{cache_file} || $ENV{HOME} . "/.jolokia_meta";
if (!open(F,">$cache_file")) {
$self->_error("Cannot save $cache_file: $!");
return;
}
print F to_json($meta,{utf8 => 1,pretty => 1});
close F;
}
# Load from server
sub _load_from_server {
my $self = shift;
# Create sample meta-data
return $self->_example_meta if ($ENV{USE_SAMPLE_JOLOKIA_META});
# Load with HTTP-Client, hardcoded for now
$self->_info("Loading Jolokia meta data from $JOLOKIA_META_URL");
my $ua = new JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent($self->{ua_config});
my $response = $ua->get($JOLOKIA_META_URL);
if ($response->is_success) {
my $content = $response->decoded_content; # or whatever
$self->{verifier}->verify(ua_config => $self->{ua_config}, logger => $self->{logger},
url => $JOLOKIA_META_URL, data => $content);
return from_json($content, {utf8 => 1});
}
else {
# Log an error, but do not exit ...
$self->{logger}->error("Cannot load Jolokia Meta-Data from $JOLOKIA_META_URL: " . $response->status_line);
return undef;
}
}
# Do something with errors and info messages
sub _debug {
shift->{logger}->debug(@_);
}
sub _error {
my $self = shift;
$self->{logger}->error(@_);
}
sub _fatal {
my $self = shift;
$self->{logger}->error(@_);
die "\n";
}
sub _info {
my $self = shift;
$self->{logger}->info(@_);
}
# Sample meta data, also used for creating site meta data.
sub _example_meta {
return {
repositories => [
"http://labs.consol.de/maven/repository"
],
'snapshots-repositories' => [
"http://labs.consol.de/maven/snapshots-repository"
],
versions => {
"0.90-SNAPSHOT" => { jmx4perl => "[0.90,1.0)" },
"0.83" => { jmx4perl => "[0.73,1.0)" },
"0.82" => { jmx4perl => "[0.73,1.0)" } ,
"0.81" => { jmx4perl => "[0.73,1.0)" } ,
},
mapping => {
"war" => [ "jolokia-war", "jolokia-war-%v.war", "jolokia.war" ],
"osgi" => [ "jolokia-osgi", "jolokia-osgi-%v.jar", "jolokia.jar" ],
"osgi-bundle" => [ "jolokia-osgi-bundle", "jolokia-osgi-bundle-%v.jar", "jolokia-bundle.jar" ],
"mule" => [ "jolokia-mule", "jolokia-mule-%v.jar", "jolokia-mule.jar" ],
"jdk6" => [ "jolokia-jvm-jdk6", "jolokia-jvm-jdk6-%v-agent.jar", "jolokia.jar" ]
},
templates => {
"jolokia-access.xml" => "http://www.jolokia.org/templates/jolokia-access.xml"
}
};
}
1;
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
The Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut
1;

162
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier.pm Normal file
View File

@ -0,0 +1,162 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier;
=head1 NAME
JMX::Jmx4Perl::Agent::Verifier - Handler for various verifiers which picks
the most secure one first.
=head1 DESCRIPTION
Entry module for verification of downloaded artifacts. Depending on modules
installed, various validation mechanisms are tried in decreasing order fo
vialibility:
=over
=item L<Crypt::OpenPGP>
The strongest validation is provided by PGP signatures with which Jolokia
artifact is signed. The verifier uses L<Crypt::OpenPGP> for verifying PGP
signatures.
=item L<Digest::SHA1>
If OpenPGP is not available or when no signature is provided from the Jolokia
site (unlikely), a simple SHA1 checksum is fetched and compared to the artifact
downloaded. This is not secure, but guarantees some degree of consistency.
=item L<Digest::MD5>
As last resort, when this module is availabl, a MD5 checksum is calculated and
compared to the checksum also downloaded from www.jolokia.org.
=back
=head1 METHODS
=over 4
=cut
use Data::Dumper;
use vars qw(@VERIFIERS @WARNINGS);
use strict;
# Pick the verifier, which is the most reliable
BEGIN {
@VERIFIERS = ();
@WARNINGS = ();
my $create = sub {
my $module = shift;
eval "require $module";
die $@ if $@;
my $verifier;
eval "\$verifier = new $module()";
die $@ if $@;
return $verifier;
};
my $prefix = "JMX::Jmx4Perl::Agent::Jolokia::Verifier::";
if (`gpg --version` =~ /GnuPG/m) {
push @VERIFIERS,$create->($prefix . "GnuPGVerifier");
} else {
push @WARNINGS,"No signature verification available. Please install GnupPG.";
}
# Disabled support for OpenPGP since it doesn't support the digest
# algorithm used for signging the jolokia artefacts
# } elsif (eval "requireCrypt::OpenPGP; 1") {
# push @VERIFIERS,$create->($prefix . "OpenPGPVerifier");
push @VERIFIERS,$create->($prefix . "SHA1Verifier") if eval "require Digest::SHA1; 1";
push @VERIFIERS,$create->($prefix . "MD5Verifier") if eval "require Digest::MD5; 1";
}
=item $verifier = JMX::Jmx4Perl::Agent::Jolokia::Verifier->new(%args)
Creates a new verifier. It takes an expanded hash als argument, where the
following keys are respected:
"ua_config" UserAgent configuration used for accessing
remote signatures/checksums
"logger" Logger
=cut
sub new {
my $class = shift;
my $self = {@_};
bless $self,(ref($class) || $class);
}
=item $verifier->verify(url => $url,path => $file)
=item $verifier->verify(url => $url,data => $data)
Verifies the given file (C<path>) or scalar data (C<data>) by trying various
validators in turn. Technically, each validator is asked for an extension
(e.g. ".asc" for a PGP signature), which is appended to URL and this URL is
tried for downloading the signature/checksum. If found, the content of the
signature/checksum is passed to specific verifier along with the data/file to
validate. A verifier will die, if validation fails, so one should put this in
an eval if required. If validation passes, the method returns silently.
=back
=cut
sub verify {
my $self = shift;
my %args = @_;
my $url = $args{url};
my $ua = new JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent($self->{ua_config});
my $log = $self->{logger};
$log->warn($_) for @WARNINGS;
for my $verifier (@VERIFIERS) {
my $ext = $verifier->extension;
if ($ext) {
my $response = $ua->get($url . $ext);
if ($response->is_success) {
my $content = $response->decoded_content;
$verifier->verify(%args,signature => $content,logger => $log);
return;
} else {
$log->warn($verifier->name . ": Couldn't load $url$ext");
}
}
}
$log->warn("No suitable validation mechanism found with $url");
}
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
The Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut
1;

89
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/ChecksumVerifier.pm Normal file
View File

@ -0,0 +1,89 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier - Verifies a
checksum for a downloaded artifact.
=head1 DESCRIPTION
This verifier provides the base for simple checksum checking. It needs to be
subclassed to provide the proper extension (e.g. ".sha1") and creating of a
digester.
=cut
use strict;
sub new {
my $class = shift;
my $self = {};
bless $self,(ref($class) || $class);
}
sub extension {
die "abstract";
}
sub name {
die "abstract";
}
sub create_digester {
die "abstract";
}
sub verify {
my $self = shift;
my %args = @_;
my $logger = $args{logger};
my $sig = $args{signature};
chomp $sig;
$sig =~ s/^([^\s]+).*$/$1/;
my $digester = $self->create_digester;
my $file = $args{path};
if ($file) {
open (my $fh, "<", $file) || ($logger->error("Cannot open $file for ",$self->name," check: $!") && die "\n");
$digester->addfile($fh);
close $fh;
} else {
my $data = $args{data};
$digester->add($data);
}
my $sig_calc = $digester->hexdigest;
if (lc($sig) eq lc($sig_calc)) {
$logger->info("Passed ",$self->name," check (" . $sig_calc . ")",($file ? " for file $file" : ""));
} else {
$logger->error("Failed ",$self->name," check. Got: " . $sig_calc . ", Expected: " . $sig);
die "\n";
}
}
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
The Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut
1;

170
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/GnuPGVerifier.pm Normal file
View File

@ -0,0 +1,170 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::GnuPGVerifier;
use JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey;
use Module::Find;
use Data::Dumper;
use File::Temp qw/tempfile/;
use strict;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Verifier::GnuPGVerifier - Verifies PGP
signature with a natively installed GnuPG (with gpg found in the path)
=head1 DESCRIPTION
This verifier uses a natively installed GPG for validating a PGP signature
obtained from the download site. It's similar to
L<JMX::Jmx4Perl::Agent::Jolokia::Verifier::OpenPGPVerifier> except that it will
use a locally installed GnuPG installation. Please note, that it will import
the public key used for signature verification into the local keystore.
=cut
sub new {
my $class = shift;
my $self = {};
($self->{gpg},$self->{version}) = &_gpg_version();
bless $self,(ref($class) || $class);
}
sub extension {
return ".asc";
}
sub name {
return "GnuPG";
}
sub verify {
my $self = shift;
my %args = @_;
my $log = $args{logger};
my $gpg = $self->{gpg};
die "Neither 'path' nor 'data' given for specifying the file/data to verify"
unless $args{path} || $args{data};
my $signature_path = $self->_store_tempfile($args{signature});
my $path = $args{path} ? $args{path} : $self->_store_tempfile($args{data});
my @cmd = (
$gpg,
qw(--verify --batch --no-tty -q --logger-fd=1),
);
eval {
push @cmd, $signature_path,$path;
# Unset language for proper parsing of the output independent
# of the locale
local $ENV{LANG} = undef;
my $cmd = join ' ', @cmd;
my $output = `$cmd`;
if ($output =~ /public\s*key/i) {
# Import key and retry
$self->_import_key(\%args);
$output = `$cmd`;
}
$self->_verify_gpg_output($?,$output,\%args);
};
# Always cleanup
my $error = $@;
unlink $signature_path;
unlink $path unless $args{path};
die $error if $error;
}
sub _verify_gpg_output {
my $self = shift;
my $code = shift;
my $output = shift;
my $args = shift;
my $log = $args->{logger};
my $key = $1 if $output =~ /\s+([\dA-F]{8})/;
# print $output,"\n";
if ($code) {
$log->error("Invalid signature",$args->{path} ? " for " . $args->{path} : "",$key ? " (key: $key)" : "");
die "\n";
} else {
$log->info("Good PGP signature" . ($key ? " ($key)" : ""));
}
}
sub _import_key {
my $self = shift;
my $args = shift;
my $gpg = $self->{gpg};
my $log = $args->{logger};
my $key_path = $self->_store_tempfile($JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey::KEY);
my @cmd = ($gpg,qw(--import --verbose --batch --no-tty --logger-fd=1),$key_path);
my $cmd = join ' ', @cmd;
my $output = `$cmd 2>&1`;
if ($?) {
$log->error("Cannot add public PGP used for verification to local keystore: $output");
die "\n";
} else {
#$log->info($output);
my $info = $1 if $output =~ /([\dA-F]{8}.*import.*)$/mi;
$log->info($info ? $info : "Added jmx4perl key");
}
unlink $key_path;
}
sub _gpg_version {
my $gpg = "gpg2";
my $out = `gpg2 --version`;
if ($?) {
$out = `gpg --version`;
$gpg = "gpg";
if ($?) {
die "Cannot find gpg or gpg2: $out\n";
}
}
$out =~ /GnuPG.*?(\S+)\s*$/m;
return ($gpg,$1);
}
sub _store_tempfile {
my $self = shift;
my $sig = shift || die "No data given to store in temp file";
my ($fh,$path) = tempfile();
print $fh $sig;
close $fh;
return $path;
}
1;
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
The Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 AUTHOR
roland@cpan.org
=cut

Some files were not shown because too many files have changed in this diff Show More