root/trunk/plagger/t/TestPlagger.pm

Revision 1722 (checked in by miyagawa, 14 years ago)

Simplified Publish::iCal, slightly modified version of that of Kentaro. Support full-day event if entry datetime is 00:00. No event API

Line 
1 package t::TestPlagger;
2 use Config;
3 use FindBin;
4 use File::Basename;
5 use File::Spec;
6 use Test::Base -Base;
7 use URI::Escape ();
8 use Plagger;
9
10 our @EXPORT = qw(test_requires test_requires_network test_requires_command test_plugin_deps
11                  run_eval_expected run_eval_expected_with_capture
12                  slurp_file file_contains file_doesnt_contain);
13
14 our($BaseDir, $BaseDirURI);
15 {
16     my @path = File::Spec->splitdir($FindBin::Bin);
17     while (defined(my $dir = pop @path)) {
18         if ($dir eq 't') {
19             $BaseDir = File::Spec->catfile(@path);
20             $BaseDirURI = join "/", map URI::Escape::uri_escape($_), @path;
21             last;
22         }
23     }
24 }
25
26 =item test_requires
27
28 Checks to see if the module can be loaded.
29
30    test_requires("Your::Momma");
31    test_requires("Your::Momma",3.141); # version 3.141 or later
32
33 If this fails rather than failing tests this B<skips all tests>.
34
35 =cut
36
37 sub test_requires() {
38     my($mod, $ver) = @_;
39
40     if ($ver) {
41         eval qq{use $mod $ver};
42     } else {
43         eval qq{use $mod};
44     }
45
46     if ($@) {
47         if ($@ =~ /^Can't locate/) {
48             plan skip_all => "Test requires module '$mod' but it's not found";
49         }
50         else {
51             plan skip_all => "$@";
52         }
53     }
54 }
55
56 =item has_network($spec)
57
58 Returns true if and only if the specified port can be established.  The
59 spec should be of the form:
60
61   hostname:port
62
63 e.g.
64
65   plagger.org:80
66
67 This function always returns false immediatly without connecting to the
68 network if the enviroment varible C<NO_NETWORK> has been set.
69
70 =cut
71
72 sub has_network() {
73     my $host = shift;
74     return if $ENV{NO_NETWORK};
75
76     require IO::Socket::INET;
77     my $conn = IO::Socket::INET->new(PeerAddr => $host, Timeout => 15);
78     defined $conn;
79 }
80
81 =item test_requires_network
82
83 This function skips all tests if the network is not reachable, e.g.
84
85   # can I reach google's web site?
86   test_requires_network();
87  
88   # can I reach plagger's web site?
89   test_requires_network("plagger.org")
90  
91   # can I reach a different port?
92   test_requires_network("gmail.com:443");
93
94 =cut
95
96 sub test_requires_network() {
97     my $host = shift || 'www.google.com:80';
98        $host .= ":80" if $host !~ /:/;
99
100     unless (has_network($host)) {
101         plan skip_all => "Test requires network($host) which is not available now.";
102     }
103 }
104
105 =item test_requires_command($command)
106
107 This function skips all tests if the given command
108 doesn't exist in your path (i.e. in the dirs in the PATH enviroment
109 variable.)
110
111 =cut
112
113 sub test_requires_command() {
114     my $command = shift;
115     for my $path (split /$Config::Config{path_sep}/, $ENV{PATH}) {
116         if (-e File::Spec->catfile($path, $command) && -x _) {
117             return 1;
118         }
119     }
120     plan skip_all => "Test requires '$command' command but it's not found";
121 }
122
123 =item test_plugin_deps
124
125 This function skips all tests if the module's requirements
126 (modules, versions, platforms, bundles) aren't installed.
127
128 If you pass an argument then it will check the requirement
129 for that module:
130
131   # this will check the Foo-Bar.yaml file for deps
132   test_plugin_deps("Foo::Bar");
133
134 Called with no arguments it works out magically the name of
135 the plugin based on the directory the test file is located
136 in.
137
138    # in the Foo-Bar/wobble.t file
139    # this will check the Foo-Bar.yaml file for deps   
140    test_plugin_deps();
141  
142 The requirements are defined in YAML files located
143 in the C<deps> directory inside the Plagger directory.  A typical
144 YAML file looks like this:
145
146   name: Publish::Speech::MacOSX
147   author: Ryo Okamoto
148   platform: darwin
149   depends:
150     Mac::Files: 0
151     Mac::Speech: 0
152
153 Or
154
155   name: Subscription::Bookmarks::Mozilla
156   author: youpy
157   bundles:
158     - Subscription::XPath
159
160 =cut
161
162 sub test_plugin_deps() {
163     my($mod, $no_warning) = @_;
164     $mod ||= File::Basename::basename($FindBin::Bin);
165     $mod =~ s!::!-!g;
166
167     my $file = File::Spec->catfile( $BaseDir, "deps", "$mod.yaml" );
168     unless (-e $file) {
169         warn "Can't find deps file for $mod" unless $no_warning;
170         return;
171     }
172
173     my $meta = eval { YAML::LoadFile($file) } or die "reading $file failed:\n$@";
174
175     if ($meta->{platform} && $meta->{platform} ne $^O) {
176         plan skip_all => "Test requires to be run on '$meta->{platform}'";
177     }
178
179     for my $plugin (@{ $meta->{bundles} || [] }) {
180         $plugin =~ s/::/-/g;
181         test_plugin_deps($plugin, 1);
182     }
183
184     while (my($mod, $ver) = each %{$meta->{depends} || {}}) {
185         test_requires($mod, $ver);
186     }
187 }
188
189 =item run_eval_expected
190
191 Add a new test run across all blocks to check that
192 the expected blocks can be evaled succesfully.  During
193 these evaluations the expected input is availible from
194 C<$context>.
195
196 One extra test failure will happen per block that's expected
197 output throws an error when evaluated.  No successes are
198 generated by this code, but the expected code may in
199 turn generate many sucesses or failures.
200
201 =cut
202
203 sub run_eval_expected {
204     run {
205         my $block = shift;
206        
207         # context is being pulled out here so that
208         # the eval box can see it
209         my $context = $block->input; # it's not always true
210        
211         eval $block->expected;
212         fail $@ if $@;
213     };
214 }
215
216 =item run_eval_expected_with_capture
217
218 Add new test run across all blocks to check that
219 the expected blocks can be evaled succesfully.  During
220 these evaluations the expected input is availible from
221 C<$context>, and warnings created by the filters
222 are avalible from C<$warnings>.
223
224 =cut
225
226 sub run_eval_expected_with_capture {
227     filters_delay;
228     for my $block (blocks) {
229      
230         # capture all the warnings from the filters
231         # this is often used in the tests as a way to find
232         # out what has happened (e.g. the Growl plugin)
233         my $warnings;
234         {
235             local $SIG{__WARN__} = sub { $warnings .= "@_" };
236             $block->run_filters;
237         }
238        
239         # context is being pulled out here so that
240         # the eval box can see it
241         my $context = $block->input;
242        
243         eval $block->expected;
244         fail $@ if $@;
245     }
246 }
247
248 =item slurp_file($filename)
249
250 Returns the contents of the file, as a single scalar
251
252 =cut
253
254 sub slurp_file() {
255     my $file = shift;
256     open my $fh, $file or return;
257     return join '', <$fh>;
258 }
259
260 =item file_contains($filename, $regexp)
261
262 Test if the file (specified by filename) matches the passed regexp.
263
264 =cut
265
266 sub file_contains() {
267     my($file, $pattern) = @_;
268
269     like slurp_file($file), $pattern;
270 }
271
272 =item file_doesnt_contains($filename, $regexp)
273
274 Test the file (specified by filename) doesnt matches the passed regexp.
275 If the file doesn't exist, this test will fail.
276
277 =cut
278
279 sub file_doesnt_contain() {
280     my($file, $pattern) = @_;
281     $pattern = qr/\Q$pattern\E/ unless ref $pattern;
282
283     my $content = slurp_file($file) or return fail("$file: $!");
284     unlike $content, $pattern;
285 }
286
287 package t::TestPlagger::Filter;
288 use Test::Base::Filter -base;
289 use File::Temp ();
290
291
292 =over
293
294 =item interpolate
295
296 Filter that replaces scalar values of the type
297
298   $foo
299   $foo::bar
300
301 With their actual values.  But don't do backslash escaped things like
302
303   \$foo
304
305 Note that you can't do this either:
306
307   ${foo}
308
309 Meaning you can't use $foo like so:
310
311   BAR$fooHELLO
312  
313 =cut
314
315 sub interpolate {
316     my $stuff = shift;
317    
318     # interpert in $foo::bar to their values in the string
319     # (but not \$foo::bar)
320     $stuff =~ s/(?<!\\)     # check there's no backslash before this
321                 (\$[\w\:]+) # look for a $var possibly with packages
322                /$1/eegx;    # replace it with its value
323
324     $stuff =~ s/\\\$/\$/g;  # turn the escaped \$ into $
325    
326     $stuff;
327 }
328
329 =item config
330
331 Filter that configures plagger based on the YAML passed in.
332
333 =cut
334
335 sub config {
336     my $yaml = shift;
337    
338     # replace $foo values with their actual values
339     $yaml = $self->interpolate($yaml);
340
341     # set sane defaults for testing
342     my $config = YAML::Load($yaml);
343     $config->{global}->{log}->{level}  ||= 'error' unless $ENV{TEST_VERBOSE};
344     $config->{global}->{assets_path}   ||= File::Spec->catfile($t::TestPlagger::BaseDir, 'assets');
345     $config->{global}->{cache}->{base} ||= File::Temp::tempdir(CLEANUP => 1);
346
347     Plagger->bootstrap(config => $config);
348 }
349
350 =item output_file
351
352 Reads the file who's filename is in $main::output and returns it (failing on problems)
353
354 =cut
355
356 sub output_file {
357     my $output = $main::output or die "\$main::output is undefined";
358     open my $fh, $output or return ::fail("$output: $!");
359     return join '', <$fh>;
360 }
361
362 1;
363
Note: See TracBrowser for help on using the browser.