Bump for release.
[poe:poe-test-loops.git] / lib / POE / Test / Loops.pm
1 # vim: ts=2 sw=2 expandtab
2
3 package POE::Test::Loops;
4
5 use strict;
6 use vars qw($VERSION);
7
8 use vars qw($VERSION);
9 $VERSION = '1.050'; # NOTE - Should be #.### (three decimal places)
10
11 use File::Spec;
12 use File::Path;
13 use File::Find;
14
15 use constant TEST_BLOCK_FOR_WHICH => 0x01;
16 use constant TEST_BLOCK_FOR_WRONG => 0x02;
17 use constant TEST_BLOCK_FOR_RIGHT => 0x04;
18 use constant TEST_BLOCK_BEGIN     => 0x08;
19
20 ### Find the test libraries.
21
22 use lib qw(./lib ../lib);
23 use POE::Test::DondeEstan;
24 my $source_base = POE::Test::DondeEstan->marco();
25
26 ### Generate loop tests.
27
28 sub generate {
29   my ($dir_base, $loops, $flag_verbose) = @_;
30
31   foreach my $loop (@$loops) {
32     my $loop_dir = lc($loop);
33     $loop_dir =~ s/::/_/g;
34
35     my $fqmn = _find_event_loop_file($loop);
36     unless ($fqmn) {
37       $flag_verbose and print "Couldn't find a loop for $loop ...\n";
38       next;
39     }
40
41     $flag_verbose and print "Found $fqmn\n";
42
43     my $loop_cfg = _get_loop_cfg($fqmn);
44     unless (defined $loop_cfg and length $loop_cfg) {
45       $loop_cfg = (
46                                 "sub skip_tests { return }"
47                         );
48     }
49
50     my $source = (
51                         "#!/usr/bin/perl -w\n" .
52                         "\n" .
53                         "use strict;\n" .
54                         "\n" .
55                         "use lib qw(--base_lib--);\n" .
56                         "use Test::More;\n" .
57                         "use POSIX qw(_exit);\n" .
58                         "\n" .
59                         "--loop_cfg--\n" .
60                         "\n" .
61                         "BEGIN {\n" .
62                         "  if (my \$why = skip_tests('--test_name--')) {\n" .
63                         "    plan skip_all => \$why\n" .
64                         "  }\n" .
65                         "}\n" .
66                         "\n" .
67                         "# Run the tests themselves.\n" .
68                         "require '--base_file--';\n" .
69                         "\n" .
70                         "_exit 0 if \$^O eq 'MSWin32';\n" .
71                         "CORE::exit 0;\n"
72                 );
73
74                 # Full directory where source files are found.
75
76     my $dir_src = File::Spec->catfile($source_base, "Loops");
77     my $dir_dst = File::Spec->catfile($dir_base, $loop_dir);
78
79                 # Gather the list of source files.
80                 # Each will be used to generate a real test file.
81
82     opendir BASE, $dir_src or die $!;
83     my @base_files = grep /\.pm$/, readdir(BASE);
84     closedir BASE;
85
86                 # Initialize the destination directory.  Clear or create as needed.
87
88     $dir_dst =~ tr[/][/]s;
89     $dir_dst =~ s{/+$}{};
90
91     rmtree($dir_dst);
92     mkpath($dir_dst, 0, 0755);
93
94                 # For each source file, generate a corresponding one in the
95                 # configured destination directory.  Expand various bits to
96                 # customize the test.
97
98     foreach my $base_file (@base_files) {
99       my $test_name = $base_file;
100       $test_name =~ s/\.pm$//;
101
102       my $full_file = File::Spec->catfile($dir_dst, $base_file);
103       $full_file =~ s/\.pm$/.t/;
104
105                         # These hardcoded expansions are for the base file to be required,
106                         # and the base library directory where it'll be found.
107
108       my $expanded_src = $source;
109       $expanded_src =~ s/--base_file--/$base_file/g;
110       $expanded_src =~ s/--base_lib--/$dir_src/g;
111       $expanded_src =~ s/--loop_cfg--/$loop_cfg/g;
112       $expanded_src =~ s/--test_name--/$test_name/g;
113
114                         # Write with lots of error checking.
115
116       open EXPANDED, ">$full_file" or die $!;
117       print EXPANDED $expanded_src;
118       close EXPANDED or die $!;
119     }
120   }
121 }
122
123 sub _find_event_loop_file {
124   my $loop_name = shift;
125
126   my $loop_module;
127   if ($loop_name =~ /^POE::/) {
128     $loop_module = File::Spec->catfile(split(/::/, $loop_name)) . ".pm";
129   }
130   else {
131     $loop_name =~ s/::/_/g;
132     $loop_module = File::Spec->catfile("POE", "Loop", $loop_name) .  ".pm";
133   }
134
135   foreach my $inc (@INC) {
136     my $fqmn = File::Spec->catfile($inc, $loop_module);
137     next unless -f $fqmn;
138     return $fqmn;
139   }
140
141   return;
142 }
143
144 sub _get_loop_cfg {
145   my $fqmn = shift;
146
147   my ($in_test_block, @test_source);
148
149   open SOURCE, "<$fqmn" or die $!;
150   while (<SOURCE>) {
151     # Not in a test block.
152     unless ($in_test_block) {
153
154       # Proper =for syntax.
155       if (/^=for\s+poe_tests\s+(\S.*?)$/) {
156         push @test_source, $1;
157         $in_test_block = TEST_BLOCK_FOR_RIGHT;
158         next;
159       }
160
161       # Not sure which =for syntax is in use.
162       if (/^=for\s+poe_tests\s*$/) {
163         $in_test_block = TEST_BLOCK_FOR_WHICH;
164         next;
165       }
166
167       if (/^=begin\s+(poe_tests)\s*$/) {
168         $in_test_block = TEST_BLOCK_BEGIN;
169         next;
170       }
171
172       # Some random line.  Do nothing.
173       next;
174     }
175
176     # Which test block format are we in?
177     if ($in_test_block & TEST_BLOCK_FOR_WHICH) {
178       # If the following line is blank, then we're probably in the
179       # wrong, multi-line kind originally documented and now
180       # deprecated.
181       if (/^\s*$/) {
182         $in_test_block = TEST_BLOCK_FOR_WRONG;
183         next;
184       }
185
186       # The following line is not blank, so it appears we're in a
187       # properly formated =for paragraph.
188       $in_test_block = TEST_BLOCK_FOR_RIGHT;
189       push @test_source, $_;
190       next;
191     }
192
193     # The =begin syntax ends with an =end.
194     if ($in_test_block & TEST_BLOCK_BEGIN) {
195       if (/^=end\s*poe_tests\s*$/) {
196         $in_test_block = 0;
197         next;
198       }
199
200       # Be helpful?
201       die "=cut not the proper way to end =begin poe_tests" if /^=cut\s*$/;
202
203       push @test_source, $_;
204       next;
205     }
206
207     # The proper =for syntax ends on a blank line.
208     if ($in_test_block & TEST_BLOCK_FOR_RIGHT) {
209       if (/^$/) {
210         $in_test_block = 0;
211         next;
212       }
213
214       # Be helpful?
215       die "=cut not the proper way to end =for poe_tests" if /^=cut\s*$/;
216
217       push @test_source, $_;
218       next;
219     }
220
221     # The wrong =for syntax ends on =cut.
222     if ($in_test_block & TEST_BLOCK_FOR_WRONG) {
223       if (/^=cut\s*$/) {
224         $in_test_block = 0;
225         next;
226       }
227
228       # Be helpful?
229       die "=end not the proper way to end =for poe_tests" if /^=end/;
230
231       push @test_source, $_;
232       next;
233     }
234
235     die "parser in unknown state: $in_test_block";
236   }
237
238   shift @test_source while @test_source and $test_source[0] =~ /^\s*$/;
239   pop @test_source while @test_source and $test_source[-1] =~ /^\s*$/;
240
241   return join "", @test_source;
242 }
243
244 1;
245
246 __END__
247
248 =head1 NAME
249
250 POE::Test::Loops - Reusable tests for POE::Loop authors
251
252 =head1 SYNOPSIS
253
254         #!/usr/bin/perl -w
255
256         use strict;
257         use Getopt::Long;
258         use POE::Test::Loops;
259
260         my ($dir_base, $flag_help, @loop_modules, $flag_verbose);
261         my $result = GetOptions(
262                 'dirbase=s' => \$dir_base,
263                 'loop=s' => \@loop_modules,
264                 'verbose' => \$flag_verbose,
265                 'help' => \$flag_help,
266         );
267
268         if (
269                 !$result or !$dir_base or $flag_help or !@loop_modules
270         ) {
271                 die(
272                         "$0 usage:\n",
273                         "  --dirbase DIR   (required) base directory for tests\n",
274                         "  --loop MODULE   (required) loop modules to test\n",
275                         "  --verbose   show some extra output\n",
276                         "  --help   you're reading it\n",
277                 );
278         }
279
280         POE::Test::Loops::generate($dir_base, \@loop_modules, $flag_verbose);
281         exit 0;
282
283 =head1 DESCRIPTION
284
285 POE::Test::Loops contains one function, generate(), which will
286 generate all the loop tests for one or more POE::Loop subclasses.
287
288 The L</SYNOPSIS> example is a version of L<poe-gen-tests>, which is a
289 stand-alone utility to generate the actual tests.  L<poe-gen-tests>
290 also documents the POE::Test::Loops system in more detail.
291
292 =head1 FUNCTIONS
293
294 =head2 generate( $DIRBASE, \@LOOPS, $VERBOSE )
295
296 Generates the loop tests.  DIRBASE is the (relative) directory in
297 which a subdirectory for each of the LOOPS is created.  If VERBOSE is
298 set to a TRUE value some progress reporting is printed.
299
300         POE::Test::Loops::generate(
301                 "./t",
302                 [ "POE::Loop::Yours" ],
303                 1,
304         );
305
306 =head1 SEE ALSO
307
308 L<POE::Loop> and L<poe-gen-tests>.
309
310 =head1 AUTHOR & COPYRIGHT
311
312 See L<poe-gen-tests>.
313
314 =cut