d8e1e81bc2f470b20a067ad77275521860727c04
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_003';
24 @EXPORT_OK = qw(opt_required_all opt_required_one opt_exclusive load_config find_scripts);
25 %EXPORT_TAGS = ( ALL
=> \
@EXPORT_OK );
29 my ( $opt_hash, @opt_names ) = @_;
31 my @have = grep { defined( $opt_hash->{$_} ) } @opt_names;
34 pod2usage
( -exitval
=> 1,
35 -message
=> "Missing at least one of " . join( ", ", map { "--$_" } @opt_names ) );
40 my ( $opt_hash, @opt_names ) = @_;
42 my @missing = grep { !defined( $opt_hash->{$_} ) } @opt_names;
47 -message
=> "Missing "
48 . join( ", ", map { "--$_" } @missing )
50 . ( @missing > 1 ?
"s" : "" )
56 my ( $opt_hash, @opt_names ) = @_;
58 my @missing = grep { defined( $opt_hash->{$_} ) } @opt_names;
59 @missing < 2 and return;
61 @missing = map { "--" . $_ } @missing;
62 my $final_m = pop @missing;
65 -message
=> "Options "
66 . join( " and ", join( ", ", @missing ), $final_m )
67 . " are mutual exclusive"
74 _HASH
( $_[0] ) and %opts = %{ $_[0] };
77 terse
=> 'failed_only',
78 save_output
=> 'yes', # report ...
79 show_html
=> 'yes', # report ...
84 ( defined( $opts{file
} ) and $opts{file
} =~ m/(?:_w$|^wap\/)/ )
85 ?
"Nokia6210/1.0 (03.01) UP.Link/5.0.0.4 VZDE-check_wap $VERSION"
86 : "Mozilla/5.0 (Windows; U; WinNT4.0; en-US; rv: VZDE-check_web $VERSION)"
88 accept_cookies
=> 'yes', # check LWP::UA param
89 show_cookie
=> 'yes', # check LWP::UA param
90 show_headers
=> 'yes', # check LWP::UA param
91 send_cookie
=> 'yes', # check LWP::UA param
97 my @cfg_dirs = uniq
map { realpath
($_) } config_dirs
();
98 my $progname = fileparse
( $0, qr/\.[^.]*$/ );
99 my @cfg_pattern = map { ( $progname . "." . $_, "check_web." . $_ ) } Config
::Any
->extensions();
100 my @cfg_files = File
::Find
::Rule
->file()->name(@cfg_pattern)->maxdepth(1)->in(@cfg_dirs);
103 my $merger = Hash
::Merge
->new('LEFT_PRECEDENT');
104 # read config file(s)
105 my $all_cfg = Config
::Any
->load_files(
107 files
=> [@cfg_files],
109 flatten_to_hash
=> 1,
113 foreach my $filename (@cfg_files)
115 defined( $all_cfg->{$filename} )
116 or next; # file not found or not parsable ...
117 # merge into default and previous loaded config ...
118 %cfg = %{ $merger->merge( \
%cfg, $all_cfg->{$filename} ) };
127 my ( $cfg, @patterns ) = @_;
128 my @script_filenames;
131 defined( $cfg->{script_dirs
} )
133 _ARRAY
( $cfg->{script_dirs
} )
134 ? @
{ $cfg->{script_dirs
} }
136 _STRING
( $cfg->{script_dirs
} )
137 ?
( $cfg->{script_dirs
} )
138 : ( config_dirs
("check_web") )
141 : ( config_dirs
("check_web") );
143 grep { -d
$_ } map { File
::Spec
->file_name_is_absolute($_) ?
$_ : config_dirs
($_) } @cfg_dirs;
145 # map { File::Spec->catdir( $_, $directories ) }
146 # config_dirs( $cfg{script_dir} // "check_web" ); # XXX basename $0
147 foreach my $pattern (@patterns)
149 if ( -f
$pattern and -r
$pattern )
151 push( @script_filenames, $pattern );
155 my ( $volume, $directories, $fn ) = File
::Spec
->splitpath($pattern);
157 $fn =~ m/\.[^.]*$/ ?
($fn) : map { $fn . "." . $_ } Config
::Any
->extensions();
158 my @script_dirs = grep { -d
$_ }
159 map { File
::Spec
->catdir( $_, $directories ) } @cfg_dirs;
160 push( @script_filenames,
161 File
::Find
::Rule
->file()->name(@script_pattern)->maxdepth(1)->in(@script_dirs) );
164 return @script_filenames;