/[suikacvs]/messaging/manakai/lib/Message/DOM/DOMConfiguration.pm
Suika

Diff of /messaging/manakai/lib/Message/DOM/DOMConfiguration.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by wakaba, Thu Jun 21 14:57:53 2007 UTC revision 1.4 by wakaba, Sat Jul 14 09:19:11 2007 UTC
# Line 5  push our @ISA, 'Message::IF::DOMConfigur Line 5  push our @ISA, 'Message::IF::DOMConfigur
5  require Message::DOM::DOMException;  require Message::DOM::DOMException;
6    
7  use overload  use overload
8        '%{}' => sub {
9          tie my %list, ref $_[0], $_[0];
10          return \%list;
11        },
12      eq => sub {      eq => sub {
13        return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::DOMConfiguration');        return 0 unless UNIVERSAL::isa ($_[1], 'Message::DOM::DOMConfiguration');
14        return $${$_[0]} eq $${$_[1]};        return $${$_[0]} eq $${$_[1]};
# Line 18  sub ___report_error ($$) { Line 22  sub ___report_error ($$) {
22    $_[1]->throw;    $_[1]->throw;
23  } # ___report_error  } # ___report_error
24    
25    sub TIEHASH ($$) { $_[1] }
26    
27    ## TODO: Define Perl binding
28    
29    ## |DOMConfiguration| attribute
30    
31    my %names = (
32                 'error-handler' => 1,
33                 q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
34                 q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
35                 q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
36                 q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
37    );
38      ## http://suika.fam.cx/www/2006/dom-config/xml-id
39      ## xml-dtd
40    
41    sub parameter_names ($) {
42      require Message::DOM::DOMStringList;
43      return bless [sort {$a cmp $b} keys %names],
44          'Message::DOM::DOMStringList::StaticList';
45    } # parameter_names
46    
47  ## |DOMConfiguration| methods  ## |DOMConfiguration| methods
48    
49    sub can_set_parameter ($$;$) {
50      my $name = ''.$_[1];
51      if ({
52           q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
53           q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
54           q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
55           q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
56          }->{$name}) {
57        return 1;
58      } elsif ($name eq 'error-handler') {
59        return 1 unless defined $_[2];
60        return ref $_[2] eq 'CODE';
61      } else {
62        return 0;
63      }
64    } # can_set_parameter
65    
66  sub get_parameter ($$) {  sub get_parameter ($$) {
67    return ${$${$_[0]}}->{$_[1]};    my $name = ''.$_[1];
68      if ({
69           q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
70           q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
71           q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
72           q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
73           'error-handler' => 1,
74          }->{$name}) {
75        return ${$${$_[0]}}->{$name};    
76      } else {
77        report Message::DOM::DOMException
78            -object => $_[0],
79            -type => 'NOT_FOUND_ERR',
80            -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
81      }
82  } # get_parameter  } # get_parameter
83    *FETCH = \&get_parameter;
84    
85    ## TODO: Should we allow $cfg->{error_handler}?
86    
87  sub set_parameter ($$;$) {  sub set_parameter ($$;$) {
88      my $name = ''.$_[1];
89    if (defined $_[2]) {    if (defined $_[2]) {
90      ${$${$_[0]}}->{$_[1]} = $_[2];      if ({
91             q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
92             q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
93             q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
94             q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
95            }->{$name}) {
96          if ($_[2]) {
97            ${$${$_[0]}}->{$name} = 1;
98          } else {
99            delete ${$${$_[0]}}->{$name};
100          }
101        } elsif ($name eq 'error-handler') {
102          if (ref $_[2] eq 'CODE') {
103            ${$${$_[0]}}->{$name} = $_[2];
104          } else {
105            report Message::DOM::DOMException
106                -object => $_[0],
107                -type => 'TYPE_MISMATCH_ERR',
108                -subtype => 'CONFIGURATION_PARAMETER_TYPE_ERR';
109          }
110        } else {
111          report Message::DOM::DOMException
112              -object => $_[0],
113              -type => 'NOT_FOUND_ERR',
114              -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
115        }
116    } else {    } else {
117      if ($_[1] eq 'http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree' or      if ({
118          $_[1] eq 'http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute' or           q<http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree> => 1,
119          $_[1] eq 'http://suika.fam.cx/www/2006/dom-config/strict-document-children') {           q<http://suika.fam.cx/www/2006/dom-config/dtd-attribute-type> => 1,
120        ${$${$_[0]}}->{$_[1]} = 1;           q<http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute> => 1,
121             q<http://suika.fam.cx/www/2006/dom-config/strict-document-children> => 1,
122            }->{$name}) {
123          ${$${$_[0]}}->{$name} = 1;
124      } elsif ($_[1] eq 'error-handler') {      } elsif ($_[1] eq 'error-handler') {
125        ${$${$_[0]}}->{$_[1]} = sub { };        ${$${$_[0]}}->{$name} = sub ($) {
126            ## NOTE: Same as one set by |Document| constructor.
127            warn $_[0];
128            return $_[0]->severity != 3; # SEVERITY_FATAL_ERROR
129          };
130      } else {      } else {
131        delete ${$${$_[0]}}->{$_[1]};        report Message::DOM::DOMException
132              -object => $_[0],
133              -type => 'NOT_FOUND_ERR',
134              -subtype => 'UNRECOGNIZED_CONFIGURATION_PARAMETER_ERR';
135      }      }
136    }    }
137    ## http://suika.fam.cx/www/2006/dom-config/clone-entity-reference-subtree    return undef;
   ## http://suika.fam.cx/www/2006/dom-config/dtd-default-attribute  
   ## http://suika.fam.cx/www/2006/dom-config/xml-id  
   ## error-handler  
   ## xml-dtd  
   ## http://suika.fam.cx/www/2006/dom-config/strict-document-children  
138  } # set_parameter  } # set_parameter
139    *STORE = \&set_parameter;
140    
141    sub DELETE ($$) {
142      local $Error::Depth = $Error::Depth + 1;
143      $_[0]->set_parameter ($_[1] => undef);
144    } # DELETE
145    
146    sub EXISTS ($$) { exists $names{$_[1]} }
147    
148    sub FIRSTKEY ($) {
149      my $a = keys %names;
150      return each %names;
151    } # FIRSTKEY
152                  
153    sub NEXTKEY ($) {
154      return each %names;
155    } # NEXTKEY
156    
157  package Message::IF::DOMConfiguration;  package Message::IF::DOMConfiguration;
158    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24