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 ($$) {
  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 05:58:11 $
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}}) {
52	$new->{$lfname}->{$fver} = 1;
53	}
54	} elsif (defined $_[0]->{$fname}) {
55	$new->{lc $fname} = {''.$_[0]->{$fname} => 1};
56	}
57	}
58	return $new;
59	} else {
60	my @f = split /\s+/, $_[0];
61	## TODO: Definition of space ???
62	## TODO: How to parse features string into names and versions ???
63	my $new = {};
64	while (@f) {
65	my $fname = lc shift @f;
66	if (@f and $f[0] =~ /\A[\d\.]+\z/) {
67	$new->{$fname}->{shift @f} = 1;
68	} else {
69	$new->{$fname}->{''} = 1;
70	}
71	}
72	return $new;
73	}
74	} else {
75	return {};
76	}
77	} # _parse_features
78
79	package Message::IF::DOMImplementationSource;
80
81	=head1 LICENSE
82
83	Copyright 2007 Wakaba <w@suika.fam.cx>
84
85	This program is free software; you can redistribute it and/or
86	modify it under the same terms as Perl itself.
87
88	=cut
89
90	1;
91	## $Date: 2007/07/07 05:58:11 $