Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. # This is the PerSAX Handlers Package
  2.  
  3. package DOMTSHandler;
  4.  
  5. use Switch;
  6.  
  7. use XML::XPath;
  8. use XML::XPath::XMLParser;
  9.  
  10. our $description = 0;
  11. our $string_index = 0;
  12. our $ret_index = 0;
  13. our $condition_index = 0;
  14. our $test_index = 0;
  15. our $iterator_index = 0;
  16. our $temp_index = 0;
  17. # Sometimes, we need temp nodes
  18. our $tnode_index = 0;
  19. our $dom_feature = "\"XML\"";
  20. our %bootstrap_api = (
  21.         dom_implementation_create_document_type => "",
  22.         dom_implementation_create_document      => "",
  23. );
  24. our %native_interface = (
  25.         DOMString => \&generate_domstring_interface,
  26.         DOMTimeStamp => "",
  27.         DOMUserData => "",
  28.         DOMObject =>"",
  29. );
  30. our %special_type = (
  31.         # Some of the type are not defined now!
  32.         boolean => "bool ",
  33.         int => "int32_t ",
  34.         "unsigned long" => "uint32_t ",
  35.         DOMString => "dom_string *",
  36.         List => "list *",
  37.         Collection => "list *",
  38.         DOMImplementation => "dom_implementation *",
  39.         NamedNodeMap => "dom_namednodemap *",
  40.         NodeList => "dom_nodelist *",
  41.         HTMLCollection => "dom_html_collection *",
  42.         HTMLFormElement => "dom_html_form_element *",
  43.         CharacterData => "dom_characterdata *",
  44.         CDATASection => "dom_cdata_section *",
  45. );
  46. our %special_prefix = (
  47.         DOMString => "dom_string",
  48.         DOMImplementation => "dom_implementation",
  49.         NamedNodeMap => "dom_namednodemap",
  50.         NodeList => "dom_nodelist",
  51.         HTMLCollection => "dom_html_collection",
  52.         HTMLFormElement => "dom_html_form_element",
  53.         CharacterData => "dom_characterdata",
  54.         CDATASection => "dom_cdata_section *",
  55. );
  56.  
  57. our %unref_prefix = (
  58.         DOMString => "dom_string",
  59.         NamedNodeMap => "dom_namednodemap",
  60.         NodeList => "dom_nodelist",
  61.         HTMLCollection => "dom_html_collection",
  62. );
  63.  
  64. our %special_method = (
  65. );
  66.  
  67. our %special_attribute = (
  68.         namespaceURI => "namespace",
  69. );
  70.  
  71. our %no_unref = (
  72.         "boolean" => 1,
  73.         "int" => 1,
  74.         "unsigned int" => 1,
  75.         "List" => 1,
  76.         "Collection" => 1,
  77. );
  78.  
  79. our %override_suffix = (
  80.         boolean => "bool",
  81.         int => "int",
  82.         "unsigned long" => "unsigned_long",
  83.         DOMString => "domstring",
  84.         DOMImplementation => "domimplementation",
  85.         NamedNodeMap => "domnamednodemap",
  86.         NodeList => "domnodelist",
  87.         HTMLCollection => "domhtmlcollection",
  88.         Collection => "list",
  89.         List => "list",
  90. );
  91.  
  92. our %exceptions = (
  93.        
  94.         DOM_NO_ERR                      =>  0,
  95.         DOM_INDEX_SIZE_ERR              =>  1,
  96.         DOM_DOMSTRING_SIZE_ERR          =>  2,
  97.         DOM_HIERARCHY_REQUEST_ERR       =>  3,
  98.         DOM_WRONG_DOCUMENT_ERR          =>  4,
  99.         DOM_INVALID_CHARACTER_ERR       =>  5,
  100.         DOM_NO_DATA_ALLOWED_ERR         =>  6,
  101.         DOM_NO_MODIFICATION_ALLOWED_ERR =>  7,
  102.         DOM_NOT_FOUND_ERR               =>  8,
  103.         DOM_NOT_SUPPORTED_ERR           =>  9,
  104.         DOM_INUSE_ATTRIBUTE_ERR         => 10,
  105.         DOM_INVALID_STATE_ERR           => 11,
  106.         DOM_SYNTAX_ERR                  => 12,
  107.         DOM_INVALID_MODIFICATION_ERR    => 13,
  108.         DOM_NAMESPACE_ERR               => 14,
  109.         DOM_INVALID_ACCESS_ERR          => 15,
  110.         DOM_VALIDATION_ERR              => 16,
  111.         DOM_TYPE_MISMATCH_ERR           => 17,
  112.  
  113.         DOM_UNSPECIFIED_EVENT_TYPE_ERR  => (1<<30)+0,
  114.         DOM_DISPATCH_REQUEST_ERR        => (1<<30)+1,
  115.  
  116.         DOM_NO_MEM_ERR                  => (1<<31)+0,
  117. );
  118.  
  119. our @condition = qw(same equals notEquals less lessOrEquals greater greaterOrEquals isNull notNull and or xor not instanceOf isTrue isFalse hasSize contentType hasFeature implementationAttribute);
  120.  
  121. our @exception = qw(INDEX_SIZE_ERR DOMSTRING_SIZE_ERR HIERARCHY_REQUEST_ERR WRONG_DOCUMENT_ERR INVALID_CHARACTER_ERR NO_DATA_ALLOWED_ERR NO_MODIFICATION_ALLOWED_ERR NOT_FOUND_ERR NOT_SUPPORTED_ERR INUSE_ATTRIBUTE_ERR NAMESPACE_ERR UNSPECIFIED_EVENT_TYPE_ERR DISPATCH_REQUEST_ERR);
  122.  
  123. our @assertion = qw(assertTrue assertFalse assertNull assertNotNull assertEquals assertNotEquals assertSame assertInstanceOf assertSize assertEventCount assertURIEquals);
  124.  
  125. our @assertexception = qw(assertDOMException assertEventException assertImplementationException);
  126.  
  127. our @control = qw(if while for-each else);
  128.  
  129. our @framework_statement = qw(assign increment decrement append plus subtract mult divide load implementation comment hasFeature implementationAttribute EventMonitor.setUserObj EventMonitor.getAtEvents EventMonitor.getCaptureEvents EventMonitor.getBubbleEvents EventMonitor.getAllEvents wait);
  130.  
  131. sub new {
  132.         my $type = shift;
  133.         my $dtd = shift;
  134.         my $chdir = shift;
  135.         my $dd = XML::XPath->new(filename => $dtd);
  136.         my $self = {
  137.                         # The DTD file of the xml files
  138.                         dd => $dd,
  139.                         # To indicate whether we are in comments
  140.                         comment => 0,
  141.                         # To indicate that whether we are in <comment> element
  142.                         inline_comment => 0,
  143.                         # The stack of elements encountered utill now
  144.                         context => [],
  145.                         # The map for <var> name => type
  146.                         var => {},
  147.                         # See the comment on generate_condition2 for this member
  148.                         condition_stack => [],
  149.                         # The list for UNREF
  150.                         unref => [],
  151.                         string_unref => [],
  152.                         # The indent of current statement
  153.                         indent => "",
  154.                         # The variables for List/Collection
  155.                         # We now, declare an array for a list and then add them into a list
  156.                         # The map for all the List/Collection in one test
  157.                         # "List Name" => "Member type"
  158.                         list_map => {},
  159.                         # The name of the current List/Collection
  160.                         list_name => "",
  161.                         # The number of items of the current List/Collection
  162.                         list_num => 0,
  163.                         # Whether List/Collection has members
  164.                         list_hasmem => 0,
  165.                         # The type of the current List/Collection
  166.                         list_type => "",
  167.                         # Whether we are in exception assertion
  168.                         exception => 0,
  169.                         # Where to chdir
  170.                         chdir => $chdir
  171.                         };
  172.  
  173.         return bless $self, $type;
  174. }
  175.  
  176. sub start_element {
  177.         my ($self, $element) = @_;
  178.  
  179.         my $en = $element->{Name};
  180.  
  181.         my $dd = $self->{dd};
  182.         my $ct = $self->{context};
  183.         push(@$ct, $en);
  184.  
  185.         switch ($en) {
  186.                 case "test" {
  187.                         ;
  188.                 }
  189.                 case "metadata" {
  190.                         # start comments here
  191.                         print "/*\n";
  192.                         $self->{comment} = 1;
  193.                 }
  194.  
  195.                 # Print the var definition
  196.                 case "var" {
  197.                         $self->generate_var($element->{Attributes});
  198.                 }
  199.  
  200.                 case "member" {
  201.                         if ($self->{context}->[-2] eq "var") {
  202.                                 if ($self->{"list_hasmem"} eq 1) {
  203.                                         print ", ";
  204.                                 }
  205.                                 $self->{"list_hasmem"} = 1;
  206.                                 $self->{"list_num"} ++;
  207.                         }
  208.                 }
  209.  
  210.  
  211.                 # The framework statements
  212.                 case [@framework_statement] {
  213.                         # Because the implementationAttribute & hasFeature belongs to both
  214.                         # framework-statement and condition, we should distinct the two
  215.                         # situation here. Let the generate_condtion to do the work.
  216.                         if ($en eq "hasFeature" || $en eq "implementationAttribute") {
  217.                                 next;
  218.                         }
  219.  
  220.                         $self->generate_framework_statement($en, $element->{Attributes});
  221.                 }
  222.  
  223.                 case [@control] {
  224.                         $self->generate_control_statement($en, $element->{Attributes});
  225.                 }
  226.  
  227.                 # Test condition
  228.                 case [@condition] {
  229.                         $self->generate_condition($en, $element->{Attributes});
  230.                 }
  231.  
  232.                 # The assertsions
  233.                 case [@assertion] {
  234.                         $self->generate_assertion($en, $element->{Attributes});
  235.                 }
  236.                
  237.                 case [@assertexception] {
  238.                         # Indeed, nothing to do here!
  239.                 }
  240.  
  241.                 # Deal with exception
  242.                 case [@exception] {
  243.                         # Just see end_element
  244.                         $self->{'exception'} = 1;
  245.                 }
  246.  
  247.                 # Then catch other case
  248.                 else {
  249.                         # we don't care the comment nodes
  250.                         if ($self->{comment} eq 0) {
  251.                                 $self->generate_interface($en, $element->{Attributes});
  252.                         }
  253.                 }
  254.         }
  255. }
  256.  
  257. sub end_element {
  258.         my ($self, $element) = @_;
  259.  
  260.         my @ct = @{$self->{context}};
  261.         my $name = pop(@{$self->{context}});
  262.  
  263.         switch ($name) {
  264.                 case "metadata" {
  265.                         print "*/\n";
  266.                         $self->{comment} = 0;
  267.                         $self->generate_main();
  268.                 }
  269.                 case "test" {
  270.                         $self->cleanup();
  271.                 }
  272.  
  273.                 case "var" {
  274.                         $self->generate_list();
  275.                 }
  276.  
  277.                 # End of condition
  278.                 case [@condition] {
  279.                         $self->complete_condition($name);
  280.                 }
  281.  
  282.                 # The assertion
  283.                 case [@assertion] {
  284.                         $self->complete_assertion($name);
  285.                 }
  286.  
  287.                 case [@control] {
  288.                         $self->complete_control_statement($name);
  289.                 }
  290.  
  291.                 case [@exception] {
  292.                         $name = "DOM_".$name;
  293.                         print "assert(exp == $exceptions{$name});\n";
  294.                         $self->{'exception'} = 0;
  295.                 }
  296.  
  297.         }
  298. }
  299.  
  300. sub characters {
  301.         my ($self, $data) = @_;
  302.         our $description;
  303.  
  304.         my $ct = $self->{context};
  305.  
  306.         if ($self->{"inline_comment"} eq 1) {
  307.                 print "$data->{Data}";
  308.                 return ;
  309.         }
  310.  
  311.         # We print the comments here
  312.         if ($self->{comment} eq 1) {
  313.                 # So, we are in comments state
  314.                 my $top = $ct->[$#{$ct}];
  315.                 if ($top eq "metadata") {
  316.                         return;
  317.                 }
  318.  
  319.                 if ($top eq "description") {
  320.                         if ($description eq 0) {
  321.                                 print "description: \n";
  322.                                 $description = 1;
  323.                         }
  324.                         print "$data->{Data}";
  325.                 } else {
  326.                         print "$top: $data->{Data}\n";
  327.                 }
  328.                 return;
  329.         }
  330.  
  331.         if ($self->{context}->[-1] eq "member") {
  332.                 # We should mark that the List/Collection has members
  333.                 $self->{"list_hasmem"} = 1;
  334.  
  335.                 # Here, we should detect the characters type
  336.                 # whether it is a integer or string (now, we only take care
  337.                 # of the two types, because I did not find any other type).
  338.                 if ($self->{"list_type"} eq "") {
  339.                         if ($data->{Data} =~ /^\"/) {
  340.                                 $self->{"list_type"} = "char *";
  341.                                 print "const char *".$self->{"list_name"}."Array[] = \{ $data->{Data}";
  342.                         } else {
  343.                                 if ($data->{Data} =~ /^[0-9]+/) {
  344.                                         $self->{"list_type"} = "int *";
  345.                                         print "int ".$self->{"list_name"}."Array[] = \{ $data->{Data}";
  346.                                 } else {
  347.                                         die "Some data in the <member> we can't process: \"$data->{Data}\"";
  348.                                 }
  349.                         }
  350.                 } else {
  351.                         # So, we must have known the type, just output the member
  352.                         print "$data->{Data}";
  353.                 }
  354.         }
  355. }
  356.  
  357. sub generate_main {
  358.         my $self = shift;
  359.         # Firstly, push a new "b" to the string_unref list
  360.         push(@{$self->{"string_unref"}}, "b");
  361.  
  362.         print << "__EOF__"
  363.  
  364. #include <stdio.h>
  365. #include <string.h>
  366. #include <stdbool.h>
  367. #include <unistd.h>
  368.  
  369. #include <dom/dom.h>
  370. #include <dom/functypes.h>
  371.  
  372. #include <domts.h>
  373.  
  374. dom_implementation *doc_impl;
  375.  
  376. int main(int argc, char **argv)
  377. {
  378.         dom_exception exp;
  379.  
  380.         (void)argc;
  381.         (void)argv;
  382.  
  383.         if (chdir("$self->{chdir}") < 0) {
  384.                 perror("chdir (\\"$self->{chdir})\\"");
  385.                 return 1;
  386.         }
  387. __EOF__
  388. }
  389.  
  390. # Note that, we have not just declare variables here
  391. # we should also define EventListener here!
  392. # I think this should be done after the EventListener design
  393. # is complete
  394. sub generate_var {
  395.         my ($self, $ats) = @_;
  396.  
  397.         my $type = "";
  398.         my $dstring = "";
  399.  
  400.         # For the case like <var name="v" type="DOMString" value="some some"
  401.         if ($ats->{"type"} eq "DOMString" and exists $ats->{"value"}) {
  402.                 $dstring = $self->generate_domstring($ats->{"value"});
  403.                 $ats->{"value"} = $dstring;
  404.         }
  405.  
  406.         $type = type_to_ctype($ats->{"type"});
  407.         if ($type eq "") {
  408.                 print "Not implement this type now\n";
  409.                 return;
  410.         }
  411.  
  412.         print "\t$type$ats->{'name'}";
  413.         if (exists $ats->{"value"}) {
  414.                 print " = $ats->{'value'};\n";
  415.         } else {
  416.                 if ($type =~ m/\*/) {
  417.                         print " = NULL;\n";
  418.                 } else {
  419.                         print ";\n";
  420.                 }
  421.         }
  422.  
  423.         my $var = $self->{"var"};
  424.         $var->{$ats->{"name"}} = $ats->{"type"};
  425.  
  426.         # If the type is List/Collection, we should take care of it
  427.         if ($ats->{"type"} =~ /^(List|Collection)$/) {
  428.                 $self->{"list_name"} = $ats->{"name"};
  429.         }
  430. }
  431.  
  432. sub generate_list {
  433.         my $self = shift;
  434.  
  435.         # We should deal with the end of <var> when the <var> is declaring a List/Collection
  436.         if ($self->{"list_hasmem"} eq 1) {
  437.                 # Yes, we are in List/Collection declaration
  438.                 # Firstly, enclose the Array declaration
  439.                 print "};\n";
  440.  
  441.                 # Now, we should create the list * for the List/Collection
  442.                 # Note, we should deal with "int" or "string" type with different params.
  443.                 if ($self->{"list_type"} eq "char *") {
  444.                         print $self->{"list_name"}." = list_new(STRING);\n";
  445.                 }
  446.                 if ($self->{"list_type"} eq "int *") {
  447.                         print $self->{"list_name"}." = list_new(INT);\n";
  448.                 }
  449.                 if ($self->{"list_type"} eq "") {
  450.                         die "A List/Collection has children member but no type is impossible!";
  451.                 }
  452.                 for (my $i = 0; $i < $self->{"list_num"}; $i++) {
  453.                         # Use *(char **) to convert char *[] to char *
  454.                         print "list_add(".$self->{"list_name"}.", *(char **)(".$self->{"list_name"}."Array + $i));\n";
  455.                 }
  456.         } else {
  457.                 if ($self->{"list_name"} ne "") {
  458.                         #TODO: generally, we set the list type as dom_string, but it may be dom_node
  459.                         print $self->{"list_name"}." = list_new(DOM_STRING);\n";
  460.                         $self->{"list_type"} = "DOMString";
  461.                 }
  462.         }
  463.  
  464.         # Add the List/Collection to map
  465.         $self->{"list_map"}->{$self->{"list_name"}} = $self->{"list_type"};
  466.  
  467.         # Reset the List/Collection member state
  468.         $self->{"list_hasmem"} = 0;
  469.         $self->{"list_name"} = "";
  470.         $self->{"list_type"} = "";
  471.         $self->{"list_num"} = 0;
  472. }
  473.  
  474. sub generate_load {
  475.         my ($self, $a) = @_;
  476.         my %ats = %$a;
  477.         my $doc = $ats{"var"};
  478.  
  479.         $test_index ++;
  480.         # define the test file path, use HTML if there is, otherwise using XML
  481.         # Attention: I intend to copy the test files to the program excuting dir
  482.         print "\tconst char *test$test_index = \"$ats{'href'}.html\";\n\n";
  483.         print "\t$doc = load_html(test$test_index, $ats{'willBeModified'});";
  484.         print "\tif ($doc == NULL) {\n";
  485.         $test_index ++;
  486.         print "\t\tconst char *test$test_index = \"$ats{'href'}.xml\";\n\n";
  487.         print "\t\t$doc = load_xml(test$test_index, $ats{'willBeModified'});\n";
  488.         print "\t\tif ($doc == NULL)\n";
  489.         print "\t\t\treturn 1;\n";
  490.         print "\t\t}\n";
  491.         print << "__EOF__";
  492.         exp = dom_document_get_implementation($doc, &doc_impl);
  493.         if (exp != DOM_NO_ERR)
  494.                 return exp;
  495. __EOF__
  496.  
  497.         $self->addto_cleanup($doc);
  498. }
  499.  
  500. sub generate_framework_statement {
  501.         my ($self, $name, $ats) = @_;
  502.  
  503.         switch($name) {
  504.                 case "load" {
  505.                         $self->generate_load($ats);
  506.                 }
  507.  
  508.                 case "assign" {
  509.                         my $var = $ats->{"var"};
  510.                         my $value = "0";
  511.                         if (exists $ats->{"value"}) {  
  512.                                 $value = $ats->{"value"};
  513.                         }
  514.  
  515.                         # Assign with strong-type-conversion, this is necessary in C.
  516.                         # And we may need to do deep-copy in the future. FIXME
  517.                         my $type = type_to_ctype($self->{"var"}->{$var});
  518.                         print "$var = \($type\) $value;\n";
  519.                 }
  520.  
  521.                 case "increment" {
  522.                         my $var = $ats->{"var"};
  523.                         my $value = $ats->{"value"};
  524.  
  525.                         print "$var += $value;\n";
  526.                 }
  527.  
  528.                 case "decrement" {
  529.                         my $var = $ats->{"var"};
  530.                         my $value = $ats->{"value"};
  531.  
  532.                         print "$var -= $value;\n";
  533.                 }
  534.                
  535.                 case "append" {
  536.                         my $col = $ats->{"collection"};
  537.                         my $obj = "";
  538.  
  539.                         # God, the DTD said, there should be a "OBJ" attribute, but there may not!
  540.                         if (exists $ats->{"obj"}) {
  541.                                 $obj = $ats->{"obj"};
  542.                         } else {
  543.                                 $obj = $ats->{"item"}
  544.                         }
  545.  
  546.                         if (not $self->{"var"}->{$col} =~ /^(List|Collection)/) {
  547.                                 die "Append data to some non-list type!";
  548.                         }
  549.  
  550.                         print "list_add($col, $obj);\n";
  551.                 }
  552.                
  553.                 case [qw(plus subtract mult divide)] {
  554.                         my $var = $ats->{"var"};
  555.                         my $op1 = $ats->{"op1"};
  556.                         my $op2 = $ats->{"op2"};
  557.  
  558.                         my %table = ("plus", "+", "subtract", "-", "mult", "*", "divide", "/");
  559.                         print "$var = $op1 $table{$name} $op2;\n";
  560.                 }
  561.  
  562.                 case "comment" {
  563.                         print "\*";
  564.                         $self->{"inline_comment"} = 1;
  565.                 }
  566.  
  567.                 case "implementation" {
  568.                         if (not exists $ats->{"obj"}) {
  569.                                 my $var = $ats->{"var"};
  570.                                 my $dstring = generate_domstring($self, $dom_feature);
  571.                                 print "exp = dom_implregistry_get_dom_implementation($dstring, \&$var);\n";
  572.                                 print "\tif (exp != DOM_NO_ERR) {\n";
  573.                                 $self->cleanup_fail("\t\t");
  574.                                 print "\t\treturn exp;\n\t}\n";
  575.                                 last;
  576.                         }
  577.  
  578.                         my $obj = $ats->{"obj"};
  579.                         my $var = $ats->{"var"};
  580.                         # Here we directly output the libDOM's get_implementation API
  581.                         print "\texp = dom_document_get_implementation($obj, \&$var);\n";
  582.                         print "\tif (exp != DOM_NO_ERR) {\n";
  583.                         $self->cleanup_fail("\t\t");
  584.                         print "\t\treturn exp;\n\t}\n";
  585.                 }
  586.  
  587.                 # We deal with hasFeaturn and implementationAttribute in the generate_condition
  588.                 case "hasFeature" {
  589.                         die "No, never can be here!";
  590.                 }
  591.                 case "implementaionAttribute" {
  592.                         die "No, never can be here!";
  593.                 }
  594.                
  595.                 # Here, we die because we did not implement other statements
  596.                 # We did not implement these statements, because there are no use of them in the W3C DOMTS now
  597.                 case [@framework_statement] {
  598.                         die "The statement \"$name\" is not implemented yet!";
  599.                 }
  600.  
  601.         }
  602. }
  603.  
  604. sub complete_framework_statement {
  605.         my ($self, $name) = @_;
  606.  
  607.         switch($name) {
  608.                 case "comment" {
  609.                         print "*/\n";
  610.                         $self->{"inline_comment"} = 0;
  611.                 }
  612.         }
  613. }
  614.  
  615. sub generate_interface {
  616.         my ($self, $en, $a) = @_;
  617.         my %ats = %$a;
  618.         my $dd = $self->{dd};
  619.  
  620.         if (exists $ats{'interface'}) {
  621.                 # Firstly, test whether it is a DOM native interface
  622.                 if (exists $native_interface{$ats{'interface'}}) {
  623.                         if ($native_interface{$ats{'interface'}} eq "") {
  624.                                 die "Unkown how to deal with $en of $ats{'interface'}";
  625.                         }
  626.  
  627.                         return $native_interface{$ats{'interface'}}($self, $en, $a);
  628.                 }
  629.  
  630.                 my $ns = $dd->find("/library/interface[\@name=\"$ats{'interface'}\"]/method[\@name=\"$en\"]");
  631.                 if ($ns->size() != 0) {
  632.                         my $node = $ns->get_node(1);
  633.                         $self->generate_method($en, $node, %ats);
  634.                 } else {
  635.                         my $ns = $dd->find("/library/interface[\@name=\"$ats{'interface'}\"]/attribute[\@name=\"$en\"]");
  636.                         if ($ns->size() != 0) {
  637.                                 my $node = $ns->get_node(1);
  638.                                 $self->generate_attribute_accessor($en, $node, %ats);
  639.                         }
  640.                 }
  641.         } else {
  642.                 my $ns = $dd->find("/library/interface/method[\@name=\"$en\"]");
  643.                 if ($ns->size() != 0) {
  644.                         my $node = $ns->get_node(1);
  645.                         $self->generate_method($en, $node, %ats);
  646.                 } else {
  647.                         my $ns = $dd->find("/library/interface/attribute[\@name=\"$en\"]");
  648.                         if ($ns->size() != 0) {
  649.                                 my $node = $ns->get_node(1);
  650.                                 $self->generate_attribute_accessor($en, $node, %ats);
  651.                         } else {
  652.                                 die "Oh, Can't find how to deal with the element $en\n";
  653.                         }
  654.                 }
  655.         }
  656. }
  657.  
  658. sub generate_method {
  659.         my ($self, $en, $node, %ats) = @_;
  660.         my $dd = $self->{dd};
  661.         if (! exists $ats{'interface'}) {
  662.                 my $n = $node;
  663.                 while($n->getLocalName() ne "interface") {
  664.                         $n = $n->getParentNode();
  665.                 }
  666.                 $ats{'interface'} = $n->getAttribute("name");
  667.         }
  668.  
  669.         $method = to_cmethod($ats{'interface'}, $en);
  670.         my $cast = to_attribute_cast($ats{'interface'});
  671.         my $ns = $dd->find("parameters/param", $node);
  672.         my $params = "${cast}$ats{'obj'}";
  673.         for ($count = 1; $count <= $ns->size; $count++) {
  674.                 my $n = $ns->get_node($count);
  675.                 my $p = $n->getAttribute("name");
  676.                 my $t = $n->getAttribute("type");
  677.  
  678.                 # Change the raw string and the char * to dom_string
  679.                 if ($t eq "DOMString") {
  680.                         if ($ats{$p} =~ /^"/ or $self->{"var"}->{$ats{$p}} eq "char *") {
  681.                                 $self->generate_domstring($ats{$p});
  682.                                 $params = $params.", dstring$string_index";
  683.                                 next;
  684.                         }
  685.                 }
  686.  
  687.                 # For the case that the testcase did not provide the param, we just pass a NULL
  688.                 # Because we are in C, not like C++ which can overriden functions
  689.                 if (not exists $ats{$p}) {
  690.                         $params = $params.", NULL";
  691.                         next;
  692.                 }
  693.  
  694.                 $params = $params.", $ats{$p}";
  695.         }
  696.  
  697.         #$ns = $dd->find("returns", $node);
  698.         #my $n = $ns->get_node(1);
  699.         #my $t = $n->getAttribute("type");
  700.         # declare the return value
  701.         #my $tp = type_to_ctype($t);
  702.         #print "\t$tp ret$ret_index;\n";
  703.         my $unref = 0;
  704.         my $temp_node = 0;
  705.         if (exists $ats{'var'}) {
  706.                 # Add the bootstrap params
  707.                 if (exists $bootstrap_api{$method}) {
  708.                         if ($method eq "dom_implementation_create_document") {
  709.                                 $params = $params.", myrealloc, NULL, NULL";
  710.                         } else {
  711.                                 $params = $params.", myrealloc, NULL";
  712.                         }
  713.                 }
  714.                 # Deal with the situation like
  715.                 #
  716.                 # dom_node_append_child(node, new_node, &node);
  717.                 #
  718.                 # Here, we should import a tempNode, and change this expression to
  719.                 #
  720.                 # dom_node *tnode1 = NULL;
  721.                 # dom_node_append_child(node, new_node, &tnode1);
  722.                 # dom_node_unref(node);
  723.                 # node = tnode1;
  724.                 #
  725.                 # Over.
  726.                 if ($ats{'obj'} eq $ats{'var'}) {
  727.                         my $t = type_to_ctype($self->{'var'}->{$ats{'var'}});
  728.                         $tnode_index ++;
  729.                         print "$t tnode$tnode_index = NULL;";
  730.                         $params = $params.", \&tnode$tnode_index";
  731.                         # The ats{'obj'} must have been added to cleanup stack
  732.                         $unref = 1;
  733.                         # Indicate that we have created a temp node
  734.                         $temp_node = 1;
  735.                 } else {
  736.                         $params = $params.", (void *) \&$ats{'var'}";
  737.                         $unref = $self->param_unref($ats{'var'});
  738.                 }
  739.         }
  740.  
  741.         print "\texp = $method($params);\n";
  742.  
  743.         if ($self->{'exception'} eq 0) {
  744.                 print << "__EOF__";
  745.         if (exp != DOM_NO_ERR) {
  746.         fprintf(stderr, "Exception raised from %s\\n", "$method");
  747. __EOF__
  748.  
  749.                 $self->cleanup_fail("\t\t");
  750.                 print << "__EOF__";
  751.                 return exp;
  752.         }
  753. __EOF__
  754.         }
  755.  
  756.         if (exists $ats{'var'} and $unref eq 0) {
  757.                 $self->addto_cleanup($ats{'var'});
  758.         }
  759.  
  760.         if ($temp_node eq 1) {
  761.                 my $t = $self->{'var'}->{$ats{'var'}};
  762.                 if (not exists $no_unref{$t}) {
  763.                         my $prefix = "dom_node";
  764.                         if (exists $unref_prefix{$t}) {
  765.                                 $prefix = $unref_prefix{$t};
  766.                         }
  767.                         print $prefix."_unref(".$ats{'obj'}.");\n";
  768.                 }
  769.                 print "$ats{'var'} = tnode$tnode_index;";
  770.         }
  771. }
  772.  
  773. sub generate_attribute_accessor {
  774.         my ($self, $en, $node, %ats) = @_;
  775.  
  776.         if (defined($ats{'var'})) {
  777.                 generate_attribute_fetcher(@_);
  778.         } else {
  779.                 if (defined($ats{'value'})) {
  780.                         generate_attribute_setter(@_);
  781.                 }
  782.         }
  783. }
  784.  
  785. sub generate_attribute_fetcher {
  786.         my ($self, $en, $node, %ats) = @_;
  787.         my $dd = $self->{dd};
  788.         if (! exists $ats{'interface'}) {
  789.                 my $n = $node;
  790.                 while($n->getLocalName() ne "interface") {
  791.                         $n = $n->getParentNode();
  792.                 }
  793.                 $ats{'interface'} = $n->getAttribute("name");
  794.         }
  795.  
  796.         my $fetcher = to_attribute_fetcher($ats{'interface'}, "$en");
  797.         my $cast = to_attribute_cast($ats{'interface'});
  798.         my $unref = 0;
  799.         my $temp_node = 0;
  800.         # Deal with the situation like
  801.         #
  802.         # dom_node_get_next_sibling(child, &child);
  803.         #
  804.         # Here, we should import a tempNode, and change this expression to
  805.         #
  806.         # dom_node *tnode1 = NULL;
  807.         # dom_node_get_next_sibling(child, &tnode1);
  808.         # dom_node_unref(child);
  809.         # child = tnode1;
  810.         #
  811.         # Over.
  812.         if ($ats{'obj'} eq $ats{'var'}) {
  813.                 my $t = type_to_ctype($self->{'var'}->{$ats{'var'}});
  814.                 $tnode_index ++;
  815.                 print "\t$t tnode$tnode_index = NULL;\n";
  816.                 print "\texp = $fetcher(${cast}$ats{'obj'}, \&tnode$tnode_index);\n";
  817.                 # The ats{'obj'} must have been added to cleanup stack
  818.                 $unref = 1;
  819.                 # Indicate that we have created a temp node
  820.                 $temp_node = 1;
  821.         } else {
  822.                 $unref = $self->param_unref($ats{'var'});
  823.                 print "\texp = $fetcher(${cast}$ats{'obj'}, \&$ats{'var'});\n";
  824.         }
  825.  
  826.  
  827.         if ($self->{'exception'} eq 0) {
  828.                 print << "__EOF__";
  829.         if (exp != DOM_NO_ERR) {
  830.                 fprintf(stderr, "Exception raised when fetch attribute %s", "$en");
  831. __EOF__
  832.                 $self->cleanup_fail("\t\t");
  833.                 print << "__EOF__";
  834.                 return exp;
  835.         }
  836. __EOF__
  837.         }
  838.  
  839.         if ($temp_node eq 1) {
  840.                 my $t = $self->{'var'}->{$ats{'var'}};
  841.                 if (not exists $no_unref{$t}) {
  842.                         my $prefix = "dom_node";
  843.                         if (exists $unref_prefix{$t}) {
  844.                                 $prefix = $unref_prefix{$t};
  845.                         }
  846.                         print $prefix."_unref(".$ats{'obj'}.");\n";
  847.                 }
  848.                 print "$ats{'var'} = tnode$tnode_index;";
  849.         }
  850.  
  851.         if ($unref eq 0) {
  852.                 $self->addto_cleanup($ats{'var'});
  853.         }
  854. }
  855.  
  856. sub generate_attribute_setter {
  857.         my ($self, $en, $node, %ats) = @_;
  858.         my $dd = $self->{dd};
  859.         if (! exists $ats{'interface'}) {
  860.                 my $n = $node;
  861.                 while($n->getLocalName() ne "interface") {
  862.                         $n = $n->getParentNode();
  863.                 }
  864.                 $ats{'interface'} = $n->getAttribute("name");
  865.         }
  866.  
  867.         my $setter = to_attribute_setter($ats{'interface'}, "$en");
  868.         my $param = "$ats{'obj'}";
  869.  
  870.         # For DOMString, we should deal specially
  871.         my $lp = $ats{'value'};
  872.         if ($node->getAttribute("type") eq "DOMString") {
  873.                 if ($ats{'value'} =~ /^"/ or $self->{"var"}->{$ats{'value'}} eq "char *") {
  874.                         $lp = $self->generate_domstring($ats{'value'});
  875.                 }
  876.         }
  877.  
  878.         $param = $param.", $lp";
  879.  
  880.         print "exp = $setter($param);";
  881.  
  882.         if ($self->{'exception'} eq 0) {
  883.                 print << "__EOF__";
  884.                 if (exp != DOM_NO_ERR) {
  885.                         fprintf(stderr, "Exception raised when fetch attribute %s", "$en");
  886. __EOF__
  887.                 $self->cleanup_fail("\t\t");
  888.                 print << "__EOF__";
  889.                         return exp;
  890.                 }
  891. __EOF__
  892.         }
  893.  
  894. }
  895.  
  896.  
  897. sub generate_condition {
  898.         my ($self, $name, $ats) = @_;
  899.  
  900.         # If we are in nested or/and/xor/not, we should put a operator before test
  901.         my @array = @{$self->{condition_stack}};
  902.         if ($#array ge 0) {
  903.                 switch ($array[-1]) {
  904.                         case "xor" {
  905.                                 print " ^ ";
  906.                         }
  907.                         case "or" {
  908.                                 print " || ";
  909.                         }
  910.                         case "and" {
  911.                                 print " && ";
  912.                         }
  913.                         # It is the indicator, just pop it.
  914.                         case "new" {
  915.                                 pop(@{$self->{condition_stack}});
  916.                         }
  917.                 }
  918.         }
  919.  
  920.         switch ($name) {
  921.                 case [qw(less lessOrEquals greater greaterOrEquals)] {
  922.                         my $actual = $ats->{actual};
  923.                         my $expected = $ats->{expected};
  924.                         my $method = $name;
  925.                         $method =~ s/[A-Z]/_$&/g;
  926.                         $method = lc $method;
  927.                         print "$method($expected, $actual)";
  928.                 }
  929.  
  930.                 case "same" {
  931.                         my $actual = $ats->{actual};
  932.                         my $expected = $ats->{expected};
  933.                         my $func = $self->find_override("is_same", $actual, $expected);
  934.                         print "$func($expected, $actual)";
  935.                 }
  936.  
  937.                 case [qw(equals notEquals)]{
  938.                         my $actual = $ats->{actual};
  939.                         my $expected = $ats->{expected};
  940.                         my $ig;
  941.                         if (exists $ats->{ignoreCase}){
  942.                                 $ig = $ats->{ignoreCase};
  943.                         } else {
  944.                                 $ig = "false";
  945.                         }
  946.                         $ig = adjust_ignore($ig);
  947.  
  948.                         my $func = $self->find_override("is_equals", $actual, $expected);
  949.                         if ($name =~ /not/i){
  950.                                 print "(false == $func($expected, $actual, $ig))";
  951.                         } else {
  952.                                 print "$func($expected, $actual, $ig)";
  953.                         }
  954.                 }
  955.  
  956.                 case [qw(isNull notNull)]{
  957.                         my $obj = $ats->{obj};
  958.                         if ($name =~ /not/i) {
  959.                                 print "(false == is_null($obj))";
  960.                         } else {
  961.                                 print "is_null($obj)";
  962.                         }
  963.                 }
  964.  
  965.                 case "isTrue" {
  966.                         my $value = $ats->{value};
  967.                         print "is_true($value)";
  968.                 }
  969.  
  970.                 case "isFalse" {
  971.                         my $value = $ats->{value};
  972.                         print "(false == is_true($value))";
  973.                 }
  974.  
  975.                 case "hasSize" {
  976.                         my $obj = $ats->{obj};
  977.                         my $size = $ats->{expected};
  978.                         my $func = $self->find_override("is_size", $obj, $size);
  979.                         print "$func($size, $obj)";
  980.                 }
  981.  
  982.                 case "contentType" {
  983.                         my $type = $ats->{type};
  984.                         print "is_contenttype(\"$type\")";
  985.                 }
  986.  
  987.                 case "instanceOf" {
  988.                         my $obj = $ats->{obj};
  989.                         my $type = $ats->{type};
  990.                         print "instanceOf(\"$type\", $obj)";
  991.                 }
  992.  
  993.                 case "hasFeature" {
  994.                         if (exists $ats->{var}) {
  995.                                 $self->generate_interface($name, $ats);
  996.                         } else {
  997.                                 my $feature = $ats->{feature};
  998.                                 if (not ($feature =~ /^"/)) {
  999.                                         $feature = '"'.$feature.'"';
  1000.                                 }
  1001.                                 my $version = "NULL";
  1002.                                 if (exists $ats->{version}) {
  1003.                                         $version = $ats->{version};
  1004.                                         if (not ($version =~ /^"/)) {
  1005.                                                 $version = '"'.$version.'"';
  1006.                                         }
  1007.                                        
  1008.                                 }
  1009.  
  1010.                                 if ($self->{context}->[-2] ne "condition") {
  1011.                                         # we are not in a %condition place, so we must be a statement
  1012.                                         # we change this to assert
  1013.                                         # print "assert(has_feature($feature, $version));\n"
  1014.                                         # do nothing if we are not in condition.
  1015.                                 } else {
  1016.                                         print "has_feature($feature, $version)";
  1017.                                 }
  1018.                         }
  1019.                 }
  1020.  
  1021.                 case "implementationAttribute" {
  1022.                         my $value = $ats->{value};
  1023.                         my $name = $ats->{name};
  1024.                        
  1025.                         if ($self->{context}->[-2] ne "condition") {
  1026.                                 # print "assert(implementation_attribute(\"$name\", $value));";
  1027.                                 # Do nothing, and the same with hasFeature, this means we will
  1028.                                 # run all test cases now and try to get a result whether we support
  1029.                                 # such feature.
  1030.                         } else {
  1031.                                 print "implementation_attribute(\"$name\", $value)";
  1032.                         }
  1033.                 }
  1034.  
  1035.                 case [qw(and or xor)] {
  1036.                         push(@{$self->{condition_stack}}, $name);
  1037.                         push(@{$self->{condition_stack}}, "new");
  1038.                         print "(";
  1039.                 }
  1040.  
  1041.                 case "not" {
  1042.                         push(@{$self->{condition_stack}}, $name);
  1043.                         print "(false == ";
  1044.                 }
  1045.         }
  1046.  
  1047. }
  1048.  
  1049. sub complete_condition {
  1050.         my ($self, $name) = @_;
  1051.  
  1052.         if ($name =~ /^(xor|or|and)$/i) {
  1053.                 print ")";
  1054.                 my $top = pop(@{$self->{condition_stack}});
  1055.                 die "Condition stack error! $top != $name" if $top ne $name;
  1056.         }
  1057.  
  1058.         if ($name eq "not") {
  1059.                 my $top = pop(@{$self->{condition_stack}});
  1060.                                 die "Condition stack error! $top != $name" if $top ne $name;
  1061.                 print ")";
  1062.         }
  1063.  
  1064.         # we deal with the situation that the %condition is in a control statement such as
  1065.         # <if> or <while>, and we should start a new '{' block here
  1066.         if ($self->{context}->[-1] eq "condition") {
  1067.                 print ") {\n";
  1068.                 pop(@{$self->{context}});
  1069.         }
  1070. }
  1071.  
  1072. sub generate_assertion {
  1073.         my ($self, $name, $ats) = @_;
  1074.  
  1075.         print "\tassert(";
  1076.         switch($name){
  1077.                 # Only assertTrue & assertFalse can have nested %conditions
  1078.                 case [qw(assertTrue assertFalse assertNull)] {
  1079.                         my $n = $name;
  1080.                         $n =~ s/assert/is/g;
  1081.                         if (exists $ats->{actual}){
  1082.                                 my $ta = { value => $ats->{actual}, obj => $ats->{actual}};
  1083.                                 $self->generate_condition($n,$ta);
  1084.                         }
  1085.                 }
  1086.  
  1087.                 case [qw(assertNotNull assertEquals assertNotEquals assertSame)] {
  1088.                         my $n = $name;
  1089.                         $n =~ s/assert//g;
  1090.                         $n = lcfirst $n;
  1091.                         if (exists $ats->{actual}){
  1092.                                 my $ta = {      
  1093.                                                 actual => $ats->{actual},
  1094.                                                 value => $ats->{actual},
  1095.                                                 obj => $ats->{actual},
  1096.                                                 expected => $ats->{expected},
  1097.                                                 ignoreCase => $ats->{ignoreCase},
  1098.                                                 type => $ats->{type},
  1099.                                          };
  1100.                                 $self->generate_condition($n,$ta);
  1101.                         }
  1102.                 }
  1103.  
  1104.                 case "assertInstanceOf" {
  1105.                         my $obj = $ats->{obj};
  1106.                         my $type = $ats->{type};
  1107.                         print "is_instanceof(\"$type\", $obj)";
  1108.                 }
  1109.  
  1110.                 case "assertSize" {
  1111.                         my $n = $name;
  1112.                         $n =~ s/assert/has/;
  1113.                         if (exists $ats->{collection}){
  1114.                                 my $ta = { obj => $ats->{collection}, expected => $ats->{size}};
  1115.                                 $self->generate_condition($n,$ta);
  1116.                         }
  1117.                 }
  1118.        
  1119.                 case "assertEventCount" {
  1120.                         #todo
  1121.                 }
  1122.                
  1123.                 case "assertURIEquals" {
  1124.                         my $actual = $ats->{actual};
  1125.                         my ($scheme, $path, $host, $file, $name, $query, $fragment, $isAbsolute) = qw(NULL NULL NULL NULL NULL NULL NULL NULL);
  1126.                         if (exists $ats->{scheme}) {
  1127.                                 $scheme = $ats->{scheme};
  1128.                         }
  1129.                         if (exists $ats->{path}) {
  1130.                                 $path = $ats->{path};
  1131.                         }
  1132.                         if (exists $ats->{host}) {
  1133.                                 $host = $ats->{host};
  1134.                         }
  1135.                         if (exists $ats->{file}) {
  1136.                                 $file = $ats->{file};
  1137.                         }
  1138.                         if (exists $ats->{name}) {
  1139.                                 $name = $ats->{name};
  1140.                         }
  1141.                         if (exists $ats->{query}) {
  1142.                                 $query = $ats->{query};
  1143.                         }
  1144.                         if (exists $ats->{fragment}) {
  1145.                                 $fragment = $ats->{fragment};
  1146.                         }
  1147.                         if (exists $ats->{isAbsolute}) {
  1148.                                 $isAbsolute = $ats->{isAbsolute};
  1149.                         }
  1150.  
  1151.                         print "is_uri_equals($scheme, $path, $host, $file, $name, $query, $fragment, $isAbsolute, $actual)"
  1152.                 }
  1153.         }
  1154.  
  1155. }
  1156.  
  1157. sub complete_assertion {
  1158.         my ($self, $name) = @_;
  1159.  
  1160.         print ");\n";
  1161. }
  1162.  
  1163. sub generate_control_statement {
  1164.         my ($self, $name, $ats) = @_;
  1165.  
  1166.         switch($name) {
  1167.                 case "if" {
  1168.                         print "\tif(";
  1169.                         push(@{$self->{"context"}}, "condition");
  1170.                 }
  1171.  
  1172.                 case "else" {
  1173.                         $self->cleanup_block_domstring();
  1174.                         print "\t} else {";
  1175.                 }
  1176.  
  1177.                 case "while" {
  1178.                         print "\twhile (";
  1179.                         push(@{$self->{"context"}}, "condition");
  1180.                 }
  1181.  
  1182.                 case "for-each" {
  1183.                         # Detect what is the collection type, if it is "string", we
  1184.                         # should also do some conversion work
  1185.                         my $coll = $ats->{"collection"};
  1186.                         # The default member type is dom_node
  1187.                         my $type = "dom_node *";
  1188.                         if (exists $self->{"list_map"}->{$coll}) {
  1189.                                 $type = $self->{"list_map"}->{$coll};
  1190.                         }
  1191.  
  1192.                         # Find the member variable, if it is not declared before, declare it firstly
  1193.                         my $member = $ats->{"member"};
  1194.                         if (not exists $self->{"var"}->{$member}) {
  1195.                                 print "$type  $member;\n";
  1196.                                 # Add the new variable to the {var} map
  1197.                                 $self->{"var"}->{"$member"} = $type;
  1198.                         }
  1199.  
  1200.                         # Now the member is conformed to be declared
  1201.                         if ($self->{"var"}->{$coll} =~ /^(List|Collection)$/) {
  1202.                                 # The element in the list is not equal with the member object
  1203.                                 # For now, there is only one case for this, it is "char *" <=> "DOMString"
  1204.                                 my $conversion = 0;
  1205.                                 if ($self->{"var"}->{"$member"} ne $type) {
  1206.                                         if ($self->{"var"}->{"$member"} eq "DOMString") {
  1207.                                                 if ($type eq "char *") {
  1208.                                                         $conversion = 1;
  1209.                                                 }
  1210.                                         }
  1211.                                 }
  1212.  
  1213.                                 $iterator_index++;
  1214.                                 print "unsigned int iterator$iterator_index = 0;";
  1215.                                 if ($conversion eq 1) {
  1216.                                         print "char *tstring$temp_index = NULL;";
  1217.                                 }
  1218.                                 print "foreach_initialise_list($coll, \&iterator$iterator_index);\n";
  1219.                                 print "while(get_next_list($coll, \&iterator$iterator_index, ";
  1220.                                 if ($conversion eq 1) {
  1221.                                         print "\&tstring$temp_index)) {\n";
  1222.                                         print "exp = dom_string_create((const uint8_t *)tstring$temp_index,";
  1223.                                         print "strlen(tstring$temp_index), &$member);\n";
  1224.                                         print "if (exp != DOM_NO_ERR) {\n";
  1225.                                         print "\t\tfprintf(stderr, \"Can't create DOMString\\n\");";
  1226.                                         $self->cleanup_fail("\t\t");
  1227.                                         print "\t\treturn exp;\n\t}\n";
  1228.                                         $temp_index ++;
  1229.                                 } else {
  1230.                                         print "\&$member)) {\n";
  1231.                                 }
  1232.                         }
  1233.  
  1234.                         if ($self->{"var"}->{$coll} eq "NodeList") {
  1235.                                 $iterator_index++;
  1236.                                 print "unsigned int iterator$iterator_index = 0;";
  1237.                                 print "foreach_initialise_domnodelist($coll, \&iterator$iterator_index);\n";
  1238.                                 print "while(get_next_domnodelist($coll, \&iterator$iterator_index, \&$member)) {\n";
  1239.                         }
  1240.  
  1241.                         if ($self->{"var"}->{$coll} eq "NamedNodeMap") {
  1242.                                 $iterator_index++;
  1243.                                 print "unsigned int iterator$iterator_index = 0;";
  1244.                                 print "foreach_initialise_domnamednodemap($coll, \&iterator$iterator_index);\n";
  1245.                                 print "while(get_next_domnamednodemap($coll, \&iterator$iterator_index, \&$member)) {\n";
  1246.                         }
  1247.  
  1248.                         if ($self->{"var"}->{$coll} eq "HTMLCollection") {
  1249.                                 $iterator_index++;
  1250.                                 print "unsigned int iterator$iterator_index = 0;";
  1251.                                 print "foreach_initialise_domhtmlcollection($coll, \&iterator$iterator_index);\n";
  1252.                                 print "while(get_next_domhtmlcollection($coll, \&iterator$iterator_index, \&$member)) {\n";
  1253.                         }
  1254.                 }
  1255.         }
  1256.  
  1257.         # Firstly, we enter a new block, so push a "b" into the string_unref list
  1258.         push(@{$self->{"string_unref"}}, "b");
  1259. }
  1260.  
  1261. sub complete_control_statement {
  1262.         my ($self, $name) = @_;
  1263.  
  1264.         # Note: we only print a '}' when <if> element ended but not <else>
  1265.         # The reason is that there may be no <else> element in <if> and
  1266.         # we when there is an <else> element, it must nested in <if>. ^_^
  1267.         switch($name) {
  1268.                 case [qw(if while for-each)] {
  1269.                         # Firstly, we should cleanup the dom_string in this block
  1270.                         $self->cleanup_block_domstring();
  1271.  
  1272.                         print "}\n";
  1273.                 }
  1274.         }
  1275. }
  1276.  
  1277.  
  1278. ###############################################################################
  1279. #
  1280. # The helper functions
  1281. #
  1282. sub generate_domstring {
  1283.         my ($self, $str) = @_;
  1284.         $string_index = $string_index + 1;
  1285.  
  1286.         print << "__EOF__";
  1287.         const char *string$string_index = $str;
  1288.         dom_string *dstring$string_index;
  1289.         exp = dom_string_create((const uint8_t *)string$string_index,
  1290.                         strlen(string$string_index), &dstring$string_index);
  1291.         if (exp != DOM_NO_ERR) {
  1292.                 fprintf(stderr, "Can't create DOMString\\n");
  1293. __EOF__
  1294.         $self->cleanup_fail("\t\t");
  1295.         print << "__EOF__";
  1296.                 return exp;
  1297.         }
  1298.  
  1299. __EOF__
  1300.  
  1301.         push(@{$self->{string_unref}}, "$string_index");
  1302.  
  1303.         return "dstring$string_index";
  1304. }
  1305.  
  1306. sub cleanup_domstring {
  1307.         my ($self, $indent) = @_;
  1308.  
  1309.         for (my $i = 0; $i <= $#{$self->{string_unref}}; $i++) {
  1310.                 if ($self->{string_unref}->[$i] ne "b") {
  1311.                         print $indent."dom_string_unref(dstring$self->{string_unref}->[$i]);\n";
  1312.                 }
  1313.         }
  1314. }
  1315.  
  1316. sub cleanup_block_domstring {
  1317.         my $self = shift;
  1318.  
  1319.         while ((my $num = pop(@{$self->{string_unref}})) ne "b" and $#{$self->{string_unref}} ne -1) {
  1320.                 print "dom_string_unref(dstring$num);\n";
  1321.         }
  1322. }
  1323.  
  1324. sub type_to_ctype {
  1325.         my $type = shift;
  1326.  
  1327.         if (exists $special_type{$type}) {
  1328.                 return $special_type{$type};
  1329.         }
  1330.  
  1331.         # If the type is not specially treated, we can transform it by rules
  1332.         if ($type =~ m/^HTML/) {
  1333.                 # Don't deal with this now
  1334.                 return "";
  1335.         }
  1336.  
  1337.         # The core module comes here
  1338.         $type =~ s/[A-Z]/_$&/g;
  1339.         $type = lc $type;
  1340.  
  1341.         # For events module
  1342.         $type =~ s/_u_i_/_ui_/g;
  1343.  
  1344.         return "dom".$type." *";
  1345. }
  1346.  
  1347. sub to_cmethod {
  1348.         my ($type, $m) = @_;
  1349.         my $prefix = get_prefix($type);
  1350.         my $ret;
  1351.  
  1352.         if (exists $special_method{$m}) {
  1353.                 $ret = $prefix."_".$special_method{$m};
  1354.         } else {
  1355.                 $m =~ s/[A-Z]/_$&/g;
  1356.                 $m = lc $m;
  1357.                 $ret = $prefix."_".$m;
  1358.         }
  1359.  
  1360.         $ret =~ s/h_t_m_l/html/;
  1361.         $ret =~ s/c_d_a_t_a/cdata/;
  1362.         $ret =~ s/_n_s$/_ns/;
  1363.         # For DOMUIEvent
  1364.         $ret =~ s/_u_i_/_ui_/;
  1365.         # For initEvent
  1366.         $ret =~ s/init_event/init/;
  1367.         return $ret;
  1368. }
  1369.  
  1370. sub to_attribute_fetcher {
  1371.         return to_attribute_accessor(@_, "get");
  1372. }
  1373.  
  1374. sub to_attribute_setter {
  1375.         return to_attribute_accessor(@_, "set");
  1376. }
  1377.  
  1378. sub to_attribute_accessor {
  1379.         my ($type, $af, $accessor) = @_;
  1380.         my $prefix = get_prefix($type);
  1381.         my $ret;
  1382.  
  1383.         if (exists $special_attribute{$af}) {
  1384.                 $ret = $prefix."_".$accessor."_".$special_attribute{$af};
  1385.         } else {
  1386.                 $af =~ s/[A-Z]/_$&/g;
  1387.                 $af = lc $af;
  1388.                 $ret = $prefix."_".$accessor."_".$af;
  1389.         }
  1390.  
  1391.         $ret =~ s/h_t_m_l/html/;
  1392.         return $ret;
  1393. }
  1394.  
  1395. sub to_attribute_cast {
  1396.         my $type = shift;
  1397.         my $ret = get_prefix($type);
  1398.         $ret =~ s/h_t_m_l/html/;
  1399.         return "(${ret} *)";
  1400. }
  1401.  
  1402. sub get_prefix {
  1403.         my $type = shift;
  1404.  
  1405.         if (exists $special_prefix{$type}) {
  1406.                 $prefix = $special_prefix{$type};
  1407.         } else {
  1408.                 $type =~ s/[A-Z]/_$&/g;
  1409.                 $prefix = lc $type;
  1410.                 $prefix = "dom".$prefix;
  1411.         }
  1412.         return $prefix;
  1413. }
  1414.  
  1415. # This function remain unsed
  1416. sub get_suffix {
  1417.         my $type = shift;
  1418.         my $suffix = "default";
  1419.  
  1420.         if (exists $override_suffix{$type}) {
  1421.                 $suffix = $override_suffix{$type};
  1422.         } else {
  1423.                 $type =~ s/[A-Z]/_$&/g;
  1424.                 $suffix = lc $type;
  1425.                 $suffix = "dom".$suffix;
  1426.         }
  1427.         return $suffix;
  1428. }
  1429.  
  1430. #asserttions sometimes can contain sub-statements according the DTD. Like
  1431. #<assertEquals ..>
  1432. # <stat1 />
  1433. # <stat2 />
  1434. #</assertEquals>
  1435. #
  1436. # And assertion can contains assertions too! So, I use the assertion_stack
  1437. # to deal:
  1438. #
  1439. # when we encounter an assertion, we push $assertionName, "end", "start" to
  1440. # the stack, and when we encounter a statement, we examine the stack to see
  1441. # the top element, if it is:
  1442. #
  1443. # 1. "start", then we are in sub-statement of that assertion, and this is the
  1444. #       the first sub-statement, so we should print a if (condtion==true) {, before
  1445. #       print the real statement.
  1446. # 2. "end", then we are in sub-statement of that assertion, and we are not the
  1447. #       first one, just print the statement.
  1448. #
  1449. # But after searching the whole testcases, I found no use of sub-statements of assertions.
  1450. # So, this function left unsed!
  1451.  
  1452. sub end_half_assertion {
  1453.         my ($self, $name) = @_;
  1454.  
  1455.         my $top = pop(@{$self->{assertion_stack}});
  1456.         if ($top eq "end") {
  1457.                 print "$self->{indent}"."}\n";
  1458.         } else {
  1459.                 if ($top eq "start") {
  1460.                         pop(@{$self->{assertion_stack}});
  1461.                         pop(@{$self->{assertion_stack}});
  1462.                 }
  1463.         }
  1464.  
  1465.         pop(@{$self->{assertion_stack}});
  1466. }
  1467. ### Enclose an unsed function
  1468. ##############################################################################################
  1469.  
  1470.  
  1471. sub cleanup_domvar {
  1472.         my ($self, $indent) = @_;
  1473.  
  1474.         my $str = join($indent, reverse @{$self->{unref}});
  1475.         print $indent.$str."\n";
  1476. }
  1477.  
  1478. sub cleanup_fail {
  1479.         my ($self, $indent) = @_;
  1480.  
  1481.         $self->cleanup_domstring($indent);
  1482.         $self->cleanup_domvar($indent);
  1483. }
  1484.  
  1485. sub cleanup {
  1486.         my $self = shift;
  1487.  
  1488.         print "\n\n";
  1489.         $self->cleanup_domstring("\t");
  1490.         $self->cleanup_domvar("\t");
  1491.         print "\n\tprintf(\"PASS\");\n";
  1492.         print "\n\treturn 0;\n";
  1493.         print "\n\}\n";
  1494. }
  1495.  
  1496. sub addto_cleanup {
  1497.         my ($self, $var) = @_;
  1498.  
  1499.         my $type = $self->{'var'}->{$var};
  1500.         if (not exists $no_unref{$type}) {
  1501.                 my $prefix = "dom_node";
  1502.                 if (exists $unref_prefix{$type}) {
  1503.                         $prefix = $unref_prefix{$type};
  1504.                 }
  1505.                 push(@{$self->{unref}}, $prefix."_unref(".$var.");\n");
  1506.         }
  1507. }
  1508.  
  1509. sub adjust_ignore {
  1510.         my $ig = shift;
  1511.  
  1512.         if ($ig eq "auto"){
  1513.                 return "true";
  1514.         }
  1515.         return $ig;
  1516. }
  1517.  
  1518. sub find_override {
  1519.         my ($self, $func, $var, $expected) = @_;
  1520.         my $vn = $self->{var}->{$var};
  1521.  
  1522.         # Deal with string types
  1523.         if ($expected eq "DOMString") {
  1524.                 return $func."_domstring";
  1525.         } else {
  1526.                 if ($expected =~ /^\"/ or $self->{"var"}->{$expected} eq "char *") {
  1527.                         return $func."_string";
  1528.                 }
  1529.         }
  1530.  
  1531.         if (exists $override_suffix{$vn}) {
  1532.                 $func = $func."_".$override_suffix{$vn}
  1533.         }
  1534.         return $func;
  1535. }
  1536.  
  1537. sub param_unref {
  1538.         my ($self, $var) = @_;
  1539.  
  1540.         my $type = $self->{'var'}->{$var};
  1541.         if (not exists $no_unref{$type}) {
  1542.                 my $prefix = "dom_node";
  1543.                 if (exists $unref_prefix{$type}) {
  1544.                         $prefix = $unref_prefix{$type};
  1545.                 }
  1546.                 print "\tif ($var != NULL) {\n";
  1547.                 print "\t\t" . $prefix."_unref(".$var.");\n";
  1548.                 print "\t\t$var = NULL;\n";
  1549.                 print "\t}\n";
  1550.         }
  1551.  
  1552.         foreach my $item (@{$self->{unref}}) {
  1553.                 $item =~ m/.*\((.*)\).*/;
  1554.                 if ($var eq $1) {
  1555.                         return 1;
  1556.                 }
  1557.         }
  1558.  
  1559.         foreach my $item (@{$self->{string_unref}}) {
  1560.                 if ($var eq $item) {
  1561.                         return 1;
  1562.                 }
  1563.         }
  1564.  
  1565.         return 0;
  1566. }
  1567.  
  1568. sub generate_domstring_interface {
  1569.         my ($self, $en, $a) = @_;
  1570.  
  1571.         switch ($en) {
  1572.                 case "length" {
  1573.                         print "$a->{'var'} = dom_string_length($a->{'obj'});";
  1574.                 }
  1575.  
  1576.                 else {
  1577.                         die "Can't generate method/attribute $en for DOMString";
  1578.                 }
  1579.         }
  1580. }
  1581.  
  1582. 1;
  1583.