Parent Directory
| 
Revision Log
++ manakai/t/ChangeLog 7 Jul 2007 09:10:55 -0000 * DOM-Document.t: New test for ARRAY qualified name is added. Set |strict_error_checking| to false for a test not to be raised by |create_attribute_ns|. 2007-07-07 Wakaba <wakaba@suika.fam.cx> ++ manakai/lib/Message/DOM/ChangeLog 7 Jul 2007 09:09:46 -0000 * Attr.pm (create_attribute, create_attribute_ns): Implemented. * DOMDocument.pm: Load character classes from |Char::Class::XML|. (compat_mode): Check |defined| not to be warned as "uninitialized" when |{manakai_compat_mode}| is |undef|. * DOMException.pm (INVALID_CHARACTER_ERR, NAMESPACE_ERR): Added. * DOMImplementationRegistry.pm, DOMImplementationSource.pm: Statements to set |$Error::Depth| are removed since they are result in "uninitialized" warnings unless the |Message::DOM::DOMException| module is loaded earlier. Usually methods invoked in these methods does not raise any exception so that it makes no difference. 2007-07-07 Wakaba <wakaba@suika.fam.cx>
| 1 | wakaba | 1.1 | package Message::DOM::DOMImplementationSource; |
| 2 | use strict; | ||
| 3 | our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; | ||
| 4 | push our @ISA, 'Message::IF::DOMImplementationSource'; | ||
| 5 | |||
| 6 | $Message::DOM::DOMImplementationRegistry::SourceClass->{''.__PACKAGE__} = 1; | ||
| 7 | |||
| 8 | ## |DOMImplementationSource| methods | ||
| 9 | |||
| 10 | sub get_dom_implementation ($$) { | ||
| 11 | require Message::DOM::DOMImplementation; | ||
| 12 | my $r = Message::DOM::DOMImplementation->new; | ||
| 13 | |||
| 14 | my $features = _parse_features ($_[1]); | ||
| 15 | for my $feature (keys %$features) { | ||
| 16 | my $fkey = $feature; | ||
| 17 | my $plus = $feature =~ s/^\+// ? 1 : 0; | ||
| 18 | for my $version (keys %{$features->{$fkey}}) { | ||
| 19 | unless ($Message::DOM::DOMImplementation::HasFeature->{$feature} | ||
| 20 | ->{$version}) { | ||
| 21 | return undef; | ||
| 22 | } | ||
| 23 | } | ||
| 24 | } | ||
| 25 | |||
| 26 | return $r; | ||
| 27 | } # get_dom_implementation | ||
| 28 | |||
| 29 | sub get_dom_implementation_list ($$) { | ||
| 30 | require Message::DOM::DOMImplementationList; | ||
| 31 | my $list = bless [], 'Message::DOM::DOMImplementationList'; | ||
| 32 | my $dom = $_[0]->get_dom_implementation ($_[1]); | ||
| 33 | push @$list, $dom if defined $dom; | ||
| 34 | return $list; | ||
| 35 | } # get_dom_implementation_list | ||
| 36 | |||
| 37 | sub _parse_features ($) { | ||
| 38 | if (defined $_[0]) { | ||
| 39 | if (ref $_[0] eq 'HASH') { | ||
| 40 | my $new = {}; | ||
| 41 | for my $fname (keys %{$_[0]}) { | ||
| 42 | if (ref $_[0]->{$fname} eq 'HASH') { | ||
| 43 | my $lfname = lc $fname; | ||
| 44 | ## TODO: Feature names are case-insensitive, but | ||
| 45 | ## what kind of case-insensitivity? | ||
| 46 | for my $fver (keys %{$_[0]->{$fname}}) { | ||
| 47 | $new->{$lfname}->{$fver} = 1 if $_[0]->{$fname}->{$fver}; | ||
| 48 | } | ||
| 49 | } elsif (ref $_[0]->{$fname} eq 'ARRAY') { | ||
| 50 | my $lfname = lc $fname; | ||
| 51 | for my $fver (@{$_[0]->{$fname}}) { |