#!/usr/bin/perl ## This file is automatically generated ## at 2006-04-03T13:41:55+00:00, ## from file "DIS.dis", ## module , ## for . ## Don't edit by hand! use strict; require Message::DOM::DOMCore; require Message::DOM::DOMFeature; require Message::Markup::SuikaWikiConfig21; require Message::Util::DIS::Perl; require Message::Util::DIS::Value; require Message::Util::Error; require Message::Util::Error::DOMException; require Message::Util::ManakaiNode; package Message::Util::DIS; our $VERSION = 20060403.1341; $Message::DOM::DOMCore::ManakaiDOMConfiguration{'Message::Util::IFLatest::DISDatabase'}->{'error-handler'} = {'checker', sub ($$$) { my ($self, $name, $value) = @_; { $name = lc $name; } { $value = bless $value, 'Message::DOM::DOMCore::ManakaiDOMErrorHandler' if ref $value eq 'CODE'; } my $r = 0; { $r = UNIVERSAL::isa ($value, 'Message::DOM::IFLatest::DOMErrorHandler' ); } $r} , 'get_default', sub ($$) { my ($self, $name) = @_; { $name = lc $name; } my $r; { $r = sub { my (undef, $err) = @_; CORE::warn $err; return ($err-> severity != '3' ); }; } { $r = bless $r, 'Message::DOM::DOMCore::ManakaiDOMErrorHandler' if ref $r eq 'CODE'; } $r} , 'iname', 'onerr', 'otype', 'Message::DOM::IFLatest::DOMErrorHandler', 'setter', sub ($$$) { my ($self, $name, $value) = @_; { $name = lc $name; } { $value = bless $value, 'Message::DOM::DOMCore::ManakaiDOMErrorHandler' if ref $value eq 'CODE'; } { $self->[1]->{ 'onerr' } = $value; } } , 'type', 'object'}; $Message::DOM::DOMCore::ManakaiDOMError::Def{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#more-than-one-methods-for-a-type'} = {'description', 'Method |%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#method-name});| for resource <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});> has multiple definitions', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/Core/textFormatter', 'Message::Util::Error::formatter', 'sev', '1', 't', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#more-than-one-methods-for-a-type'}; $Message::Util::DIS::Method{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#Interface'}->{'get_error_interface_resource'} = sub ($) { my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { $r = $self; } ;} ; } $r} ; $Message::Util::DIS::Method{'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#ConstGroup'}->{'get_error_interface_resource'} = sub ($) { my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $parent = $self-> parent_resource ; if ($parent and $parent-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/ErrorAny' )) { $r = $parent; } } ;} ; } $r} ; $Message::Util::DIS::Method{'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DOMConfigurationParameter'}->{'get_dom_configuration_parameter_name'} = sub ($) { my ($self) = @_; my $r = ''; { { local $Error::Depth = $Error::Depth + 1; { $r = $self-> get_property_text ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#domConfigurationParameterName' ); unless (defined $r) { $r = $self-> name_uri ; } $r = lc $r if defined $r; } ;} ; } $r} ; $Message::Util::DIS::Method{'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#DOMConfigurationParameterApplication'}->{'get_dom_configuration_parameter_name'} = sub ($) { my ($self) = @_; my $r = ''; { { local $Error::Depth = $Error::Depth + 1; { my $cp = $self-> get_property_resource ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#domConfigurationParameter' ); if (defined $cp) { $r = $cp-> get_property_text ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#domConfigurationParameterName' ); unless (defined $r) { $r = $cp-> name_uri ; } $r = lc $r if defined $r; } else { $r = undef ; # error } } ;} ; } $r} ; $Message::Util::DIS::Method{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#ErrorCode'}->{'get_error_interface_resource'} = sub ($) { my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $parent = $self-> parent_resource ; if ($parent) { $r = $parent-> get_error_interface_resource ; } } ;} ; } $r} ; $Message::Util::DIS::Method{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#ErrorSubCode'}->{'get_error_interface_resource'} = sub ($) { my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $parent = $self-> get_error_code_resource ; if ($parent) { $r = $parent-> get_error_interface_resource ; } } ;} ; } $r} ; $Message::Util::DIS::Method{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#ErrorSubCode'}->{'get_error_code_resource'} = sub ($) { my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $parent = $self-> parent_resource ; if ($parent and $parent-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#ErrorCode' )) { $r = $parent; } } ;} ; } $r} ; sub HIERARCHY_REQUEST_ERR (); sub INVALID_SOURCE_ERR (); sub INVALID_STATE_ERR (); sub NOT_SUPPORTED_ERR (); sub AUTOLOAD { my $al = our $AUTOLOAD; $al =~ s/.+:://; if ({'HIERARCHY_REQUEST_ERR', 'Message::Util::IFLatest::DISException::HIERARCHY_REQUEST_ERR', 'INVALID_SOURCE_ERR', 'Message::Util::IFLatest::DISException::INVALID_SOURCE_ERR', 'INVALID_STATE_ERR', 'Message::Util::IFLatest::DISException::INVALID_STATE_ERR', 'NOT_SUPPORTED_ERR', 'Message::Util::IFLatest::DISException::NOT_SUPPORTED_ERR'}->{$al}) { no strict 'refs'; *{$AUTOLOAD} = \&{{'HIERARCHY_REQUEST_ERR', 'Message::Util::IFLatest::DISException::HIERARCHY_REQUEST_ERR', 'INVALID_SOURCE_ERR', 'Message::Util::IFLatest::DISException::INVALID_SOURCE_ERR', 'INVALID_STATE_ERR', 'Message::Util::IFLatest::DISException::INVALID_STATE_ERR', 'NOT_SUPPORTED_ERR', 'Message::Util::IFLatest::DISException::NOT_SUPPORTED_ERR'}->{$al}}; goto &{$AUTOLOAD}; } else { require Carp; Carp::croak (qq); } } sub import { my $self = shift; if (@_) { local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; $self->SUPER::import (@_); for (grep {not /\W/} @_) { eval qq{$_}; } } } our %EXPORT_TAG = ('DISExceptionCode', ['HIERARCHY_REQUEST_ERR', 'INVALID_SOURCE_ERR', 'INVALID_STATE_ERR', 'NOT_SUPPORTED_ERR']); our @EXPORT_OK = ('HIERARCHY_REQUEST_ERR', 'INVALID_SOURCE_ERR', 'INVALID_STATE_ERR', 'NOT_SUPPORTED_ERR'); use Exporter; push our @ISA, 'Exporter'; package Message::Util::IFLatest::DISImplementation; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISImplementation; our $VERSION = 20060403.1341; push our @ISA, 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGImplementation', 'Message::Util::DIS::Perl::ManakaiDISImplementationPerl', 'Message::Util::DIS::Value::ManakaiDISImplementationValue', 'Message::Util::IF::DISImplementation', 'Message::Util::IFLatest::DISImplementation'; sub create_dis_document ($) { my ($self) = @_; my $r; { $r = bless $self-> create_swcfg_document , 'Message::Util::DIS::ManakaiDISDocument' ; $r-> default_element_type_namespace_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' ); } $r} sub create_dis_parser ($) { my ($self) = @_; my $r; { $r = bless $self-> create_swcfg_parser , 'Message::Util::DIS::ManakaiDISParser' ; } $r} sub create_dis_database ($) { my ($self) = @_; my $r; { $r = bless { forDef => { 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' => bless ({ uri => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' , isa => { 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' => 1}, revISA => {}, 'r' => 0, }, 'Message::Util::DIS::ManakaiDISForDefinition' ), }, resDef => {}, modDef => {}, seq => 0, }, 'Message::Util::DIS::ManakaiDISDatabase' ; $r->{forDef}->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' }->{db} = $r; } $r} sub tfuris_to_uri ($;$$) { my ($self, $typeURI, $forURI) = @_; my $r; { $typeURI = 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#any' unless defined $typeURI; $forURI = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' unless defined $forURI; { if ($forURI eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $r = $typeURI; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $typeURI; my $__furi = $forURI; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $r = qq; } } ; } $r} sub _camel_case_to_underscore_name ($$) { my ($self, $camelName) = @_; my $r = ''; { $r = $camelName; $r =~ s/^([A-Z0-9]+)$/lc $1/ge; $r =~ s/([A-Z][A-Z0-9]*)$/"_".lc $1/ge; $r =~ s/([A-Z0-9])([A-Z0-9]*)([A-Z0-9])/$1.lc ($2)."_".lc $3/ge; $r =~ s/([A-Z])/"_".lc $1/ge; $r =~ s/(?=[0-9](?!$))/_/g; $r =~ tr/-/_/; } $r} $Message::DOM::ImplFeature{q}->{q}->{q<1.0>} ||= 1; $Message::DOM::ImplFeature{q}->{q}->{q<>} = 1; $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/www/2006/feature/min', {'', '1', '3.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#minimum', {'', '1', '3.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#perl', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#value', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#core', {'', '1', '2.1', '1'}}; $Message::DOM::ClassPoint{q} = 8.1; $Message::DOM::ManakaiDOMImplementationSource::SourceClass{q} = 1; $Message::DOM::DOMFeature::ClassInfo->{q}->{compat_class}->{q} = 1; $Message::Util::Grove::ClassProp{q} = {'v1h', ['lpmi']}; package Message::Util::IFLatest::DISParser; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISParser; our $VERSION = 20060403.1341; push our @ISA, 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGParser', 'Message::Markup::IFLatest::SWCFGParser', 'Message::Util::IF::DISParser', 'Message::Util::IFLatest::DISParser'; sub parse ($$) { my ($self, $input) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { $r = $self->SUPER::parse ($input) ## NOTE: Method name directly written #< M::swcfg21:ManakaiSWCFGParser # ::swcfg21:ForLatest.parse> ($input) } ;} ; if (defined $r) { $r = bless $r, 'Message::Util::DIS::ManakaiDISDocument' ; $r-> default_element_type_namespace_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' ); } } $r} sub new ($$$) { my ($self, $impl, $features) = @_; { { if (CORE::defined $features) { if (CORE::ref ($features) eq 'HASH') { my $__new = {}; for my $__fname (keys %{$features}) { if (CORE::ref ($features->{$__fname}) eq 'HASH') { my $__lfname = lc $__fname; for my $__fver (keys %{$features->{$__fname}}) { $__new->{$__lfname}->{$__fver} = $features->{$__fname}->{$__fver}; } } elsif (CORE::ref ($features->{$__fname}) eq 'ARRAY') { my $__lfname = lc $__fname; for my $__fver (@{$features->{$__fname}}) { $__new->{$__lfname}->{$__fver} = 1 ; } } else { $__new->{lc $__fname} = {(CORE::defined $features->{$__fname} ? $features->{$__fname} : '') => 1 }; } } $features = $__new; } else { my @__f = split /\s+/, $features; my $__new = {}; while (@__f) { my $__name = lc shift @__f; if (@__f and $__f[0] =~ /^[\d\.]+$/) { $__new->{$__name}->{shift @__f} = 1; } else { $__new->{$__name}->{''} = 1; } } $features = $__new; } } else { $features = {}; } } ; } my $r; { { local $Error::Depth = $Error::Depth + 1; { $r = $self->SUPER::new ($impl-> get_feature ( 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#Core' => '2.1'), $features); } ;} ; } $r} $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#core', {'', '1', '2.1', '1'}}; $Message::DOM::ClassPoint{q} = 3.1; $Message::DOM::DOMLS::ParserClass{q} = 1; package Message::Util::IFLatest::DISNode; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISNode; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::IF::DISNode', 'Message::Util::IFLatest::DISNode'; use Message::Util::Error; sub lookup_namespace_prefix ($;$%) { my ($self, $namespaceURI, %opt) = @_; my $r; { $r = undef ; my $od = $self-> owner_document || $self; my $binds = $od->{ 'node' }->{ 'swnsb' }; if (defined $namespaceURI) { FIND: { for my $prefix (keys %$binds) { if (defined $binds->{$prefix} and $binds->{$prefix} eq $namespaceURI) { $r = $prefix; last FIND; } } ## From module list try {local $Error::Depth = $Error::Depth + 3; my $db = $self-> owner_dis_document -> dis_database ; for my $mod_uri (keys %{$db->{modDef}}) { my $mod = $db-> get_module ($mod_uri); my $mod_ln = $mod-> local_name ; next if exists $binds->{$mod_ln}; my $ns_uri = $mod-> target_namespace_uri ; $ns_uri = '' unless defined $ns_uri; if ($ns_uri eq $namespaceURI) { $r = $mod_ln; last FIND; } } } catch Message::Util::IFLatest::DISException with { my $err = shift; $err->throw unless $err->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' } eq 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_ASSOCIATED_DB_ERR' ; }; last FIND unless $opt{make_new_binding}; ## Not found if ($namespaceURI =~ /(\w+)$/) { my $prefix = $1; unless (exists $binds->{$prefix}) { $binds->{$prefix} = $namespaceURI; $r = $prefix; last FIND; } } my $i = 1; { unless (exists $binds->{'ns'.$i}) { $binds->{$r = 'ns'.$i} = $namespaceURI; last FIND; } $i++; redo; } } # FIND } else { ## Null namespace FIND: { if (exists $binds->{'nu'.'ll'} and not defined $binds->{'nu'.'ll'}) { $r = 'nu'.'ll'; last FIND; } for my $prefix (keys %$binds) { if (not defined $prefix) { $r = $prefix; last FIND; } } last FIND unless $opt{make_new_binding}; ## Not found my $i = ''; { unless (exists $binds->{'nu'.'ll'.$i}) { $binds->{$r = 'nu'.'ll'.$i} = undef ; last FIND; } $i++; redo; } } } } $r} sub lookup_namespace_uri ($$%) { my ($self, $prefix, %opt) = @_; my $r; { my $od = $self-> owner_dis_document || $self; my $binds = $od->{ 'node' }->{ 'swnsb' }; if (exists $binds->{$prefix}) { $r = $binds->{$prefix}; } else { ## From module list FIND: { if ($od->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#disNamespaceResolver' }) { $r = $od->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#disNamespaceResolver' } ->($prefix); last FIND if defined $r; } try {local $Error::Depth = $Error::Depth + 3; my $db = $od-> dis_database ; for my $mod_uri (keys %{$db->{modDef}}) { my $mod = $db-> get_module ($mod_uri); if ($mod-> local_name eq $prefix) { $r = $mod-> target_namespace_uri ; last FIND; } } } catch Message::Util::IFLatest::DISException with { my $err = shift; $err->throw unless $err->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' } eq 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_ASSOCIATED_DB_ERR' ; }; if ($opt{make_new_binding}) { $r = $binds->{$prefix} = $prefix; } elsif ($opt{raise_prefix_exception}) { report Message::Markup::SuikaWikiConfig21::ManakaiSWCFGException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $self, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'lookup_namespace_uri', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNDECLARED_NS_PREFIX_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISNode', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'prefix'; ; } else { $r = undef ; } } # FIND } } $r} sub _get_node_reference ($$) { my ($self, $object) = @_; my $r; { my $class; if ($object->{ 'swnt' } eq '#element') { $class = 'Message::Util::DIS::ManakaiDISElement' ; } elsif ($object->{ 'swnt' } eq '#comment') { $class = 'Message::Util::DIS::ManakaiDISComment' ; } elsif ($object->{ 'swnt' } eq '#document') { $class = 'Message::Util::DIS::ManakaiDISDocument' ; } elsif ($object->{ 'swnt' } eq '#fragment') { $class = 'Message::Util::DIS::ManakaiDISDocumentFragment' ; } else { ; } { $object->{ 'rc' }++; ${$object->{ 'grc' }}++; $r = bless { 'node' => $object, }, $class; } ; } $r} sub owner_dis_document ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = Message::Util::DIS::ManakaiDISNode->_get_node_reference ($self->{ 'node' }->{ 'swod' }) if $self->{ 'node' }->{ 'swod' }; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISNode', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_dis_document'; } } $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::NSResolverDIS; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiNSResolverDIS; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::IF::NSResolverDIS', 'Message::Util::IFLatest::NSResolverDIS'; sub prefix_to_uri ($;$%) { my ($self, $prefix, %opt) = @_; my $r; { if (defined $prefix) { { local $Error::Depth = $Error::Depth + 1; { $r = $self-> lookup_namespace_uri ($prefix); } ;} ; unless (defined $r) { report Message::Markup::SuikaWikiConfig21::ManakaiSWCFGException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $opt{node}, '-type' => 'NAMESPACE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'prefix_to_uri', 'http://www.w3.org/2001/04/infoset#prefix' => $prefix, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNDECLARED_NS_PREFIX_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiNSResolverDIS', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#param-name' => 'prefix'; ; } } elsif (defined $self->{ 'node' } ->{ 'dns' }) { $r = $self->{ 'node' }->{ 'dns' }; } else { ## Default namespace { local $Error::Depth = $Error::Depth + 1; { $r = ($self-> owner_dis_document || $self) -> module_element -> defining_namespace_uri ; } ;} ; } } $r} sub qname_to_uri ($$%) { my ($self, $qname, %opt) = @_; my $r; { $qname =~ s/^\s+//; $qname =~ s/\s+$//; my ($prefix, $lname) = split /\s*[:|]\s*/, $qname, 2; { local $Error::Depth = $Error::Depth + 1; { if (defined $lname) { $r = $self-> prefix_to_uri ($prefix) . $lname; } else { ## In default namespace if (defined $opt{default_namespace_uri}) { $r = $opt{default_namespace_uri} . $prefix; } else { $r = $self-> prefix_to_uri ( undef ) . $prefix; } } } ;} ; } $r} sub qname_to_pair ($$%) { my ($self, $qname, %opt) = @_; my $r = []; { $qname =~ s/^\s+//; $qname =~ s/\s+$//; my ($prefix, $lname) = split /\s*[:|]\s*/, $qname, 2; { local $Error::Depth = $Error::Depth + 1; { if (defined $lname) { $r = [$self-> prefix_to_uri ($prefix), $lname]; } else { ## In default namespace $r = [$self-> prefix_to_uri ( undef ), $prefix]; } } ;} ; } $r} sub tfqnames_to_uri ($$;$$%) { my ($self, $tfqnames, $defaultTypeURI, $defaultForURI, %opt) = @_; my $r; { my ($typeq, $forq) = split /\s*[:|][:|]\s*/, $tfqnames, 2; my ($typeURI, $forURI); if (defined $forq) { { local $Error::Depth = $Error::Depth + 1; { $typeURI = $typeq eq '' ? defined $defaultTypeURI ? $defaultTypeURI : 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#any' : $self-> qname_to_uri ($typeq, %opt); } ;} ; if (length $forq) { $forURI = $self-> qname_to_uri ($forq, %opt); } else { $forURI = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ; } } else { ## "For" omitted { local $Error::Depth = $Error::Depth + 1; { $typeURI = $typeq eq '' ? defined $defaultTypeURI ? $defaultTypeURI : 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#any' : $self-> qname_to_uri ($typeq, %opt); } ;} ; $forURI = defined $defaultForURI ? $defaultForURI : 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ; } { if ($forURI eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $r = $typeURI; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $typeURI; my $__furi = $forURI; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $r = qq; } } ; } $r} sub tfpqnames_to_uri ($$;$$%) { my ($self, $tfpqnames, $defaultTypeURI, $defaultForURI, %opt) = @_; my $r; { my ($typeq, $forq, @forpq) = split /\s*[:|][:|]\s*/, $tfpqnames; my ($typeURI, $forURI); my $forpURI = []; undef $forq if defined $forq and $forq eq '+'; if (defined $forq) { { local $Error::Depth = $Error::Depth + 1; { $typeURI = $typeq eq '' ? defined $defaultTypeURI ? $defaultTypeURI : 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#any' : $self-> qname_to_uri ($typeq, %opt); if (length $forq) { $forURI = $self-> qname_to_uri ($forq, %opt); } else { $forURI = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ; } } ;} ; } else { ## "For" omitted { local $Error::Depth = $Error::Depth + 1; { $typeURI = $typeq eq '' ? defined $defaultTypeURI ? $defaultTypeURI : 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#any' : $self-> qname_to_uri ($typeq, %opt); } ;} ; $forURI = defined $defaultForURI ? $defaultForURI : 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ; } { local $Error::Depth = $Error::Depth + 1; { for my $forpq (@forpq) { push @$forpURI, $self-> qname_to_uri ($forpq, %opt); } } ;} ; { if ($forURI eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' and @{$forpURI} == 0) { $r = $typeURI; } elsif (@{$forpURI}) { my $__turi = $typeURI; my $__furi = $forURI; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } my @__fp; for my $__uri (@{$forpURI}) { my $__fpuri = $__uri; $__fpuri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])} {sprintf '%%%02X', ord $1}ge; push @__fp, $__fpuri; } $r = qq.join ('+', @__fp); } else { my $__turi = $typeURI; my $__furi = $forURI; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'(),*:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $r = qq; } } ; } $r} $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::DISElement; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISElement; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::DIS::ManakaiNSResolverDIS', 'Message::Util::DIS::ManakaiDISNode', 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGElement', 'Message::Util::DIS::Perl::ManakaiDISElementPerl', 'Message::Util::IF::DISElement', 'Message::Util::IFLatest::DISElement'; sub for_match ($$;$%) { my ($self, $forArg, $forpArg, %opt) = @_; my $r = 0; { $forArg = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' unless defined $forArg; $forpArg ||= []; FORMATCH: { { local $Error::Depth = $Error::Depth + 1; { my $for_res = ($opt{database_arg} ||= $self-> owner_dis_document -> dis_database ) -> get_for ($forArg); my $forp_res = [map { $opt{database_arg}-> get_for ($_) } @{$forpArg}]; my @ce = @{$self-> dis_all_child_elements }; for my $ce (@ce) { my $et = $ce-> expanded_uri ; if ($et eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ForCheck' ) { my $fors = [split /\s+/, $ce-> value ]; FCs: for my $f (@$fors) { if ($f =~ /^!=(.+)$/) { ## -- NOT EQUAL TO my $uri = $self-> qname_to_uri ($1); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); for my $arg_res ($for_res, @{$forp_res}) { if ($arg_res eq $for) { $r = 0 ; last FORMATCH; } } } elsif ($f =~ /^!(.+)$/) { ## -- NOT ISA my $uri = $self-> qname_to_uri ($1); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); for my $arg_res ($for_res, @{$forp_res}) { if ($arg_res-> isa_uri ($uri)) { $r = 0 ; last FORMATCH; } } } elsif ($f =~ /^=(.+)$/) { ## -- EQUAL TO my $uri = $self-> qname_to_uri ($1); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); for my $arg_res ($for_res, @{$forp_res}) { if ($arg_res eq $for) { next FCs; } } $r = 0 ; last FORMATCH; } else { ## -- ISA my $uri = $self-> qname_to_uri ($f); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); for my $arg_res ($for_res, @{$forp_res}) { if ($arg_res-> isa_uri ($uri)) { next FCs; } } $r = 0 ; last FORMATCH; } } # FCs } # dis:ForCheck } # children my $has_for = 0 ; for my $ce (@ce) { if ($ce-> expanded_uri eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--For' ) { my $fors = [split /\s+/, $ce-> value ]; my $ok = 1 ; $has_for = 1 ; AFOR: for my $f (@$fors) { if ($f =~ /^!=(.+)$/) { ## -- NOT EQUAL TO my $uri = $self-> qname_to_uri ($1); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); if ($for eq $for_res) { $ok = 0 ; last AFOR; } } elsif ($f =~ /^!(.+)$/) { ## -- NOT ISA my $uri = $self-> qname_to_uri ($1); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); if ($for_res-> isa_uri ($uri)) { $ok = 0 ; last AFOR; } } elsif ($f =~ /^=(.+)$/) { ## -- EQUAL TO my $uri = $self-> qname_to_uri ($1); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); unless ($for eq $for_res) { $ok = 0 ; last AFOR; } } else { ## -- ISA my $uri = $self-> qname_to_uri ($f); my $for = $opt{database_arg}-> get_for ($uri); $for-> is_referred ($ce); unless ($for_res-> isa_uri ($uri)){ $ok = 0 ; last AFOR; } } } # AFOR if ($ok) { $r = 1 ; last FORMATCH; } } # dis:For } # $ce $r = $has_for ? 0 : 1 ; } ;} ; } # FORMATCH } $r} sub media_type_match ($$;$%) { my ($self, $mediaType, $defaultMediaType, %opt) = @_; my $r = 0; { if (defined $mediaType) { { local $Error::Depth = $Error::Depth + 1; { my $ctn = $self-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'ContentType'); my $ct; $ct = $ctn-> qname_value_uri if $ctn; $ct = $defaultMediaType unless defined $ct; my $res = $self-> owner_dis_document -> dis_database -> get_resource ($ct); $res-> is_referred ($ctn or $self); unless ($res-> is_subset_of_uri ($mediaType)) { $r = 0 ; } else { $r = 1 ; } } ;} ; } else { $r = 1 ; } } $r} sub media_type_uri ($%) { my ($self, %opt) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { $r = $opt{default_media_type}; my $ctn = $self-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'ContentType'); $r = $ctn-> qname_value_uri if $ctn; } ;} ; } $r} sub dis_get_attribute ($$%) { my ($self, $attrName, %opt) = @_; my $r; { C: for my $c (@{$self-> dis_child_elements (for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $opt{database_arg})}) { if ($c-> expanded_uri eq $attrName and $c-> media_type_match ($opt{media_type}, $opt{default_media_type}, for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $opt{database_arg})) { $r = $c; last C; } } } $r} sub dis_get_attribute_list ($$%) { my ($self, $attrName, %opt) = @_; my $r; { $r = bless [], 'Message::Util::DIS::ManakaiDISElementList' ; for my $c (@{$self-> dis_child_elements (for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $opt{database_arg})}) { if ($c-> expanded_uri eq $attrName and $c-> media_type_match ($opt{media_type}, $opt{default_media_type}, for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $opt{database_arg})) { push @$r, $c; } } } $r} sub dis_child_elements ($%) { my ($self, %opt) = @_; my $r; { $r = bless [], 'Message::Util::DIS::ManakaiDISElementList' ; { local $Error::Depth = $Error::Depth + 1; { C: for my $cn (@{$self-> child_nodes }) { ## $cn is an #element. my $dn; { $cn->{'node'}->{ 'rc' }++; ${$cn->{'node'}->{ 'grc' }}++; $dn = bless { 'node' => $cn->{'node'}, }, 'Message::Util::DIS::ManakaiDISElement'; } ; next C unless $dn-> for_match ($opt{for_arg}, $opt{forp_arg}, database_arg => $opt{database_arg}); push @$r, $dn; } } ;} ; } $r} sub dis_all_child_elements ($) { my ($self) = @_; my $r; { $r = bless [], 'Message::Util::DIS::ManakaiDISElementList' ; { local $Error::Depth = $Error::Depth + 1; { for my $cn (@{$self-> child_nodes }) { ## $cn is an #element. my $dn; { $cn->{'node'}->{ 'rc' }++; ${$cn->{'node'}->{ 'grc' }}++; $dn = bless { 'node' => $cn->{'node'}, }, 'Message::Util::DIS::ManakaiDISElement'; } ; push @$r, $dn; } } ;} ; } $r} sub qname_value_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $v = $self-> value ; if (defined $v and not ref $v eq 'ARRAY') { $r = $self-> qname_to_uri ($v, node => $self); } else { $r = undef ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'qname_value_uri'; } } sub qname_value_local_name ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $v = $self-> value ; if (defined $v and not ref $v eq 'ARRAY') { my ($n, $v) = split /\s*[:|]\s*/, $v, 2; $r = defined $v ? $v : $n; } else { $r = undef ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'qname_value_local_name'; } } sub qname_value_prefix ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $v = $self-> value ; if (defined $v and not ref $v eq 'ARRAY') { my ($p, $l) = split /\s*[:|]\s*/, $v, 2; $r = defined $l ? $p : undef ; } else { $r = undef ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'qname_value_prefix'; } } sub qname_value_namespace_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $v = $self-> value ; if (defined $v and not ref $v eq 'ARRAY') { my ($p, $v) = split /\s*[:|]\s*/, $v, 2; $r = $self-> prefix_to_uri (defined $v ? $p : undef ); } else { $r = undef ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'qname_value_namespace_uri'; } } sub tfqnames_value_uri ($;$$%) { my ($self, $defaultTypeURI, $defaultForURI, %opt) = @_; my $r; { my $v = $self-> value ; if (defined $v and not ref $v eq 'ARRAY') { { local $Error::Depth = $Error::Depth + 1; { if ($self-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#TFPQNames' , 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#TFPQNames' , for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $opt{database_arg})) { $r = $self-> tfpqnames_to_uri ($v, $defaultTypeURI, $defaultForURI, node => $self); } else { $r = $self-> tfqnames_to_uri ($v, $defaultTypeURI, $defaultForURI, node => $self); } } ;} ; } else { $r = undef ; } } $r} sub element_type_match ($$%) { my ($self, $etype, %opt) = @_; my $r = 0; { { local $Error::Depth = $Error::Depth + 1; { my $et = $self-> expanded_uri ; my $rdef = $self-> owner_dis_document -> dis_database -> get_resource ($et); $r = $rdef-> is_subset_of_uri ($etype, srinfo => $opt{srinfo}); } ;} ; } $r} sub is_resource_element ($;$) { if (@_ == 1) {my ($self) = @_; my $r = 0; { { local $Error::Depth = $Error::Depth + 1; { $r = ($self-> expanded_uri eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ResourceDef' ); } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'is_resource_element'; } } sub is_property_element ($%) { my ($self, %opt) = @_; my $r = 0; { { local $Error::Depth = $Error::Depth + 1; { my $xn = $self-> expanded_uri ; if ($xn eq 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#resourceType' or $xn eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' ) { $r = 1 ; } else { my $rdef = ($opt{database_arg} or $self-> owner_dis_document -> dis_database ) -> get_resource ($xn); $r = $rdef-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Source#Property' ) || $rdef-> is_type_uri ( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#Property' ); ## TODO: Remove this. } } ;} ; } $r} sub get_feature ($$$) { my ($self, $feature, $version) = @_; { $feature = lc $feature; } { $version = '' unless defined $version; } my $r; { $feature =~ s/^\+//; CLASS: for my $class (grep { $Message::Util::DIS::ManakaiDISElement::CompatClass{$_} } keys %Message::Util::DIS::ManakaiDISElement::CompatClass) { if ($Message::DOM::ClassFeature{$class}->{$feature}->{$version}) { { $self->{'node'}->{ 'rc' }++; ${$self->{'node'}->{ 'grc' }}++; $r = bless { 'node' => $self->{'node'}, }, $class; } ; last CLASS; } } } $r} sub unlink_from_document ($$) { my ($self, $databaseArg) = @_; { { local $Error::Depth = $Error::Depth + 1; { my $ods = $self->{ 'node' }->{ 'swod' }; $self->{ 'node' }->{ 'swnsb' } = $self-> get_namespace_binding_list ($databaseArg); $self->{ 'node' }->{ 'dns' } = ${$self-> get_default_namespace_uri_ref }; my @nodes = ($self->{ 'node' }); while (defined (my $node = shift @nodes)) { CORE::delete $node->{ 'swod' }; push @nodes, grep {$_} @{$node->{ 'swcn' }}, $node->{ 'shadow' }, $node->{ 'shadowsib' }; } $self->{ 'node' } -> _orphanate ; } ;} ; } } sub get_namespace_binding_list ($$) { my ($self, $databaseArg) = @_; my $r = {}; { my $ods = $self->{ 'node' }->{ 'swod' }; if ($ods->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#allNSBindings' }) { $r = $ods->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#allNSBindings' }; } else { if ($databaseArg) { for my $mod_uri (keys %{$databaseArg->{modDef}}) { my $mod = $databaseArg-> get_module ($mod_uri); $ods->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#allNSBindings' } ->{$mod-> local_name } = $mod-> target_namespace_uri ; } } for my $prefix (keys %{$ods->{ 'swnsb' }}) { $ods->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#allNSBindings' }->{$prefix} = $ods->{ 'swnsb' }->{$prefix}; } $r = $ods->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#allNSBindings' }; } } $r} sub get_default_namespace_uri_ref ($) { my ($self) = @_; my $r; { my $ods = $self->{ 'node' }->{ 'swod' }; if ($ods->{ 'dns' }) { $r = \ ($ods->{ 'dns' }); } else { { local $Error::Depth = $Error::Depth + 1; { $r = \($ods->{ 'dns' } = $self-> owner_dis_document -> module_element -> defining_namespace_uri ); } ;} ; } } $r} sub preserve_node_path ($) { my ($self) = @_; { { local $Error::Depth = $Error::Depth + 1; { $self-> flag (nodePath => $self-> node_path (key => [qw/QName Name Type type/])); } ;} ; } } sub clone ($) { my ($self) = @_; my $r; { $r = bless $self->SUPER::clone, 'Message::Util::DIS::ManakaiDISElement' ; } $r} $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#perl', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#core', {'', '1', '2.1', '1'}}; $Message::DOM::ClassPoint{q} = 4.1; $Message::Util::DIS::ManakaiDISElement::CompatClass{q} = 1; $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q} = {'o', ['p'], 's', ['swcn'], 's0', ['shadow', 'shadowsib']}; package Message::Util::IFLatest::DISModuleElement; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISModuleElement; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::DIS::ManakaiDISElement', 'Message::Util::IF::DISElement', 'Message::Util::IF::DISModuleElement', 'Message::Util::IFLatest::DISElement', 'Message::Util::IFLatest::DISModuleElement'; sub require_element ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { $r = bless $self-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'Require', make_new_node => 1 ), 'Message::Util::DIS::ManakaiDISElement' ; } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleElement', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'require_element'; } } sub default_for_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $df = $self-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'DefaultFor'); if ($df) { $r = (bless $df, 'Message::Util::DIS::ManakaiDISElement' ) -> qname_value_uri || 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ; } else { $r = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ; } } ;} ; } $r; } else {my ($self, $given) = @_; { { local $Error::Depth = $Error::Depth + 1; { $self-> set_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'DefaultFor' => $given); } ;} ; } } } sub defining_namespace_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $df = $self-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'Namespace'); if ($df) { $r = $df-> value ; } else { ; } } ;} ; } $r; } else {my ($self, $given) = @_; { { local $Error::Depth = $Error::Depth + 1; { $self-> set_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'Namespace' => $given); } ;} ; } } } $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#perl', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#core', {'', '1', '2.1', '1'}}; $Message::DOM::ClassPoint{q} = 4.1; package Message::Util::IFLatest::DISElementList; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISElementList; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::IF::DISElementList', 'Message::Util::IFLatest::DISElementList'; $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::DISComment; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISComment; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::DIS::ManakaiDISNode', 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGComment', 'Message::Util::IF::DISComment', 'Message::Util::IFLatest::DISComment'; $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#core', {'', '1', '2.1', '1'}}; $Message::DOM::ClassPoint{q} = 3.1; $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q} = {'o', ['p'], 's', ['swcn']}; package Message::Util::IFLatest::DISDocumentFragment; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISDocumentFragment; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::DIS::ManakaiDISNode', 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGDocumentFragment', 'Message::Util::IF::DISDocumentFragment', 'Message::Util::IFLatest::DISDocumentFragment'; $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#core', {'', '1', '2.1', '1'}}; $Message::DOM::ClassPoint{q} = 3.1; $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q} = {'o', ['p', 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#shadowParent', 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#shadowSiblingOf', 'shadowo'], 's', ['swcn']}; package Message::Util::IFLatest::DISDocument; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISDocument; our $VERSION = 20060403.1341; push our @ISA, 'Message::Util::DIS::ManakaiDISNode', 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGDocument', 'Message::Util::IF::DISDocument', 'Message::Util::IFLatest::DISDocument'; sub module_element ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { $r = $self-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'Module', make_new_node => 1 ); } ;} ; $r = bless $r, 'Message::Util::DIS::ManakaiDISModuleElement' ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'module_element'; } } sub dis_database ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { if ($self->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#db' }) { $r = $self->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#db' }; } else { report Message::Util::DIS::ManakaiDISException -object => $self, '-type' => 'INVALID_STATE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_ASSOCIATED_DB_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDocument', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_database'; ; } } $r; } else {my ($self, $given) = @_; { $self->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#db' } = $given; require Scalar::Util; Scalar::Util::weaken ($self->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#db' }); } } } sub dis_child_elements ($%) { my ($self, %opt) = @_; my $r; { $r = bless [], 'Message::Util::DIS::ManakaiDISElementList' ; { local $Error::Depth = $Error::Depth + 1; { C: for my $cn (@{$self-> child_nodes }) { next C unless $cn-> node_type eq '#element'; my $dn; { $cn->{'node'}->{ 'rc' }++; ${$cn->{'node'}->{ 'grc' }}++; $dn = bless { 'node' => $cn->{'node'}, }, 'Message::Util::DIS::ManakaiDISElement'; } ; next C unless $dn-> for_match ($opt{for_arg}, $opt{forp_arg}, database_arg => $opt{database_arg}); push @$r, $dn; } } ;} ; } $r} sub dis_all_child_elements ($) { my ($self) = @_; my $r; { $r = bless [], 'Message::Util::DIS::ManakaiDISElementList' ; { local $Error::Depth = $Error::Depth + 1; { C: for my $cn (@{$self-> child_nodes }) { next C unless $cn-> node_type eq '#element'; my $dn; { $cn->{'node'}->{ 'rc' }++; ${$cn->{'node'}->{ 'grc' }}++; $dn = bless { 'node' => $cn->{'node'}, }, 'Message::Util::DIS::ManakaiDISElement'; } ; push @$r, $dn; } } ;} ; } $r} sub add_namespace_binding ($$;$) { my ($self, $prefix, $namespaceURI) = @_; { if (defined $namespaceURI) { $self->{ 'node' }->{ 'swnsb' }->{$prefix} = $namespaceURI; } else { CORE::delete $self->{ 'node' }->{ 'swnsb' } ->{$prefix}; } } } sub dis_namespace_resolver ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#disNamespaceResolver' }; } $r; } else {my ($self, $given) = @_; { $self->{ 'node' }->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#disNamespaceResolver' } = $given; } } } $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/swcfg21#core', {'', '1', '2.1', '1'}}; $Message::DOM::ClassPoint{q} = 3.1; $Message::Util::ManakaiNode::ManakaiNodeRef::Prop{q} = {'o', ['p'], 's', ['swcn'], 's2', ['swetb']}; package Message::Util::IFLatest::DISDatabase; our $VERSION = 20060403.1341; package Message::Util::DIS::ManakaiDISDatabase; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::DIS::Perl::ManakaiDISDatabasePerl', 'Message::Util::IF::DISDatabase', 'Message::Util::IFLatest::DISDatabase'; sub get_module ($$%) { my ($self, $moduleURI, %opt) = @_; my $r; { my $modURI; if (defined $opt{for_arg}) { { if ($opt{for_arg} eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $modURI = $moduleURI; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $moduleURI; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $modURI = qq; } } ; } else { $modURI = $moduleURI; } if (defined $self->{modDef}->{$modURI}) { $r = $self->{modDef}->{$modURI}; } else { $r = $self->{modDef}->{$modURI} = bless { uri => $modURI, db => $self, forp => [], 'tu' => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#Module' , 'r' => 0, }, 'Message::Util::DIS::ManakaiDISModuleDefinition' ; require Scalar::Util; Scalar::Util::weaken ($r->{db}); { if (defined 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all') { if (ref 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' eq 'SCALAR') { $r->{for} = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'; } elsif (defined $Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'}) { $r->{for} = $Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'}; } else { require Scalar::Util; $r->{for} = $Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'} = \('http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'}); } } else { CORE::delete $r->{for}; } } ; } } $r} sub get_for ($;$) { my ($self, $forURI) = @_; my $r; { $forURI = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' unless defined $forURI; if (defined $self->{forDef}->{$forURI}) { $r = $self->{forDef}->{$forURI}; } elsif (defined $self->{ 'rm' }->{$forURI}) { { local $Error::Depth = $Error::Depth + 1; { $self-> _pl_load_dis_database_module ($self-> get_module (${$self->{ 'rm' }->{$forURI}})); } ;} ; unless (defined $self->{forDef}->{$forURI}) { report Message::Util::DIS::ManakaiDISException -object => $self, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'get_for', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $forURI, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#moduleURI' => ${$self->{'rm'} ->{$forURI}}; ; } $r = $self->{forDef}->{$forURI}; } else { $r = $self->{forDef}->{$forURI} = bless { uri => $forURI, isa => { 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' => 1 }, revISA => {}, db => $self, 'tu' => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#For' , 'r' => 0, }, 'Message::Util::DIS::ManakaiDISForDefinition' ; $self->{forDef}->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' }->{revISA}->{$forURI} = 1 ; require Scalar::Util; Scalar::Util::weaken ($r->{db}); } } $r} sub get_resource ($;$%) { my ($self, $resourceURI, %opt) = @_; my $r; { $resourceURI = 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#any' unless defined $resourceURI; my $resURI; if (defined $opt{for_arg}) { { if ($opt{for_arg} eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $resURI = $resourceURI; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $resourceURI; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $resURI = qq; } } ; } else { $resURI = $resourceURI; } if (defined $self->{resDef}->{$resURI}) { $r = $self->{resDef}->{$resURI}; } elsif (defined $self->{ 'rm' }->{$resURI}) { { local $Error::Depth = $Error::Depth + 1; { $self-> _pl_load_dis_database_module ($self-> get_module (${$self->{ 'rm' }->{$resURI}})); } ;} ; unless (defined $self->{resDef}->{$resURI}) { report Message::Util::DIS::ManakaiDISException -object => $self, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'get_resource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $resURI, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#moduleURI' => ${$self->{'rm'} ->{$resURI}}; ; } $r = $self->{resDef}->{$resURI}; } else { $r = $self->{resDef}->{$resURI} = bless { uri => $resURI, aliasURI => {$resURI => 1 }, db => $self, forp => [], seq => -1, 'tu' => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#Resource' , 'r' => 0, }, 'Message::Util::DIS::ManakaiDISResourceDefinition' ; require Scalar::Util; Scalar::Util::weaken ($r->{db}); { if (defined 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all') { if (ref 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' eq 'SCALAR') { $r->{for} = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'; } elsif (defined $Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'}) { $r->{for} = $Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'}; } else { require Scalar::Util; $r->{for} = $Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'} = \('http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all'}); } } else { CORE::delete $r->{for}; } } ; } } $r} sub get_any_resource ($;$%) { my ($self, $resourceURI, %opt) = @_; my $r; { $resourceURI = 'http://suika.fam.cx/~wakaba/archive/2004/dom/main#any' unless defined $resourceURI; my $resURI; if (defined $opt{for_arg}) { { if ($opt{for_arg} eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $resURI = $resourceURI; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $resourceURI; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $resURI = qq; } } ; } else { $resURI = $resourceURI; } if (defined $self->{resDef}->{$resURI}) { $r = $self->{resDef}->{$resURI}; } elsif (defined $self->{modDef}->{$resURI}) { $r = $self->{modDef}->{$resURI}; } elsif (defined $self->{forDef}->{$resURI}) { $r = $self->{forDef}->{$resURI}; } elsif (defined $self->{ 'rm' }->{$resURI}) { { local $Error::Depth = $Error::Depth + 1; { $self-> _pl_load_dis_database_module ($self-> get_module (${$self->{ 'rm' }->{$resURI}})); } ;} ; if (defined $self->{resDef}->{$resURI}) { $r = $self->{resDef}->{$resURI}; } elsif (defined $self->{forDef}->{$resURI}) { $r = $self->{forDef}->{$resURI}; } else { report Message::Util::DIS::ManakaiDISException -object => $self, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'get_any_resource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $resURI, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#moduleURI' => ${$self->{'rm'} ->{$resURI}}; ; } } else { { local $Error::Depth = $Error::Depth + 1; { $r = $self-> get_resource ($resURI); } ;} ; } } $r} sub get_source_file ($$) { my ($self, $fileName) = @_; my $r; { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceFile' }->{$fileName}; } $r} sub set_source_file ($$$) { my ($self, $fileName, $doc) = @_; { $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceFile' }->{$fileName} = $doc; } } sub load_module ($$$%) { my ($self, $doc, $resolver, %opt) = @_; { $resolver = bless $resolver, 'Message::Util::DIS::ManakaiDISModuleResolver' if ref $resolver eq 'CODE'; } { $resolver = bless $resolver, 'Message::Util::DIS::ManakaiDISModuleResolver' if ref $resolver eq 'CODE'; ## -- Module Name, URI $opt{for_arg} = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' unless defined $opt{for_arg}; my $mod_node; my $mod_name_node; { local $Error::Depth = $Error::Depth + 1; { $mod_node = $doc-> module_element ; $mod_name_node = $mod_node-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'QName'); unless ($mod_name_node) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $mod_node, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_module', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_MODULE_QNAME_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase'; ; } ;} ; } $mod_name_node = bless $mod_name_node, 'Message::Util::DIS::ManakaiDISElement' if $mod_name_node->isa ( 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGElement' ); my $mod_name_uri = $mod_name_node -> qname_value_uri ; my $mod = $self-> get_module ($mod_name_uri, for_arg => $opt{for_arg}); unless ($mod-> is_defined ) { ## -- Initializes Module Definition Object my $v = $mod_name_node-> qname_value_local_name ; { if (defined $v) { if (ref $v eq 'SCALAR') { $mod->{localName} = $v; } elsif (defined $Message::Util::ManakaiStringRef::Value{$v}) { $mod->{localName} = $Message::Util::ManakaiStringRef::Value{$v}; } else { require Scalar::Util; $mod->{localName} = $Message::Util::ManakaiStringRef::Value{$v} = \($v); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$v}); } } else { CORE::delete $mod->{localName}; } } ; my $ns = $mod_name_node-> qname_value_namespace_uri ; { if (defined $ns) { if (ref $ns eq 'SCALAR') { $mod->{namespaceURI} = $ns; } elsif (defined $Message::Util::ManakaiStringRef::Value{$ns}) { $mod->{namespaceURI} = $Message::Util::ManakaiStringRef::Value{$ns}; } else { require Scalar::Util; $mod->{namespaceURI} = $Message::Util::ManakaiStringRef::Value{$ns} = \($ns); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$ns}); } } else { CORE::delete $mod->{namespaceURI}; } } ; { if (defined $opt{for_arg}) { if (ref $opt{for_arg} eq 'SCALAR') { $mod->{for} = $opt{for_arg}; } elsif (defined $Message::Util::ManakaiStringRef::Value{$opt{for_arg}}) { $mod->{for} = $Message::Util::ManakaiStringRef::Value{$opt{for_arg}}; } else { require Scalar::Util; $mod->{for} = $Message::Util::ManakaiStringRef::Value{$opt{for_arg}} = \($opt{for_arg}); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$opt{for_arg}}); } } else { CORE::delete $mod->{for}; } } ; $mod->{src} = $mod_node; $mod->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isDefined' } = 1 ; $self-> set_source_file ($mod_name_uri => $doc); $mod-> target_namespace_uri ($mod_node-> defining_namespace_uri ); { $mod->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceFile'} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ('http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String', $doc->flag ('http://suika.fam.cx/~wakaba/archive/2005/swcfg21#fileName'), base_type => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String'); { local $Error::Depth = $Error::Depth + 1; { $mod->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceFile'}-> name ('http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceFile'); } ;} ; } ; { $mod->{ 'r' } = time; } ; ## -- Loads "for" definition my $root_elements = $doc-> dis_all_child_elements ; if ($mod-> for_uri eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { R: for my $el (@$root_elements) { next R unless $el-> expanded_uri eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ForDef' ; $self-> load_for ($mod, $el, srinfo => $opt{srinfo}); } } ## -- Loads "for all" my $rmod = $self-> get_module ($mod_name_uri, for_arg => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ); unless ($rmod-> is_defined ) { my $rdoc = $resolver-> uri_to_document ($self, $rmod-> uri , $mod-> namespace_uri , $mod-> local_name , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ); unless ($rdoc) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $mod->source_element, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_module', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#namespaceURI' => $mod->namespace_uri, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#for' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#localName' => $mod->local_name, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNABLE_TO_GET_MODULE_ERR', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $rmod->uri; ; } ;} ; } $self-> load_module ($rdoc, $resolver, for_arg => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' , on_resource_read => $opt{on_resource_read}, srinfo => $opt{srinfo}); } else { # if "for all" loaded $rmod-> get_property_boolean ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--In' ); ## Dummy to ensure the module is loaded } ## -- Loads Required Modules ## NOTE:: "dis:For" is not allowed since "dis:ForDef" is not read my $req_node = $mod_node-> require_element ; for my $rm (@{$req_node-> dis_all_child_elements }) { next unless $rm-> expanded_uri eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Module' ; my ($uri, $nuri, $ln, $for); my $mqn = $rm-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'QName'); if ($mqn) { my $mqv = $mqn-> value ; my $mqp = ($mqn->isa ( 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGElement' ) ? (bless $mqn, 'Message::Util::DIS::ManakaiDISElement' ) : $mqn) -> qname_to_pair ($mqv, node => $mqn); ($nuri, $ln) = @$mqp; } else { my $mn = $rm-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'Name'); if ($mn) { $nuri = $mod-> namespace_uri ; $ln = $mn-> value ; } else { $nuri = $mod-> namespace_uri ; $ln = $mod-> local_name ; } } my $wfn = $rm-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'WithFor'); if ($wfn) { $for = ($wfn->isa ( 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGElement' ) ? (bless $wfn, 'Message::Util::DIS::ManakaiDISElement' ) : $wfn) -> qname_value_uri ; } else { $for = $mod-> for_uri ; } my $rmod = $self-> get_module ($nuri . $ln, for_arg => $for); $mod-> add_referring_module_uri ($nuri.$ln); unless ($rmod-> is_defined ) { my $rdoc = $resolver-> uri_to_document ($self, $rmod-> uri , $nuri, $ln, $for); unless ($rdoc) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $rm, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_module', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#namespaceURI' => $nuri, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#for' => $for, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#localName' => $ln, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNABLE_TO_GET_MODULE_ERR', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $rmod->uri; ; } ;} ; } $self-> load_module ($rdoc, $resolver, for_arg => $for, on_resource_read => $opt{on_resource_read}, srinfo => $opt{srinfo}); } } # Child Module elements ## -- Loads child resources $root_elements = $doc-> dis_child_elements (for_arg => $opt{for_arg}, database_arg => $self); for my $el (@$root_elements) { if ($el-> is_resource_element ) { $self-> load_resource ($mod, undef , undef , $el, for_arg => $opt{for_arg}, on_resource_read => $opt{on_resource_read}, srinfo => $opt{srinfo}); } else { my $et = $el-> expanded_uri ; if ({ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ForDef' => 1, 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Module' => 1, 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ImplNote' => 1, }->{$et}) { # } else { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $el, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_module', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#ELEMENT_NOT_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType' => $et, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $mod->uri; ; } ;} ; } } # element types } my $dn = $mod_node-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'Namespace'); unless ($dn and defined $dn-> value ) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $mod_node, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_module', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_REQUIRED_ATTR_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Namespace'; ; } ;} ; } } # Unless this module loaded } ;} ; # Deep } } sub load_for ($$$%) { my ($self, $mod, $el, %opt) = @_; { { local $Error::Depth = $Error::Depth + 1; { my $qn_node = $el-> get_attribute_ns ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--' , 'QName'); unless ($qn_node) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $el, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_for', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_FOR_QNAME_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase'; ; } ;} ; } $qn_node = bless $qn_node, 'Message::Util::DIS::ManakaiDISElement' if $qn_node->isa ( 'Message::Markup::SuikaWikiConfig21::ManakaiSWCFGElement' ); my $qn_uri = $qn_node-> qname_value_uri ; my $for = $self-> get_for ($qn_uri); unless ($for-> is_defined ) { ## -- Initializes "For" Definition Object $for->{src} = $el; $for->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isDefined' } = 1 ; $for->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' } = \ ($mod-> uri ); $mod-> add_for_resource ($for); for my $ce (@{$el-> dis_all_child_elements }) { my $xn = $ce-> expanded_uri ; if ($xn eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ISA' or $xn eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Implement' ) { my $sfor = $self-> get_for ($ce-> qname_value_uri ); $for-> add_isa ($sfor); $sfor-> is_referred ($ce); ## TODO: warn if dis:Implement } elsif ({ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Description' => 1, 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ImplNote' => 1, 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--FullName' => 1, 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--QName' => 1, }->{$xn}) { # } else { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $ce, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_for', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#ELEMENT_NOT_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType' => $xn, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $qn_uri; ; } ;} ; } } for (keys %{$opt{srinfo}->{for}->{$qn_uri}->{supOf} or {}}) { my $subfor = $self-> get_for ($_); $subfor-> add_isa ($for, srinfo => $opt{srinfo}); } for (keys %{$opt{srinfo}->{for}->{$qn_uri}->{subOf} or {}}) { my $supfor = $self-> get_for ($_); $for-> add_isa ($supfor, srinfo => $opt{srinfo}); } } else { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $el, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_for', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#anotherSourceNode' => $el, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#FOR_ALREADY_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $qn_uri; ; } ;} ; } # isDefine? } ;} ; # DEEP } } sub load_resource ($$$$$%) { my ($self, $mod, $parentResource, $dynParent, $el, %opt) = @_; { $opt{for_arg} = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' unless defined $opt{for_arg}; $opt{forp_arg} ||= []; { local $Error::Depth = $Error::Depth + 1; { ## -- Node names my @res_uri; ## Unique resource identifier generated from node id my $node_id = $el-> node_id_ref ; my $node_uri; { if ($opt{for_arg} eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' and @{$opt{forp_arg}} == 0) { $node_uri = $$node_id; } elsif (@{$opt{forp_arg}}) { my $__turi = $$node_id; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } my @__fp; for my $__uri (@{$opt{forp_arg}}) { my $__fpuri = $__uri; $__fpuri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])} {sprintf '%%%02X', ord $1}ge; push @__fp, $__fpuri; } $node_uri = qq.join ('+', @__fp); } else { my $__turi = $$node_id; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'(),*:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $node_uri = qq; } } ; my $al_node = $el-> dis_get_attribute ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AliasFor' , for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $self); my $al_canon_uri; if ($al_node) { $al_canon_uri = $al_node-> tfqnames_value_uri ($$node_id, $opt{for_arg}, for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $self); } ## User defined resource identifiers my $qn_node = $el-> dis_get_attribute ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--QName' , for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $self); my $res; ALD: { if ($qn_node) { my $qn_uri = $qn_node-> qname_value_uri ; my $qn_urif; { if ($opt{for_arg} eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $qn_urif = $qn_uri; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $qn_uri; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $qn_urif = qq; } } ; push @res_uri, $qn_urif; $res = $self-> get_resource ($qn_urif); if ($res-> is_defined ) { last ALD if defined $al_canon_uri and $res->{aliasURI}->{$al_canon_uri}; { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $qn_node, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#anotherSourceNode' => $res->{src}, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_ALREADY_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $qn_urif; ; } ;} ; } my $v = $qn_node-> qname_value_local_name ; { if (defined $v) { if (ref $v eq 'SCALAR') { $res->{localName} = $v; } elsif (defined $Message::Util::ManakaiStringRef::Value{$v}) { $res->{localName} = $Message::Util::ManakaiStringRef::Value{$v}; } else { require Scalar::Util; $res->{localName} = $Message::Util::ManakaiStringRef::Value{$v} = \($v); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$v}); } } else { CORE::delete $res->{localName}; } } ; my $ns = $qn_node-> qname_value_namespace_uri ; { if (defined $ns) { if (ref $ns eq 'SCALAR') { $res->{namespaceURI} = $ns; } elsif (defined $Message::Util::ManakaiStringRef::Value{$ns}) { $res->{namespaceURI} = $Message::Util::ManakaiStringRef::Value{$ns}; } else { require Scalar::Util; $res->{namespaceURI} = $Message::Util::ManakaiStringRef::Value{$ns} = \($ns); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$ns}); } } else { CORE::delete $res->{namespaceURI}; } } ; } else { ## Anonymous or local my $n_node = $el-> dis_get_attribute ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Name' , for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $self); if ($n_node) { if ($parentResource) { my $puri = $parentResource->{uri}; my $ru; my $ruf; my $ln = $n_node-> value ; { my $__parent = $puri; my $__ln = $ln; for my $__uri ($__parent, $__ln) { $__uri =~ s{([^0-9A-Za-z!\$'(),*:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $ru = qq; } ; { if ($opt{for_arg} eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $ruf = $ru; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $ru; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $ruf = qq; } } ; push @res_uri, $ruf; $res = $self-> get_resource ($ruf); my $v = $n_node-> value ; { if (defined $v) { if (ref $v eq 'SCALAR') { $res->{localName} = $v; } elsif (defined $Message::Util::ManakaiStringRef::Value{$v}) { $res->{localName} = $Message::Util::ManakaiStringRef::Value{$v}; } else { require Scalar::Util; $res->{localName} = $Message::Util::ManakaiStringRef::Value{$v} = \($v); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$v}); } } else { CORE::delete $res->{localName}; } } ; $res->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isAnon' } = 1 ; } else { ## Root local name resource my $ln = $n_node-> value ; my $ns_uri = $mod-> source_element -> defining_namespace_uri ; my $qn_uri = $ns_uri . $ln; my $qn_urif; { if ($opt{for_arg} eq 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ) { $qn_urif = $qn_uri; } else { ## NOTE: [RFC 3986] ## fragment := *(pchar / "/" / "?") ## pchar := unreserved / pct-encoded / sub-delims / [:@] ## unreserved := ALPHA / DIGIT / [._~-] ## sub-delims := [!$&'()*+,;=] ## NOTE: [XPointer Framework] ## SchemeData := *EscapedData ## EscapedData := NormalChar / "^(" / "^)" / "^^" ## / "(" SchemeData ")" ## NormalChar := UnicodeChar - [()^] my $__turi = $qn_uri; my $__furi = $opt{for_arg}; for my $__uri ($__turi, $__furi) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])}{sprintf '%%%02X', ord $1}ge; } $qn_urif = qq; } } ; push @res_uri, $qn_urif; $res = $self-> get_resource ($qn_urif); if ($res-> is_defined ) { last ALD if defined $al_canon_uri and $res->{aliasURI}->{$al_canon_uri}; { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $n_node, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#anotherSourceNode' => $res->source_element, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_ALREADY_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $res->uri; ; } ;} ; } { if (defined $ns_uri) { if (ref $ns_uri eq 'SCALAR') { $res->{namespaceURI} = $ns_uri; } elsif (defined $Message::Util::ManakaiStringRef::Value{$ns_uri}) { $res->{namespaceURI} = $Message::Util::ManakaiStringRef::Value{$ns_uri}; } else { require Scalar::Util; $res->{namespaceURI} = $Message::Util::ManakaiStringRef::Value{$ns_uri} = \($ns_uri); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$ns_uri}); } } else { CORE::delete $res->{namespaceURI}; } } ; { if (defined $ln) { if (ref $ln eq 'SCALAR') { $res->{localName} = $ln; } elsif (defined $Message::Util::ManakaiStringRef::Value{$ln}) { $res->{localName} = $Message::Util::ManakaiStringRef::Value{$ln}; } else { require Scalar::Util; $res->{localName} = $Message::Util::ManakaiStringRef::Value{$ln} = \($ln); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$ln}); } } else { CORE::delete $res->{localName}; } } ; } } else { push @res_uri, $node_uri; $res = $self-> get_resource ($node_uri); $res->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isAnon' } = 1 ; } } # anon { if (defined $opt{for_arg}) { if (ref $opt{for_arg} eq 'SCALAR') { $res->{for} = $opt{for_arg}; } elsif (defined $Message::Util::ManakaiStringRef::Value{$opt{for_arg}}) { $res->{for} = $Message::Util::ManakaiStringRef::Value{$opt{for_arg}}; } else { require Scalar::Util; $res->{for} = $Message::Util::ManakaiStringRef::Value{$opt{for_arg}} = \($opt{for_arg}); Scalar::Util::weaken ($Message::Util::ManakaiStringRef::Value{$opt{for_arg}}); } } else { CORE::delete $res->{for}; } } ; $res->{forp} = $opt{forp_arg}; $res->{src} = $el; $res->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' } = \ ($mod->{uri}); $res-> parent_resource ($parentResource) if $parentResource; $res-> dynamic_parent_resource ($dynParent) if $dynParent; unless ($res->{uri} eq $node_uri) { push @res_uri, $node_uri; my $nu_res = $self-> get_resource ($node_uri); $res-> merge_as_alias ($nu_res); } $res->{seq} = $self->{seq}++; $res-> source_node_id_ref ($node_id); { $res->{ 'r' } = time; } ; $mod-> add_resource_uri ($_) for @res_uri; ## -- Alias if ($al_node) { my $canon_res = $self-> get_resource ($al_canon_uri); $canon_res-> is_referred ($al_node); $canon_res-> merge_as_alias ($res, node => $al_node, no_equality_check => 1 ); $res = $canon_res; } else { $res->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isDefined' } = 1 ; } } # ALD ## -- Registers as child $parentResource-> _add_child_resource ($res) if $parentResource; $dynParent-> _add_dynamic_child_resource ($res) if $dynParent; my $is_multires = 0 ; my @props; my @cres; my @ce0 = @{$el-> dis_child_elements (for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $self)}; my $has_type = $al_node; while (@ce0) { my $ce = shift @ce0; if ($ce-> element_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#resourceType' , database_arg => $self, srinfo => $opt{srinfo}) or $ce-> element_type_match ( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' , database_arg => $self, srinfo => $opt{srinfo})) { ## TODO: Remove this. $has_type = 1 ; my $type_uri = $ce-> qname_value_uri ; my $type = $self-> get_resource ($type_uri); $res-> add_type_uri ($type_uri, srinfo => $opt{srinfo}); $type-> is_referred ($ce); if ($type-> is_subset_of_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--MultipleResource' , srinfo => $opt{srinfo})) { $is_multires = 1 ; } } elsif ($ce-> element_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--subsetOf' , database_arg => $self, srinfo => $opt{srinfo})) { my $sres = $self-> get_resource ($ce-> tfqnames_value_uri ($$node_id, $opt{for_arg}, for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, database_arg => $self)); $res-> add_super_resource ($sres, srinfo => $opt{srinfo}); } elsif ($ce-> is_resource_element ) { push @cres, $ce; } elsif ($ce-> element_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--dataType' , database_arg => $self, srinfo => $opt{srinfo})) { my $uri = $ce-> qname_value_uri ; { $res->{'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--dataType'} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $uri); { local $Error::Depth = $Error::Depth + 1; { $res->{'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--dataType'}-> name ($ce->expanded_uri); } ;} ; } ; my $type = $self-> get_resource ($uri); $type-> is_referred ($ce); } elsif ($ce-> element_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--multipleProperties' , database_arg => $self, srinfo => $opt{srinfo})) { my $uri = $ce-> qname_value_uri ; { $res->{'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--multipleProperties'} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $uri); { local $Error::Depth = $Error::Depth + 1; { $res->{'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--multipleProperties'}-> name ($ce->expanded_uri); } ;} ; } ; my $type = $self-> get_resource ($uri); $type-> is_referred ($ce); } else { ## Property and invalid element is not checked, since not ## all property definitions has loaded at this stage. push @props, $ce; } } # @ce0 unless ($has_type) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $el, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'load_resource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_RDF_TYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $res->{uri}; } ;} ; } my $srres = $opt{srinfo}->{resource}->{$res-> uri }; F: for my $auri (keys %{$srres->{aliasURI} or {}}) { next F unless $srres->{aliasURI}->{$auri}; $res->{aliasURI}->{$auri} = 1 ; $self->{resDef}->{$auri} = $res; A: for (keys %{$res->{subOf} or {}}) { next A unless $res->{subOf}->{$_}; my $s = $self-> get_resource ($_); $s->{supOf}->{$auri} = 1 ; } A: for (keys %{$res->{supOf} or {}}) { next A unless $res->{supOf}->{$_}; my $s = $self-> get_resource ($_); $s->{subOf}->{$auri} = 1 ; } } F: for my $suri (keys %{$srres->{supOf} or {}}) { next F unless $srres->{supOf}->{$suri}; my $sres = $self-> get_resource ($suri); $sres-> add_super_resource ($res, srinfo => $opt{srinfo}); } F: for my $suri (keys %{$srres->{subOf} or {}}) { next F unless $srres->{subOf}->{$suri}; my $sres = $self-> get_resource ($suri); $res-> add_super_resource ($sres, srinfo => $opt{srinfo}); } ## -- Child resources if (not $is_multires and not $al_node) { for my $re (@cres) { $self-> load_resource ($mod, $res, $res, $re, for_arg => $opt{for_arg}, forp_arg => $opt{forp_arg}, on_resource_read => $opt{on_resource_read}, srinfo => $opt{srinfo}); } } ## -- Multiple representations if ($is_multires) { for my $pe (@props) { if ($pe-> element_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--resourceFor' , database_arg => $self, srinfo => $opt{srinfo})) { my $for_uri = $pe-> qname_value_uri ; my $for = $self-> get_for ($for_uri); $for-> is_referred ($pe); $self-> load_resource ($mod, $parentResource, $res, $el, for_arg => $opt{for_arg}, forp_arg => [@{$opt{forp_arg}}, $for_uri], on_resource_read => $opt{on_resource_read}, srinfo => $opt{srinfo}); } } } ($opt{on_resource_read} or sub {})->($self, $res); } ;} ; # DEEP } } sub read_properties ($%) { my ($self, %opt) = @_; { { local $Error::Depth = $Error::Depth + 1; { F: for my $fd (values %{$self->{modDef}}, values %{$self->{forDef}}, values %{$self->{resDef}}) { next F if $fd->isa ( 'Message::Util::DIS::ManakaiDISModuleLite' ); if ($fd-> is_defined ) { $fd-> read_properties (on_resource_read => $opt{on_resource_read}); } } CORE::delete $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceFile' }; } ;} ; } } sub check_undefined_resource ($) { my ($self) = @_; { for my $fd (values %{$self->{forDef}}) { if (my $ref = $fd-> is_referred and not $fd-> is_defined ) { report Message::Util::DIS::ManakaiDISException -object => $self, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'check_undefined_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNodePath' => $ref, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#FOR_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $fd->uri; ; } } for my $fd (values %{$self->{resDef}}) { if (my $ref = $fd-> is_referred and not $fd-> is_defined ) { report Message::Util::DIS::ManakaiDISException -object => $self, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'check_undefined_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNodePath' => $ref, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $fd->uri; ; } } } } sub unload_module ($$%) { my ($self, $module, %opt) = @_; my $r = {}; { { local $Error::Depth = $Error::Depth + 1; { $r = $opt{srinfo} || {}; ## -- |For|s F: for my $for (@{$module-> get_for_resource_list }) { my $uri = $for-> uri ; A: for (%{$for->{ISA} or {}}) { next A unless $for->{ISA}->{$_}; my $sfor = $self-> get_for ($_); next A unless $sfor; delete $sfor->{revISA}->{$uri}; } A: for (%{$for->{revISA} or {}}) { next A unless $for->{revISA}->{$_}; my $sfor = $self-> get_for ($_); next A unless $sfor; delete $sfor->{ISA}->{$uri}; $r->{for}->{$uri}->{supOf}->{$_} = 1 ; } delete $self->{forDef}->{$uri}; delete $self->{ 'rm' }->{$uri}; } # F ## -- Resources my @res_list = map { [$_, $self-> get_resource ($_)] } @{$module-> get_resource_uri_list }; my %res_list = map {$_->[0] => 1 } @res_list; for my $ur (@res_list) { my $uri = $ur->[0]; my $res = $ur->[1]; my $owner = $res-> owner_module ; if (defined $owner and $owner eq $module) { ## Non-alias my %alias; my %sub = %{$res->{supOf} or {}}; A: for (keys %{$res->{aliasURI} or {}}) { next A unless $res->{aliasURI}->{$_}; $alias{$_} = 1 ; delete $sub{$_} if $res->{aliasURI}->{$_}; $r->{resource}->{$uri}->{supOf} = \%sub; unless ($res_list{$_}) { ## Defined by other module $r->{resource}->{$uri}->{aliasURI}->{$_} = 1 ; } } A: for (keys %{$res->{subOf} or {}}) { next A unless $res->{aliasURI}->{$_}; my $sres = $self-> get_resource ($_); next A unless $sres; delete $res->{supOf}->{$_} for keys %alias; } A: for (keys %{$res->{supOf} or {}}) { next A unless $res->{aliasURI}->{$_}; my $sres = $self-> get_resource ($_); next A unless $sres; delete $res->{subOf}->{$_} for keys %alias; } A: for (keys %alias) { delete $self->{resDef}->{$_}; delete $self->{ 'rm' }->{$_}; } } else { ## Alias delete $res->{aliasURI}->{$uri}; delete $res->{subOf}->{$uri}; delete $res->{supOf}->{$uri}; A: for (keys %{$res->{subOf} or {}}) { next A unless $res->{subOf}->{$_}; my $sres = $self-> get_resource ($_); next A unless $sres; delete $sres->{supOf}->{$uri}; } A: for (keys %{$res->{supOf} or {}}) { next A unless $res->{supOf}->{$_}; my $sres = $self-> get_resource ($_); next A unless $sres; delete $sres->{subOf}->{$uri}; } delete $self->{resDef}->{$uri}; delete $self->{ 'rm' }->{$uri}; } } ## -- Keys my $v = $module->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#Perl/plHashKey' }; K: for my $scope (keys %{$v or {}}) { my $ks = $self-> get_resource ($scope); L: for my $key (keys %{$v->{$scope} or {}}) { next L unless $v->{$scope}->{$key}; delete $ks->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#Perl/plHashKey' }->{$key}; } } ## -- Module itself for (@{$module-> uris }) { delete $self->{modDef}->{$_}; } } ;} ; } $r} sub xcref_to_resource ($$$%) { my ($self, $xcref, $contextNode, %opt) = @_; my $r = []; { my ($q1, $q2, $q3) = split /\s*\.\s*/, $xcref, 3; { local $Error::Depth = $Error::Depth + 1; { if (defined $q3) { $r->[2] = $self-> get_resource ($contextNode-> tfqnames_to_uri ($q3, undef , $opt{for_arg}, node => $opt{node})); $r->[1] = $r->[2]-> parent_resource ; } elsif (defined $q2) { if ($q2 =~ /:/) { $r->[1] = $self-> get_resource ($contextNode-> tfqnames_to_uri ($q2, undef , $opt{for_arg}, node => $opt{node})); } else { $r->[0] = $self-> get_resource ($contextNode-> tfqnames_to_uri ($q1, undef , $opt{for_arg}, node => $opt{node})); $r->[1] = $r->[0]-> get_const_resource_by_name ($q2); } } else { ## $q1 only $r->[2] = $self-> get_resource ($contextNode-> tfqnames_to_uri ($q1, undef , $opt{for_arg}, node => $opt{node})); if ($r->[2]-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#ErrorSubCode' )) { $r->[1] = $r->[2]-> parent_resource ; } else { $r->[1] = $r->[2]; CORE::delete $r->[2]; } } if ($r->[2] and not $r->[2]-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#ErrorSubCode' )) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $opt{node}, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'xcref_to_resource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode' => $xcref, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#expectedType' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#ErrorSubCode', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $r->[2]->{uri}; } ;} ; } $r->[2]-> is_referred ($opt{node} or $contextNode) if $r->[2]; if (not $r->[1] or not $r->[1]-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#Const' )) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $opt{node}, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'xcref_to_resource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode' => $xcref, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#expectedType' => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#Const', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#localName' => ($r->[1] ? $r->[1]->local_name : undef), 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => ($r->[1] ? $r->[1]->uri : undef); } ;} ; } $r->[1]-> is_referred ($opt{node} or $contextNode); unless ($r->[0]) { my $cg = $r->[1]-> parent_resource ; $r->[0] = $cg-> parent_resource if $cg; } if (not $r->[0] or not $r->[0]-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#AnyExceptionAnyClass' )) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $opt{node}, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'xcref_to_resource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode' => $xcref, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#expectedType' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#AnyExceptionAnyClass', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#localName' => $r->[0]->local_name, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $r->[0]->{uri}; } ;} ; } $r->[0]-> is_referred ($opt{node} or $contextNode); } ;} ; } $r} sub get_feature ($$$) { my ($self, $feature, $version) = @_; { $feature = lc $feature; } { $version = '' unless defined $version; } my $r; { $feature =~ s/^\+//; CLASS: for my $class (grep { $Message::Util::DIS::ManakaiDISDatabase::CompatClass{$_} } keys %Message::Util::DIS::ManakaiDISDatabase::CompatClass) { if ($Message::DOM::ClassFeature{$class}->{$feature}->{$version}) { $r = bless {o => $self}, $class; last CLASS; } } } $r} sub free ($) { my ($self) = @_; { for my $file (values %{$self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceFile' }}) { $file-> free if $file; } CORE::delete $self->{modDef}; CORE::delete $self->{forDef}; CORE::delete $self->{resDef}; } } sub get_module_uri_list ($) { my ($self) = @_; my $r = []; { $r = [map {$_-> uri } values %{$self->{modDef}}]; } $r} sub get_any_resource_uri_list ($) { my ($self) = @_; my $r = []; { $r = [keys %{$self->{ 'rm' }}, map {$_-> uri } values %{$self->{modDef}}]; } $r} sub ___report_error ($$) { my ($self, $err) = @_; my $r; { if ($err->isa ( 'Message::DOM::IF::DOMError' )) { { local $Error::Depth = $Error::Depth + 1; { my $cfg = $self-> dom_config ; my $h = $cfg-> get_parameter ('error-handler'); $r = $h-> handle_error ($err); } ;} ; } else { $err-> throw ; } } $r} sub dom_config ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { $r = bless [$self, $self, 'Message::Util::IFLatest::DISDatabase'], 'Message::DOM::DOMCore::ManakaiDOMConfiguration' ; } ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISDatabase', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dom_config'; } } sub get_module_resource_list ($) { my ($self) = @_; my $r = []; { $r = [map {$self->{modDef}->{$_}} grep {defined $self->{modDef}->{$_}} keys %{$self->{modDef}}]; } $r} $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#perl', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 2; $Message::Util::DIS::ManakaiDISDatabase::CompatClass{q} = 1; package Message::Util::IFLatest::DISModuleResolver; our $VERSION = 20060403.1342; package Message::Util::DIS::ManakaiDISModuleResolver; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::IF::DISModuleResolver', 'Message::Util::IFLatest::DISModuleResolver'; sub uri_to_document ($$$$$$) { my ($self, $disDB, $moduleURI, $moduleNamespaceURI, $moduleLocalName, $moduleFor) = @_; my $r; { goto &$self; } $r} $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::DISAnyResource; our $VERSION = 20060403.1342; package Message::Util::DIS::ManakaiDISAnyResource; our $VERSION = 20060403.1342; push our @ISA, 'Message::DOM::DOMFeature::ManakaiHasFeatureByGetFeature', 'Message::Util::IF::DISAnyResource', 'Message::Util::IFLatest::DISAnyResource'; sub uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{uri}; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uri'; } } sub uri_ref ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = \ ($self->{uri}); } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uri_ref'; } } sub uris ($;$) { if (@_ == 1) {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#MDOM_IMPL_ATTR_NOT_IMPLEMENTED', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uris'; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uris'; } } sub is_same_resource ($$) { my ($self, $anotherResource) = @_; my $r = 0; { if (UNIVERSAL::isa ($anotherResource, 'Message::Util::DIS::ManakaiDISAnyResource' )) { $r = $self->{uri} eq $anotherResource->{uri}; } } $r} sub name_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { if (defined $self->{localName}) { $r = defined $self->{namespaceURI} ? ${$self->{namespaceURI}} . ${$self->{localName}} : ${$self->{localName}}; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'name_uri'; } } sub local_name ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{localName} ? ${$self->{localName}} : undef ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'local_name'; } } sub namespace_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{namespaceURI} ? ${$self->{namespaceURI}} : undef ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'namespace_uri'; } } sub for_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{for} ? ${$self->{for}} : undef ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'for_uri'; } } sub forp_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = [@{$self->{forp}}]; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'forp_uri'; } } sub is_for_uri ($$) { my ($self, $forURI) = @_; my $r = 0; { { local $Error::Depth = $Error::Depth + 1; { C: for my $this_for_uri (${$self->{for}||\''}, @{$self->{forp}||[]}) { if ($this_for_uri eq $forURI) { ## Shortcut $r = 1 ; last C; } my $this_for = $self-> database -> get_for ($this_for_uri); if ($this_for-> isa_uri ($forURI)) { $r = 1 ; last C; } } } ;} ; } $r} sub is_defined ($;$) { if (@_ == 1) {my ($self) = @_; my $r = 0; { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isDefined' }; } $r; } else {my ($self, $given) = @_; { $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isDefined' } = $given; } } } sub owner_module ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self-> database -> get_module (${$self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' }}) if defined $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' }; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_module'; } } sub owner_module_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { if (defined $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' }) { $r = ${$self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' }}; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_module_uri'; } } sub owner_module_uri_ref ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' }; } $r; } else {my ($self, $given) = @_; { $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#definingModule' } = $given; } } } sub is_referred ($;$) { if (@_ == 1) {my ($self) = @_; my $r = ''; { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isReferred' }; } $r; } else {my ($self, $given) = @_; { if (defined $given) { if (ref $given) { { local $Error::Depth = $Error::Depth + 1; { if ($given->isa ( 'Message::Util::IF::DVValue' )) { $given = $given-> source_node_path ; } else { $given = $given-> flag ('nodePath') || $given-> node_path (key => [qw/QName Name type Type/]); } } ;} ; } $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isReferred' } = $given; } } } } sub source_node_id ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { if (defined $self->{ 'snid' }) { $r = ${$self->{ 'snid' }}; } else { $r = undef ; } } $r; } else {my ($self, $given) = @_; { if (defined $given) { $self->{ 'snid' } = \$given; } else { CORE::delete $self->{ 'snid' }; } } } } sub source_node_id_ref ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{ 'snid' }; } $r; } else {my ($self, $given) = @_; { if (defined $given) { $self->{ 'snid' } = $given; } else { CORE::delete $self->{ 'snid' }; } } } } sub is_anonymous ($;$) { if (@_ == 1) {my ($self) = @_; my $r = 0; { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isAnon' }; } $r; } else {my ($self, $given) = @_; { $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isAnon' } = $given; } } } sub source_element ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{src}; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'source_element'; } } sub database ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{db}; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'database'; } } sub read_properties ($%) { my ($self, %opt) = @_; { { local $Error::Depth = $Error::Depth + 1; { if (my $src = $self->{src}) { my $for = $self-> for_uri ; my $forp = $self-> forp_uri ; my $db = $self-> database ; for my $el (@{$src-> dis_child_elements (for_arg => $for, forp_arg => $forp, database_arg => $db)}) { my $xu = $el-> expanded_uri ; if ({ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AliasFor' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ContentType' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--dataType' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--For' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ForCheck' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Name' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Namespace' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--multipleProperties' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#resourceType' => 1 , 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' => 1 , ## TODO: Remove this. 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--QName' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Require' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--resourceFor' => 1 , }->{$xu}) { # } elsif ($el-> is_property_element (database_arg => $db)) { my $add_prop; $add_prop = sub ($$$) { my ($self, $el, $db) = @_; my $prop = $db-> get_resource ($el-> expanded_uri ); my $prop_uri = $prop-> uri ; my $prop_mult = $prop-> multiple_properties_uri ; my $new_value; my $base_type; my $copy_tree = 0 ; my %mtopt = (for_arg => $for, forp_arg => $forp, default_media_type => $prop-> default_lextype_uri , database_arg => $db); my $new_value_type = $el-> media_type_uri (%mtopt); if ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#QName' , $mtopt{default_media_type}, %mtopt)) { { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ($new_value_type, undef, base_type => $base_type = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#QName'); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; $new_value-> local_name ($el-> qname_value_local_name ); $new_value-> prefix (my $prefix = $el-> qname_value_prefix ); if (not defined $prefix) { if ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#LanguageTag' , $mtopt{default_media_type}, %mtopt)) { $new_value-> namespace_uri ('urn:x-suika-fam-cx:lang:'); } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#ScriptTag' , $mtopt{default_media_type}, %mtopt)) { $new_value-> namespace_uri ('http://suika.fam.cx/~wakaba/archive/2005/5/script#'); } else { $new_value-> namespace_uri ($el-> qname_value_namespace_uri ); } } else { $new_value-> namespace_uri ($el-> qname_value_namespace_uri ); } ## TODO: Check whether defined } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--TFQNames' , $mtopt{default_media_type}, %mtopt) or $el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#TFPQNames' , $mtopt{default_media_type}, %mtopt)) { { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $el->tfqnames_value_uri ($self->source_node_id, $self->for_uri, for_arg => $self->for_uri, forp_arg => $self->forp_uri, database_arg => $db)); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; ## TODO: Check whether defined $new_value_type = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' ; } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl' , $mtopt{default_media_type}, %mtopt)) { $el-> preserve_node_path ; { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value_ref ($new_value_type, $el->value_ref, base_type => $base_type = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl'); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} } ; for my $p ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--actualType' ) { if (UNIVERSAL::isa ($self->{$p}, 'Message::Util::IF::DVURIValue' )) { my $v; { $v = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $self->{$p}->uri); { local $Error::Depth = $Error::Depth + 1; { $v-> name ($prop_uri); } ;} ; } ; $new_value-> set_property ($p => $v); } } $new_value-> default_namespace_uri_ref ($el-> get_default_namespace_uri_ref ); $new_value-> namespace_binding_list ($el-> get_namespace_binding_list ($db)); $new_value-> source_node_path ($el-> flag ('nodePath')); } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#disdoc' , $mtopt{default_media_type}, %mtopt) or $el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#disdocInline' , $mtopt{default_media_type}, %mtopt) or $el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#muf' , $mtopt{default_media_type}, %mtopt) or $el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dpg' , $mtopt{default_media_type}, %mtopt) or $el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#tdterr' , $mtopt{default_media_type}, %mtopt)) { $el-> preserve_node_path ; { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value_ref ($new_value_type, $el->value_ref, base_type => $base_type = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#disdoc'); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} } ; $new_value-> default_namespace_uri_ref ($el-> get_default_namespace_uri_ref ); $new_value-> namespace_binding_list ($el-> get_namespace_binding_list ($db)); $new_value-> source_node_path ($el-> flag ('nodePath')); } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#XCRef' , $mtopt{default_media_type}, %mtopt)) { my $x = $db-> xcref_to_resource ($el-> value , $el, node => $el, for_arg => $self-> for_uri ); { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , ($x->[2] or $x->[1] or $x->[0]) ->uri); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; $new_value-> get_resource ($db) -> is_referred ($el); $new_value_type = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' ; } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#MemberRef' , $mtopt{default_media_type}, %mtopt)) { my $v = $el-> value ; $v =~ s/^\s+//; $v =~ s/\s+$//; my ($clsq, $mem, $gs) = split /\s*\.\s*/, $v, 3; my $res; if (defined $mem) { my $cls = $db-> get_resource ($el-> tfqnames_value_uri ($clsq, $self-> source_node_id , $self-> for_uri , node => $el)); $cls-> is_referred ($el); $res = $cls-> get_child_resource_by_name_and_type ($mem, 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#AnyMethod' ); unless ($res) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $el, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'read_properties', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode' => $v, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#expectedType' => defined $gs ? 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#Attribute' : 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#Method' , 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#localName' => $mem, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType' => $el->expanded_uri, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#parentURI' => $cls->uri; } ;} ; } if (defined $gs) { $res = $res-> get_child_resource_by_type ($gs eq 'get' ? 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#AttributeGet' : 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#AttributeSet' ); unless ($res) { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $el, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'read_properties', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode' => $v, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#expectedType' => $gs eq 'get' ? 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#AttributeGet' : 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#AttributeSet' , 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType' => $el->expanded_uri, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#parentURI' => $res->uri; } ;} ; } } } else { $res = $db-> get_resource ($el-> tfqnames_value_uri ($clsq, $self-> source_node_id , $self-> for_uri , node => $el)); } $res-> is_referred ($el); { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $el->uri); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; $new_value_type = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' ; } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis' , $mtopt{default_media_type}, %mtopt)) { $copy_tree = 1 ; $el-> preserve_node_path ; my $elc = $el->clone; { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ($new_value_type, $elc, base_type => $base_type = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis'); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; $elc-> unlink_from_document ($db); } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#Integer' , $mtopt{default_media_type}, %mtopt)) { my $v = $el-> value ; if ($v =~ /^0x/) { $v = hex $v; } else { $v += 0; } { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ($new_value_type, $v, base_type => $base_type = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#Integer'); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; } elsif ($el-> media_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#UString' , $mtopt{default_media_type}, %mtopt)) { my $v = $el-> value ; $v =~ s/\$\x0D?\x0A//gs; $v =~ s/\$\z//; warn 'String |'.$el-> value .'| contains '. 'illegal |$| character' if $v =~ /\$(?![uU])/; ## TODO: Use error-handler $v =~ s{\$(u[0-9A-Fa-f]{4}|U[0-9A-Fa-f]{8})}{ chr hex substr $1, 1 }ge; { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ('http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String', $v, base_type => $base_type = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String'); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; ## NOTE: Since |type| is set to |DISCore:String|, ## what subtype of |DISCore:UString| it was originally ## is not preserved. } else { { $new_value = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ($new_value_type, $el->value, base_type => $base_type = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String'); { local $Error::Depth = $Error::Depth + 1; { $new_value-> name ($prop_uri); } ;} ; } ; } unless ($copy_tree) { for my $ce (@{$el-> dis_child_elements (for_arg => $for, forp_arg => $forp, database_arg => $db)}) { my $xu = $ce-> expanded_uri ; if ({ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AliasFor' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--For' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ForCheck' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ContentType' => 1 , 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--resourceFor' => 1 , }->{$xu}) { # } elsif ($ce-> is_property_element (database_arg => $db)) { my $pr; { local $Error::Depth = $Error::Depth + 1; { $pr = $add_prop->($self, $ce, $db); } ;} ; if ($pr->{prop_mult} eq 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#OrderedList' ) { my $cpv = $new_value-> get_property ($xu); if (not $cpv) { { $cpv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_ordered_list ($mtopt{default_media_type}, base_type => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String'); } ; $new_value-> set_property ($xu => $cpv); } $cpv-> add_item ($pr->{new_value}); } elsif ($pr->{prop_mult} eq 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#UnorderedList' ) { my $cpv = $new_value-> get_property ($xu); if (not $cpv) { { $cpv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_unordered_list ($mtopt{default_media_type}, base_type => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String'); } ; $new_value-> set_property ($xu => $cpv); } $cpv-> add_item ($pr->{new_value}); } else { $new_value-> set_property ($xu => $pr->{new_value}); } } else { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $ce, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'read_properties', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNSUPPORTED_ELEMENT_TYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType' => $xu; } ;} ; } }} # copy_tree {new_value => $new_value, base_type => $base_type, prop_uri => $prop_uri, prop_mult => $prop_mult, new_value_type => $new_value_type}; }; my $pr; { local $Error::Depth = $Error::Depth + 1; { $pr = $add_prop->($self, $el, $db); } ;} ; if ($pr->{prop_mult} eq 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#OrderedList' ) { if (not $self->{$pr->{prop_uri}}) { { $self->{$pr->{prop_uri}} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_ordered_list ($pr->{new_value_type}, base_type => $pr->{base_type} || 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String'); } ; } $self->{$pr->{prop_uri}}-> add_item ($pr->{new_value}); } elsif ($pr->{prop_mult} eq 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#UnorderedList' ) { if (not $self->{$pr->{prop_uri}}) { { $self->{$pr->{prop_uri}} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_unordered_list ($pr->{new_value_type}, base_type => $pr->{base_type} || 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String'); } ; } $self->{$pr->{prop_uri}}-> add_item ($pr->{new_value}); } else { $self->{$pr->{prop_uri}} = $pr->{new_value}; } if ($el-> element_type_match ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Perl#propHashKey' , database_arg => $db)) { $db-> pl_add_hash_key ($xu => $pr->{new_value}-> string_value => $self); } } elsif ($el-> is_resource_element ) { ## TODO: Should rdf:type be validated? } else { { local $Error::Depth = $Error::Depth - 1; { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $el, '-type' => 'NOT_SUPPORTED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'read_properties', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNSUPPORTED_ELEMENT_TYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType' => $xu; } ;} ; } } CORE::delete $self->{src}; ($opt{on_resource_read} or sub () {})->($self, $self); } } ;} ; } } sub is_type_uri ($$) { my ($self, $typeURI) = @_; my $r = 0; { { local $Error::Depth = $Error::Depth + 1; { $r = $self-> type_resource -> is_subset_of_uri ($typeURI); } ;} ; } $r} sub revision ($;$) { if (@_ == 1) {my ($self) = @_; my $r = 0; { $r = $self->{ 'r' }; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'revision'; } } sub get_type_uri_list ($) { my ($self) = @_; my $r = []; { { local $Error::Depth = $Error::Depth + 1; { $r = $self-> type_resource -> get_super_resource_uri_list ; } ;} ; } $r} sub type_resource ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { $r = $self-> database -> get_resource ($self->{ 'tu' }); } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISAnyResource', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'type_resource'; } } sub add_type_uri ($$%) { my ($self, $uri, %opt) = @_; { { local $Error::Depth = $Error::Depth + 1; { my $current_type = $self-> type_resource ; unless ($current_type-> is_subset_of_uri ($uri, srinfo => $opt{srinfo})) { my $db = $self-> database ; my $res = $db-> get_resource ($uri); my $current_uri = $current_type-> uri ; if ($res-> is_subset_of_uri ($current_uri, srinfo => $opt{srinfo})) { $self->{ 'tu' } = $uri; } else { my $new_uri; { my $__uri1 = $current_uri; my $__uri2 = $uri; for my $__uri ($__uri1, $__uri2) { $__uri =~ s{([^0-9A-Za-z!\$'()*,:;=?\@_./~-])} {sprintf '%%%02X', ord $1}ge; } $new_uri = qq; } ; my $new_res = $db-> get_resource ($new_uri); unless ($new_res-> is_defined ) { $new_res-> is_anonymous ( 1 ); $new_res-> is_defined ( 1 ); $new_res-> add_super_resource ($current_type, srinfo => $opt{srinfo}); $new_res-> add_super_resource ($res, srinfo => $opt{srinfo}); } unless ($new_res-> owner_module_uri_ref ) { $new_res-> owner_module_uri_ref ($res-> owner_module_uri_ref ); } $self->{ 'tu' } = $new_uri; } } } ;} ; } } sub ___report_error ($$) { my ($self, $err) = @_; my $r; { if ($err->isa ( 'Message::DOM::IF::DOMError' )) { { local $Error::Depth = $Error::Depth + 1; { my $cfg = $self-> database -> dom_config ; my $h = $cfg-> get_parameter ('error-handler'); $r = $h-> handle_error ($err); } ;} ; } else { $err-> throw ; } } $r} sub get_error_interface_resource ($) { my ($self) = @_; my $r; { my $method; my $tr = $self-> type_resource ; { my $__type_uri = $tr-> uri ; $method = $Message::Util::DIS::Method{$__type_uri}->{'get_error_interface_resource'}; unless ($method) { my %__methods; for (@{$tr-> get_super_resource_uri_list }) { $__methods{$_} = $Message::Util::DIS::Method{$_}->{'get_error_interface_resource'} if $Message::Util::DIS::Method{$_}->{'get_error_interface_resource'}; } my $__db = $tr-> database ; T1: for my $__t1_uri (keys %__methods) { next T1 unless $__methods{$__t1_uri}; my $__t1 = $__db-> get_resource ($__t1_uri); T2: for my $__t2_uri (keys %__methods) { next T2 if $__t1_uri eq $__t2_uri; if ($__t1-> is_subset_of_uri ($__t2_uri)) { delete $__methods{$__t2_uri}; next T2; } if ($Message::Util::DIS::Method{$__t1_uri}->{'get_error_interface_resource'} eq $Message::Util::DIS::Method{$__t2_uri}->{'get_error_interface_resource'}) { delete $__methods{$__t2_uri}; next T2; } } } if (keys %__methods > 1) { report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#more-than-one-methods-for-a-type', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#method-name' => 'get_error_interface_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $__type_uri, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS%23getMethodForType+http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS%23ForLatest', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#method-resource-types' => [keys %__methods]; ; } $Message::Util::DIS::Method{$__type_uri}->{'get_error_interface_resource'} = $method = $__methods{[keys %__methods]->[0]} if %__methods; } } ; if ($method) { { local $Error::Depth = $Error::Depth + 1; { $r = $method->(@_); } ;} ; } else { $r = undef ; } } $r} sub get_error_code_resource ($) { my ($self) = @_; my $r; { my $method; my $tr = $self-> type_resource ; { my $__type_uri = $tr-> uri ; $method = $Message::Util::DIS::Method{$__type_uri}->{'get_error_code_resource'}; unless ($method) { my %__methods; for (@{$tr-> get_super_resource_uri_list }) { $__methods{$_} = $Message::Util::DIS::Method{$_}->{'get_error_code_resource'} if $Message::Util::DIS::Method{$_}->{'get_error_code_resource'}; } my $__db = $tr-> database ; T1: for my $__t1_uri (keys %__methods) { next T1 unless $__methods{$__t1_uri}; my $__t1 = $__db-> get_resource ($__t1_uri); T2: for my $__t2_uri (keys %__methods) { next T2 if $__t1_uri eq $__t2_uri; if ($__t1-> is_subset_of_uri ($__t2_uri)) { delete $__methods{$__t2_uri}; next T2; } if ($Message::Util::DIS::Method{$__t1_uri}->{'get_error_code_resource'} eq $Message::Util::DIS::Method{$__t2_uri}->{'get_error_code_resource'}) { delete $__methods{$__t2_uri}; next T2; } } } if (keys %__methods > 1) { report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#more-than-one-methods-for-a-type', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#method-name' => 'get_error_code_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $__type_uri, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS%23getMethodForType+http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS%23ForLatest', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#method-resource-types' => [keys %__methods]; ; } $Message::Util::DIS::Method{$__type_uri}->{'get_error_code_resource'} = $method = $__methods{[keys %__methods]->[0]} if %__methods; } } ; if ($method) { { local $Error::Depth = $Error::Depth + 1; { $r = $method->(@_); } ;} ; } else { $r = undef ; } } $r} sub get_dom_configuration_parameter_name ($) { my ($self) = @_; my $r = ''; { my $method; my $tr = $self-> type_resource ; { my $__type_uri = $tr-> uri ; $method = $Message::Util::DIS::Method{$__type_uri}->{'get_dom_configuration_parameter_name'}; unless ($method) { my %__methods; for (@{$tr-> get_super_resource_uri_list }) { $__methods{$_} = $Message::Util::DIS::Method{$_}->{'get_dom_configuration_parameter_name'} if $Message::Util::DIS::Method{$_}->{'get_dom_configuration_parameter_name'}; } my $__db = $tr-> database ; T1: for my $__t1_uri (keys %__methods) { next T1 unless $__methods{$__t1_uri}; my $__t1 = $__db-> get_resource ($__t1_uri); T2: for my $__t2_uri (keys %__methods) { next T2 if $__t1_uri eq $__t2_uri; if ($__t1-> is_subset_of_uri ($__t2_uri)) { delete $__methods{$__t2_uri}; next T2; } if ($Message::Util::DIS::Method{$__t1_uri}->{'get_dom_configuration_parameter_name'} eq $Message::Util::DIS::Method{$__t2_uri}->{'get_dom_configuration_parameter_name'}) { delete $__methods{$__t2_uri}; next T2; } } } if (keys %__methods > 1) { report Message::DOM::DOMCore::ManakaiDOMError -object => $self, '-type' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#more-than-one-methods-for-a-type', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#method-name' => 'get_dom_configuration_parameter_name', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $__type_uri, 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#resourceURI' => 'tag:suika.fam.cx,2005-09:http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS%23getMethodForType+http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS%23ForLatest', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#method-resource-types' => [keys %__methods]; ; } $Message::Util::DIS::Method{$__type_uri}->{'get_dom_configuration_parameter_name'} = $method = $__methods{[keys %__methods]->[0]} if %__methods; } } ; if ($method) { { local $Error::Depth = $Error::Depth + 1; { $r = $method->(@_); } ;} ; } else { $r = undef ; } } $r} use overload bool => sub () {1}, 'eq' => 'is_same_resource', fallback => 1; $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::DISModule; our $VERSION = 20060403.1342; package Message::Util::DIS::ManakaiDISModuleDefinition; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::DIS::ManakaiDISPropertyAccessor', 'Message::Util::DIS::Perl::ManakaiDISPerlModuleDefinition', 'Message::Util::DIS::Perl::ManakaiDISModulePerl', 'Message::Util::DIS::Perl::ManakaiDISAnyResourcePerl', 'Message::Util::DIS::ManakaiDISAnyResource', 'Message::DOM::IFLatest::GetFeature', 'Message::Util::IF::DISModule', 'Message::Util::IFLatest::DISModule'; sub uris ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = [$self->{uri}]; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uris'; } } sub owner_module ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_module'; } } sub get_feature ($$$) { my ($self, $feature, $version) = @_; { $feature = lc $feature; } { $version = '' unless defined $version; } my $r; { $feature =~ s/^\+//; CLASS: for my $class (grep { $Message::Util::DIS::ManakaiDISModuleDefinition::CompatClass{$_} } keys %Message::Util::DIS::ManakaiDISModuleDefinition::CompatClass) { if ($Message::DOM::ClassFeature{$class}->{$feature}->{$version}) { $r = bless {o => $self}, $class; last CLASS; } } } $r} sub add_resource_list ($$) { my ($self, $disResource) = @_; { { local $Error::Depth = $Error::Depth + 1; { push @{$self->{ 'mres' }||=[]}, map {\$_} @{$disResource-> uris }; } ;} ; } } sub add_resource_uri ($$) { my ($self, $uri) = @_; { push @{$self->{ 'mres' }||=[]}, \$uri; } } sub get_resource_uri_list ($) { my ($self) = @_; my $r; { $r = [map {$$_} @{$self->{ 'mres' } or []}]; } $r} sub get_resource_list ($) { my ($self) = @_; my $r = []; { { local $Error::Depth = $Error::Depth + 1; { my $db = $self-> database ; $r = [map { $db-> get_resource ($$_) } @{$self->{ 'mres' }}]; } ;} ; } $r} sub add_for_resource ($$) { my ($self, $disResource) = @_; { { local $Error::Depth = $Error::Depth + 1; { push @{$self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#forList' }||=[]}, $disResource-> uri_ref ; } ;} ; } } sub get_for_resource_list ($) { my ($self) = @_; my $r = []; { { local $Error::Depth = $Error::Depth + 1; { my $db = $self-> database ; $r = [map { $db-> get_for ($$_) } @{$self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#forList' }}]; } ;} ; } $r} sub target_namespace_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{ 'dns' } ? ${$self->{ 'dns' }} : undef ; } $r; } else {my ($self, $given) = @_; { if (defined $given) { $self->{ 'dns' } = \$given; } else { CORE::delete $self->{ 'dns' }; } } } } sub get_super_resource_uri_list ($) { my ($self) = @_; my $r = []; { $r = [$self->{uri}]; } $r} sub get_referring_module_uri_list ($) { my ($self) = @_; my $r = []; { $r = [grep {$self->{ 'ref' }->{$_}} keys %{$self->{ 'ref' } or {}}]; } $r} sub add_referring_module_uri ($$) { my ($self, $uri) = @_; { $self->{ 'ref' }->{$uri} = 1 ; } } $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#perl', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 2; $Message::Util::DIS::ManakaiDISModuleDefinition::CompatClass{q} = 1; package Message::Util::DIS::ManakaiDISModuleLite; our $VERSION = 20060403.1342; push our @ISA, 'Message::DOM::IFLatest::GetFeature', 'Message::Util::IF::DISAnyResourcePerl', 'Message::Util::IF::DISModulePerl', 'Message::Util::IF::DISResourcePerlModule', 'Message::Util::IFLatest::DISResourceProp'; sub uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{uri}; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uri'; } } sub uri_ref ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = \ ($self->{uri}); } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uri_ref'; } } sub uris ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = [$self->{uri}]; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uris'; } } sub is_same_resource ($$) { my ($self, $anotherResource) = @_; my $r = 0; { if (UNIVERSAL::isa ($anotherResource, 'Message::Util::DIS::ManakaiDISAnyResource' )) { $r = $self->{uri} eq $anotherResource->{uri}; } } $r} sub name_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { if (defined $self->{localName}) { $r = defined $self->{namespaceURI} ? ${$self->{namespaceURI}} . ${$self->{localName}} : ${$self->{localName}}; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'name_uri'; } } sub local_name ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{localName} ? ${$self->{localName}} : undef ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'local_name'; } } sub namespace_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{namespaceURI} ? ${$self->{namespaceURI}} : undef ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'namespace_uri'; } } sub for_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{for} ? ${$self->{for}} : undef ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'for_uri'; } } sub forp_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = [@{$self->{forp}}]; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'forp_uri'; } } sub is_for_uri ($$) { my ($self, $forURI) = @_; my $r = 0; { { local $Error::Depth = $Error::Depth + 1; { C: for my $this_for_uri (${$self->{for}||\''}, @{$self->{forp}||[]}) { if ($this_for_uri eq $forURI) { ## Shortcut $r = 1 ; last C; } my $this_for = $self-> database -> get_for ($this_for_uri); if ($this_for-> isa_uri ($forURI)) { $r = 1 ; last C; } } } ;} ; } $r} sub is_defined ($;$) { if (@_ == 1) {my ($self) = @_; my $r = 0; { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isDefined' }; } $r; } else {my ($self, $given) = @_; { $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#isDefined' } = $given; } } } sub owner_module ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_module'; } } sub owner_module_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{uri}; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_module_uri'; } } sub owner_module_uri_ref ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = \ ($self->{uri}); } $r; } else {my ($self, $given) = @_; { # no effect } } } sub database ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{db}; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'database'; } } sub AUTOLOAD ($) { my ($self) = @_; { my $al = our $AUTOLOAD; $al =~ s/.+:://; if ($al ne 'DESTROY') { { local $Error::Depth = $Error::Depth + 1; { $self-> database -> _pl_load_dis_database_module ($self); } ;} ; if (ref $self eq 'Message::Util::DIS::ManakaiDISModuleLite' ) { report Message::Util::DIS::ManakaiDISException -object => $self, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'AUTOLOAD', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $self->uri, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#moduleURI' => $self->uri; ; } my $code = $self->can ($al); if ($code) { goto &$code; } else { require Carp; local $Carp::CarpLevel = $Error::Depth; Carp::croak (qq); } } # $al } } sub target_namespace_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = defined $self->{ 'dns' } ? ${$self->{ 'dns' }} : undef ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISModuleLite', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'target_namespace_uri'; } } use overload bool => sub () {1}, 'eq' => 'is_same_resource', fallback => 1; $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::DISFor; our $VERSION = 20060403.1342; package Message::Util::DIS::ManakaiDISForDefinition; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::DIS::Perl::ManakaiDISAnyResourcePerl', 'Message::Util::DIS::ManakaiDISPropertyAccessor', 'Message::Util::DIS::ManakaiDISAnyResource', 'Message::Util::IF::DISFor', 'Message::Util::IFLatest::DISFor'; sub uris ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = [$self->{uri}]; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISForDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uris'; } } sub isa_uri ($$) { my ($self, $superURI) = @_; my $r = 0; { $r = $self->{uri} eq $superURI ? 1 : $self->{isa}->{$superURI}; } $r} sub add_isa ($$) { my ($self, $superFor) = @_; { my @from = ($self->{uri}, grep {$self->{revISA}->{$_}} keys %{$self->{revISA}}); my @to = ($superFor->{uri}, grep {$superFor->{isa}->{$_}} keys %{$superFor->{isa}}); { local $Error::Depth = $Error::Depth + 1; { for my $from (@from) { for my $to (@to) { $self->{db}-> get_for ($from)->{isa}->{$to} = 1 ; $self->{db}-> get_for ($to)->{revISA}->{$from} = 1 ; } } } ;} ; } } sub get_feature ($$$) { my ($self, $feature, $version) = @_; { $feature = lc $feature; } { $version = '' unless defined $version; } my $r; { $feature =~ s/^\+//; CLASS: for my $class (grep { $Message::Util::DIS::ManakaiDISForDefinition::CompatClass{$_} } keys %Message::Util::DIS::ManakaiDISForDefinition::CompatClass) { if ($Message::DOM::ClassFeature{$class}->{$feature}->{$version}) { $r = bless {o => $self}, $class; last CLASS; } } } $r} sub for_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#all' ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISForDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'for_uri'; } } sub forp_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = []; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISForDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'forp_uri'; } } sub is_for_uri ($$) { my ($self, $forURI) = @_; my $r = 0; { $r = 1 ; } $r} sub name_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->{uri}; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISForDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'name_uri'; } } sub get_super_resource_uri_list ($) { my ($self) = @_; my $r = []; { $r = [ (grep {$self->{isa}->{$_}} keys %{$self->{isa}}), (grep {$self->{aliasURI}->{$_}} keys %{$self->{aliasURI}}), ($self->{uri}), ]; } $r} $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#perl', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 2; $Message::Util::DIS::ManakaiDISForDefinition::CompatClass{q} = 1; package Message::Util::IFLatest::DISResource; our $VERSION = 20060403.1342; package Message::Util::DIS::ManakaiDISResourceDefinition; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::DIS::ManakaiDISResourceMV', 'Message::Util::DIS::Perl::ManakaiDISResourcePerl', 'Message::Util::DIS::Perl::ManakaiDISPerlModuleDefinition', 'Message::Util::DIS::Perl::ManakaiDISAnyResourcePerl', 'Message::Util::DIS::ManakaiDISPropertyAccessor', 'Message::Util::DIS::ManakaiDISAnyResource', 'Message::Util::IF::DISResource', 'Message::Util::IFLatest::DISResource'; sub uris ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = [grep {$self->{aliasURI}->{$_}} keys %{$self->{aliasURI}}]; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'uris'; } } sub is_subset_of_uri ($$%) { my ($self, $superURI, %opt) = @_; my $r = 0; { $r = $self->{aliasURI}->{$superURI} || $self->{subOf}->{$superURI}; if (not $r and $opt{srinfo}) { A: { if ($opt{srinfo}->{resource}->{$superURI}) { for my $this_uri (grep {$self->{aliasURI}->{$_}} keys %{$self->{aliasURI}}) { if ($opt{srinfo}->{resource}->{$superURI}->{aliasURI}->{$this_uri}) { $r = 1 ; last A; } if ($opt{srinfo}->{resource}->{$superURI}->{supOf}->{$this_uri}) { $r = 1 ; last A; } } } for my $this_uri (grep {$self->{aliasURI}->{$_}} keys %{$self->{aliasURI}}) { if ($opt{srinfo}->{resource}->{$this_uri}) { if ($opt{srinfo}->{resource}->{$this_uri}->{aliasURI}->{$superURI}) { $r = 1 ; last A; } } } } # A } } $r} sub add_super_resource ($$%) { my ($self, $superRes, %opt) = @_; { my @from = ($self->{uri}, grep {$self->{supOf}->{$_}} keys %{$self->{supOf}||{}}); my @to = ($superRes->{uri}, grep {$superRes->{subOf}->{$_}} keys %{$superRes->{subOf}||{}}); { local $Error::Depth = $Error::Depth + 1; { for my $from (@from) { for my $to (@to) { $self->{db}-> get_resource ($from)->{subOf}->{$to} = 1 ; $opt{srinfo}->{resource}->{$from}->{subOf}->{$to} = 1 ; $self->{db}-> get_resource ($to)->{supOf}->{$from} = 1 ; $opt{srinfo}->{resource}->{$to}->{supOf}->{$from} = 1 ; } } } ;} ; } } sub merge_as_alias ($$%) { my ($self, $aliasResource, %opt) = @_; { if (not $opt{no_equality_check} and $self eq $aliasResource) { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $opt{node}, '-type' => 'HIERARCHY_REQUEST_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#method' => 'merge_as_alias', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#MERGE_ITSELF_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $self->uri; ; } for my $uri ($aliasResource->{uri}, grep {$aliasResource->{aliasURI}->{$_}} keys %{$aliasResource->{aliasURI}}) { $self->{aliasURI}->{$uri} = 1 ; $self->{db}->{resDef}->{$uri} = $self; $self->{subOf}->{$uri} = 1 ; $self->{supOf}->{$uri} = 1 ; } for my $uri (grep {$aliasResource->{subOf}->{$_}} keys %{$aliasResource->{subOf}||{}}) { $self->{subOf}->{$uri} = 1 ; } for my $uri (grep {$aliasResource->{supOf}->{$_}} keys %{$aliasResource->{supOf}||{}}) { $self->{supOf}->{$uri} = 1 ; } my @from = grep {$self->{supOf}->{$_}} keys %{$self->{supOf}||{}}; my @to = grep {$self->{subOf}->{$_}} keys %{$self->{subOf}||{}}; { local $Error::Depth = $Error::Depth + 1; { for my $from (@from) { for my $to (@to) { $self->{db}-> get_resource ($from)->{subOf}->{$to} = 1 ; $opt{srinfo}->{resource}->{$from}->{subOf}->{$to} = 1 ; $self->{db}-> get_resource ($to)->{supOf}->{$from} = 1 ; $opt{srinfo}->{resource}->{$to}->{supOf}->{$from} = 1 ; } } } ;} ; } } sub dis_data_type_resource ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }, 'Message::Util::IF::DVURIValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }-> get_resource ($self-> database ); } else { my $pr = $self-> dynamic_parent_resource ; $r = $pr-> dis_data_type_resource if $pr; } } ;} ; unless ($r) { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $self->source_element, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_DIS_TYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_data_type_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $self->uri; ; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_data_type_resource'; } } sub dis_data_type_value ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }, 'Message::Util::IF::DVURIValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }; } else { my $pr = $self-> dynamic_parent_resource ; $r = $pr-> dis_data_type_value if $pr; } } ;} ; unless ($r) { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $self->source_element, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_DIS_TYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_data_type_value', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $self->uri; ; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_data_type_value'; } } sub dis_actual_data_type_resource ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--actualType' }, 'Message::Util::IF::DVURIValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--actualType' }-> get_resource ($self-> database ); } elsif (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }, 'Message::Util::IF::DVURIValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }-> get_resource ($self-> database ); } else { my $pr = $self-> dynamic_parent_resource ; $r = $pr-> dis_actual_data_type_resource if $pr; } } ;} ; unless ($r) { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $self->source_element, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_DIS_TYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_actual_data_type_resource', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $self->uri; ; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_actual_data_type_resource'; } } sub dis_actual_data_type_value ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--actualType' }, 'Message::Util::IF::DVURIValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--actualType' }; } elsif (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }, 'Message::Util::IF::DVURIValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Type' }; } else { my $pr = $self-> dynamic_parent_resource ; $r = $pr-> dis_actual_data_type_value if $pr; } } ;} ; unless ($r) { report Message::Util::DIS::ManakaiDISException -object => $self, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' => $self->source_element, '-type' => 'INVALID_SOURCE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_DIS_TYPE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_actual_data_type_value', 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' => $self->uri; ; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_actual_data_type_value'; } } sub _add_child_resource ($$) { my ($self, $disResource) = @_; { { local $Error::Depth = $Error::Depth + 1; { push @{$self->{ 'curis' }||=[]}, $disResource-> uri_ref ; } ;} ; } } sub _add_dynamic_child_resource ($$) { my ($self, $disResource) = @_; { { local $Error::Depth = $Error::Depth + 1; { push @{$self->{ 'dcuris' }||=[]}, $disResource-> uri_ref ; } ;} ; } } sub get_child_resource_list ($) { my ($self) = @_; my $r = []; { { local $Error::Depth = $Error::Depth + 1; { my $db = $self-> database ; $r = [map { $db-> get_resource ($$_) } @{$self->{ 'curis' }}]; } ;} ; } $r} sub get_dynamic_child_resource_list ($) { my ($self) = @_; my $r = []; { { local $Error::Depth = $Error::Depth + 1; { my $db = $self-> database ; $r = [map { $db-> get_resource ($$_) } @{$self->{ 'dcuris' }}]; } ;} ; } $r} sub get_child_resource_by_type ($$) { my ($self, $typeURI) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $db = $self-> database ; C: for my $cr_uri (@{$self->{ 'curis' }||[]}) { my $cr = $db-> get_resource ($$cr_uri); if ($cr-> is_type_uri ($typeURI)) { $r = $cr; last C; } } } ;} ; } $r} sub get_child_resource_list_by_type ($$) { my ($self, $typeURI) = @_; my $r = []; { { local $Error::Depth = $Error::Depth + 1; { my $db = $self-> database ; $r = [grep { $_-> is_type_uri ($typeURI) } map { $db-> get_resource ($$_) } @{$self->{ 'curis' }||[]}]; } ;} ; } $r} sub get_child_resource_by_name_and_type ($$$) { my ($self, $localName, $typeURI) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $db = $self-> database ; C: for my $cr_uri (@{$self->{ 'curis' }||[]}) { my $cr = $db-> get_resource ($$cr_uri); my $ln = $cr-> local_name ; if (defined $ln and $ln eq $localName and $cr-> is_type_uri ($typeURI)) { $r = $cr; last C; } } } ;} ; } $r} sub get_const_resource_by_name ($$) { my ($self, $localName) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my @constGroup; my $db = $self-> database ; C: for my $cr_uri (@{$self->{ 'curis' }||[]}) { my $cr = $db-> get_resource ($$cr_uri); my $ln = $cr-> local_name ; if ($ln and $ln eq $localName and $cr-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#Const' )) { $r = $cr; last C; } elsif ($cr-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#ConstGroup' )) { push @constGroup, $cr; } } unless ($r) { D: for my $cg (@constGroup) { $r = $cg-> get_child_resource_by_name_and_type ($localName, 'http://suika.fam.cx/~wakaba/archive/2004/dis/Lang#Const' ); last D if $r; } } } ;} ; } $r} sub parent_resource ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if ($self->{ 'puri' }) { $r = $self-> database -> get_resource (${$self->{ 'puri' }}); } } ;} ; } $r; } else {my ($self, $given) = @_; { { local $Error::Depth = $Error::Depth + 1; { if ($given) { $self->{ 'puri' } = $given-> uri_ref ; } else { CORE::delete $self->{ 'puri' }; } } ;} ; } } } sub dynamic_parent_resource ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if ($self->{ 'dpuri' }) { $r = $self-> database -> get_resource (${$self->{ 'dpuri' }}); } } ;} ; } $r; } else {my ($self, $given) = @_; { { local $Error::Depth = $Error::Depth + 1; { if ($given) { $self->{ 'dpuri' } = $given-> uri_ref ; } else { CORE::delete $self->{ 'dpuri' }; } } ;} ; } } } sub owner_class_node_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { if (exists $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#ownerClass' }) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#ownerClass' }; } else { my $res = $self; { local $Error::Depth = $Error::Depth + 1; { RES: { if ($res-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#Class' )) { $r = $res-> source_node_id ; } else { $res = $res-> parent_resource ; redo RES if $res; } } } ;} ; $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#ownerClass' } = $r; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'owner_class_node_uri'; } } sub dis_is_null_value ($;$) { if (@_ == 1) {my ($self) = @_; my $r = 0; { if ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Value' }) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--Value' }-> is_null ; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'dis_is_null_value'; } } sub feature_name_list ($;$) { if (@_ == 1) {my ($self) = @_; my $r = []; { { local $Error::Depth = $Error::Depth + 1; { $r = [map {lc} @{$self-> get_property_text_list ( 'http://suika.fam.cx/~wakaba/archive/2004/dom/feature#name' )}]; unless (@$r) { ## TODO: instance feature my $pr = $self-> parent_resource ; if ($pr) { if ($pr-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/dom/feature#Feature' ) and not $pr-> is_anonymous ) { push @$r, @{$pr-> feature_name_list }; } } } unless (@$r) { if ($self-> is_anonymous ) { my $ln = $self-> local_name ; push @$r, lc $ln if defined $ln; } else { push @$r, lc $self-> name_uri ; } } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'feature_name_list'; } } sub get_feature ($$$) { my ($self, $feature, $version) = @_; { $feature = lc $feature; } { $version = '' unless defined $version; } my $r; { $feature =~ s/^\+//; CLASS: for my $class (grep { $Message::Util::DIS::ManakaiDISResourceDefinition::CompatClass{$_} } keys %Message::Util::DIS::ManakaiDISResourceDefinition::CompatClass){ if ($Message::DOM::ClassFeature{$class}->{$feature}->{$version}) { $r = bless {o => $self}, $class; last CLASS; } } } $r} sub multiple_properties_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r = ''; { { local $Error::Depth = $Error::Depth + 1; { if ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--multipleProperties' }) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--multipleProperties' } -> get_resource ($self-> database ) -> uri ; } else { $r = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#OrderedList' ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'multiple_properties_uri'; } } sub default_lextype_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r = ''; { { local $Error::Depth = $Error::Depth + 1; { if ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--dataType' }) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--dataType' } -> get_resource ($self-> database ) -> uri ; } else { $r = 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#String' ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceDefinition', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'default_lextype_uri'; } } sub get_super_resource_uri_list ($) { my ($self) = @_; my $r = []; { $r = [ (grep {$self->{subOf}->{$_}} keys %{$self->{subOf}}), (grep {$self->{aliasURI}->{$_}} keys %{$self->{aliasURI}}), ]; } $r} use overload bool => sub () {1}, '<=>' => sub ($$) { my ($self, $anotherResource) = @_; my $r = 0; { if (UNIVERSAL::isa ($anotherResource, 'Message::Util::DIS::ManakaiDISResourceDefinition' )) { $r = $self->{seq} <=> $anotherResource->{seq}; } else { $r = $self->{uri} <=> $anotherResource; } } $r} , fallback => 1; $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}, 'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#perl', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 2; $Message::Util::DIS::ManakaiDISResourceDefinition::CompatClass{q} = 1; package Message::Util::IFLatest::DISResourceMV; our $VERSION = 20060403.1342; package Message::Util::DIS::ManakaiDISResourceMV; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::IF::DISResourceMV', 'Message::Util::IFLatest::DISResourceMV'; sub mv_local_name ($;$) { if (@_ == 1) {my ($self) = @_; my $r = ''; { { local $Error::Depth = $Error::Depth + 1; { if (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }, 'Message::Util::IF::DVQNameValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }-> local_name ; } elsif (defined $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }-> string_value ; } else { $r = $self-> local_name ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceMV', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'mv_local_name'; } } sub mv_prefix ($;$) { if (@_ == 1) {my ($self) = @_; my $r = ''; { { local $Error::Depth = $Error::Depth + 1; { if (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }, 'Message::Util::IF::DVQNameValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }-> prefix ; } unless (defined $r) { my $nsuri = $self-> mv_namespace_uri ; if (defined $nsuri and $nsuri =~ /([A-Za-z]\w*)\W*$/) { $r = $1; } elsif (defined $nsuri) { $r = 'ns'; } } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceMV', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'mv_prefix'; } } sub mv_namespace_uri ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if (UNIVERSAL::isa ($self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }, 'Message::Util::IF::DVQNameValue' )) { $r = $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }-> namespace_uri ; } elsif (defined $self->{ 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--AppName' }) { $r = undef ; } else { $r = $self-> namespace_uri ; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceMV', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'mv_namespace_uri'; } } sub mv_owner_element_resource ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { if (exists $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#mvOwnerElementURI' }) { $r = $self-> database -> get_resource ($self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#mvOwnerElementURI' }) if defined $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#mvOwnerElementURI' }; } else { $r = $self-> parent_resource ; undef $r if $r and not $r-> is_type_uri ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Markup#AnyOwnerElement' ); $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#mvOwnerElementURI' } = $r-> uri if $r; } } ;} ; } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISResourceMV', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'mv_owner_element_resource'; } } $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::DISResourceProp; our $VERSION = 20060403.1342; package Message::Util::DIS::ManakaiDISPropertyAccessor; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::IF::DISResourceProp', 'Message::Util::IFLatest::DISResourceProp'; sub get_property_value ($$) { my ($self, $propName) = @_; my $r; { if ($self->{$propName}) { $r = $self->{$propName}->[0]; } else { my $pr = $self-> database -> get_resource ($propName); A: for (grep {$pr->{aliasURI}->{$_} or $pr->{supOf}->{$_}} (keys %{$pr->{aliasURI}}, keys %{$pr->{supOf}||{}})) { my $v = $self->{$_}; if ($v) { $r = $v->[0]; last A; } } } } $r} sub get_property_value_list ($$) { my ($self, $propName) = @_; my $r = []; { my $pr = $self-> database -> get_resource ($propName); $r = [map {@$_} grep {defined $_} map {$self->{$_}} grep {$pr->{aliasURI}->{$_} or $pr->{supOf}->{$_}} (keys %{$pr->{aliasURI}}, keys %{$pr->{supOf}||{}})]; } $r} sub get_property_boolean ($$$) { my ($self, $propName, $default) = @_; my $r = 0; { if (ref $self->{$propName}) { $r = $self->{$propName}-> value ? 1 : 0 ; $r = $default unless defined $r; } else { my $pr = $self-> database -> get_resource ($propName); C: { for (map {$self->{$_}} grep {$pr->{aliasURI}->{$_} or $pr->{supOf}->{$_}} (keys %{$pr->{aliasURI}}, keys %{$pr->{supOf}||{}})) { if (defined $_) { $r = $_-> value ? 1 : 0 ; last C; } } $r = $default; } # C } } $r} sub get_property_text ($$;$) { my ($self, $propName, $default) = @_; my $r = ''; { if (defined $self->{$propName}) { $r = $self->{$propName}-> string_value ; $r = $default unless defined $r; } else { my $pr = $self-> database -> get_resource ($propName); C: { for (map {$self->{$_}} grep {$pr->{aliasURI}->{$_} or $pr->{supOf}->{$_}} (keys %{$pr->{aliasURI}}, keys %{$pr->{supOf}||{}})) { if (defined $_) { $r = $_-> string_value ; last C; } } $r = $default; } # C } } $r} sub get_property_text_list ($$%) { my ($self, $propName, %opt) = @_; my $r = []; { my $pr = $self-> database -> get_resource ($propName); $r = [map {$_-> string_value } map {@$_} grep {$_} map {$self->{$_}} grep {$pr->{aliasURI}->{$_} or $pr->{supOf}->{$_}} (keys %{$pr->{aliasURI}}, keys %{$pr->{supOf}||{}})]; } $r} sub get_property_resource ($$%) { my ($self, $propName, %opt) = @_; my $r; { { local $Error::Depth = $Error::Depth + 1; { my $v = $self-> get_property_value ($propName); if (UNIVERSAL::isa ($v, 'Message::Util::IF::DVURIValue' )) { $r = $v-> get_resource ($self-> database ); } } ;} ; } $r} sub get_property_resource_list ($$%) { my ($self, $propName, %opt) = @_; my $r = []; { $r = []; { local $Error::Depth = $Error::Depth + 1; { my $v = $self-> get_property_value_list ($propName); my $db = $self-> database ; for my $a (@$v) { if ($a->isa ( 'Message::Util::IF::DVURIValue' )) { push @$r, $a-> get_resource ($db); } if ($opt{isa_recursive}) { my $b = $a-> get_property ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#stopISARecursive' ); if ($b and $b-> value ) { $opt{isa_recursive} = 0 ; } } } } ;} ; if ($opt{recursive}) { { local $Error::Depth = $Error::Depth + 1; { $opt{___recursive_isa_done} ||= {$self-> uri => 1 }; my @p_res = @$r; for my $p_res (@p_res) { my $p_res_uri = $p_res-> uri ; next if $opt{___recursive_isa_done}->{$p_res_uri}; $opt{___recursive_isa_done}->{$p_res_uri} = 1 ; push @$r, @{$p_res-> get_property_resource_list ($propName, recursive => 1 , recursive_isa => $opt{recursive_isa}, ___recursive_isa_done => $opt{___recursive_isa_done}, default_media_type => $opt{default_media_type})}; } } ;} ; } if ($opt{recursive_isa}) { { local $Error::Depth = $Error::Depth + 1; { $opt{___recursive_isa_done} ||= {$self-> uri => 1 }; my @p_res = @$r; for my $p_res (@p_res) { my $p_res_uri = $p_res-> uri ; next if $opt{___recursive_isa_done}->{$p_res_uri}; $opt{___recursive_isa_done}->{$p_res_uri} = 1 ; push @$r, @{$p_res-> get_property_resource_list ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ISA' , recursive => 1 , ___recursive_isa_done => $opt{___recursive_isa_done}, default_media_type => $opt{default_media_type})}; } } ;} ; } if ($opt{isa_recursive}) { { local $Error::Depth = $Error::Depth + 1; { my $self_uri = $self-> uri ; $opt{___recursive_isa_done} ||= {$self_uri => 1 }; $opt{___isa_recursive_done} ||= {$self_uri => 1 }; my @p_res = @{$self-> get_property_resource_list ( 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--ISA' , recursive_isa => 0 , recursive => 0 , default_media_type => 'http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--TFQNames' )}; for my $p_res (@p_res) { my $p_res_uri = $p_res-> uri ; next if $opt{___isa_recursive_done}->{$p_res_uri}; $opt{___isa_recursive_done}->{$p_res_uri} = 1 ; push @$r, @{$p_res-> get_property_resource_list ($propName, recursive_isa => 0 , recursive => 0 , isa_recursive => 1 , ___isa_recursive_done => $opt{___isa_recursive_done}, default_media_type => $opt{default_media_type})}; } } ;} ; } } $r} sub add_property_resource_list ($$$) { my ($self, $propName, $res) = @_; { if ($self->{$propName}) { my $uriv; { $uriv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $res->uri); { local $Error::Depth = $Error::Depth + 1; { $uriv-> name ($propName); } ;} ; } ; $self->{$propName}-> add_item ($uriv); } else { { $self->{$propName} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_ordered_list ('http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI', base_type => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI'); } ; my $uriv; { $uriv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $res->uri); { local $Error::Depth = $Error::Depth + 1; { $uriv-> name ($propName); } ;} ; } ; $self->{$propName}-> add_item ($uriv); } } } sub add_property_resource_ulist ($$$) { my ($self, $propName, $res) = @_; { if ($self->{$propName}) { my $uriv; { $uriv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $res->uri); { local $Error::Depth = $Error::Depth + 1; { $uriv-> name ($propName); } ;} ; } ; $self->{$propName}-> add_item ($uriv); } else { { $self->{$propName} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_unordered_list ('http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI', base_type => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI'); } ; my $uriv; { $uriv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $res->uri); { local $Error::Depth = $Error::Depth + 1; { $uriv-> name ($propName); } ;} ; } ; $self->{$propName}-> add_item ($uriv); } } } sub add_peoperty_uri_ulist ($$$) { my ($self, $propName, $uri) = @_; { { local $Error::Depth = $Error::Depth + 1; { if ($self->{$propName}) { my $uriv; { $uriv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $uri); { local $Error::Depth = $Error::Depth + 1; { $uriv-> name ($propName); } ;} ; } ; $self->{$propName}-> add_item ($uriv); } else { { $self->{$propName} = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_unordered_list ('http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI', base_type => 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI'); } ; my $uriv; { $uriv = Message::Util::DIS::Value::ManakaiDISImplementationValue->create_dv_value ( 'http://suika.fam.cx/~wakaba/archive/2004/dis/Core#URI' , $uri); { local $Error::Depth = $Error::Depth + 1; { $uriv-> name ($propName); } ;} ; } ; $self->{$propName}-> add_item ($uriv); } } ;} ; } } $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; package Message::Util::IFLatest::DISException; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::Error'; sub ___error_def () { \%Message::Util::IFLatest::DISException::ErrorDef } sub HIERARCHY_REQUEST_ERR () { '3'} $Message::Util::IFLatest::DISException::ErrorDef{'HIERARCHY_REQUEST_ERR'} = {'description', 'An attempt is made to break the hierarchy.', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#code', '3'}; $Message::Util::IFLatest::DISException::ErrorDef{'HIERARCHY_REQUEST_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#MERGE_ITSELF_ERR'} = {'description', 'An attempt is made to merge the resource <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri} );> to itself'}; sub NOT_SUPPORTED_ERR () { '9'} $Message::Util::IFLatest::DISException::ErrorDef{'NOT_SUPPORTED_ERR'} = {'description', 'An attempt is made to do something the implementation does not support.', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#code', '9'}; $Message::Util::IFLatest::DISException::ErrorDef{'NOT_SUPPORTED_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNSUPPORTED_MEDIA_TYPE_ERR'} = {'description', '%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode}, prefix => {"}, suffix => {": } );%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType}, prefix => { (Element type: <}, suffix => {>) } );Media type <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});> is not supported'}; $Message::Util::IFLatest::DISException::ErrorDef{'NOT_SUPPORTED_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNSUPPORTED_ELEMENT_TYPE_ERR'} = {'description', 'Element type "%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType});" is not supported'}; sub INVALID_STATE_ERR () { '11'} $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_STATE_ERR'} = {'description', 'An attempt is made to use an object that is not (or no longer) usable.', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#code', '11'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_STATE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_ASSOCIATED_DB_ERR'} = {'description', 'No database has been associated with this document.'}; sub INVALID_SOURCE_ERR () { '501'} $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'} = {'description', 'The source input is well-formed but invalid.', 'http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#code', '501'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_MODULE_QNAME_ERR'} = {'description', 'The element must have its attribute.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_LOCAL_NAME_ERR'} = {'description', 'The resource does not have a local name.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNABLE_TO_GET_MODULE_ERR'} = {'description', 'Unable to get the module source of <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});>'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_FOR_QNAME_ERR'} = {'description', 'A element must have attribute.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#FOR_ALREADY_DEFINED_ERR'} = {'description', ' <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});> is already defined'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_ALREADY_DEFINED_ERR'} = {'description', '%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#moduleURI}, prefix => {Module <}, suffix => {>: }) ;Resource <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});> is already defined'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#ELEMENT_NOT_ALLOWED_ERR'} = {'description', 'Module <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});>: Element of type <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType});> is not allowed here'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_REQUIRED_ATTR_ERR'} = {'description', 'Attribute <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType});> must be specified'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#FOR_NOT_DEFINED_ERR'} = {'description', ' <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});> is not defined'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESOURCE_NOT_DEFINED_ERR'} = {'description', '%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#moduleURI}, prefix => {Module <}, suffix => {>: }) ;%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNodePath}, suffix => {: }) ;%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode}, prefix => {"}, suffix => {": }) ;%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#parentURI}, prefix => {(In <}, suffix => {>) }) ;Resource%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri}, prefix => { <}, suffix => {>});%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#localName}, prefix => { "}, suffix => {"}); is not defined or wrong type%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#expectedType}, prefix => { (<}, suffix => {> is expected)});'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_SOURCE_NODE_ERR'} = {'description', 'A resource does not have associated node in the source tree.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#RESERVED_PERL_METHOD_NAME_ERR'} = {'description', 'A reserved Perl method name is used.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_DIS_TYPE_ERR'} = {'description', 'Resource "%t (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});" has no "dis:Type" attribute'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_METHOD_RETURN_ERR'} = {'description', 'Method "%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#localName});" does not have "Return" child'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_ATTR_GET_ERR'} = {'description', 'A resource does not have any child.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#INTERFACE_CLASS_METHOD_ERR'} = {'description', 'An attempt is made to call a static (class) method from an interface.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#BROKEN_PARAM_SPEC_ERR'} = {'description', '%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode}, prefix => {"}, suffix => {": });Broken parameter specification'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_PREPROCESS_NO_ELEMENT_TYPE_ERR'} = {'description', '%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode}, prefix => {"}, suffix => {": });Element type name is not specified'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_PERL_PACKAGE_NAME_ERR'} = {'description', '%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri}, prefix => {<}, suffix => {>: });Perl package name is not defined'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_PREPROCESS_NO_EXCEPTION_TYPE_ERR'} = {'description', 'An exception type specification is required.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_PREPROCESS_NO_CODE_NAME_ERR'} = {'description', 'A code name specification is required.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_CODE_NOT_DEFINED_ERR'} = {'description', 'Resource%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri}, prefix => { "}, suffix => {"}); has no Perl code definition'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_PREPROCESS_NO_METHOD_ERR'} = {'description', 'A preprocessing instruction which is only allowed in method definitions is used in a code which is not a method.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_PREPROCESS_NO_FOR_ERR'} = {'description', 'A specification is required.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_PREPROCESS_NO_ASSERT_TYPE_ERR'} = {'description', 'An assertion type specification is required.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_PREPROCESS_BLOCK_NOT_ALLOWED_ERR'} = {'description', 'A preprocessing instruction block occurred with element type which does not allow it.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NON_NAMED_PARAMETER_AFTER_NAMED_ERR'} = {'description', 'A non-named method parameter following any named method parameter is occurred.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#DISPERL_NO_VALUE_ALLOWED_ERR'} = {'description', 'An element node have a value but the definition of that element type does not allow it.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_CONST_VALUE_ERR'} = {'description', 'The source element node for a constant value resource does not have attribute.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_ATTR_SET_ERR'} = {'description', 'An attribute setter is referred but the attribute does not define any setter.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_SUBROUTINE_ALREADY_DEFINED_ERR'} = {'description', 'A resource defines a Perl subroutine whose name is same as another subroutine.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_OPERATOR_ALREADY_OVERLOADED_ERR'} = {'description', 'A resource is defined to overload a Perl operator which is already overloaded by another resource.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_UNUSED_SUBROUTINE_ERR'} = {'description', 'A resource defines a Perl subroutine but it is not used.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_LICENSE_ATTR_ERR'} = {'description', 'The element does not have the attribute.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#UNSUPPORTED_ROLE_ERR'} = {'description', 'Role <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});> is not supported'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_REFLECT_GET_DEFINED_ERR'} = {'description', 'An attribute is defined to reflect an element attribute but no reflecting attribute getter template is defined.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_REFLECT_SET_DEFINED_ERR'} = {'description', 'An attribute is defined to reflect an element attribute but no reflecting attribute setter template is defined.'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_END_TAG_ERR'} = {'description', 'End tag for element "%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#elementType});" is required%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceCode}, prefix => { (}, suffix => {)});'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_RDF_TYPE_ERR'} = {'description', 'Resource%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri}, prefix => { "}, suffix => {"}); does not have "rdf:type" attribute'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#PERL_HASH_KEY_ALREADY_DEFINED_ERR'} = {'description', '<%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});>: Hash key "%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#hashKeyName});" in <%p (mame => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#hashKeyScope});> is already defined for <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#anotherURI});>'}; $Message::Util::IFLatest::DISException::ErrorDef{'INVALID_SOURCE_ERR'}->{'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype'}->{'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#NO_EXCEPTION_CLASS_ERR'} = {'description', 'Exception interface <%p (name => {http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri});>: There is no class that implements this interface'}; package Message::Util::DIS::ManakaiDISException; our $VERSION = 20060403.1342; push our @ISA, 'Message::Util::Error::DOMException::Exception', 'Message::Util::IF::DISException', 'Message::Util::IFLatest::DISException'; sub text ($;$) { if (@_ == 1) {my ($self) = @_; my $r; { $r = $self->SUPER::text; if (defined $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' }) { $r = '<' . $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#uri' } . '>: ' . $r; } if (defined $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' }) { $r = 'Node ' . $self->{ 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#sourceNode' }-> node_path . ': ' . $r; } } $r; } else {my ($self) = @_; report Message::Util::Error::DOMException::CoreException -object => $self, '-type' => 'NO_MODIFICATION_ALLOWED_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#on' => 'get', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#subtype' => 'http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#READ_ONLY_ATTRIBUTE_ERR', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#class' => 'Message::Util::DIS::ManakaiDISException', 'http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#attr' => 'text'; } } $Message::DOM::DOMFeature::ClassInfo->{q}->{has_feature} = {'http://suika.fam.cx/~wakaba/archive/2005/manakai/util/dis#core', {'', '1', '1.0', '1'}}; $Message::DOM::ClassPoint{q} = 1; push @Message::Util::IF::DISException::ISA, 'Message::Util::Error' unless @Message::Util::IF::DISException::ISA; for ($Message::DOM::IFLatest::GetFeature::, $Message::Markup::IFLatest::SWCFGParser::, $Message::Util::IF::DISAnyResource::, $Message::Util::IF::DISAnyResourcePerl::, $Message::Util::IF::DISComment::, $Message::Util::IF::DISDatabase::, $Message::Util::IF::DISDocument::, $Message::Util::IF::DISDocumentFragment::, $Message::Util::IF::DISElement::, $Message::Util::IF::DISElementList::, $Message::Util::IF::DISFor::, $Message::Util::IF::DISImplementation::, $Message::Util::IF::DISModule::, $Message::Util::IF::DISModuleElement::, $Message::Util::IF::DISModulePerl::, $Message::Util::IF::DISModuleResolver::, $Message::Util::IF::DISNode::, $Message::Util::IF::DISParser::, $Message::Util::IF::DISResource::, $Message::Util::IF::DISResourceMV::, $Message::Util::IF::DISResourcePerlModule::, $Message::Util::IF::DISResourceProp::, $Message::Util::IF::NSResolverDIS::){} ## License: 1;