/[suikacvs]/messaging/manakai/bin/domts2perl.pl
Suika

Diff of /messaging/manakai/bin/domts2perl.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Sun Oct 10 06:09:47 2004 UTC revision 1.4 by wakaba, Wed Jan 5 12:19:38 2005 UTC
# Line 5  use Getopt::Long; Line 5  use Getopt::Long;
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';
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_dir.'/'.$_.'.pl');               '--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
35        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    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24