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	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}}) {
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	wakaba	1.2	## $Date: 2007/07/07 05:58:11 $