Message/DOM/DOMImplementationSource.pm

package Message::DOM::DOMImplementationSource;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::IF::DOMImplementationSource';

$Message::DOM::DOMImplementationRegistry::SourceClass->{''.__PACKAGE__} = 1;

## |DOMImplementationSource| methods

sub get_dom_implementation ($$) {
  require Message::DOM::DOMImplementation;
  my $r = Message::DOM::DOMImplementation->new;

  my $features = _parse_features ($_[1]);
  for my $feature (keys %$features) {
    my $fkey = $feature;
    my $plus = $feature =~ s/^\+// ? 1 : 0;
    for my $version (keys %{$features->{$fkey}}) {
      unless ($Message::DOM::DOMImplementation::HasFeature->{$feature}
              ->{$version}) {
        return undef;
      }
    }
  }

  return $r;
} # get_dom_implementation

sub get_dom_implementation_list ($$) {
  local $Error::Depth = $Error::Depth + 1;
  require Message::DOM::DOMImplementationList;
  my $list = bless [], 'Message::DOM::DOMImplementationList';
  my $dom = $_[0]->get_dom_implementation ($_[1]);
  push @$list, $dom if defined $dom;
  return $list;
} # get_dom_implementation_list

sub _parse_features ($) {
  if (defined $_[0]) {
    if (ref $_[0] eq 'HASH') {
      my $new = {};
      for my $fname (keys %{$_[0]}) {
        if (ref $_[0]->{$fname} eq 'HASH') {
          my $lfname = lc $fname;
          ## TODO: Feature names are case-insensitive, but
          ## what kind of case-insensitivity?
          for my $fver (keys %{$_[0]->{$fname}}) {
            $new->{$lfname}->{$fver} = 1 if $_[0]->{$fname}->{$fver};
          }
        } elsif (ref $_[0]->{$fname} eq 'ARRAY') {
          my $lfname = lc $fname;
          for my $fver (@{$_[0]->{$fname}}) {
            $new->{$lfname}->{$fver} = 1;
          }
        } elsif (defined $_[0]->{$fname}) {
          $new->{lc $fname} = {''.$_[0]->{$fname} => 1};
        }
      }
      return $new;
    } else {
      my @f = split /\s+/, $_[0];
      ## TODO: Definition of space ???
      ## TODO: How to parse features string into names and versions ???
      my $new = {};
      while (@f) {
        my $fname = lc shift @f;
        if (@f and $f[0] =~ /\A[\d\.]+\z/) {
          $new->{$fname}->{shift @f} = 1;
        } else {
          $new->{$fname}->{''} = 1;
        }
      }
      return $new;
    }
  } else {
    return {};
  }
} # _parse_features

package Message::IF::DOMImplementationSource;

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1;
## $Date: 2007/07/07 04:47:29 $
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	local $Error::Depth = $Error::Depth + 1;
31	require Message::DOM::DOMImplementationList;
32	my $list = bless [], 'Message::DOM::DOMImplementationList';
33	my $dom = $_[0]->get_dom_implementation ($_[1]);
34	push @$list, $dom if defined $dom;
35	return $list;
36	} # get_dom_implementation_list
37
38	sub _parse_features ($) {
39	if (defined $_[0]) {
40	if (ref $_[0] eq 'HASH') {
41	my $new = {};
42	for my $fname (keys %{$_[0]}) {
43	if (ref $_[0]->{$fname} eq 'HASH') {
44	my $lfname = lc $fname;
45	## TODO: Feature names are case-insensitive, but
46	## what kind of case-insensitivity?
47	for my $fver (keys %{$_[0]->{$fname}}) {
48	$new->{$lfname}->{$fver} = 1 if $_[0]->{$fname}->{$fver};
49	}
50	} elsif (ref $_[0]->{$fname} eq 'ARRAY') {
51	my $lfname = lc $fname;
52	for my $fver (@{$_[0]->{$fname}}) {
53	$new->{$lfname}->{$fver} = 1;
54	}
55	} elsif (defined $_[0]->{$fname}) {
56	$new->{lc $fname} = {''.$_[0]->{$fname} => 1};
57	}
58	}
59	return $new;
60	} else {
61	my @f = split /\s+/, $_[0];
62	## TODO: Definition of space ???
63	## TODO: How to parse features string into names and versions ???
64	my $new = {};
65	while (@f) {
66	my $fname = lc shift @f;
67	if (@f and $f[0] =~ /\A[\d\.]+\z/) {
68	$new->{$fname}->{shift @f} = 1;
69	} else {
70	$new->{$fname}->{''} = 1;
71	}
72	}
73	return $new;
74	}
75	} else {
76	return {};
77	}
78	} # _parse_features
79
80	package Message::IF::DOMImplementationSource;
81
82	=head1 LICENSE
83
84	Copyright 2007 Wakaba <w@suika.fam.cx>
85
86	This program is free software; you can redistribute it and/or
87	modify it under the same terms as Perl itself.
88
89	=cut
90
91	1;
92	## $Date: 2007/07/07 04:47:29 $