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