/[suikacvs]/messaging/manakai/lib/Message/DOM/Node.pm
Suika

Diff of /messaging/manakai/lib/Message/DOM/Node.pm

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

revision 1.11 by wakaba, Sat Jul 7 15:05:01 2007 UTC revision 1.12 by wakaba, Sun Jul 8 05:42:37 2007 UTC
# Line 279  sub text_content ($;$) { Line 279  sub text_content ($;$) {
279    
280  ## |Node| methods  ## |Node| methods
281    
282    sub append_child ($$) {
283      ## NOTE: |Element|, |Entity|, |DocumentFragment|, |EntityReference|.
284      ## NOTE: |Document|, |Attr|, |CharacterData|, |AttributeDefinition|,
285      ## |Notation|, |ProcessingInstruction| |ElementTypeDefinition|,
286      ## and |DocumentType| define their own implementations.
287      my $self = $_[0];
288      
289      ## NOTE: Depends on $self->node_type:
290      my $self_od = $$self->{owner_document};
291    
292      ## -- Node Type check
293      my @new_child;
294      my $new_child_parent;
295      if ($_[1]->node_type == DOCUMENT_FRAGMENT_NODE) {
296        push @new_child, @{$_[1]->child_nodes};
297        $new_child_parent = $_[1];
298      } else {
299        @new_child = ($_[1]);
300        $new_child_parent = $_[1]->parent_node;
301      }
302    
303      ## NOTE: Depends on $self->node_type:
304      if ($$self_od->{strict_error_checking}) {
305        my $child_od = $_[1]->owner_document || $_[1]; # might be DocumentType
306        if ($self_od ne $child_od and $child_od->node_type != DOCUMENT_TYPE_NODE) {
307          report Message::DOM::DOMException
308              -object => $self,
309              -type => 'WRONG_DOCUMENT_ERR',
310              -subtype => 'EXTERNAL_OBJECT_ERR';
311        }
312    
313        if ($$self->{manakai_read_only} or
314            (@new_child and defined $new_child_parent and
315             $$new_child_parent->{manakai_read_only})) {
316          report Message::DOM::DOMException
317              -object => $self,
318              -type => 'NO_MODIFICATION_ALLOWED_ERR',
319              -subtype => 'READ_ONLY_NODE_ERR';
320        }
321    
322        ## NOTE: |Document| has children order check here.
323    
324        for my $cn (@new_child) {
325          unless ({
326                   TEXT_NODE, 1, ENTITY_REFERENCE_NODE, 1,
327                   ELEMENT_NODE, 1, CDATA_SECTION_NODE, 1,
328                   PROCESSING_INSTRUCTION_NODE, 1, COMMENT_NODE, 1,
329                  }->{$cn->node_type}) {
330            report Message::DOM::DOMException
331                -object => $self,
332                -type => 'HIERARCHY_REQUEST_ERR',
333                -subtype => 'CHILD_NODE_TYPE_ERR';
334          }
335        }
336    
337        my $anode = $self;
338        while (defined $anode) {
339          if ($anode eq $_[1]) {
340            report Message::DOM::DOMException
341                -object => $self,
342                -type => 'HIERARCHY_REQUEST_ERR',
343                -subtype => 'ANCESTOR_NODE_ERR';
344          }
345          $anode = $$anode->{parent_node};
346        }
347      }
348    
349      ## NOTE: "Insert at" code only in insert_before and replace_child
350    
351      ## -- Removes from parent
352      if ($new_child_parent) {
353        if (@new_child == 1) {
354          my $v = $$new_child_parent->{child_nodes};
355          RP: for my $i (0..$#$v) {
356            if ($v->[$i] eq $new_child[0]) {
357              splice @$v, $i, 1, ();
358              last RP;
359            }
360          } # RP
361        } else {
362          @{$$new_child_parent->{child_nodes}} = ();
363        }
364      }
365    
366      ## -- Rewrite the |parentNode| properties
367      for my $nc (@new_child) {
368        $$nc->{parent_node} = $self;
369        Scalar::Util::weaken ($$nc->{parent_node});
370      }
371    
372      ## NOTE: Depends on method:
373      push @{$$self->{child_nodes}}, @new_child;
374    
375      ## NOTE: Setting |owner_document| in |Document|.
376    
377      return $_[1];
378    } # apepnd_child
379    
380  sub clone_node ($;$) {  sub clone_node ($;$) {
381    my ($self, $deep) = @_;    my ($self, $deep) = @_;
382    
# Line 606  sub has_child_nodes ($) { Line 704  sub has_child_nodes ($) {
704    return (@{${$_[0]}->{child_nodes} or []} > 0);    return (@{${$_[0]}->{child_nodes} or []} > 0);
705  } # has_child_nodes  } # has_child_nodes
706    
707    sub insert_before ($$) {
708      ## NOTE: |Element|, |Entity|, |DocumentFragment|, |EntityReference|.
709      ## NOTE: |Document|, |Attr|, |CharacterData|, |AttributeDefinition|,
710      ## |Notation|, |ProcessingInstruction|, |ElementTypeDefinition|,
711      ## and |DocumentType| define their own implementations.
712      my $self = $_[0];
713    
714      ## NOTE: Depends on $self->node_type:
715      my $self_od = $$self->{owner_document};
716    
717      ## -- Node Type check
718      my @new_child;
719      my $new_child_parent;
720      if ($_[1]->node_type == DOCUMENT_FRAGMENT_NODE) {
721        push @new_child, @{$_[1]->child_nodes};
722        $new_child_parent = $_[1];
723      } else {
724        @new_child = ($_[1]);
725        $new_child_parent = $_[1]->parent_node;
726      }
727    
728      ## NOTE: Depends on $self->node_type:
729      if ($$self_od->{strict_error_checking}) {
730        my $child_od = $_[1]->owner_document || $_[1]; # might be DocumentType
731        if ($self_od ne $child_od and $child_od->node_type != DOCUMENT_TYPE_NODE) {
732          report Message::DOM::DOMException
733              -object => $self,
734              -type => 'WRONG_DOCUMENT_ERR',
735              -subtype => 'EXTERNAL_OBJECT_ERR';
736        }
737    
738        if ($$self->{manakai_read_only} or
739            (@new_child and defined $new_child_parent and
740             $$new_child_parent->{manakai_read_only})) {
741          report Message::DOM::DOMException
742              -object => $self,
743              -type => 'NO_MODIFICATION_ALLOWED_ERR',
744              -subtype => 'READ_ONLY_NODE_ERR';
745        }
746    
747        ## NOTE: |Document| has children order check here.
748    
749        for my $cn (@new_child) {
750          unless ({
751                   TEXT_NODE, 1, ENTITY_REFERENCE_NODE, 1,
752                   ELEMENT_NODE, 1, CDATA_SECTION_NODE, 1,
753                   PROCESSING_INSTRUCTION_NODE, 1, COMMENT_NODE, 1,
754                  }->{$cn->node_type}) {
755            report Message::DOM::DOMException
756                -object => $self,
757                -type => 'HIERARCHY_REQUEST_ERR',
758                -subtype => 'CHILD_NODE_TYPE_ERR';
759          }
760        }
761    
762        my $anode = $self;
763        while (defined $anode) {
764          if ($anode eq $_[1]) {
765            report Message::DOM::DOMException
766                -object => $self,
767                -type => 'HIERARCHY_REQUEST_ERR',
768                -subtype => 'ANCESTOR_NODE_ERR';
769          }
770          $anode = $$anode->{parent_node};
771        }
772      }
773      
774      ## -- Insert at... ## NOTE: Only in insert_before and replace_child
775      my $index = -1; # last
776      if (defined $_[2]) {
777        ## error if $_[1] eq $_[2];
778        
779        my $cns = $self->child_nodes;
780        my $cnsl = @$cns;
781        C: {
782          $index = 0;
783          for my $i (0..($cnsl-1)) {
784            my $cn = $cns->[$i];
785            if ($cn eq $_[2]) {
786              $index += $i;
787              last C;
788            } elsif ($cn eq $_[1]) {
789              $index = -1; # offset
790            }
791          }
792          
793          report Message::DOM::DOMException
794              -object => $self,
795              -type => 'NOT_FOUND_ERR',
796              -subtype => 'NOT_CHILD_ERR';
797        } # C
798      }
799      ## NOTE: "else" only in replace_child
800    
801      ## -- Removes from parent
802      if ($new_child_parent) {
803        if (@new_child == 1) {
804          my $v = $$new_child_parent->{child_nodes};
805          RP: for my $i (0..$#$v) {
806            if ($v->[$i] eq $new_child[0]) {
807              splice @$v, $i, 1, ();
808              last RP;
809            }
810          } # RP
811        } else {
812          @{$$new_child_parent->{child_nodes}} = ();
813        }
814      }
815    
816      ## -- Rewrite the |parentNode| properties
817      for my $nc (@new_child) {
818        $$nc->{parent_node} = $self;
819        Scalar::Util::weaken ($$nc->{parent_node});
820      }
821    
822      ## NOTE: Depends on method:
823      if ($index == -1) {
824        push @{$$self->{child_nodes}}, @new_child;
825      } else {
826        splice @{$$self->{child_nodes}}, $index, 0, @new_child;
827      }
828    
829      ## NOTE: Setting |owner_document| in |Document|.
830    
831      return $_[1];
832    } # insert_before
833    
834  sub is_equal_node ($$) {  sub is_equal_node ($$) {
835    local $Error::Depth = $Error::Depth + 1;    local $Error::Depth = $Error::Depth + 1;
836    
# Line 657  sub is_supported ($$;$) { Line 882  sub is_supported ($$;$) {
882    return $Message::DOM::DOMImplementation::HasFeature->{$feature}->{$version};    return $Message::DOM::DOMImplementation::HasFeature->{$feature}->{$version};
883  } # is_supported;  } # is_supported;
884    
 ## NOTE: Only applied to Elements and Documents  
 sub append_child ($$) {  
   my ($self, $new_child) = @_;  
   if (defined $$new_child->{parent_node}) {  
     my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};  
     for (0..$#$parent_list) {  
       if ($parent_list->[$_] eq $new_child) {  
         splice @$parent_list, $_, 1;  
         last;  
       }  
     }  
   }  
   push @{$$self->{child_nodes}}, $new_child;  
   $$new_child->{parent_node} = $self;  
   Scalar::Util::weaken ($$new_child->{parent_node});  
   ## TODO:  
   $$new_child->{owner_document} = $self if $self->node_type == DOCUMENT_NODE;  
   return $new_child;  
 } # append_child  
   
885  sub manakai_append_text ($$) {  sub manakai_append_text ($$) {
886    ## NOTE: For |Element|, |Attr|, |Entity|, |EntityReference|,    ## NOTE: For |Element|, |Attr|, |Entity|, |EntityReference|,
887    ## |DocumentFragment|, and |AttributeDefinition|.  In addition,    ## |DocumentFragment|, and |AttributeDefinition|.  In addition,
# Line 696  sub manakai_append_text ($$) { Line 901  sub manakai_append_text ($$) {
901    }    }
902  } # manakai_append_text  } # manakai_append_text
903    
 ## NOTE: Only applied to Elements and Documents  
 sub insert_before ($$;$) {  
   my ($self, $new_child, $ref_child) = @_;  
   if (defined $$new_child->{parent_node}) {  
     my $parent_list = ${$$new_child->{parent_node}}->{child_nodes};  
     for (0..$#$parent_list) {  
       if ($parent_list->[$_] eq $new_child) {  
         splice @$parent_list, $_, 1;  
         last;  
       }  
     }  
   }  
   my $i = @{$$self->{child_nodes}};  
   if (defined $ref_child) {  
     for (0..$#{$$self->{child_nodes}}) {  
       if ($$self->{child_nodes}->[$_] eq $ref_child) {  
         $i = $_;  
         last;  
       }  
     }  
   }  
   splice @{$$self->{child_nodes}}, $i, 0, $new_child;  
   $$new_child->{parent_node} = $self;  
   Scalar::Util::weaken ($$new_child->{parent_node});  
   return $new_child;  
 } # insert_before  
   
904  sub is_default_namespace ($$) {  sub is_default_namespace ($$) {
905    ## TODO: Document that ElementTypeDefinition and AttributeDefinition    ## TODO: Document that ElementTypeDefinition and AttributeDefinition
906    ## are same as DocumentType    ## are same as DocumentType
# Line 933  sub normalize ($) { Line 1111  sub normalize ($) {
1111    ## is not reverted.    ## is not reverted.
1112  } # normalize  } # normalize
1113    
 ## NOTE: Only applied to Elements and Documents  
1114  sub remove_child ($$) {  sub remove_child ($$) {
1115    my ($self, $old_child) = @_;    my ($self, $old_child) = @_;
1116    my $parent_list = $$self->{child_nodes};  
1117      if ($$self->{manakai_read_only} and
1118          ${$$self->{owner_document} or $self}->{strict_error_checking}) {
1119        report Message::DOM::DOMException
1120            -object => $self,
1121            -type => 'NO_MODIFICATION_ALLOWED_ERR',
1122            -subtype => 'READ_ONLY_NODE_ERR';
1123      }
1124    
1125      my $parent_list = $$self->{child_nodes} || [];
1126    for (0..$#$parent_list) {    for (0..$#$parent_list) {
1127      if ($parent_list->[$_] eq $old_child) {      if ($parent_list->[$_] eq $old_child) {
1128        splice @$parent_list, $_, 1;        splice @$parent_list, $_, 1, ();
1129        last;        delete $$old_child->{parent_node};
1130          return $old_child;
1131      }      }
1132    }    }
1133    delete $$old_child->{parent_node};  
1134    return $old_child;    report Message::DOM::DOMException
1135          -object => $self,
1136          -type => 'NOT_FOUND_ERR',
1137          -subtype => 'NOT_CHILD_ERR';
1138  } # remove_child  } # remove_child
1139    
1140    sub replace_child ($$) {
1141      ## NOTE: |Element|, |Entity|, |DocumentFragment|, |EntityReference|.
1142      ## NOTE: |Document|, |Attr|, |CharacterData|, |AttributeDefinition|,
1143      ## |Notation|, |ProcessingInstruction|, |ElementTypeDefinition|,
1144      ## and |DocumentType| define their own implementations.
1145      my $self = $_[0];
1146    
1147      ## NOTE: Depends on $self->node_type:
1148      my $self_od = $$self->{owner_document};
1149    
1150      ## -- Node Type check
1151      my @new_child;
1152      my $new_child_parent;
1153      if ($_[1]->node_type == DOCUMENT_FRAGMENT_NODE) {
1154        push @new_child, @{$_[1]->child_nodes};
1155        $new_child_parent = $_[1];
1156      } else {
1157        @new_child = ($_[1]);
1158        $new_child_parent = $_[1]->parent_node;
1159      }
1160    
1161      ## NOTE: Depends on $self->node_type:
1162      if ($$self_od->{strict_error_checking}) {
1163        my $child_od = $_[1]->owner_document || $_[1]; # might be DocumentType
1164        if ($self_od ne $child_od and $child_od->node_type != DOCUMENT_TYPE_NODE) {
1165          report Message::DOM::DOMException
1166              -object => $self,
1167              -type => 'WRONG_DOCUMENT_ERR',
1168              -subtype => 'EXTERNAL_OBJECT_ERR';
1169        }
1170    
1171        if ($$self->{manakai_read_only} or
1172            (@new_child and defined $new_child_parent and
1173             $$new_child_parent->{manakai_read_only})) {
1174          report Message::DOM::DOMException
1175              -object => $self,
1176              -type => 'NO_MODIFICATION_ALLOWED_ERR',
1177              -subtype => 'READ_ONLY_NODE_ERR';
1178        }
1179    
1180        ## NOTE: |Document| has children order check here.
1181    
1182        for my $cn (@new_child) {
1183          unless ({
1184                   TEXT_NODE, 1, ENTITY_REFERENCE_NODE, 1,
1185                   ELEMENT_NODE, 1, CDATA_SECTION_NODE, 1,
1186                   PROCESSING_INSTRUCTION_NODE, 1, COMMENT_NODE, 1,
1187                  }->{$cn->node_type}) {
1188            report Message::DOM::DOMException
1189                -object => $self,
1190                -type => 'HIERARCHY_REQUEST_ERR',
1191                -subtype => 'CHILD_NODE_TYPE_ERR';
1192          }
1193        }
1194    
1195        my $anode = $self;
1196        while (defined $anode) {
1197          if ($anode eq $_[1]) {
1198            report Message::DOM::DOMException
1199                -object => $self,
1200                -type => 'HIERARCHY_REQUEST_ERR',
1201                -subtype => 'ANCESTOR_NODE_ERR';
1202          }
1203          $anode = $$anode->{parent_node};
1204        }
1205      }
1206      
1207      ## -- Insert at... ## NOTE: Only in insertBefore and replaceChild
1208      my $index = -1; # last
1209      if (defined $_[2]) {
1210        ## error if $_[1] eq $_[2];
1211        
1212        my $cns = $self->child_nodes;
1213        my $cnsl = @$cns;
1214        C: {
1215          $index = 0;
1216          for my $i (0..($cnsl-1)) {
1217            my $cn = $cns->[$i];
1218            if ($cn eq $_[2]) {
1219              $index += $i;
1220              last C;
1221            } elsif ($cn eq $_[1]) {
1222              $index = -1; # offset
1223            }
1224          }
1225          
1226          report Message::DOM::DOMException
1227              -object => $self,
1228              -type => 'NOT_FOUND_ERR',
1229              -subtype => 'NOT_CHILD_ERR';
1230        } # C
1231      } else {
1232        ## NOTE: Only in replaceChild
1233        report Message::DOM::DOMException
1234            -object => $self,
1235            -type => 'NOT_FOUND_ERR',
1236            -subtype => 'NOT_CHILD_ERR';
1237      }
1238    
1239      ## -- Removes from parent
1240      if ($new_child_parent) {
1241        if (@new_child == 1) {
1242          my $v = $$new_child_parent->{child_nodes};
1243          RP: for my $i (0..$#$v) {
1244            if ($v->[$i] eq $new_child[0]) {
1245              splice @$v, $i, 1, ();
1246              last RP;
1247            }
1248          } # RP
1249        } else {
1250          @{$$new_child_parent->{child_nodes}} = ();
1251        }
1252      }
1253    
1254      ## -- Rewrite the |parentNode| properties
1255      for my $nc (@new_child) {
1256        $$nc->{parent_node} = $self;
1257        Scalar::Util::weaken ($$nc->{parent_node});
1258      }
1259    
1260      ## NOTE: Depends on method:
1261      splice @{$$self->{child_nodes}}, $index, 1, @new_child;
1262      delete ${$_[2]}->{parent_node};
1263    
1264      ## NOTE: Setting |owner_document| in |Document|.
1265    
1266      return $_[2];
1267    } # replace_child
1268    
1269  sub manakai_set_read_only ($;$$) {  sub manakai_set_read_only ($;$$) {
1270    my $value = 1 if $_[1];    my $value = 1 if $_[1];
1271    if ($_[2]) {    if ($_[2]) {
# Line 1001  sub set_user_data ($$$;$) { Line 1320  sub set_user_data ($$$;$) {
1320    
1321      if (defined $handler) {      if (defined $handler) {
1322        eval q{        eval q{
1323            no warnings;
1324          sub DESTROY {          sub DESTROY {
1325            my $uds = ${$_[0]}->{user_data};            my $uds = ${$_[0]}->{user_data};
1326            for my $key (keys %$uds) {            for my $key (keys %$uds) {
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24