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	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			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 $