root/trunk/plagger/t/TestPlagger.pm

Revision 1344 (checked in by youpy, 14 years ago)

TestPlagger?: test_requires_network() allows host to check network availability

Line 
1 package t::TestPlagger;
2 use FindBin;
3 use File::Basename;
4 use File::Spec;
5 use Test::Base -Base;
6 use URI::Escape ();
7 use Plagger;
8
9 our @EXPORT = qw(test_requires test_requires_network test_requires_command test_plugin_deps
10                  run_eval_expected run_eval_expected_with_capture
11                  slurp_file file_contains file_doesnt_contain);
12
13 our($BaseDir, $BaseDirURI);
14 {
15     my @path = File::Spec->splitdir($FindBin::Bin);
16     while (my $dir = pop @path) {
17         if ($dir eq 't') {
18             $BaseDir = File::Spec->catfile(@path);
19             $BaseDirURI = join "/", map URI::Escape::uri_escape($_), @path;
20             last;
21         }
22     }
23 }
24
25 sub test_requires() {
26     my($mod, $ver) = @_;
27
28     if ($ver) {
29         eval qq{use $mod $ver};
30     } else {
31         eval qq{use $mod};
32     }
33
34     if ($@) {
35         plan skip_all => "$@";
36     }
37 }
38
39 sub has_network() {
40     my $host = shift;
41     return if $ENV{NO_NETWORK};
42
43     require IO::Socket::INET;
44     my $conn = IO::Socket::INET->new(PeerAddr => $host, Timeout => 10);
45     defined $conn;
46 }
47
48 sub test_requires_network() {
49     my $host = shift || 'www.google.com:80';
50
51     unless (has_network($host)) {
52         plan skip_all => "Test requires network($host) which is not available now.";
53     }
54 }
55
56 sub test_requires_command() {
57     my $command = shift;
58     for my $path (split /:/, $ENV{PATH}) {
59         if (-e File::Spec->catfile($path, $command) && -x _) {
60             return 1;
61         }
62     }
63     plan skip_all => "Test requires '$command' command but it's not found";
64 }
65
66 sub test_plugin_deps() {
67     my($mod, $no_warning) = @_;
68     $mod ||= File::Basename::basename($FindBin::Bin);
69     $mod =~ s!::!-!g;
70
71     my $file = File::Spec->catfile( $BaseDir, "deps", "$mod.yaml" );
72     unless (-e $file) {
73         warn "Can't find deps file for $mod" unless $no_warning;
74         return;
75     }
76
77     my $meta = YAML::LoadFile($file);
78
79     for my $plugin (@{ $meta->{bundles} || [] }) {
80         $plugin =~ s/::/-/g;
81         test_plugin_deps($plugin, 1);
82     }
83
84     while (my($mod, $ver) = each %{$meta->{depends} || {}}) {
85         test_requires($mod, $ver);
86     }
87 }
88
89 sub run_eval_expected {
90     run {
91         my $block = shift;
92         my $context = $block->input; # it's not always true
93         eval $block->expected;
94         fail $@ if $@;
95     };
96 }
97
98 sub run_eval_expected_with_capture {
99     filters_delay;
100     for my $block (blocks) {
101         my $warning;
102         {
103             local $SIG{__WARN__} = sub { $warning .= "@_" };
104             $block->run_filters;
105         }
106         my $context = $block->input;
107         eval $block->expected;
108         fail $@ if $@;
109     }
110 }
111
112 sub slurp_file() {
113     my $file = shift;
114     open my $fh, $file or return;
115     return join '', <$fh>;
116 }
117
118 sub file_contains() {
119     my($file, $pattern) = @_;
120
121     like slurp_file($file), $pattern;
122 }
123
124 sub file_doesnt_contain() {
125     my($file, $pattern) = @_;
126
127     my $content = slurp_file($file) or return fail("$file: $!");
128     unlike $content, $pattern;
129 }
130
131 package t::TestPlagger::Filter;
132 use Test::Base::Filter -base;
133 use File::Temp ();
134
135 sub interpolate {
136     my $stuff = shift;
137     $stuff =~ s/(?<!\\)(\$[\w\:]+)/$1/eeg;
138     $stuff =~ s/\\\$/\$/g;
139     $stuff;
140 }
141
142 sub config {
143     my $yaml = shift;
144     $yaml = $self->interpolate($yaml);
145
146     # set sane defaults for testing
147     my $config = YAML::Load($yaml);
148     $config->{global}->{log}->{level}  ||= 'error';
149     $config->{global}->{assets_path}   ||= File::Spec->catfile($t::TestPlagger::BaseDir, 'assets');
150     $config->{global}->{cache}->{base} ||= File::Temp::tempdir(CLEANUP => 1);
151
152     Plagger->bootstrap(config => $config);
153 }
154
155 sub output_file {
156     my $output = $main::output or die "\$main::output is undefined";
157     open my $fh, $output or return ::fail("$output: $!");
158     return join '', <$fh>;
159 }
160
161 1;
Note: See TracBrowser for help on using the browser.