8add76ba96ecadc265986e90a9eece9e19f8ea27
1 package WWW
::Mechanize
::Script
::Util
;
7 use vars qw
/$VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS/;
11 use File
::Basename
qw(fileparse);
12 use File
::ConfigDir
qw(config_dirs);
15 # use Hash::MoreUtils;
16 use List
::MoreUtils
qw(uniq);
17 use Params
::Util
qw(_HASH _ARRAY _STRING);
20 $VERSION = '0.001_002';
23 @EXPORT_OK = qw(opt_required_all opt_required_one opt_exclusive load_config find_scripts);
24 %EXPORT_TAGS = ( ALL
=> \
@EXPORT_OK );
28 my ( $opt_hash, @opt_names ) = @_;
30 my @have = grep { defined( $opt_hash->{$_} ) } @opt_names;
33 pod2usage
( -exitval
=> 1,
34 -message
=> "Missing at least one of " . join( ", ", map { "--$_" } @opt_names ) );
39 my ( $opt_hash, @opt_names ) = @_;
41 my @missing = grep { !defined( $opt_hash->{$_} ) } @opt_names;
46 -message
=> "Missing "
47 . join( ", ", map { "--$_" } @missing )
49 . ( @missing > 1 ?
"s" : "" )
55 my ( $opt_hash, @opt_names ) = @_;
57 my @missing = grep { defined( $opt_hash->{$_} ) } @opt_names;
58 @missing < 2 and return;
60 @missing = map { "--" . $_ } @missing;
61 my $final_m = pop @missing;
64 -message
=> "Options "
65 . join( " and ", join( ", ", @missing ), $final_m )
66 . " are mutual exclusive"
73 _HASH
( $_[0] ) and %opts = %{ $_[0] };
76 terse
=> 'failed_only',
77 save_output
=> 'yes', # report ...
78 show_html
=> 'yes', # report ...
83 ( defined( $opts{file
} ) and $opts{file
} =~ m/(?:_w$|^wap\/)/ )
84 ?
"Nokia6210/1.0 (03.01) UP.Link/5.0.0.4 VZDE-check_wap $VERSION"
85 : "Mozilla/5.0 (Windows; U; WinNT4.0; en-US; rv: VZDE-check_web $VERSION)"
87 accept_cookies
=> 'yes', # check LWP::UA param
88 show_cookie
=> 'yes', # check LWP::UA param
89 show_headers
=> 'yes', # check LWP::UA param
90 send_cookie
=> 'yes', # check LWP::UA param
96 my @cfg_dirs = uniq
map { realpath
($_) } config_dirs
();
97 my $progname = fileparse
( $0, qr/\.[^.]*$/ );
98 my @cfg_pattern = map { ( $progname . "." . $_, "check_web." . $_ ) } Config
::Any
->extensions();
99 my @cfg_files = File
::Find
::Rule
->file()->name(@cfg_pattern)->maxdepth(1)->in(@cfg_dirs);
102 my $merger = Hash
::Merge
->new('LEFT_PRECEDENT');
103 # read config file(s)
104 my $all_cfg = Config
::Any
->load_files(
106 files
=> [@cfg_files],
108 flatten_to_hash
=> 1,
112 foreach my $filename (@cfg_files)
114 defined( $all_cfg->{$filename} )
115 or next; # file not found or not parsable ...
116 # merge into default and previous loaded config ...
117 %cfg = %{ $merger->merge( \
%cfg, $all_cfg->{$filename} ) };
126 my ( $cfg, @patterns ) = @_;
127 my @script_filenames;
130 defined( $cfg->{script_dirs
} )
132 _ARRAY
( $cfg->{script_dirs
} )
133 ? @
{ $cfg->{script_dirs
} }
135 _STRING
( $cfg->{script_dirs
} )
136 ?
( $cfg->{script_dirs
} )
137 : ( config_dirs
("check_web") )
140 : ( config_dirs
("check_web") );
142 grep { -d
$_ } map { File
::Spec
->file_name_is_absolute($_) ?
$_ : config_dirs
($_) } @cfg_dirs;
144 # map { File::Spec->catdir( $_, $directories ) }
145 # config_dirs( $cfg{script_dir} // "check_web" ); # XXX basename $0
146 foreach my $pattern (@patterns)
148 if ( -f
$pattern and -r
$pattern )
150 push( @script_filenames, $pattern );
154 my ( $volume, $directories, $fn ) = File
::Spec
->splitpath($pattern);
156 $fn =~ m/\.[^.]*$/ ?
($fn) : map { $fn . "." . $_ } Config
::Any
->extensions();
157 my @script_dirs = grep { -d
$_ }
158 map { File
::Spec
->catdir( $_, $directories ) } @cfg_dirs;
159 push( @script_filenames,
160 File
::Find
::Rule
->file()->name(@script_pattern)->maxdepth(1)->in(@script_dirs) );
163 return @script_filenames;