1 package WWW
::Mechanize
::Script
::Util
;
7 use vars qw
/$VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS/;
9 # ABSTRACT: some basic utility functions for scripts
13 use File
::Basename
qw(fileparse);
14 use File
::ConfigDir
qw(config_dirs);
17 use List
::MoreUtils
qw(uniq);
18 use Params
::Util
qw(_HASH _ARRAY _STRING);
21 $VERSION = '0.001_004';
24 @EXPORT_OK = qw(opt_required_all opt_required_one opt_exclusive load_config find_scripts);
25 %EXPORT_TAGS = ( ALL
=> \
@EXPORT_OK );
29 This module doesn't export anything by default, but any of the following on request:
57 =head2 opt_required_one(\%opt_hash, @opt_names)
59 Fails by invoking pod2usage when none of the options in @opt_names are
66 my ( $opt_hash, @opt_names ) = @_;
68 my @have = grep { defined( $opt_hash->{$_} ) } @opt_names;
71 pod2usage
( -exitval
=> 1,
72 -message
=> "Missing at least one of " . join( ", ", map { "--$_" } @opt_names ) );
75 =head2 opt_required_all(\%opt_hash, @opt_names)
77 Fails by invoking pod2usage when any of the options in @opt_names are
84 my ( $opt_hash, @opt_names ) = @_;
86 my @missing = grep { !defined( $opt_hash->{$_} ) } @opt_names;
91 -message
=> "Missing "
92 . join( ", ", map { "--$_" } @missing )
94 . ( @missing > 1 ?
"s" : "" )
98 =head2 opt_exclusive(\%opt_hash, @opt_names)
100 Fails by invoking pod2usage when more than one of the options in @opt_names
101 are given in %opt_hash.
107 my ( $opt_hash, @opt_names ) = @_;
109 my @missing = grep { defined( $opt_hash->{$_} ) } @opt_names;
110 @missing < 2 and return;
112 @missing = map { "--" . $_ } @missing;
113 my $final_m = pop @missing;
116 -message
=> "Options "
117 . join( " and ", join( ", ", @missing ), $final_m )
118 . " are mutual exclusive"
122 =head2 load_config(;\%opt_hash)
124 Tries to load the primary configuration. It looks in any directory returned
125 by L<File::ConfigDir/config_dirs> for files named either I<check_web> or
126 like the basename of the invoking script (C<$0>) with any extension
127 supported by L<Config::Any>. The found configuration files are merged into
128 a single configuration hash using L<Hash::Merge> with the I<LEFT_PRECEDENT>
131 When an option hash is given, the default agent is computed based on
132 the value of I<$opt_hash{file}>.
139 _HASH
( $_[0] ) and %opts = %{ $_[0] };
142 terse
=> 'failed_only',
143 save_output
=> 'yes', # report ...
144 show_html
=> 'yes', # report ...
149 ( defined( $opts{file
} ) and $opts{file
} =~ m/(?:_w$|^wap\/)/ )
150 ?
"Nokia6210/1.0 (03.01) UP.Link/5.0.0.4 VZDE-check_wap $VERSION"
151 : "Mozilla/5.0 (Windows; U; WinNT4.0; en-US; rv: VZDE-check_web $VERSION)"
153 accept_cookies
=> 'yes', # check LWP::UA param
154 show_cookie
=> 'yes', # check LWP::UA param
155 show_headers
=> 'yes', # check LWP::UA param
156 send_cookie
=> 'yes', # check LWP::UA param
162 my @cfg_dirs = uniq
map { realpath
($_) } config_dirs
();
163 my $progname = fileparse
( $0, qr/\.[^.]*$/ );
164 my @cfg_pattern = map { ( "check_web." . $_, $progname . "." . $_ ) } Config
::Any
->extensions();
165 my @cfg_files = File
::Find
::Rule
->file()->name(@cfg_pattern)->maxdepth(1)->in(@cfg_dirs);
168 my $merger = Hash
::Merge
->new('LEFT_PRECEDENT');
169 # read config file(s)
170 my $all_cfg = Config
::Any
->load_files(
172 files
=> [@cfg_files],
174 flatten_to_hash
=> 1,
178 foreach my $filename (@cfg_files)
180 defined( $all_cfg->{$filename} )
181 or next; # file not found or not parsable ...
182 # merge into default and previous loaded config ...
183 %cfg = %{ $merger->merge( \
%cfg, $all_cfg->{$filename} ) };
190 =head2 find_scripts(\%cfg,@patterns)
192 Finds scripts based on configuration and given patterns.
198 When C<%cfg> contains an array with full qualified path names below the
199 I<script_dirs>, those directories are scanned. When the directories are
200 relative, the are concatenated using L<File::ConfigDir/config_dirs> (each
201 entry in the I<script_dirs> is evaluated separately).
203 When C<%cfg> contains a string below the key I<script_dirs>, the
204 I<config_dirs($cfg{script_dirs})> is used to find the scripts.
206 In any other case, I<config_dirs("check_web")> is used.
210 The C<@patterns> list must contain one or more file names or expandable
211 shell patterns with or without directory parts and/or extensions.
213 Valid entries are for example:
219 qw(check_host_app_one)
223 qw(check_host/app_one)
227 qw(check_host_app_one.json)
231 qw(check_host/app_one.yml)
235 qw(check_splunk_[1-5])
245 Returns the list of found script file names.
251 my ( $cfg, @patterns ) = @_;
252 my @script_filenames;
255 defined( $cfg->{script_dirs
} )
257 _ARRAY
( $cfg->{script_dirs
} )
258 ? @
{ $cfg->{script_dirs
} }
260 _STRING
( $cfg->{script_dirs
} )
261 ?
( $cfg->{script_dirs
} )
262 : ( config_dirs
("check_web") )
265 : ( config_dirs
("check_web") );
267 grep { -d
$_ } map { File
::Spec
->file_name_is_absolute($_) ?
$_ : config_dirs
($_) } @cfg_dirs;
269 # map { File::Spec->catdir( $_, $directories ) }
270 # config_dirs( $cfg{script_dir} // "check_web" ); # XXX basename $0
271 foreach my $pattern (@patterns)
273 if ( -f
$pattern and -r
$pattern )
275 push( @script_filenames, $pattern );
279 my ( $volume, $directories, $fn ) = File
::Spec
->splitpath($pattern);
281 $fn =~ m/\.[^.]*$/ ?
($fn) : map { $fn . "." . $_ } Config
::Any
->extensions();
282 my @script_dirs = grep { -d
$_ }
283 map { File
::Spec
->catdir( $_, $directories ) } @cfg_dirs;
284 push( @script_filenames,
285 File
::Find
::Rule
->file()->name(@script_pattern)->maxdepth(1)->in(@script_dirs) );
288 return @script_filenames;