manakai/bin/domts2perl.pl

#!/usr/bin/perl -w 
use strict;

use Getopt::Long;
my $dir;
my $out_dir;
my $file_pattern;
my $domtest2perl = 'domtest2perl.pl';
my %Opt = (
  test2perl_option => [],
);
GetOptions (
  'domtest2perl-option=s' => sub {
    shift;
    push @{$Opt{test2perl_option}}, shift;
  },
  'domtest2perl-path=s' => \$domtest2perl,
  'test-directory=s' => \$dir,
  'test-file-pattern=s' => \$file_pattern,
  'output-directory=s' => \$out_dir,
) or die;
$dir or die "$0: test-directory must be specified";
$out_dir or die "$0: output-directory must be specified";
$file_pattern ||= qr/\.xml$/;

opendir my $dirh, $dir or die "$0: $dir: $!";
for (grep {$_ ne 'alltests.xml'} grep /$file_pattern/, readdir $dirh) {
  my $in_file = $dir.'/'.$_;
  my $out_file = $out_dir.'/'.$_.'.pl';
  if (-e $out_file and -C $in_file >= -C $out_file) {
    warn "$_.pl: Skipped - it is newer than source\n";
    next;
  }
  my @cmd = ('perl', map ({"-I$_"} @INC),
             $domtest2perl, $in_file,
             '--output-file-name' => $out_file,
             @{$Opt{test2perl_option}});
  print STDERR join " ", @cmd, "\n";
  print STDERR $in_file, "\n";
  print STDERR '-> ' . $out_file, "\n";
  system @cmd and die "$0: $domtest2perl: $@";
  system 'perl', map ({"-I$_"} @INC), '-c', $out_file
    and die "$0: $out_file: $@";
}

1;

__END__

=head1 NAME

domts2perl - Generates Perl Test Code from DOM Test Suite

=head1 SYNOPSIS

  perl path/to/domts2perl.pl --test-directory=path/to/source/xml/directory/ \
           --output-directory=path/to/result/pl/directory/ \
           --domtest2perl=path/to/domts2perl/pl

=head1 OPTIONS

=over 4

=item --domtest2perl=I<path>

Path to the F<domtest2perl.pl> to convert each XMl file to Perl code. 

=item --output-directory=I<path>

Path to result Perl code directory. 

=item --test-directory=I<path>

Path to source XML files in the package of the DOM Test Suite. 

=back

=head1 SEE ALSO

I<Document Object Model (DOM) Conformance Test Suites>,
<http://www.w3.org/DOM/Test/>.

F<domtest2perl.pl>

=head1 LICENSE

Copyright 2004-2005 Wakaba <w@suika.fam.cx>.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

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