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