/[suikacvs]/markup/html/whatpm/Whatpm/XML/Parser.pm
Suika

Diff of /markup/html/whatpm/Whatpm/XML/Parser.pm

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

revision 1.11 by wakaba, Wed Oct 15 08:05:47 2008 UTC revision 1.20 by wakaba, Sun Oct 19 09:25:21 2008 UTC
# Line 196  sub _initialize_tree_constructor ($) { Line 196  sub _initialize_tree_constructor ($) {
196    $self->{document}->manakai_is_html (0);    $self->{document}->manakai_is_html (0);
197    $self->{document}->set_user_data (manakai_source_line => 1);    $self->{document}->set_user_data (manakai_source_line => 1);
198    $self->{document}->set_user_data (manakai_source_column => 1);    $self->{document}->set_user_data (manakai_source_column => 1);
199    
200      $self->{ge}->{'amp;'} = {value => '&', only_text => 1};
201      $self->{ge}->{'apos;'} = {value => "'", only_text => 1};
202      $self->{ge}->{'gt;'} = {value => '>', only_text => 1};
203      $self->{ge}->{'lt;'} = {value => '<', only_text => 1};
204      $self->{ge}->{'quot;'} = {value => '"', only_text => 1};
205  } # _initialize_tree_constructor  } # _initialize_tree_constructor
206    
207  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 214  sub _terminate_tree_constructor ($) { Line 220  sub _terminate_tree_constructor ($) {
220    
221  ## XML5: No namespace support.  ## XML5: No namespace support.
222    
 ## XML5: XML5 has "empty tag token".  In this implementation, it is  
 ## represented as a start tag token with $self->{self_closing} flag  
 ## set to true.  
   
 ## XML5: XML5 has "short end tag token".  In this implementation, it  
 ## is represented as an end tag token with $token->{tag_name} flag set  
 ## to an empty string.  
   
223  ## XML5: Start, main, end phases.  In this implementation, they are  ## XML5: Start, main, end phases.  In this implementation, they are
224  ## represented by insertion modes.  ## represented by insertion modes.
225    
# Line 230  sub INITIAL_IM () { 0 } Line 228  sub INITIAL_IM () { 0 }
228  sub BEFORE_ROOT_ELEMENT_IM () { 1 }  sub BEFORE_ROOT_ELEMENT_IM () { 1 }
229  sub IN_ELEMENT_IM () { 2 }  sub IN_ELEMENT_IM () { 2 }
230  sub AFTER_ROOT_ELEMENT_IM () { 3 }  sub AFTER_ROOT_ELEMENT_IM () { 3 }
231    sub IN_SUBSET_IM () { 4 }
232    
233  {  {
234  my $token; ## TODO: change to $self->{t}  my $token; ## TODO: change to $self->{t}
# Line 269  sub _construct_tree ($) { Line 268  sub _construct_tree ($) {
268    while (1) {    while (1) {
269      if ($self->{insertion_mode} == IN_ELEMENT_IM) {      if ($self->{insertion_mode} == IN_ELEMENT_IM) {
270        $self->_tree_in_element;        $self->_tree_in_element;
271        } elsif ($self->{insertion_mode} == IN_SUBSET_IM) {
272          $self->_tree_in_subset;
273      } elsif ($self->{insertion_mode} == AFTER_ROOT_ELEMENT_IM) {      } elsif ($self->{insertion_mode} == AFTER_ROOT_ELEMENT_IM) {
274        $self->_tree_after_root_element;        $self->_tree_after_root_element;
275      } elsif ($self->{insertion_mode} == BEFORE_ROOT_ELEMENT_IM) {      } elsif ($self->{insertion_mode} == BEFORE_ROOT_ELEMENT_IM) {
# Line 295  sub _tree_initial ($) { Line 296  sub _tree_initial ($) {
296                
297        ## NOTE: Default value for both |public_id| and |system_id| attributes        ## NOTE: Default value for both |public_id| and |system_id| attributes
298        ## are empty strings, so that we don't set any value in missing cases.        ## are empty strings, so that we don't set any value in missing cases.
299        $doctype->public_id ($token->{public_identifier})        $doctype->public_id ($token->{pubid}) if defined $token->{pubid};
300            if defined $token->{public_identifier};        $doctype->system_id ($token->{sysid}) if defined $token->{sysid};
       $doctype->system_id ($token->{system_identifier})  
           if defined $token->{system_identifier};  
301                
302        ## TODO: internal_subset        ## TODO: internal_subset
303                
304        $self->{document}->append_child ($doctype);        $self->{document}->append_child ($doctype);
305          
306        $self->{insertion_mode} = BEFORE_ROOT_ELEMENT_IM;        $self->{ge} = {};
307    
308          ## XML5: No "has internal subset" flag.
309          if ($token->{has_internal_subset}) {
310            $self->{doctype} = $doctype;
311            $self->{insertion_mode} = IN_SUBSET_IM;
312          } else {
313            $self->{insertion_mode} = BEFORE_ROOT_ELEMENT_IM;
314          }
315        $token = $self->_get_next_token;        $token = $self->_get_next_token;
316        return;        return;
317      } elsif ($token->{type} == START_TAG_TOKEN or      } elsif ($token->{type} == START_TAG_TOKEN or
# Line 423  sub _tree_before_root_element ($) { Line 430  sub _tree_before_root_element ($) {
430        $el->set_user_data (manakai_source_column => $token->{column});        $el->set_user_data (manakai_source_column => $token->{column});
431    
432        my $has_attr;        my $has_attr;
433        for my $attr_name (sort {$a cmp $b} keys %{$token->{attributes}}) {        for my $attr_name (sort {$token->{attributes}->{$a}->{index} <=>
434                                   $token->{attributes}->{$b}->{index}}
435                             keys %{$token->{attributes}}) {
436          my $ns;          my $ns;
437          my ($p, $l) = split /:/, $attr_name, 2;          my ($p, $l) = split /:/, $attr_name, 2;
438    
# Line 444  sub _tree_before_root_element ($) { Line 453  sub _tree_before_root_element ($) {
453          }          }
454                    
455          if ($has_attr->{defined $ns ? $ns : ''}->{$l}) {          if ($has_attr->{defined $ns ? $ns : ''}->{$l}) {
456            ## NOTE: Attributes are sorted as Unicode characters (not            $ns = undef;
457            ## code units) of their names, for stable output.            ($p, $l) = (undef, $attr_name);
   
           ## TODO: Should be sorted by source order?  
           $self->{parse_error}->(level => $self->{level}->{must}, type => 'duplicate ns attr',  
                           token => $token,  
                           value => $attr_name);  
           next;  
458          } else {          } else {
459            $has_attr->{defined $ns ? $ns : ''}->{$l} = 1;            $has_attr->{defined $ns ? $ns : ''}->{$l} = 1;
460          }          }
# Line 608  sub _tree_in_element ($) { Line 611  sub _tree_in_element ($) {
611        $el->set_user_data (manakai_source_column => $token->{column});        $el->set_user_data (manakai_source_column => $token->{column});
612    
613        my $has_attr;        my $has_attr;
614        for my $attr_name (sort {$a cmp $b} keys %{$token->{attributes}}) {        for my $attr_name (sort {$token->{attributes}->{$a}->{index} <=>
615                                   $token->{attributes}->{$b}->{index}}
616                             keys %{$token->{attributes}}) {
617          my $ns;          my $ns;
618          my ($p, $l) = split /:/, $attr_name, 2;          my ($p, $l) = split /:/, $attr_name, 2;
619    
# Line 629  sub _tree_in_element ($) { Line 634  sub _tree_in_element ($) {
634          }          }
635                    
636          if ($has_attr->{defined $ns ? $ns : ''}->{$l}) {          if ($has_attr->{defined $ns ? $ns : ''}->{$l}) {
637            ## NOTE: Attributes are sorted as Unicode characters (not            $ns = undef;
638            ## code units) of their names, for stable output.            ($p, $l) = (undef, $attr_name);
   
           ## TODO: Should be sorted by source order?  
           $self->{parse_error}->(level => $self->{level}->{must}, type => 'duplicate ns attr',  
                           token => $token,  
                           value => $attr_name);  
           next;  
639          } else {          } else {
640            $has_attr->{defined $ns ? $ns : ''}->{$l} = 1;            $has_attr->{defined $ns ? $ns : ''}->{$l} = 1;
641          }          }
# Line 809  sub _tree_after_root_element ($) { Line 808  sub _tree_after_root_element ($) {
808    } # B    } # B
809  } # _tree_after_root_element  } # _tree_after_root_element
810    
811    sub _tree_in_subset ($) {
812      my $self = shift;
813    
814      B: while (1) {
815        if ($token->{type} == COMMENT_TOKEN) {
816          ## Ignore the token.
817    
818          ## Stay in the state.
819          $token = $self->_get_next_token;
820          next B;
821        } elsif ($token->{type} == ELEMENT_TOKEN) {
822          unless ($self->{doctype}->get_element_type_definition_node
823                    ($token->{name})) {
824            my $node = $self->{document}->create_element_type_definition
825                ($token->{name});
826            $node->set_user_data (manakai_source_line => $token->{line});
827            $node->set_user_data (manakai_source_column => $token->{column});
828            
829            $node->content_model_text (join '', @{$token->{content}})
830                if $token->{content};
831            
832            $self->{doctype}->set_element_type_definition_node ($node);
833          } else {
834            ## TODO: ...
835            
836          }
837    
838          ## Stay in the mode.
839          $token = $self->_get_next_token;
840          next B;
841        } elsif ($token->{type} == ATTLIST_TOKEN) {
842          my $ed = $self->{doctype}->get_element_type_definition_node
843              ($token->{name});
844          unless ($ed) {
845            $ed = $self->{document}->create_element_type_definition
846                ($token->{name});
847            $ed->set_user_data (manakai_source_line => $token->{line});
848            $ed->set_user_data (manakai_source_column => $token->{column});
849            $self->{doctype}->set_element_type_definition_node ($ed);
850          }
851    
852          for my $at (@{$token->{attrdefs}}) {
853            unless ($ed->get_attribute_definition_node ($at->{name})) {
854              my $node = $self->{document}->create_attribute_definition
855                  ($at->{name});
856              $node->set_user_data (manakai_source_line => $at->{line});
857              $node->set_user_data (manakai_source_column => $at->{column});
858    
859              my $type = defined $at->{type} ? {
860                CDATA => 1, ID => 2, IDREF => 3, IDREFS => 4, ENTITY => 5,
861                ENTITIES => 6, NMTOKEN => 7, NMTOKENS => 8, NOTATION => 9,
862              }->{$at->{type}} : 10;
863              if (defined $type) {
864                $node->declared_type ($type);
865              } else {
866                $self->{parse_error}->(level => $self->{level}->{must}, type => 'unknown declared type', ## TODO: type
867                                value => $at->{type},
868                                token => $at);
869              }
870              
871              push @{$node->allowed_tokens}, @{$at->{tokens}};
872              
873              my $default = defined $at->{default} ? {
874                FIXED => 1, REQUIRED => 2, IMPLIED => 3,
875              }->{$at->{default}} : 4;
876              if (defined $default) {
877                $node->default_type ($default);
878                if (defined $at->{value}) {
879                  if ($default == 1 or $default == 4) {
880                    #
881                  } elsif (length $at->{value}) {
882                    $self->{parse_error}->(level => $self->{level}->{must}, type => 'default value not allowed', ## TODO: type
883                                    token => $at);
884                  }
885                } else {
886                  if ($default == 1 or $default == 4) {
887                    $self->{parse_error}->(level => $self->{level}->{must}, type => 'default value not provided', ## TODO: type
888                                    token => $at);
889                  }
890                }
891              } else {
892                $self->{parse_error}->(level => $self->{level}->{must}, type => 'unknown default type', ## TODO: type
893                                value => $at->{default},
894                                token => $at);
895              }
896    
897              $node->text_content ($at->{value}) if defined $at->{value};
898    
899              $ed->set_attribute_definition_node ($node);
900            } else {
901              ## TODO: ...
902            }
903          } # $at
904    
905          ## Stay in the mode.
906          $token = $self->_get_next_token;
907          next B;
908        } elsif ($token->{type} == GENERAL_ENTITY_TOKEN) {
909          ## TODO: predefined entity names
910    
911          unless ($self->{ge}->{$token->{name}.';'}) {
912            ## For parser.
913            $self->{ge}->{$token->{name}.';'} = $token;
914            if (defined $token->{value} and
915                $token->{value} !~ /[&<]/) {
916              $token->{only_text} = 1;
917            }
918            
919            ## For DOM.
920            if (defined $token->{notation}) {
921              my $node = $self->{document}->create_general_entity ($token->{name});
922              $node->set_user_data (manakai_source_line => $token->{line});
923              $node->set_user_data (manakai_source_column => $token->{column});
924              
925              $node->public_id ($token->{pubid}); # may be undef
926              $node->system_id ($token->{sysid}); # may be undef
927              $node->notation_name ($token->{notation});
928              
929              $self->{doctype}->set_general_entity_node ($node);
930            }
931          } else {
932            ## TODO: ...
933            
934          }
935    
936          ## Stay in the mode.
937          $token = $self->_get_next_token;
938          next B;
939        } elsif ($token->{type} == PARAMETER_ENTITY_TOKEN) {
940          unless ($self->{pe}->{$token->{name}}) {
941            ## For parser.
942            $self->{pe}->{$token->{name}} = $token;
943          } else {
944            ## TODO: ...
945          }
946          
947          ## Stay in the mode.
948          $token = $self->_get_next_token;
949          next B;
950        } elsif ($token->{type} == NOTATION_TOKEN) {
951          unless ($self->{doctype}->get_notation_node
952                    ($token->{name})) {
953            my $node = $self->{document}->create_notation ($token->{name});
954            $node->set_user_data (manakai_source_line => $token->{line});
955            $node->set_user_data (manakai_source_column => $token->{column});
956            
957            $node->public_id ($token->{pubid}); # may be undef
958            $node->system_id ($token->{sysid}); # may be undef
959            
960            $self->{doctype}->set_notation_node ($node);
961          } else {
962            ## TODO: ...
963            
964          }
965    
966          ## Stay in the mode.
967          $token = $self->_get_next_token;
968          next B;
969        } elsif ($token->{type} == PI_TOKEN) {
970          my $pi = $self->{document}->create_processing_instruction
971              ($token->{target}, $token->{data});
972          $self->{doctype}->append_child ($pi);
973          ## TODO: line/col
974          
975          ## Stay in the mode.
976          $token = $self->_get_next_token;
977          next B;
978        } elsif ($token->{type} == END_OF_DOCTYPE_TOKEN) {
979          $self->{insertion_mode} = BEFORE_ROOT_ELEMENT_IM;
980          $token = $self->_get_next_token;
981          return;
982        } elsif ($token->{type} == ABORT_TOKEN) {
983          return;
984        } else {
985          die "$0: XML parser subset im: Unknown token type $token->{type}";
986        }
987      } # B
988    
989    } # _tree_in_subset
990    
991  }  }
992    
993  1;  1;
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.20
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24