bin/wtscript2json.pl

   1 #! perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use v5.10.1;
   7
   8 use File::Slurp qw(write_file);
   9 use Getopt::Long;
  10 use JSON ();
  11 use List::MoreUtils qw(zip);
  12 use Params::Util qw(_ARRAY);
  13 use Pod::Usage;
  14
  15 use WWW::Mechanize::Script::Util qw(:ALL);
  16 use WWW::Mechanize::Script;
  17
  18 our $VERSION = '0.001_002';
  19 my %opts = (
  20              "input-files"    => [],
  21              "output-files"   => [],
  22              "output-pattern" => []
  23            );
  24 my @options = (
  25                 "input-files=s@"      => $opts{"input-files"},
  26                 "output-files=s@"     => $opts{"output-files"},
  27                 "output-pattern=s{2}" => $opts{"output-pattern"},
  28                 "help|h", "usage|?"
  29               );
  30
  31 GetOptions( \%opts, @options ) or pod2usage(2);
  32
  33 # clean-up defaults
  34 @{ $opts{"input-files"} }    or delete $opts{"input-files"};
  35 @{ $opts{"output-files"} }   or delete $opts{"output-files"};
  36 @{ $opts{"output-pattern"} } or delete $opts{"output-pattern"};
  37
  38 # check ...
  39 defined( $opts{help} )
  40   and $opts{help}
  41   and pod2usage(
  42                  {
  43                    -verbose => 2,
  44                    -exitval => 0
  45                  }
  46                );
  47 defined( $opts{usage} ) and $opts{usage} and pod2usage(1);
  48 opt_required_all( \%opts, qw(input-files) );
  49 opt_exclusive( \%opts, qw(output-files output-pattern) );
  50 opt_required_one( \%opts, qw(output-files output-pattern) );
  51 _ARRAY( $opts{"input-files"} )
  52   and _ARRAY( $opts{"output-files"} )
  53   and scalar( @{ $opts{"input-files"} } ) != scalar( @{ $opts{"output-files"} } )
  54   and pod2usage(
  55                  {
  56                    -message => "Count of --input-files and --output-files doesn't match",
  57                    -exitval => 1
  58                  }
  59                );
  60
  61 my %in2out =
  62     _ARRAY( $opts{"output-files"} )
  63   ? zip( @{ $opts{"input-files"} }, @{ $opts{"output-files"} } )
  64   : ();
  65 my %cfg = load_config();
  66
  67 my $coder = JSON->new();
  68 _ARRAY( $cfg{wtscript_extensions} )
  69   and Config::Any::WTScript->extensions( @{ $cfg{wtscript_extensions} } );
  70 foreach my $filename ( @{ $opts{"input-files"} } )
  71 {
  72     my @script_files = find_scripts( \%cfg, $filename );
  73     my $scripts = Config::Any->load_files(
  74                                            {
  75                                              files           => [@script_files],
  76                                              use_ext         => 1,
  77                                              flatten_to_hash => 1,
  78                                            }
  79                                          );
  80     if ( $opts{"output-files"} )
  81     {
  82         @script_files = keys %{$scripts};
  83         scalar(@script_files) > 1
  84           and pod2usage(
  85                    {
  86                      -message => "filename $filename is ambigious: " . join( ", ", @script_files ),
  87                      -exitval => 1
  88                    }
  89           );
  90         scalar(@script_files) < 1
  91           and next;    # file not found or not parsable ...
  92                        # merge into default and previous loaded config ...
  93         my $json = $coder->pretty->encode( $scripts->{ $script_files[0] } );
  94         write_file( $in2out{$filename}, $json );
  95     }
  96     else
  97     {
  98         while ( my ( $script_file, $script ) = each(%$scripts) )
  99         {
 100             my $json = $coder->pretty->encode($script);
 101             ( my $target = $script_file ) =~
 102               s/$opts{"output-pattern"}->[0]/$opts{"output-pattern"}->[1]/;
 103             write_file( $target, $json );
 104         }
 105     }
 106 }
 107
 108 __END__
 109
 110 =head1 NAME
 111
 112 check_web2 - allows checking of website according to configured specifications
 113
 114 =head1 DESCRIPTION
 115
 116 check_web2 is intended to be used to check web-sites according a configuration.
 117 The configuration covers the request configuration (including agent part) and
 118 check configuration to specify check parameters.
 119
 120 See C<WWW::Mechanize::Script> for details about the configuration options.
 121
 122 =head2 HISTORY
 123
 124 This script is created as successor of an check_web script of a nagios setup
 125 based on HTTP::WebCheck. This module isn't longer maintained, so decision
 126 was made to create a new environment simulating the old one basing on
 127 WWW::Mechanize.
 128
 129 =head1 SYNOPSIS
 130
 131   $ check_web2 --file domain1/site1.json
 132   $ check_web2 --file domain2/site1.yml
 133   # for compatibility
 134   $ check_web2 --file domain1/site2.wts
 135
 136 =head1 AUTHOR
 137
 138 Jens Rehsack, C<< <rehsack at cpan.org> >>
 139
 140 =head1 BUGS
 141
 142 Please report any bugs or feature requests to C<bug-www-mechanize-script at rt.cpan.org>, or through
 143 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WWW-Mechanize-Script>.  I will be notified, and then you'll
 144 automatically be notified of progress on your bug as I make changes.
 145
 146 =head1 SUPPORT
 147
 148 You can find documentation for this module with the perldoc command.
 149
 150     perldoc WWW:Mechanize::Script
 151
 152 You can also look for information at:
 153
 154 =over 4
 155
 156 =item * RT: CPAN's request tracker (report bugs here)
 157
 158 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize-Script>
 159
 160 =item * AnnoCPAN: Annotated CPAN documentation
 161
 162 L<http://annocpan.org/dist/WWW-Mechanize-Script>
 163
 164 =item * CPAN Ratings
 165
 166 L<http://cpanratings.perl.org/d/WWW-Mechanize-Script>
 167
 168 =item * Search CPAN
 169
 170 L<http://search.cpan.org/dist/WWW-Mechanize-Script/>
 171
 172 =back
 173
 174 =head1 ACKNOWLEDGEMENTS
 175
 176 =head1 LICENSE AND COPYRIGHT
 177
 178 Copyright 2012 Jens Rehsack.
 179
 180 This program is free software; you can redistribute it and/or modify it
 181 under the terms of either: the GNU General Public License as published
 182 by the Free Software Foundation; or the Artistic License.
 183
 184 See http://dev.perl.org/licenses/ for more information.
 185
 186 =cut