From dc55c48cd5d5d32fa97c09ea86cbb9a48243db03 Mon Sep 17 00:00:00 2001 From: Jens Rehsack Date: Thu, 9 Aug 2012 14:06:24 +0200 Subject: [PATCH] - bump version to 0.001_003 - improve documentation (including Dist::Zilla's Plugin for Pod::Weaver) - improve report/summary generator during code-review while documenting --- bin/check_web2.pl | 9 +- bin/wtscript2json.pl | 82 +------- dist.ini | 7 +- etc/check_web.json | 11 +- lib/Config/Any/WTScript.pm | 24 +-- lib/WWW/Mechanize/Script.pm | 212 +++++++++++++++++++-- lib/WWW/Mechanize/Script/Plugin.pm | 4 +- lib/WWW/Mechanize/Script/Plugin/ContentSizeTest.pm | 4 +- lib/WWW/Mechanize/Script/Plugin/RegexMatchTest.pm | 8 +- .../Mechanize/Script/Plugin/ResponseTimeTest.pm | 4 +- lib/WWW/Mechanize/Script/Plugin/StatusTest.pm | 4 +- lib/WWW/Mechanize/Script/Plugin/TextMatchTest.pm | 6 +- lib/WWW/Mechanize/Script/Util.pm | 5 +- 13 files changed, 247 insertions(+), 133 deletions(-) diff --git a/bin/check_web2.pl b/bin/check_web2.pl index 4ec7fe3..3e48383 100644 --- a/bin/check_web2.pl +++ b/bin/check_web2.pl @@ -3,6 +3,9 @@ use strict; use warnings; +# PODNAME: check_web2 +# ABSTRACT: allows checking of website according to configured specifications + use v5.10.1; use Getopt::Long; @@ -12,7 +15,7 @@ use Params::Util qw(_ARRAY); use WWW::Mechanize::Script::Util qw(:ALL); use WWW::Mechanize::Script; -my $VERSION = 0.001; +my $VERSION = '0.001_003'; my %opts; my @options = ( "file=s", "help|h", "usage|?" ); @@ -68,10 +71,6 @@ exit( $@ ? 255 : $code ); __END__ -=head1 NAME - -check_web2 - allows checking of website according to configured specifications - =head1 DESCRIPTION check_web2 is intended to be used to check web-sites according a configuration. diff --git a/bin/wtscript2json.pl b/bin/wtscript2json.pl index e3abbc9..54abcc6 100644 --- a/bin/wtscript2json.pl +++ b/bin/wtscript2json.pl @@ -3,6 +3,9 @@ use strict; use warnings; +# PODNAME: wtscript2json +# ABSTRACT: convert read configuration into JSON + use v5.10.1; use File::Slurp qw(write_file); @@ -15,7 +18,7 @@ use Pod::Usage; use WWW::Mechanize::Script::Util qw(:ALL); use WWW::Mechanize::Script; -our $VERSION = '0.001_002'; +our $VERSION = '0.001_003'; my %opts = ( "input-files" => [], "output-files" => [], @@ -107,80 +110,3 @@ foreach my $filename ( @{ $opts{"input-files"} } ) __END__ -=head1 NAME - -check_web2 - allows checking of website according to configured specifications - -=head1 DESCRIPTION - -check_web2 is intended to be used to check web-sites according a configuration. -The configuration covers the request configuration (including agent part) and -check configuration to specify check parameters. - -See C for details about the configuration options. - -=head2 HISTORY - -This script is created as successor of an check_web script of a nagios setup -based on HTTP::WebCheck. This module isn't longer maintained, so decision -was made to create a new environment simulating the old one basing on -WWW::Mechanize. - -=head1 SYNOPSIS - - $ check_web2 --file domain1/site1.json - $ check_web2 --file domain2/site1.yml - # for compatibility - $ check_web2 --file domain1/site2.wts - -=head1 AUTHOR - -Jens Rehsack, C<< >> - -=head1 BUGS - -Please report any bugs or feature requests to C, or through -the web interface at L. I will be notified, and then you'll -automatically be notified of progress on your bug as I make changes. - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW:Mechanize::Script - -You can also look for information at: - -=over 4 - -=item * RT: CPAN's request tracker (report bugs here) - -L - -=item * AnnoCPAN: Annotated CPAN documentation - -L - -=item * CPAN Ratings - -L - -=item * Search CPAN - -L - -=back - -=head1 ACKNOWLEDGEMENTS - -=head1 LICENSE AND COPYRIGHT - -Copyright 2012 Jens Rehsack. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. - -=cut diff --git a/dist.ini b/dist.ini index 07230b1..04db36f 100644 --- a/dist.ini +++ b/dist.ini @@ -1,6 +1,6 @@ name = WWW-Mechanize-Script -version = 0.001_002 +version = 0.001_003 author = Jens Rehsack license = Perl_5 copyright_holder = Jens Rehsack @@ -29,12 +29,14 @@ copyright_holder = Jens Rehsack [MetaResources] +[AutoPrereqs] [Prereqs / ConfigureRequires] -Module::Build = 0.38 +Module::Build = 0.3800 [Prereqs / BuildRequires] Test::More = 0 +Module::Build = 0.3800 [Prereqs] Config::Any = 0 @@ -51,3 +53,4 @@ WWW::Mechanize = 1.72 WWW::Mechanize::Timed = 0.44 perl = 5.014 +[PodWeaver] diff --git a/etc/check_web.json b/etc/check_web.json index 575d0e3..32d1384 100644 --- a/etc/check_web.json +++ b/etc/check_web.json @@ -20,12 +20,19 @@ "an error occurred while processing this directive" ] }, - "request" : {} + "request" : { + "method" : "GET" + } }, "wtscript_extensions" : [ "txt", "wts", "wtscript" ], "script_dirs" : ["/data/devel/Vodafone/vzapp-nagios/nagios-plugins/check_web_config"], + "templating" : { + "vars" : { + "CODE_NAMES" : ["OK", "WARNING", "CRITICAL", "UNKNOWN", "DEPENDENT", "EXCEPTION"] + }, + }, "summary" : { - "template" : "[% CODE_NAME; IF MESSAGES.size > 0 %] - [% MESSAGES.join(', '); END %]\n", + "template" : "[% CODE_NAMES.$CODE; IF MESSAGES.size > 0 %] - [% MESSAGES.join(', '); END %]\n", "target" : "-" }, "report" : { diff --git a/lib/Config/Any/WTScript.pm b/lib/Config/Any/WTScript.pm index 135daf3..c7bfc47 100644 --- a/lib/Config/Any/WTScript.pm +++ b/lib/Config/Any/WTScript.pm @@ -1,8 +1,6 @@ package Config::Any::WTScript; -=head1 NAME - -Config::Any::WTScript - Parse wtscript files. +# ABSTRACT: Parse wtscript files. =head1 SYNOPSIS @@ -14,8 +12,6 @@ Config::Any::WTScript - Parse wtscript files. Parses a wtscript file and converts it to a set of test objects. -=head1 CLASS METHODS - =cut use strict; @@ -31,7 +27,7 @@ use File::Slurp qw(read_file); use constant ST_FILE => 0; use constant ST_TEST_BLOCK => 1; -$VERSION = '0.001_002'; +$VERSION = '0.001_003'; # horizontal space regexp my $reHS = qr/[\t ]/; @@ -40,7 +36,7 @@ my $reWORD = qr/(?: (?: [^=)\s] | [^)\s] (?!>) )+ )/x; # eat comments regexp my $reCOMMENT = qr/(?: \s*? ^ \s* \# .* )+/mx; -=head2 extensions(;@extensions) +=method extensions(;@extensions) When list of extensions to accept given, replace current list with given list. @@ -57,7 +53,7 @@ sub extensions return @extensions; } -=head2 load( $file ) +=method load( $file ) Parses wtscript text data passed in a scalar variable C<$data>. @@ -407,18 +403,16 @@ sub _parse_scalar } } -=head1 COPYRIGHT - -Copyright (c) 2001-2003 Ilya Martynov. All rights reserved. +=head1 ACKNOWLEDGEMENTS -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +The original parsing code is from L, written by +Ilya Martynov. =head1 SEE ALSO -L +L -L +L =cut diff --git a/lib/WWW/Mechanize/Script.pm b/lib/WWW/Mechanize/Script.pm index 6b7f041..7091b87 100644 --- a/lib/WWW/Mechanize/Script.pm +++ b/lib/WWW/Mechanize/Script.pm @@ -8,13 +8,12 @@ use File::Path qw(make_path); use Hash::Merge (); use IO::File; use Module::Pluggable::Object (); -use Template (); -use WWW::Mechanize (); -use WWW::Mechanize::Timed (); +use Params::Util qw(_HASH); +use Template (); +use WWW::Mechanize (); +use WWW::Mechanize::Timed (); -=head1 NAME - -WWW::Mechanize::Script - fetch websites and executes tests on the results +# ABSTRACT: fetch websites and executes tests on the results =head1 SYNOPSIS @@ -27,11 +26,44 @@ WWW::Mechanize::Script - fetch websites and executes tests on the results $wms->run_test(%{$test}); } -=head1 METHODS - =cut -our $VERSION = '0.001_002'; +our $VERSION = '0.001_003'; + +=method new(\%cfg) + +Instantiates new WWW::Mechanize::Script object. + +Configuration hash looks like: + + defaults => { + check => { # check defaults + "code_cmp" : ">", + "XXX_code" : 2, + "ignore_case" : true, + }, + request => { # request defaults + agent => { # LWP::UserAgent defaults + agent => "Agent Adderly", + accept_cookies => 'yes', # check LWP::UA param + show_cookie => 'yes', # check LWP::UA param + show_headers => 'yes', # check LWP::UA param + send_cookie => 'yes', # check LWP::UA param + }, + }, + }, + script_dirs => [qw(/old/wtscripts /new/json_scripts)], + summary => { + template => "[% CODE_NAME; IF MESSAGES.size > 0 %] - [% MESSAGES.join(', '); END %]\n", + target => "-" + }, + report => { + template => "[% USE Dumper; Dumper.dump(RESPONSE) %]", + target => "/tmp/@OPTS_FILE@.log", + append => true + } + +=cut sub new { @@ -39,11 +71,24 @@ sub new my $self = bless( { cfg => { %{$cfg} } }, $class ); - my $default = $cfg->{default}; - return $self; } +=method _gen_code_compute + +Interpretes one of following config hash parameters + + defaults => { + check => { # check defaults + code_cmp => ">", + code_func => 'my ($cur,$new) = @_; return $cur > $new ? $cur : $new;' + } + } + +When none of them are there, the sample in defaults->check->code_func is used. + +=cut + sub _gen_code_compute { my $check_cfg = $_[0]; @@ -76,7 +121,7 @@ sub _gen_code_compute return $compute_code; } -=head2 test_plugins( ) +=method test_plugins( ) The C classmethod returns the names of configuration loading plugins as found by L. @@ -110,6 +155,13 @@ sub test_plugins return @tp; } +=method get_request_value($request,$value_name) + +Returns the value for creating the request - either from current script +or from defaults (C<< defaults->request->$value_name >>). + +=cut + sub get_request_value { my ( $self, $request, $value_name ) = @_; @@ -138,16 +190,43 @@ sub _get_target return $target; } -my @codes = qw(OK WARNING CRITICAL UNKNOWN DEPENDENT EXCEPTION); +=method summarize($code,@msgs) + +Generates the summary passing the template in the configuration of +C<< config->summary >> into L. + +Following variables are provided for the template processing: + +=over 4 + +=item CODE + +The accumulated return code of all executed checks computed via +L. + +=item MESSAGES + +Collected messages returned of all executed checks. + +=back + +Plus all constants named in the C<< config->templating->vars >> hash and +those in C<< config->summary->vars >> hash. + +The output target is guessed from C<< config->summary->target >> whereby +the special target I<-> is interpreted as C. + +=cut sub summarize { my ( $self, $code, @msgs ) = @_; my %vars = ( - CODE => $code, - CODE_NAME => $codes[$code] // $codes[-1], - MESSAGES => [@msgs] + %{ _HASH( $self->{cfg}->{templating}->{vars} ) // {} }, + %{ _HASH( $self->{cfg}->{report}->{vars} ) // {} }, + CODE => $code, + MESSAGES => [@msgs] ); my $input = $self->{cfg}->{summary}->{source} // \$self->{cfg}->{summary}->{template}; @@ -159,15 +238,71 @@ sub summarize return; } +=method gen_report($full_test, $mech, $code, @msgs) + +Generates a report for a test within a script by passing the template +in the configuration of C<< config->report >> into L. + +Following variables are provided for the template processing: + +=over 4 + +=item CODE + +The accumulated return code of all executed checks computed via +L. + +=item MESSAGES + +Collected messages returned of all executed checks. + +=item RESPONSE + +Hash containing the following L items: + +=over 8 + +=item CODE + +HTTP response code + +=item CONTENT + +Content of the response + +=item BASE + +The base URI for this response + +=item HEADER + +Header keys/values as perl hash + +=back + +=back + +Plus all constants named in the C<< config->templating->vars >> hash and +those in C<< config->report->vars >> hash. + +The output target is guessed from C<< config->summary->target >> whereby +the special target I<-> is interpreted as C. + +When the C<< config->summary->append >> flag is set and contains a true +value, the output is appended to an existing target. + +=cut + sub gen_report { my ( $self, $full_test, $mech, $code, @msgs ) = @_; my $response = $mech->response(); my %vars = ( - CODE => $code, - CODE_NAME => $codes[$code] // $codes[-1], - MESSAGES => [@msgs], - RESPONSE => { + %{ _HASH( $self->{cfg}->{templating}->{vars} ) // {} }, + %{ _HASH( $self->{cfg}->{report}->{vars} ) // {} }, + CODE => $code, + MESSAGES => [@msgs], + RESPONSE => { CODE => $response->code(), CONTENT => $response->content(), BASE => $response->base(), @@ -175,7 +310,6 @@ sub gen_report map { $_ => $response->headers()->header($_) } $response->headers()->header_field_names() }, - CODE => $response->code(), } ); @@ -188,6 +322,16 @@ sub gen_report return; } +=method run_script(@script) + +Runs a script consisting of at least one test and generates a summary if +configured. The code to accumulate the return codes from each test is taken +from C<< config->defaults->check >> as described in L. + +Returns the accumulated return codes from all tests in the given script. + +=cut + sub run_script { my ( $self, @script ) = @_; @@ -210,6 +354,32 @@ sub run_script return ( $code, @msgs ); } +=method run_test(\%test) + +Runs one test and generates a report if configured (C<< config->report >>). + +The request is constructed from C<< test->request >> whereby the part +below C<< test->request->agent >> is used to parametrize a new instance +of L. + +All keys defined below C<< test->request->agent >> are taken as +setter of WWW::Mechanize::Timed or a inherited class. + +If there is a hash defined at C<< test->request->http_headers >>, those +headers are passed along with the URI specified at C<< test->request->uri >> +to GET/POST or whatever you want to do (C<< test->request->method >>). + +Which checks are executed is defined below C<< test->check >>. Each valid +plugin below the I namespace is approved +for relevance for the test (see L). + +The code to accumulate the return codes from each test is taken +from C<< test->check >> as described in L. + +Returns the accumulated return codes from all checks in the given tests. + +=cut + sub run_test { my ( $self, $test ) = @_; diff --git a/lib/WWW/Mechanize/Script/Plugin.pm b/lib/WWW/Mechanize/Script/Plugin.pm index 192683f..ce63475 100644 --- a/lib/WWW/Mechanize/Script/Plugin.pm +++ b/lib/WWW/Mechanize/Script/Plugin.pm @@ -3,7 +3,9 @@ package WWW::Mechanize::Script::Plugin; use strict; use warnings; -our $VERSION = '0.001_002'; +# ABSTRACT: plugin base class for check plugins + +our $VERSION = '0.001_003'; use 5.014; diff --git a/lib/WWW/Mechanize/Script/Plugin/ContentSizeTest.pm b/lib/WWW/Mechanize/Script/Plugin/ContentSizeTest.pm index 8630fb6..5e72a98 100644 --- a/lib/WWW/Mechanize/Script/Plugin/ContentSizeTest.pm +++ b/lib/WWW/Mechanize/Script/Plugin/ContentSizeTest.pm @@ -5,7 +5,9 @@ use warnings; use parent qw(WWW::Mechanize::Script::Plugin); -our $VERSION = '0.001_002'; +# ABSTRACT: check for size of received content + +our $VERSION = '0.001_003'; use 5.014; diff --git a/lib/WWW/Mechanize/Script/Plugin/RegexMatchTest.pm b/lib/WWW/Mechanize/Script/Plugin/RegexMatchTest.pm index 98b25d1..54dcd3a 100644 --- a/lib/WWW/Mechanize/Script/Plugin/RegexMatchTest.pm +++ b/lib/WWW/Mechanize/Script/Plugin/RegexMatchTest.pm @@ -5,9 +5,11 @@ use warnings; use parent qw(WWW::Mechanize::Script::Plugin); +# ABSTRACT: check for required/forbidden text via regular expression in response + use Params::Util qw(_ARRAY0); -our $VERSION = '0.001_002'; +our $VERSION = '0.001_003'; use 5.014; @@ -25,7 +27,9 @@ sub check_response my $ignore_case = $self->get_check_value_as_bool( $check, "ignore_case" ); my $content = $mech->is_html() ? $mech->text() : $mech->content(); - defined($regex_require) and ref($regex_require) ne "ARRAY" and $regex_require = [$regex_require]; + defined($regex_require) + and ref($regex_require) ne "ARRAY" + and $regex_require = [$regex_require]; defined($regex_forbid) and ref($regex_forbid) ne "ARRAY" and $regex_forbid = [$regex_forbid]; my @match_fails; diff --git a/lib/WWW/Mechanize/Script/Plugin/ResponseTimeTest.pm b/lib/WWW/Mechanize/Script/Plugin/ResponseTimeTest.pm index d79bd38..2714a6b 100644 --- a/lib/WWW/Mechanize/Script/Plugin/ResponseTimeTest.pm +++ b/lib/WWW/Mechanize/Script/Plugin/ResponseTimeTest.pm @@ -5,7 +5,9 @@ use warnings; use parent qw(WWW::Mechanize::Script::Plugin); -our $VERSION = '0.001_002'; +# ABSTRACT: check response time of request + +our $VERSION = '0.001_003'; use 5.014; diff --git a/lib/WWW/Mechanize/Script/Plugin/StatusTest.pm b/lib/WWW/Mechanize/Script/Plugin/StatusTest.pm index 5ae5e40..9536edf 100644 --- a/lib/WWW/Mechanize/Script/Plugin/StatusTest.pm +++ b/lib/WWW/Mechanize/Script/Plugin/StatusTest.pm @@ -5,7 +5,9 @@ use warnings; use parent qw(WWW::Mechanize::Script::Plugin); -our $VERSION = '0.001_002'; +# ABSTRACT: prove expected HTTP status of the response + +our $VERSION = '0.001_003'; use 5.014; diff --git a/lib/WWW/Mechanize/Script/Plugin/TextMatchTest.pm b/lib/WWW/Mechanize/Script/Plugin/TextMatchTest.pm index 33e1b9f..6025abe 100644 --- a/lib/WWW/Mechanize/Script/Plugin/TextMatchTest.pm +++ b/lib/WWW/Mechanize/Script/Plugin/TextMatchTest.pm @@ -5,9 +5,11 @@ use warnings; use parent qw(WWW::Mechanize::Script::Plugin); +# ABSTRACT: check for required/forbidden text in response + use Params::Util qw(_ARRAY0); -our $VERSION = '0.001_002'; +our $VERSION = '0.001_003'; use 5.014; @@ -26,7 +28,7 @@ sub check_response my $content = $mech->is_html() ? $mech->text() : $mech->content(); defined($text_require) and ref($text_require) ne "ARRAY" and $text_require = [$text_require]; - defined($text_forbid) and ref($text_forbid) ne "ARRAY" and $text_forbid = [$text_forbid]; + defined($text_forbid) and ref($text_forbid) ne "ARRAY" and $text_forbid = [$text_forbid]; my @match_fails; my $code = 0; diff --git a/lib/WWW/Mechanize/Script/Util.pm b/lib/WWW/Mechanize/Script/Util.pm index 8add76b..d8e1e81 100644 --- a/lib/WWW/Mechanize/Script/Util.pm +++ b/lib/WWW/Mechanize/Script/Util.pm @@ -6,18 +6,19 @@ use warnings; use base qw/Exporter/; use vars qw/$VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS/; +# ABSTRACT: some basic utility functions for scripts + use Config::Any; use Cwd qw(realpath); use File::Basename qw(fileparse); use File::ConfigDir qw(config_dirs); use File::Find::Rule; use Hash::Merge (); -# use Hash::MoreUtils; use List::MoreUtils qw(uniq); use Params::Util qw(_HASH _ARRAY _STRING); use Pod::Usage; -$VERSION = '0.001_002'; +$VERSION = '0.001_003'; @EXPORT = (); @EXPORT_OK = qw(opt_required_all opt_required_one opt_exclusive load_config find_scripts); -- 2.11.4.GIT