- bump version to 0.001_003
authorJens Rehsack <sno@NetBSD.org>
Thu, 9 Aug 2012 12:06:24 +0000 (9 14:06 +0200)
committerJens Rehsack <sno@NetBSD.org>
Thu, 9 Aug 2012 12:06:24 +0000 (9 14:06 +0200)
- improve documentation (including Dist::Zilla's Plugin for Pod::Weaver)
- improve report/summary generator during code-review while documenting

13 files changed:
bin/check_web2.pl
bin/wtscript2json.pl
dist.ini
etc/check_web.json
lib/Config/Any/WTScript.pm
lib/WWW/Mechanize/Script.pm
lib/WWW/Mechanize/Script/Plugin.pm
lib/WWW/Mechanize/Script/Plugin/ContentSizeTest.pm
lib/WWW/Mechanize/Script/Plugin/RegexMatchTest.pm
lib/WWW/Mechanize/Script/Plugin/ResponseTimeTest.pm
lib/WWW/Mechanize/Script/Plugin/StatusTest.pm
lib/WWW/Mechanize/Script/Plugin/TextMatchTest.pm
lib/WWW/Mechanize/Script/Util.pm

index 4ec7fe3..3e48383 100644 (file)
@@ -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.
index e3abbc9..54abcc6 100644 (file)
@@ -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<WWW::Mechanize::Script> 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<< <rehsack at cpan.org> >>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to C<bug-www-mechanize-script at rt.cpan.org>, or through
-the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WWW-Mechanize-Script>.  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<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize-Script>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/WWW-Mechanize-Script>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/WWW-Mechanize-Script>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/WWW-Mechanize-Script/>
-
-=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
index 07230b1..04db36f 100644 (file)
--- 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 <rehsack@cpan.org>
 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]
index 575d0e3..32d1384 100644 (file)
                "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" : {
index 135daf3..c7bfc47 100644 (file)
@@ -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<HTTP::WebTest::Parser>, written by
+Ilya Martynov.
 
 =head1 SEE ALSO
 
-L<HTTP::WebTest|HTTP::WebTest>
+L<HTTP::WebTest>
 
-L<HTTP::WebTest::API|HTTP::WebTest::API>
+L<HTTP::WebTest::Parser>
 
 =cut
 
index 6b7f041..7091b87 100644 (file)
@@ -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<plugins()> classmethod returns the names of configuration loading plugins as 
 found by L<Module::Pluggable::Object|Module::Pluggable::Object>.
@@ -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<Template::Toolkit>.
+
+Following variables are provided for the template processing:
+
+=over 4
+
+=item CODE
+
+The accumulated return code of all executed checks computed via
+L</_gen_code_compute>.
+
+=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<stdout>.
+
+=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<Template::Toolkit>.
+
+Following variables are provided for the template processing:
+
+=over 4
+
+=item CODE
+
+The accumulated return code of all executed checks computed via
+L</_gen_code_compute>.
+
+=item MESSAGES
+
+Collected messages returned of all executed checks.
+
+=item RESPONSE
+
+Hash containing the following L<HTTP::Response|response> 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<stdout>.
+
+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</_gen_code_compute>.
+
+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<WWW::Mechanize::Timed>.
+
+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<WWW::Mechanize::Script::Plugin> namespace is approved
+for relevance for the test (see L<WWW::Mechanize::Script::Plugin/can_check>).
+
+The code to accumulate the return codes from each test is taken
+from C<< test->check >> as described in L</_gen_code_compute>.
+
+Returns the accumulated return codes from all checks in the given tests.
+
+=cut
+
 sub run_test
 {
     my ( $self, $test ) = @_;
index 192683f..ce63475 100644 (file)
@@ -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;
 
index 8630fb6..5e72a98 100644 (file)
@@ -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;
 
index 98b25d1..54dcd3a 100644 (file)
@@ -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;
index d79bd38..2714a6b 100644 (file)
@@ -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;
 
index 5ae5e40..9536edf 100644 (file)
@@ -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;
 
index 33e1b9f..6025abe 100644 (file)
@@ -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;
index 8add76b..d8e1e81 100644 (file)
@@ -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);