5 |
my $dir; |
my $dir; |
6 |
my $out_dir; |
my $out_dir; |
7 |
my $file_pattern; |
my $file_pattern; |
8 |
|
my $domtest2perl = 'domtest2perl.pl'; |
9 |
GetOptions ( |
GetOptions ( |
10 |
|
'domtest2perl-path=s' => \$domtest2perl, |
11 |
'test-directory=s' => \$dir, |
'test-directory=s' => \$dir, |
12 |
'test-file-pattern=s' => \$file_pattern, |
'test-file-pattern=s' => \$file_pattern, |
13 |
'output-directory=s' => \$out_dir, |
'output-directory=s' => \$out_dir, |
14 |
); |
) or die; |
15 |
$dir or die "$0: test-directory must be specified"; |
$dir or die "$0: test-directory must be specified"; |
16 |
$out_dir or die "$0: output-directory must be specified"; |
$out_dir or die "$0: output-directory must be specified"; |
17 |
$file_pattern ||= qr/\.xml$/; |
$file_pattern ||= qr/\.xml$/; |
18 |
|
|
19 |
opendir my $dirh, $dir or die "$0: $dir: $!"; |
opendir my $dirh, $dir or die "$0: $dir: $!"; |
20 |
for (grep {$_ ne 'alltests.xml'} grep /$file_pattern/, readdir $dirh) { |
for (grep {$_ ne 'alltests.xml'} grep /$file_pattern/, readdir $dirh) { |
21 |
|
my $in_file = $dir.'/'.$_; |
22 |
my $out_file = $out_dir.'/'.$_.'.pl'; |
my $out_file = $out_dir.'/'.$_.'.pl'; |
23 |
|
if (-e $out_file and -C $in_file >= -C $out_file) { |
24 |
|
warn "$_.pl: Skipped - it is newer than source\n"; |
25 |
|
next; |
26 |
|
} |
27 |
my @cmd = ('perl', map ({"-I$_"} @INC), |
my @cmd = ('perl', map ({"-I$_"} @INC), |
28 |
'domtest2perl.pl', $dir.'/'.$_, |
$domtest2perl, $in_file, |
29 |
'--output-file' => $out_file); |
'--output-file' => $out_file); |
30 |
print STDERR join " ", @cmd, "\n"; |
#print STDERR join " ", @cmd, "\n"; |
31 |
system @cmd and die "$0: domtest2perl.pl: $@"; |
print STDERR $in_file, "\n"; |
32 |
|
print STDERR '-> ' . $out_file, "\n"; |
33 |
|
system @cmd and die "$0: $domtest2perl: $@"; |
34 |
system 'perl', map ({"-I$_"} @INC), '-c', $out_file |
system 'perl', map ({"-I$_"} @INC), '-c', $out_file |
35 |
and die "$0: $out_file: $@"; |
and die "$0: $out_file: $@"; |
36 |
} |
} |
37 |
|
|
38 |
|
1; |
39 |
|
|
40 |
|
__END__ |
41 |
|
|
42 |
|
=head1 NAME |
43 |
|
|
44 |
|
domts2perl - Generates Perl Test Code from DOM Test Suite |
45 |
|
|
46 |
|
=head1 SYNOPSIS |
47 |
|
|
48 |
|
perl path/to/domts2perl.pl --test-directory=path/to/source/xml/directory/ \ |
49 |
|
--output-directory=path/to/result/pl/directory/ \ |
50 |
|
--domtest2perl=path/to/domts2perl/pl |
51 |
|
|
52 |
|
=head1 OPTIONS |
53 |
|
|
54 |
|
=over 4 |
55 |
|
|
56 |
|
=item --domtest2perl=I<path> |
57 |
|
|
58 |
|
Path to the F<domtest2perl.pl> to convert each XMl file to Perl code. |
59 |
|
|
60 |
|
=item --output-directory=I<path> |
61 |
|
|
62 |
|
Path to result Perl code directory. |
63 |
|
|
64 |
|
=item --test-directory=I<path> |
65 |
|
|
66 |
|
Path to source XML files in the package of the DOM Test Suite. |
67 |
|
|
68 |
|
=back |
69 |
|
|
70 |
|
=head1 SEE ALSO |
71 |
|
|
72 |
|
I<Document Object Model (DOM) Conformance Test Suites>, |
73 |
|
<http://www.w3.org/DOM/Test/>. |
74 |
|
|
75 |
|
F<domtest2perl.pl> |
76 |
|
|
77 |
|
=head1 LICENSE |
78 |
|
|
79 |
|
Copyright 2004-2005 Wakaba <w@suika.fam.cx>. All rights reserved. |
80 |
|
|
81 |
|
This program is free software; you can redistribute it and/or |
82 |
|
modify it under the same terms as Perl itself. |
83 |
|
|
84 |
|
=cut |
85 |
|
|