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

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

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

revision 1.6 by wakaba, Fri Dec 31 12:03:39 2004 UTC revision 1.7 by wakaba, Wed Jan 5 12:19:38 2005 UTC
# Line 236  sub node2code ($) { Line 236  sub node2code ($) {
236                     => 'load (' .                     => 'load (' .
237                        perl_literal ($node->getAttributeNS (undef, 'href')).                        perl_literal ($node->getAttributeNS (undef, 'href')).
238                        ')';                        ')';
239      } elsif ($Method->{$ln}) {    } elsif ($ln eq 'hasFeature' and
240               not $node->hasAttributeNS (undef, 'var')) {
241        ## If there is a "hasFeature" element in "body" and
242        ## it does not have "var" attribute, then it is part of the
243        ## implementation condition.
244        $result .= perl_statement 'hasFeature ('.
245                           to_perl_value ($node->getAttributeNS (undef, 'feature'),
246                                          default => 'undef') . ', '.
247                           to_perl_value ($node->getAttributeNS (undef, 'version'),
248                                          default => 'undef') . ')';
249      } elsif ($Method->{$ln}) {
250        $result .= perl_var (type => '$',        $result .= perl_var (type => '$',
251                             local_name => $node->getAttributeNS (undef, 'var')).                             local_name => $node->getAttributeNS (undef, 'var')).
252                   ' = '                   ' = '
# Line 447  sub node2code ($) { Line 457  sub node2code ($) {
457        $result .= body2code ($child);        $result .= body2code ($child);
458      }      }
459      $result .= q[      $result .= q[
460          } catch Message::DOM::DOMException with {          } catch Message::DOM::IF::DOMException with {
461            my $err = shift;            my $err = shift;
462            $success = 1 if $err->{-type} eq ].perl_literal ($errname).q[;            $success = 1 if $err->{-type} eq ].perl_literal ($errname).q[;
463          };          };
# Line 511  sub node2code ($) { Line 521  sub node2code ($) {
521      }      }
522      $result = "try {      $result = "try {
523                   $true                   $true
524                 } catch Message::DOM::ManakaiDOMException with {                 } catch Message::DOM::DOMMain::ManakaiDOMException with {
525                   my \$err = shift;                   my \$err = shift;
526                   $false                   $false
527                 };";                 };";
# Line 738  for (my $i = 0; $i < $child->length; $i+ Line 748  for (my $i = 0; $i < $child->length; $i+
748          }          }
749        }        }
750      } elsif ($ln eq 'implementationAttribute') {      } elsif ($ln eq 'implementationAttribute') {
751        $result .= perl_comment        $result .= perl_statement 'impl_attr ('.
752                       sprintf 'Implementation attribute: @name=%s, @value=%s',                           perl_list
753                               $node->getAttributeNS (undef, 'name'),                               ($node->getAttributeNS (undef, 'name'),
754                               $node->getAttributeNS (undef, 'value');                                $node->getAttributeNS (undef, 'value')).')';
755      } else {      } else {
756        $result .= node2code ($node);        $result .= node2code ($node);
757      }      }
# Line 772  $pre .= perl_statement q<plan (>.(0+$Sta Line 782  $pre .= perl_statement q<plan (>.(0+$Sta
782    
783  output_result $pre.$result;  output_result $pre.$result;
784    
785    1;
786    
787    __END__
788    
789    =head1 NAME
790    
791    domtest2perl - DOM Test Suite XML Test File to Perl Test Code Converter
792    
793    =head1 SYNOPSIS
794    
795      perl path/to/domtest2perl.pl input.xml > output.pl
796      perl path/to/domtest2perl.pl input.xml --output-file=output.pl
797    
798    =over 4
799    
800    =item I<input.xml>
801    
802    The name of file to input.  It should be an XML document
803    in the DOM Test Suite.
804    
805    =item I<output.pl>
806    
807    The name of file to output.  It is overwritten if already exists.
808    
809    =back
810    
811    =head1 SEE ALSO
812    
813    I<Document Object Model (DOM) Conformance Test Suites>,
814    <http://www.w3.org/DOM/Test/>.
815    
816    F<domts2perl.pl>
817    
818    F<mkdommemlist.pl>
819    
820    =head1 LICENSE
821    
822    Copyright 2004-2005 Wakaba <w@suika.fam.cx>.  All rights reserved.
823    
824    This program is free software; you can redistribute it and/or
825    modify it under the same terms as Perl itself.
826    
827    =cut
828    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24