Module:
@QName: MCharset|Encode
@FullName:
@@lang: en
@@@: Manakai Charset Encode Module
@Namespace:
http://suika.fam.cx/~wakaba/archive/2005/manakai/Charset/Encode/
@enDesc:
The <DFN::manakai Charset Encode Module> is ...
{TODO::
This module is subject to change.
}
@DISCore:author: DISCore|Wakaba
@License: license|Perl+MPL
@Date:
$Date: 2006/04/09 14:29:41 $
@Require:
@@Module:
@@@QName: MDOM|DOMFeature
@@@WithFor: ManakaiDOM|ManakaiDOMLatest
@@Module:
@@@WithFor: ManakaiDOM|ManakaiDOM
@@Module:
@@@QName: DISlib|Charset
@@@WithFor: ManakaiDOM|all
@DefaultFor: ManakaiDOM|ManakaiDOMLatest
Namespace:
@cs:
http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/
@dis:
http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
@DISlib:
http://suika.fam.cx/~wakaba/archive/2004/dis/
@dx:
http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#
@f:
http://suika.fam.cx/~wakaba/archive/2004/dom/feature#
@fe:
http://suika.fam.cx/www/2006/feature/
@icharset:
urn:x-suika-fam-cx:charset:
@idl:
http://suika.fam.cx/~wakaba/archive/2004/dis/IDL#
@kwd:
http://suika.fam.cx/~wakaba/archive/2005/rfc2119/
@lang:
http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#
@license:
http://suika.fam.cx/~wakaba/archive/2004/8/18/license#
@ManakaiDOM:
http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#
@MCharset:
http://suika.fam.cx/~wakaba/archive/2005/manakai/Charset/
@mce:
http://suika.fam.cx/~wakaba/archive/2005/manakai/Charset/Encode/
@MDOM:
http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.
@mn:
http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode#
@rdf:
http://www.w3.org/1999/02/22-rdf-syntax-ns#
@rdfs:
http://www.w3.org/2000/01/rdf-schema#
@test:
http://suika.fam.cx/~wakaba/archive/2004/dis/Test#
@xml-auto-charset:
http://suika.fam.cx/www/2006/03/xml-entity/
ResourceDef:
@QName: MCharset|
@rdf:type: dis|ModuleGroup
@FullName:
@@lang:en
@@@:
The manakai Charset modules
@DISPerl:packageName:
Message::Charset::
@DISPerl:interfacePackageName:
@@@:
Message::Charset::IFLatest::
@@For: ManakaiDOM|ManakaiDOMLatest
@DISPerl:interfacePackageName:
@@@:
Message::Charset::IF::
@@For: !ManakaiDOM|ManakaiDOMLatest
## -- Features
FeatureDef:
@QName: MCEncodeFeature
@featureQName: fe|MCEncode
@FeatureVerDef:
@@QName: MCEncodeFeature10
@@f:instanceOf: MCEncodeFeature
@@Version: 1.0
@@enDesc:
The manakai Charset Encode Module, version 1.0
ElementTypeBinding:
@Name: FeatureDef
@ElementType:
dis:ResourceDef
@ShadowContent:
@@rdf:type: f|Feature
@@For: =ManakaiDOM|all
ElementTypeBinding:
@Name: FeatureVerDef
@ElementType:
dis:ResourceDef
@ShadowContent:
@@rdf:type: f|Feature
ElementTypeBinding:
@Name: featureQName
@ElementType:
f:name
@ShadowContent:
@@ContentType: DISCore|QName
ElementTypeBinding:
@Name: IFQName
@ElementType:
dis:QName
@ShadowContent:
@@ForCheck: ManakaiDOM|ForIF
ElementTypeBinding:
@Name: ClsQName
@ElementType:
dis:QName
@ShadowContent:
@@ForCheck: ManakaiDOM|ForClass
ElementTypeBinding:
@Name: IFISA
@ElementType:
dis:ISA
@ShadowContent:
@@ForCheck: ManakaiDOM|ForIF
ElementTypeBinding:
@Name: ClsISA
@ElementType:
dis:ISA
@ShadowContent:
@@ForCheck: ManakaiDOM|ForClass
ElementTypeBinding:
@Name: IFClsDef
@ElementType:
dis:ResourceDef
@ShadowContent:
@@rdf:type:
@@@@: dis|MultipleResource
@@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass
@@resourceFor: ManakaiDOM|ForIF
@@resourceFor:
@@@@: ManakaiDOM|ForClass
@@@ForCheck: ManakaiDOM|ManakaiDOMLatest !=ManakaiDOM|ManakaiDOM
@@For: ManakaiDOM|ManakaiDOMLatest
@@For: =ManakaiDOM|ManakaiDOM
@@rdf:type:
@@@@: DISLang|Interface
@@@ForCheck: ManakaiDOM|ForIF
@@rdf:type:
@@@@: DISLang|Class
@@@ForCheck: ManakaiDOM|ForClass
@@Implement:
@@@@: ||ManakaiDOM|ManakaiDOM||ManakaiDOM|ForIF
@@@ContentType: DISCore|TFPQNames
@@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOM
@@Implement:
@@@@: ||ManakaiDOM|ManakaiDOMLatest||ManakaiDOM|ForIF
@@@ContentType: DISCore|TFPQNames
@@@ForCheck: ManakaiDOM|ForClass ManakaiDOM|ManakaiDOMLatest
@@f:implements:
@@@@: MCEncodeFeature10
@@@For: ManakaiDOM|ManakaiDOMLatest
ElementTypeBinding:
@Name: ClsDef
@ElementType:
dis:ResourceDef
@ShadowContent:
@@rdf:type:
@@@@: dis|MultipleResource
@@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass
@@resourceFor:
@@@@: ManakaiDOM|ForClass
@@@ForCheck: ManakaiDOM|ManakaiDOMLatest
@@For: ManakaiDOM|ManakaiDOMLatest
@@rdf:type:
@@@@: DISLang|Class
@@@ForCheck: ManakaiDOM|ForClass
@@f:implements:
@@@@: MCEncodeFeature10
@@@For: ManakaiDOM|ManakaiDOMLatest
ElementTypeBinding:
@Name: Method
@ElementType:
dis:ResourceDef
@ShadowContent:
@@rdf:type: DISLang|Method
@@ForCheck: !=ManakaiDOM|ManakaiDOM
ElementTypeBinding:
@Name: IntMethod
@ElementType:
dis:ResourceDef
@ShadowContent:
@@rdf:type: DISLang|Method
@@ForCheck: !=ManakaiDOM|ManakaiDOM ManakaiDOM|ForClass
@@ManakaiDOM:isForInternal: 1
ElementTypeBinding:
@Name: Param
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISLang|MethodParameter
ElementTypeBinding:
@Name: NamedParam
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISLang|MethodParameter
@@DISPerl:isNamedParameter: 1
ElementTypeBinding:
@Name: Return
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISLang|MethodReturn
ElementTypeBinding:
@Name: Attr
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISLang|Attribute
@@ForCheck: !=ManakaiDOM|ManakaiDOM
ElementTypeBinding:
@Name: Get
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISLang|AttributeGet
ElementTypeBinding:
@Name: Set
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISLang|AttributeSet
ElementTypeBinding:
@Name: InCase
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: ManakaiDOM|InCase
ElementTypeBinding:
@Name: PerlDef
@ElementType:
dis:Def
@ShadowContent:
@@ContentType:
lang:Perl
@@ForCheck: ManakaiDOM|ForClass
ElementTypeBinding:
@Name: Test
@ElementType:
dis:ResourceDef
@ShadowContent:
@@rdf:type: test|StandaloneTest
@@ForCheck: ManakaiDOM|ForClass
ElementTypeBinding:
@Name: enDesc
@ElementType:
dis:Description
@ShadowContent:
@@lang:en
ElementTypeBinding:
@Name: enImplNote
@ElementType:
dis:ImplNote
@ShadowContent:
@@lang:en
ElementTypeBinding:
@Name: enFN
@ElementType:
dis:FullName
@ShadowContent:
@@lang:en
## -- Implementation
IFClsDef:
@IFQName: MCEncodeImplementation
@ClsQName: ManakaiMCEncodeImplementation
@IFISA: f|MinimumImplementation
@ClsISA: f|ManakaiMinimumImplementation
@enDesc:
The <IF::MCEncodeImplementation> interface provides
factory methods to create <IF::MCEncodeHandle> objects.
@f:provides: MCEncodeFeature10
@Test:
@@enDesc:
The implementation registry should know this class when the
module is loaded.
@@PerlDef:
I: {
for my $impl (@{$Message::DOM::ImplementationRegistry
->get_implementation_list
({<Q::fe|MCEncode> => '1.0'})}) {
if ($impl->isa (<IFName::MCEncodeImplementation>)) {
last I;
}
}
$test->assert_never;
} # I
@Method:
@@Name: createMCDecodeHandle
@@enDesc:
Creates an <IF::MCDecodeHandle> object.
@@Param:
@@@Name: charset
@@@Type: String
@@@enDesc:
The URI that identifies the charset
in which strings are written to the <P::byteStream>.
@@Param:
@@@Name: byteStream
@@@Type: DISPerl|Filehandle||ManakaiDOM|all
@@@enDesc:
A reference to the filehandle that contains the byte
stream read by the <IF::MCDecodeHandle> object.
@@Param:
@@@Name: onerror
@@@Type: DISPerl|CODE||ManakaiDOM|all
@@@enDesc:
A subroutine that is called back when an error is encountered.
The <A::MCDecodeHandle.onerror> attribute of the
created object is set to this parameter value.
@@@nullCase:
@@@@enDesc:
The <A::MCDecodeHandle.onerror> attribute is set to
a do-nothing subroutine.
@@Return:
@@@Type: MCDecodeHandle
@@@enDesc:
The newly created filehandle object.
@@@nullCase:
@@@@enDesc:
If the implementation does not support <P::charset>.
@@@PerlDef:
my $csdef = $Message::Charset::Encode::CharsetDef->{$charset};
my $obj = {<H::mce|filehandle> => $byteStream,
<H::mce|charset> => $charset,
<H::mce|characterQueue> => [],
<H::mce|byteBuffer> => '',
<H::mce|onerror> => $onerror || sub {}};
if ($csdef->{uri}->{<Q::xml-auto-charset:>} or
$charset eq <Q::xml-auto-charset:>) {
__DEEP{
my $b = '';
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-8>}; # UTF-8 with no BOM
$obj->{<H::mce|inputEncoding>} = 'utf-8';
if (read $obj->{<H::mce|filehandle>}, $b, 256) {
no warnings "substr";
no warnings "uninitialized";
if (substr ($b, 0, 1) eq "<") {
if (substr ($b, 1, 1) eq "?") { # ASCII8
__CODE{XMLEntity.guess::
$ascii => $b,
$errorCondition => {
not $csdef->{<H::cs|ASCII8>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant>}};
}
} elsif (substr ($b, 1, 1) eq "\x00") {
if (substr ($b, 2, 2) eq "?\x00") { # ASCII16LE
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII16>} or
$csdef->{<H::cs|ASCII16BE>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant16LE>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant16LE>}};
}
} elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian4321
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian1234>} or
$csdef->{<H::cs|ASCII32Endian2143>} or
$csdef->{<H::cs|ASCII32Endian3412>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian4321>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian4321>}};
}
}
}
} elsif (substr ($b, 0, 3) eq "\xEF\xBB\xBF") { # UTF8
$obj->{<H::mce|hasBOM>} = true;
substr ($b, 0, 3) = '';
my $c = $b;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|UTF8EncodingScheme>} or
not $csdef->{<H::cs|BOM.Allowed>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant>}};
}
} elsif (substr ($b, 0, 2) eq "\x00<") {
if (substr ($b, 2, 2) eq "\x00?") { # ASCII16BE
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII16>} or
$csdef->{<H::cs|ASCII16LE>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant16BE>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant16BE>}};
}
} elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian3412
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian1234>} or
$csdef->{<H::cs|ASCII32Endian2143>} or
$csdef->{<H::cs|ASCII32Endian4321>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian3412>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian3412>}};
}
}
} elsif (substr ($b, 0, 2) eq "\xFE\xFF") {
if (substr ($b, 2, 2) eq "\x00<") { # ASCII16BE
$obj->{<H::mce|hasBOM>} = true;
substr ($b, 0, 2) = '';
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII16>} or
$csdef->{<H::cs|ASCII16LE>} or
not $csdef->{<H::cs|BOM.Allowed>}
},
$defaultURI => {<Q::cs|Perl.utf-16be>},
$defaultName => 'utf-16',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant16BE>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant16BE>}};
}
} elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian3412
$obj->{<H::mce|hasBOM>} = true;
substr ($b, 0, 4) = '';
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian1234>} or
$csdef->{<H::cs|ASCII32Endian2143>} or
$csdef->{<H::cs|ASCII32Endian4321>} or
not $csdef->{<H::cs|BOM.Allowed>}
},
$defaultURI => {<Q::cs|Perl.utf-16be>},
$defaultName => 'utf-16',
$restoreBOM => {
$obj->{<H::mce|byteBuffer>} .= "\x00\x00";
},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian3412>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian3412>}};
}
} else {
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-16be>};
$obj->{<H::mce|inputEncoding>} = 'utf-16';
substr ($b, 0, 2) = '';
$obj->{<H::mce|hasBOM>} = true;
}
} elsif (substr ($b, 0, 2) eq "\xFF\xFE") {
if (substr ($b, 2, 2) eq "<\x00") { # ASCII16LE
$obj->{<H::mce|hasBOM>} = true;
substr ($b, 0, 2) = '';
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII16>} or
$csdef->{<H::cs|ASCII16BE>} or
not $csdef->{<H::cs|BOM.Allowed>}
},
$defaultURI => {<Q::cs|Perl.utf-16le>},
$defaultName => 'utf-16',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant16LE>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant16LE>}};
}
} elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian4321
$obj->{<H::mce|hasBOM>} = true;
substr ($b, 0, 4) = '';
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian1234>} or
$csdef->{<H::cs|ASCII32Endian2143>} or
$csdef->{<H::cs|ASCII32Endian3412>} or
not $csdef->{<H::cs|BOM.Allowed>}
},
$defaultURI => {<Q::cs|Perl.utf-16le>},
$defaultName => 'utf-16',
$restoreBOM => {
$obj->{<H::mce|byteBuffer>} .= "\x00\x00";
},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian4321>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian4321>}};
}
} else {
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-16le>};
$obj->{<H::mce|inputEncoding>} = 'utf-16';
substr ($b, 0, 2) = '';
$obj->{<H::mce|hasBOM>} = true;
}
} elsif (substr ($b, 0, 2) eq "\x00\x00") {
if (substr ($b, 2, 2) eq "\x00<") { # ASCII32Endian1234
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian2143>} or
$csdef->{<H::cs|ASCII32Endian3412>} or
$csdef->{<H::cs|ASCII32Endian4321>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian1234>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian1234>}};
}
} elsif (substr ($b, 2, 2) eq "<\x00") { # ASCII32Endian2143
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian1234>} or
$csdef->{<H::cs|ASCII32Endian3412>} or
$csdef->{<H::cs|ASCII32Endian4321>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian2143>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian2143>}};
}
} elsif (substr ($b, 2, 2) eq "\xFE\xFF") { # ASCII32Endian1234
$obj->{<H::mce|hasBOM>} = true;
substr ($b, 0, 4) = '';
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian2143>} or
$csdef->{<H::cs|ASCII32Endian3412>} or
$csdef->{<H::cs|ASCII32Endian4321>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {
$obj->{<H::mce|hasBOM>} = false;
$obj->{<H::mce|byteBuffer>} .= "\x00\x00\xFE\xFF";
},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian1234>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian1234>}};
}
} elsif (substr ($b, 2, 2) eq "\xFF\xFE") { # ASCII32Endian2143
$obj->{<H::mce|hasBOM>} = true;
substr ($b, 0, 4) = '';
my $c = $b; $c =~ tr/\x00//d;
__CODE{XMLEntity.guess::
$ascii => $c,
$errorCondition => {
not $csdef->{<H::cs|ASCII32>} or
$csdef->{<H::cs|ASCII32Endian1234>} or
$csdef->{<H::cs|ASCII32Endian3412>} or
$csdef->{<H::cs|ASCII32Endian4321>} or
$csdef->{<H::cs|BOM.Required>}
},
$defaultURI => {<Q::cs|Perl.utf-8>},
$defaultName => 'utf-8',
$restoreBOM => {
$obj->{<H::mce|hasBOM>} = false;
$obj->{<H::mce|byteBuffer>} .= "\x00\x00\xFF\xFE";
},
}__;
if (defined $csdef->{<H::cs|noBOMVariant32Endian2143>}) {
$csdef = $Message::Charset::Encode::CharsetDef
->{$csdef->{<H::cs|noBOMVariant32Endian2143>}};
}
}
# \x4C\x6F\xA7\x94 EBCDIC
} # buffer
$obj->{<H::mce|byteBuffer>} .= $b;
} # read
}__;
} elsif ($csdef->{uri}->{<Q::cs|XML.utf-8>}) {
## BOM is optional.
__DEEP{
my $b = '';
if (read $obj->{<H::mce|filehandle>}, $b, 3) {
if ($b eq "\xEF\xBB\xBF") {
$obj->{<H::mce|hasBOM>} = true;
} else {
$obj->{<H::mce|byteBuffer>} .= $b;
}
}
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-8>}; # UTF-8 with no BOM
}__;
} elsif ($csdef->{uri}->{<Q::cs|XML.utf-16>}) {
## BOM is mandated.
__DEEP{
my $b = '';
if (read $obj->{<H::mce|filehandle>}, $b, 2) {
if ($b eq "\xFE\xFF") {
$obj->{<H::mce|hasBOM>} = true;
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-16be>}; # UTF-16BE with no BOM
} elsif ($b eq "\xFF\xFE") {
$obj->{<H::mce|hasBOM>} = true;
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-16le>}; # UTF-16LE with no BOM
} else {
$obj->{<H::mce|onerror>}
->($onerror, null, <Q::cs|no-bom-error>,
charset_uri => $charset);
$obj->{<H::mce|hasBOM>} = false;
$obj->{<H::mce|byteBuffer>} .= $b;
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-16be>}; # UTF-16BE with no BOM
}
} else {
$obj->{<H::mce|onerror>}
->($onerror, null, <Q::cs|no-bom-error>,
charset_uri => $charset);
$obj->{<H::mce|hasBOM>} = false;
$csdef = $Message::Charset::Encode::CharsetDef
->{<Q::cs|Perl.utf-16be>}; # UTF-16BE with no BOM
}
}__;
}
if ($csdef->{uri}->{<Q::cs|XML.iso-2022-jp>}) {
$obj->{<H::mce|State.2440>} = 'gl-jis-1997-swapped';
$obj->{<H::mce|State.2442>} = 'gl-jis-1997';
$obj->{<H::mce|state>} = <H::mce|State.2842>;
$r = bless $obj, <ClassName::ManakaiMCISO2022JPDecodeHandle>;
require Encode::GLJIS1997Swapped;
require Encode::GLJIS1997;
undef $r unless Encode::find_encoding ($obj->{<H::mce|State.2440>});
undef $r unless Encode::find_encoding ($obj->{<H::mce|State.2442>});
} elsif ($csdef->{uri}->{<Q::icharset|iso-2022-jp>}) {
$obj->{<H::mce|State.2440>} = 'gl-jis-1978';
$obj->{<H::mce|State.2442>} = 'gl-jis-1983';
$obj->{<H::mce|state>} = <H::mce|State.2842>;
$r = bless $obj, <ClassName::ManakaiMCISO2022JPDecodeHandle>;
require Encode::GLJIS1978;
require Encode::GLJIS1983;
undef $r unless Encode::find_encoding ($obj->{<H::mce|State.2440>});
undef $r unless Encode::find_encoding ($obj->{<H::mce|State.2442>});
} elsif (defined $csdef->{<H::cs|perlName>}->[0]) {
if ($csdef->{uri}->{<Q::cs|XML.euc-jp>} or
$csdef->{uri}->{<Q::icharset|euc-jp>}) {
$obj->{<H::mce|perlEncodingName>} = $csdef->{<H::cs|perlName>}->[0];
$r = bless $obj, <ClassName::ManakaiMCEUCJPDecodeHandle>;
require Encode::EUCJP1997;
undef $r unless Encode::find_encoding
($obj->{<H::mce|perlEncodingName>});
} elsif ($csdef->{uri}->{<Q::cs|XML.shift_jis>} or
$csdef->{uri}->{<Q::icharset|shift_jis>}) {
$obj->{<H::mce|perlEncodingName>} = $csdef->{<H::cs|perlName>}->[0];
$r = bless $obj, <ClassName::ManakaiMCShiftJISDecodeHandle>;
require Encode::ShiftJIS1997;
undef $r unless Encode::find_encoding
($obj->{<H::mce|perlEncodingName>});
} elsif ($csdef->{<H::cs|isBlockSafe>}) {
$obj->{<H::mce|perlEncodingName>} = $csdef->{<H::cs|perlName>}->[0];
$r = bless $obj, <ClassName::ManakaiMCDecodeHandle>;
require Encode;
undef $r unless Encode::find_encoding
($obj->{<H::mce|perlEncodingName>});
}
}
unless (defined $r) {
__DEEP{
$obj->{<H::mce|onerror>}
->($onerror, null, <Q::cs|charset-not-supported-error>,
charset_uri => $charset);
}__;
}
@@CODE:
@@@QName: XMLEntity.guess
@@@PerlDef:
if ($ascii =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
encoding\s*=\s*["']([^"']*)/x) {
$obj->{<H::mce|inputEncoding>} = lc $1;
my $__uri = $self-><M::MCEncodeImplementation.getURIFromCharsetName>
(<Q::cs|xmlName>, $obj->{<H::mce|inputEncoding>});
$csdef = $Message::Charset::Encode::CharsetDef->{$__uri};
if ($errorCondition) {
$obj->{<H::mce|onerror>}
->($obj->{<H::mce|onerror>}, null,
<Q::cs|charset-name-mismatch-error>,
charset_uri => $__uri,
charset_name => $obj->{<H::mce|inputEncoding>});
}
} else {
$csdef = $Message::Charset::Encode::CharsetDef->{$defaultURI};
$obj->{<H::mce|inputEncoding>} = $defaultName;
$restoreBOM;
}
@@Test:
@@@QName: MCEncodeImpl.createMCDecodeHandle.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = 'a';
open my $fh, '>', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|Perl.utf8>, $fh);
$test->id ('interface');
$test->assert_isa ($efh, <IFName::MCDecodeHandle>);
$test->id ('onerr');
$test->assert_isa ($efh-><AG::MCDecodeHandle.onerror>, 'CODE');
@@Test:
@@@QName: MCEncodeImpl.createMCXMLDecodeHandle.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = 'a';
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::xml-auto-charset:>, $fh);
$test->id ('interface');
$test->assert_isa ($efh, <IFName::MCDecodeHandle>);
$test->id ('onerr');
$test->assert_isa ($efh-><AG::MCDecodeHandle.onerror>, 'CODE');
@@Test:
@@@QName: MCEncodeImpl.createMCDecodeHandle.3.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $errors = 0;
my $byte = 'a';
open my $fh, '>', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(q<http://www.charset.example/>, $fh, sub {
$errors++;
$test->id ('errortype');
$test->assert_equals
($_[2],
<Q::cs|charset-not-supported-error>);
});
$test->id ('errors');
$test->assert_num_equals (actual_value => $errors, expected_value => 1);
$test->id ('return');
$test->assert_null ($efh);
@@Test:
@@@QName: MCEncodeImpl.createMCDecodeHandle.4.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = 'a';
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.euc-jp>, $fh);
$test->id ('interface');
$test->assert_isa ($efh, <IFName::MCDecodeHandle>);
$test->id ('class');
$test->assert_isa ($efh, <ClassName::ManakaiMCEUCJPDecodeHandle>);
$test->id ('onerr');
$test->assert_isa ($efh-><AG::MCDecodeHandle.onerror>, 'CODE');
@@Test:
@@@QName: MCEncodeImpl.createMCDecodeHandle.5.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = 'a';
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.euc-jp>, $fh);
$test->id ('interface');
$test->assert_isa ($efh, <IFName::MCDecodeHandle>);
$test->id ('class');
$test->assert_isa ($efh, <ClassName::ManakaiMCEUCJPDecodeHandle>);
$test->id ('onerr');
$test->assert_isa ($efh-><AG::MCDecodeHandle.onerror>, 'CODE');
@@Test:
@@@QName: MCEncodeImpl.createMCDecodeHandle.6.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = 'a';
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.iso-2022-jp>, $fh);
$test->id ('interface');
$test->assert_isa ($efh, <IFName::MCDecodeHandle>);
$test->id ('class');
$test->assert_isa ($efh, <ClassName::ManakaiMCISO2022JPDecodeHandle>);
$test->id ('onerr');
$test->assert_isa ($efh-><AG::MCDecodeHandle.onerror>, 'CODE');
@@Test:
@@@QName: MCEncodeImpl.createMCDecodeHandle.7.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = 'a';
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::icharset|iso-2022-jp>, $fh);
$test->id ('interface');
$test->assert_isa ($efh, <IFName::MCDecodeHandle>);
$test->id ('class');
$test->assert_isa ($efh, <ClassName::ManakaiMCISO2022JPDecodeHandle>);
$test->id ('onerr');
$test->assert_isa ($efh-><AG::MCDecodeHandle.onerror>, 'CODE');
@Method:
@@Name: getURIFromCharsetName
@@enDesc:
Returns a DOM URI that identifies a charset.
@@Param:
@@@Name: domain
@@@Type: String
@@@enDesc:
A DOM URI that identifies the context in which the charset
name is used.
@@Param:
@@@Name: name
@@@Type: String
@@@enDesc:
The charset name to convert.
@@Return:
@@@Type: String
@@@enDesc:
A DOM URI that identifies <P::name>.
@@@nullCase:
@@@@enDesc:
The implementation was unable to resolve <P::name> to a URI.
@@@PerlDef:
if ({
<Q::cs|ietfName> => true,
<Q::cs|xmlName> => true,
}->{$domain}) {
$name = lc $name;
if ($domain eq <Q::cs|ietfName>) {
$r = <Q::icharset|> . $name;
} elsif ($domain eq <Q::cs|xmlName>) {
$r = <Q::cs|XML.> . $name;
}
unless ($Message::Charset::Encode::CharsetDef->{$r}) {
U: for my $uri (keys %$Message::Charset::Encode::CharsetDef) {
for (@{$Message::Charset::Encode::CharsetDef->{$uri}->{+{
<Q::cs|ietfName> => <H::cs|ietfName>,
<Q::cs|xmlName> => <H::cs|xmlName>,
}->{$domain}} or []}) {
if ($_ eq $name) {
$r = $uri;
last U;
}
}
} # U
}
} else {
$r = null;
}
@@Test:
@@@QName: MCEncodeImpl.name2uri.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
for (
[<Q::icharset|utf-8>, 'utf-8'],
[<Q::icharset|x-no-such-charset>, 'x-no-such-charset'],
[<Q::icharset|utf-8>, 'UTF-8'],
[<Q::icharset|utf-8>, 'uTf-8'],
[<Q::icharset|utf-16be>, 'utf-16be'],
) {
$test->id ('ietfname2uri.'.$_->[1]);
my $iname = $impl-><M::MCEncodeImplementation.getURIFromCharsetName>
(<Q::cs|ietfName>, $_->[1]);
$test->assert_equals ($iname, $_->[0]);
}
for (
[<Q::cs|XML.utf-8>, 'utf-8'],
[<Q::cs|XML.x-no-such-charset>, 'x-no-such-charset'],
[<Q::cs|XML.utf-8>, 'UTF-8'],
[<Q::cs|XML.utf-8>, 'uTf-8'],
[<Q::icharset|utf-16be>, 'utf-16be'],
) {
$test->id ('xmlname2uri.'.$_->[1]);
my $iname = $impl-><M::MCEncodeImplementation.getURIFromCharsetName>
(<Q::cs|xmlName>, $_->[1]);
$test->assert_equals ($iname, $_->[0]);
}
@Method:
@@Name: getCharsetNameFromURI
@@enDesc:
Returns a name for the charset identified by a DOM URI.
@@Param:
@@@Name: domain
@@@Type: String
@@@enDesc:
A DOM URI that identifies the context in which the charset
name is used.
@@Param:
@@@Name: uri
@@@Type: String
@@@enDesc:
A DOM URI of the charset.
@@Return:
@@@Type: String
@@@enDesc:
A charset name that identifies <P::uri>.
@@@nullCase:
@@@@enDesc:
The implementation was unable to find the charset name
for the <P::uri> that can be used in <P::domain> context.
@@@PerlDef:
if ({
<Q::cs|ietfName> => true,
<Q::cs|xmlName> => true,
}->{$domain}) {
$r = $Message::Charset::Encode::CharsetDef->{$uri}->{+{
<Q::cs|ietfName> => <H::cs|ietfName>,
<Q::cs|xmlName> => <H::cs|xmlName>,
}->{$domain}}->[0];
unless (defined $r) {
if ($domain eq <Q::cs|ietfName> and
substr ($uri, 0, length <Q::icharset|>) eq <Q::icharset|>) {
$r = substr ($uri, length <Q::icharset|>);
} elsif ($domain eq <Q::cs|xmlName> and
substr ($uri, 0, length <Q::cs|XML.>) eq <Q::cs|XML.>) {
$r = substr ($uri, length <Q::cs|XML.>);
}
}
} else {
$r = null;
}
@@Test:
@@@QName: MCEncodeImpl.uri2name.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
for (
[<Q::icharset|utf-8>, 'utf-8'],
[<Q::icharset|x-no-such-charset>, 'x-no-such-charset'],
[q<http://charset.example/>, null],
) {
$test->id ('uri2ietfname.'.$_->[0]);
my $iname = $impl-><M::MCEncodeImplementation.getCharsetNameFromURI>
(<Q::cs|ietfName>, $_->[0]);
$test->assert_equals ($iname, $_->[1]);
}
for (
[<Q::cs|XML.utf-8>, 'utf-8'],
[<Q::cs|XML.x-no-such-charset>, 'x-no-such-charset'],
[q<http://charset.example/>, null],
) {
$test->id ('uri2xmlname.'.$_->[0]);
my $iname = $impl-><M::MCEncodeImplementation.getCharsetNameFromURI>
(<Q::cs|xmlName>, $_->[0]);
$test->assert_equals ($iname, $_->[1]);
}
@CODE:
@@QName: createImplForTest
@@PerlDef:
$impl = <Class::ManakaiMCEncodeImplementation>->_new;
##MCEncodeImplementation
ElementTypeBinding:
@Name: CODE
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISPerl|BlockCode
@@ForCheck: ManakaiDOM|ForClass
IFClsDef:
@IFQName: MCDecodeHandle
@ClsQName: ManakaiMCDecodeHandle
@enDesc:
An <IF::MCDecodeHandle> provides the read access to a character
stream.
@enDesc:
@@ddid: cestype
@@ForCheck: ManakaiDOM|ForClass
@@@:
The class <Class::ManakaiMCDecodeHandle> can be used to
encapsulate a byte filehandle with <Perl::Encode> call
into a character filehandle-like object.
The encoding <kwd:MUST> be stateless and signatureless. In addition,
its <Perl::Encode> implementation <kwd:MUST> support
the <Perl::FB_QUIET> flag.
@Attr:
@@Name: charset
@@enDesc:
A URI that identifies the charset of the handle.
@@Type: String
@@Get:
@@@PerlDef:
$r = $self->{<H::mce|charset>};
@Attr:
@@Name: onerror
@@enDesc:
A callback function that is invoked when an error is encountered.
{P:: The function will be invoked with arguments:
- <Perl::$self>::: The function itself.
- <Perl::$handle>::: The <IF::MCDecodeHandle> object.
If the error is thrown during the
construction of the object, it might
be <DOM::null> instead.
- <Perl::$errorType>::: The DOM URI that identifies the category
of the error.
- <Perl::%opt>::: Named parameters depending to the <Perl::$errorType>.
It <kwd:MAY> throw an exception.
}
@@Type: DISPerl|CODE||ManakaiDOM|all
@@Get:
@@@PerlDef:
$r = $self->{<H::mce|onerror>};
@@Set:
@@@PerlDef:
$self->{<H::mce|onerror>} = $given;
@@Test:
@@@QName: MCDecodeHandle.onoctetstreamerror.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = "a\xE3\x81\x82\x81a";
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|Perl.utf8>, $fh);
$test->id ('default');
$test->assert_isa ($efh-><AG::MCDecodeHandle.onerror>,
'CODE');
$test->id ('get.set');
my $sub1 = sub { return "2" };
$efh-><AS::MCDecodeHandle.onerror> ($sub1);
my $sub2 = $efh-><AG::MCDecodeHandle.onerror>;
$test->assert_equals ($sub2, $sub1);
$test->assert_equals ($sub2->(), "2");
@Method:
@@Name: getc
@@enDesc:
Returns the next character from the input.
@@Return:
@@@Type: String
@@@enDesc:
The next character.
@@@nullCase:
@@@@enDesc:
If at the end of the file, or if there was an error, in which
case <Perl::$!> is set.
@@@PerlDef:
if (@{$self->{<H::mce|characterQueue>}}) {
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
__DEEP{
my $error;
if ($self->{<H::mce|continue>}) {
if (read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>}) {
#
} else {
$error = true;
}
$self->{<H::mce|continue>} = false;
} elsif (512 > length $self->{<H::mce|byteBuffer>}) {
read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>};
}
unless ($error) {
my $string = Encode::decode ($self->{<H::mce|perlEncodingName>},
$self->{<H::mce|byteBuffer>},
Encode::FB_QUIET ());
if (length $string) {
push @{$self->{<H::mce|characterQueue>}}, split //, $string;
$r = shift @{$self->{<H::mce|characterQueue>}};
if (length $self->{<H::mce|byteBuffer>}) {
$self->{<H::mce|continue>} = true;
}
} else {
if (length $self->{<H::mce|byteBuffer>}) {
$error = true;
} else {
$r = null;
}
}
}
if ($error) {
$r = substr $self->{<H::mce|byteBuffer>}, 0, 1, '';
$self->{<H::mce|onerror>}
->($self->{<H::mce|onerror>}, $self,
<Q::cs|illegal-octets-error>,
octets => \$r);
}
}__;
}
@@Test:
@@@QName: MCDecodeHandle.getc.1.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = "a\xE3\x81\x82\x81a";
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|Perl.utf8>, $fh);
my $error = null;
$efh-><AS::MCDecodeHandle.onerror> (sub {
my ($self, $efh, $type, %opt) = @_;
$error = ${$opt{octets}};
});
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id ('1.err');
$test->assert_null ($error);
$test->id (2);
$test->assert_equals ($efh->getc, "\x{3042}");
$test->id ('1.err');
$test->assert_null ($error);
$test->id (3);
$test->assert_equals ($efh->getc, "\x81");
$test->id ('1.err');
$test->assert_equals ($error, "\x81");
$error = null;
$test->id (4);
$test->assert_equals ($efh->getc, "a");
$test->id ('4.err');
$test->assert_null ($error);
$test->id ('eof');
$test->assert_null ($efh->getc);
$test->id ('eof.err');
$test->assert_null ($error);
@@Test:
@@@QName: MCDecodeHandle.getc.2.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = "a" x 256;
$byte .= "b" x 256;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|Perl.utf8>, $fh);
my $error = null;
$efh-><AS::MCDecodeHandle.onerror> (sub {
my ($self, $efh, $type, %opt) = @_;
$error = ${$opt{octets}};
});
for my $i (0..255) {
$test->id ("a.$i");
$test->assert_equals ($efh->getc, "a");
$test->id ("a.$i.err");
$test->assert_null ($error);
}
for my $i (0..255) {
$test->id ("b.$i");
$test->assert_equals ($efh->getc, "b");
$test->id ("b.$i.err");
$test->assert_null ($error);
}
$test->id ('eof');
$test->assert_null ($efh->getc);
$test->id ('eof.err');
$test->assert_null ($error);
@@Test:
@@@QName: MCDecodeHandle.getc.3.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = "a" x 255;
$byte .= "\xE3\x81\x82";
$byte .= "b" x 256;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|Perl.utf8>, $fh);
my $error = null;
$efh-><AS::MCDecodeHandle.onerror> (sub {
my ($self, $efh, $type, %opt) = @_;
$error = ${$opt{octets}};
});
for my $i (0..254) {
$test->id ("a.$i");
$test->assert_equals ($efh->getc, "a");
$test->id ("a.$i.err");
$test->assert_null ($error);
}
$test->id ("A");
$test->assert_equals ($efh->getc, "\x{3042}");
$test->id ("A.err");
$test->assert_null ($error);
for my $i (0..255) {
$test->id ("b.$i");
$test->assert_equals ($efh->getc, "b");
$test->id ("b.$i.err");
$test->assert_null ($error);
}
$test->id ('eof');
$test->assert_null ($efh->getc);
$test->id ('eof.err');
$test->assert_null ($error);
@@Test:
@@@QName: MCDecodeHandle.getc.4.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = "a" x 255;
$byte .= "\xE3";
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|Perl.utf8>, $fh);
my $error = null;
$efh-><AS::MCDecodeHandle.onerror> (sub {
my ($self, $efh, $type, %opt) = @_;
$error = ${$opt{octets}};
});
for my $i (0..254) {
$test->id ("a.$i");
$test->assert_equals ($efh->getc, "a");
$test->id ("a.$i.err");
$test->assert_null ($error);
}
$test->id ("E3");
$test->assert_equals ($efh->getc, "\xE3");
$test->id ("E3.err");
$test->assert_equals ($error, "\xE3");
$error = null;
$test->id ('eof');
$test->assert_null ($efh->getc);
$test->id ('eof.err');
$test->assert_null ($error);
@Method:
@@Name: ungetc
@@enDesc:
Pushes a character with the given ordinal value back
onto the handle's input stream. In <Perl::IO::Handle>
only one character of pushback per handle is guaranteed.
@@Param:
@@@Name: ord
@@@Type: idl|unsignedLong||ManakaiDOM|all
@@@enDesc:
The ordinal value of the character to push back.
@@Return:
@@@PerlDef:
unshift @{$self->{<H::mce|characterQueue>}}, chr $ord;
@@Test:
@@@QName: MCDecodeHandle.ungetc.test
@@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = "a\x{4E00}b\x{4E11}";
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|Perl.utf8>, $fh);
$test->id ('1.getc');
$test->assert_equals ($efh->getc, "a");
$test->id ('1.ungetc');
$efh->ungetc (ord "a");
$test->assert_equals ($efh->getc, "a");
$test->id ('2.getc');
$test->assert_equals ($efh->getc, "\x{4E00}");
$test->id ('2.ungetc');
$efh->ungetc (ord "\x{4E00}");
$test->assert_equals ($efh->getc, "\x{4E00}");
$test->id ('3.getc');
$test->assert_equals ($efh->getc, "b");
$test->id ('4.getc');
$test->assert_equals ($efh->getc, "\x{4E11}");
$test->id ('4.ungetc');
$efh->ungetc (ord "\x{4E11}");
$test->assert_equals ($efh->getc, "\x{4E11}");
@Attr:
@@Name: inputEncoding
@@enDesc:
The name of the input charset.
@@Type: String
@@Get:
@@@enDesc:
If there is a string looks like encoding declaration,
then the value of it, in lowercase. Otherwise and
there is the UTF-16 <CHAR::BOM>, then <CODE::utf-16>.
Otherwise, <CODE::utf-8>.
@@@nullCase:
@@@@enDesc:
If the charset is different from <Q::xml-auto-charset:>.
@@@PerlDef:
$r = $self->{<H::mce|inputEncoding>};
@Attr:
@@Name: hasBOM
@@enDesc:
Whether the decoder detected the <CHAR::BYTE ORDER MARK> or not.
@@Type: idl|boolean||ManakaiDOM|all
@@Get:
@@@TrueCase:
@@@@enDesc:
If there is the <CHAR::BOM>.
@@@FalseCase:
@@@@enDesc:
Either if there is no <CHAR::BOM>, the decoder not
reached to the end of the <CHAR::BOM>, or
the decoder implementation does not provide whether
there is the <CHAR::BOM> or not.
@@@PerlDef:
$r = $self->{<H::mce|hasBOM>};
@Test:
@@QName: MCDecodeHandle.utf-8-optional-bom.1.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xEF\xBB\xBFabc>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-8>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id (2);
$test->assert_equals ($efh->getc, "b");
$test->id (3);
$test->assert_equals ($efh->getc, "c");
$test->id (4);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-8-optional-bom.2.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<abc>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-8>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id (2);
$test->assert_equals ($efh->getc, "b");
$test->id (3);
$test->assert_equals ($efh->getc, "c");
$test->id (4);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_false ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-8-optional-bom.3.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xEF\xBB\xBF\xEF\xBB\xBFabc>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-8>, $fh, sub { $error = true });
$test->id ('zwnbsp');
$test->assert_equals ($efh->getc, "\x{FEFF}");
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id (2);
$test->assert_equals ($efh->getc, "b");
$test->id (3);
$test->assert_equals ($efh->getc, "c");
$test->id (4);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-8-optional-bom.4.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xEF\xBB\xBF>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-8>, $fh, sub { $error = true });
$test->id (1);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-8-optional-bom.5.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-8>, $fh, sub { $error = true });
$test->id (1);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_false ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-8-optional-bom.6.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<ab>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-8>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id (2);
$test->assert_equals ($efh->getc, "b");
$test->id (3);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_false ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-8-optional-bom.7.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<a>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-8>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id (2);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_false ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.1.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFE\xFF\x4E\x00\x00a>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "\x{4E00}");
$test->id (2);
$test->assert_equals ($efh->getc, "a");
$test->id (3);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.2.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFF\xFE\x00\x4Ea\x00>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "\x{4E00}");
$test->id (2);
$test->assert_equals ($efh->getc, "a");
$test->id (3);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.3.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFE\xFF\x00a>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id (2);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.4.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFF\xFEa\x00>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = true });
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id (2);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_false ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.5.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFE\xFFa>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = $_[2] });
$test->id ('0.error');
$test->assert_null ($error);
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id ('1.error');
$test->assert_equals ($error, <Q::cs|illegal-octets-error>);
$error = null;
$test->id (2);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_null ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.6.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFF\xFEa>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = $_[2] });
$test->id ('0.error');
$test->assert_null ($error);
$test->id (1);
$test->assert_equals ($efh->getc, "a");
$test->id ('1.error');
$test->assert_equals ($error, <Q::cs|illegal-octets-error>);
$error = null;
$test->id (2);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_null ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.7.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFE\xFF>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = $_[2] });
$test->id (1);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_null ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.8.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFF\xFE>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = $_[2] });
$test->id (1);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_null ($error);
$test->id ('bom');
$test->assert_true ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.9.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFD\xFF>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = $_[2] });
$test->id ('no.bom');
$test->assert_equals ($error, <Q::cs|no-bom-error>);
$error = null;
$test->id (1);
$test->assert_equals ($efh->getc, "\x{FDFF}");
$test->id (2);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_null ($error);
$test->id ('bom');
$test->assert_false ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.10.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<\xFD>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = $_[2] });
$test->id ('no.bom');
$test->assert_equals ($error, <Q::cs|no-bom-error>);
$error = null;
$test->id (1);
$test->assert_equals ($efh->getc, "\xFD");
$test->id ('1.error');
$test->assert_equals ($error, <Q::cs|illegal-octets-error>);
$error = null;
$test->id (2);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_null ($error);
$test->id ('bom');
$test->assert_false ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.utf-16-with-bom.11.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my $byte = qq<>;
my $error;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.utf-16>, $fh, sub { $error = $_[2] });
$test->id ('no.bom');
$test->assert_equals ($error, <Q::cs|no-bom-error>);
$error = null;
$test->id (1);
$test->assert_null ($efh->getc);
$test->id ('err');
$test->assert_null ($error);
$test->id ('bom');
$test->assert_false ($efh-><AG::MCDecodeHandle.hasBOM>);
@Test:
@@QName: MCDecodeHandle.xml.1.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my @testdata = (
{
id => q<l=0>,
in => q<>,
out => [null],
name => 'utf-8', bom => false,
},
{
id => q<l=1>,
in => "a",
out => [null, "a", null],
name => 'utf-8', bom => false,
},
{
id => q<bom8.l=0>,
in => "\xEF\xBB\xBF",
out => [null],
name => 'utf-8', bom => true,
},
{
id => q<bom8.l=1>,
in => "\xEF\xBB\xBFa",
out => [null, "a", null],
name => 'utf-8', bom => true,
},
{
id => q<bom8.zwnbsp>,
in => "\xEF\xBB\xBF\xEF\xBB\xBF",
out => [null, "\x{FEFF}", null],
name => 'utf-8', bom => true,
},
{
id => q<bom16be.l=0>,
in => "\xFE\xFF",
out => [null],
name => 'utf-16', bom => true,
},
{
id => q<bom16le.l=0>,
in => "\xFF\xFE",
out => [null],
name => 'utf-16', bom => true,
},
{
id => q<bom16be.l=1>,
in => "\xFE\xFFa",
out => [null, "a", [<Q::cs|illegal-octets-error>]],
name => 'utf-16', bom => true,
},
{
id => q<bom16le.l=1>,
in => "\xFF\xFEa",
out => [null, "a", [<Q::cs|illegal-octets-error>]],
name => 'utf-16', bom => true,
},
{
id => q<bom16be.l=2>,
in => "\xFE\xFF\x4E\x00",
out => [null, "\x{4E00}", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16le.l=2>,
in => "\xFF\xFE\x00\x4E",
out => [null, "\x{4E00}", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16be.l=2lt>,
in => "\xFE\xFF\x00<",
out => [null, "<", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16le.l=2lt>,
in => "\xFF\xFE<\x00",
out => [null, "<", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16be.zwnbsp>,
in => "\xFE\xFF\xFE\xFF",
out => [null, "\x{FEFF}", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16le.zwnbsp>,
in => "\xFF\xFE\xFF\xFE",
out => [null, "\x{FEFF}", null],
name => 'utf-16', bom => true,
},
{
id => q<bom32e3412.l=0>,
in => "\xFE\xFF\x00\x00",
out => [null, "\x00", null],
name => 'utf-16', bom => true,
},
{
id => q<bom32e4321.l=0>,
in => "\xFF\xFE\x00\x00",
out => [null, "\x00", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16be.l=4ltq>,
in => "\xFE\xFF\x00<\x00?",
out => [null, "<", null, "?", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16le.l=4ltq>,
in => "\xFF\xFE<\x00?\x00",
out => [null, "<", null, "?", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16be.decl.1>,
in => qq[\xFE\xFF\x00<\x00?\x00x\x00m\x00l\x00 \x00v\x00e\x00r].
qq[\x00s\x00i\x00o\x00n\x00=\x00"\x001\x00.\x000\x00"].
qq[\x00 \x00e\x00n\x00c\x00o\x00d\x00i\x00n\x00g\x00=].
qq[\x00"\x00u\x00t\x00f\x00-\x001\x006\x00"\x00?\x00>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "1", null,
"6", null, '"', null, "?", null, ">", null],
name => 'utf-16', bom => true,
},
{
id => q<bom16le.decl.1>,
in => qq[\xFF\xFE<\x00?\x00x\x00m\x00l\x00 \x00v\x00e\x00r].
qq[\x00s\x00i\x00o\x00n\x00=\x00"\x001\x00.\x000\x00"].
qq[\x00 \x00e\x00n\x00c\x00o\x00d\x00i\x00n\x00g\x00=].
qq[\x00"\x00u\x00t\x00f\x00-\x001\x006\x00"\x00?\x00>\x00],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "1", null,
"6", null, '"', null, "?", null, ">", null],
name => 'utf-16', bom => true,
},
{
id => q<utf16be.decl.1>,
in => qq[\x00<\x00?\x00x\x00m\x00l\x00 \x00v\x00e\x00r].
qq[\x00s\x00i\x00o\x00n\x00=\x00"\x001\x00.\x000\x00"].
qq[\x00 \x00e\x00n\x00c\x00o\x00d\x00i\x00n\x00g\x00=].
qq[\x00"\x00u\x00t\x00f\x00-\x001\x006\x00b\x00e\x00"\x00?\x00>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "1", null,
"6", null, "b", null, "e", null, '"', null,
"?", null, ">", null],
name => 'utf-16be', bom => false,
},
{
id => q<utf16le.decl.1>,
in => qq[<\x00?\x00x\x00m\x00l\x00 \x00v\x00e\x00r].
qq[\x00s\x00i\x00o\x00n\x00=\x00"\x001\x00.\x000\x00"].
qq[\x00 \x00e\x00n\x00c\x00o\x00d\x00i\x00n\x00g\x00=].
qq[\x00"\x00u\x00t\x00f\x00-\x001\x006\x00l\x00e\x00"].
qq[\x00?\x00>\x00],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "1", null,
"6", null, "l", null, "e", null, '"', null, "?", null,
">", null],
name => 'utf-16le', bom => false,
},
{
id => q<16be.decl.1>,
in => qq[\x00<\x00?\x00x\x00m\x00l\x00 \x00v\x00e\x00r].
qq[\x00s\x00i\x00o\x00n\x00=\x00"\x001\x00.\x000\x00"].
qq[\x00 \x00e\x00n\x00c\x00o\x00d\x00i\x00n\x00g\x00=].
qq[\x00"\x00u\x00t\x00f\x00-\x001\x006\x00"\x00?\x00>],
out => [[<Q::cs|charset-name-mismatch-error>],
"<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "1", null,
"6", null, '"', null, "?", null, ">", null],
name => 'utf-16', bom => false,
},
{
id => q<16le.decl.1>,
in => qq[<\x00?\x00x\x00m\x00l\x00 \x00v\x00e\x00r].
qq[\x00s\x00i\x00o\x00n\x00=\x00"\x001\x00.\x000\x00"].
qq[\x00 \x00e\x00n\x00c\x00o\x00d\x00i\x00n\x00g\x00=].
qq[\x00"\x00u\x00t\x00f\x00-\x001\x006\x00"\x00?\x00>\x00],
out => [[<Q::cs|charset-name-mismatch-error>],
"<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "1", null,
"6", null, '"', null, "?", null, ">", null],
name => 'utf-16', bom => false,
},
{
id => q<8.decl.1>,
in => qq[<?xml version="1.0" encoding="utf-8"?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "8", null,
'"', null, "?", null, ">", null],
name => 'utf-8', bom => false,
},
{
id => q<8.decl.2>,
in => qq[<?xml encoding="utf-8"?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "8", null,
'"', null, "?", null, ">", null],
name => 'utf-8', bom => false,
},
{
id => q<8.decl.3>,
in => qq[<?xml version="1.1" encoding="utf-8"?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "1", null, '"', null, " ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "8", null,
'"', null, "?", null, ">", null],
name => 'utf-8', bom => false,
},
{
id => q<8.decl.4>,
in => qq[<?xml version="1.0"?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null, "v", null, "e", null, "r", null, "s", null,
"i", null, "o", null, "n", null, "=", null, '"', null,
"1", null, ".", null, "0", null, '"', null,
"?", null, ">", null],
name => 'utf-8', bom => false,
},
{
id => q<bom8.decl.1>,
in => qq[\xEF\xBB\xBF<?xml encoding="utf-8"?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "t", null, "f", null, "-", null, "8", null,
'"', null, "?", null, ">", null],
name => 'utf-8', bom => true,
},
{
id => q<us-ascii.decl.1>,
in => qq[<?xml encoding="us-ascii"?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"u", null, "s", null, "-", null, "a", null, "s", null,
"c", null, "i", null, "i", null,
'"', null, "?", null, ">", null],
name => 'us-ascii', bom => false,
},
{
id => q<us-ascii.decl.2>,
in => qq[<?xml encoding="US-ascii"?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, '"', null,
"U", null, "S", null, "-", null, "a", null, "s", null,
"c", null, "i", null, "i", null,
'"', null, "?", null, ">", null],
name => 'us-ascii', bom => false,
},
{
id => q<us-ascii.decl.3>,
in => qq[<?xml encoding='us-ascii'?>],
out => [null, "<", null, "?", null, "x", null, "m", null, "l", null,
" ", null,
"e", null, "n", null, "c", null, "o", null, "d", null,
"i", null, "n", null, "g", null, "=", null, "'", null,
"u", null, "s", null, "-", null, "a", null, "s", null,
"c", null, "i", null, "i", null,
"'", null, "?", null, ">", null],
name => 'us-ascii', bom => false,
},
);
for my $testdata (@testdata) {
my $byte = $testdata->{in};
my $error;
my $i = 0;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::xml-auto-charset:>, $fh, sub {
my (null, null, $etype, %opt) = @_;
$error = [$etype, \%opt];
});
$test->id ("$testdata->{id}.bom");
my $tf = $testdata->{bom} ? 'assert_true' : 'assert_false';
$test->$tf ($efh-><AG::MCDecodeHandle.hasBOM>);
$test->id ("$testdata->{id}.name");
$test->assert_equals ($efh-><AG::MCDecodeHandle.inputEncoding>,
$testdata->{name});
while (@{$testdata->{out}}) {
if ($i != 0) {
my $c = shift @{$testdata->{out}};
$test->id ("$testdata->{id}.$i");
$test->assert_equals ($efh->getc, $c);
}
my $v = shift @{$testdata->{out}};
$test->id ("$testdata->{id}.$i.error");
if (defined $v) {
$test->assert_not_null ($error);
$test->assert_equals ($error->[0], $v->[0]);
} else {
$test->assert_null ($error->[0]);
}
$error = null;
$i++;
}
$test->id ("$testdata->{id}.eof");
$test->assert_null ($efh->getc);
$test->assert_null ($error);
} # testdata
@Method:
@@Name: close
@@Return:
@@@PerlDef:
close $self->{<H::mce|filehandle>};
##MCDecodeHandle
ClsDef:
@ClsQName: ManakaiMCEUCJPDecodeHandle
@ClsISA: ManakaiMCDecodeHandle
@Method:
@@Name: getc
@@enDesc:
Returns the next character from the input.
@@Return:
@@@Type: String
@@@enDesc:
The next character.
@@@nullCase:
@@@@enDesc:
If at the end of the file, or if there was an error, in which
case <Perl::$!> is set.
@@@PerlDef:
if (@{$self->{<H::mce|characterQueue>}}) {
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
__DEEP{
my $error;
if ($self->{<H::mce|continue>}) {
if (read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>}) {
#
} else {
$error = true;
}
$self->{<H::mce|continue>} = false;
} elsif (512 > length $self->{<H::mce|byteBuffer>}) {
read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>};
}
unless ($error) {
my $string = Encode::decode ($self->{<H::mce|perlEncodingName>},
$self->{<H::mce|byteBuffer>},
Encode::FB_QUIET ());
if (length $string) {
push @{$self->{<H::mce|characterQueue>}}, split //, $string;
$r = shift @{$self->{<H::mce|characterQueue>}};
if (length $self->{<H::mce|byteBuffer>}) {
$self->{<H::mce|continue>} = true;
}
} else {
if (length $self->{<H::mce|byteBuffer>}) {
$error = true;
} else {
$r = null;
}
}
}
if ($error) {
$r = substr $self->{<H::mce|byteBuffer>}, 0, 1, '';
my $etype = <Q::cs|illegal-octets-error>;
if ($r =~ /^[\xA1-\xFE]/) {
if ($self->{<H::mce|byteBuffer>} =~ s/^([\xA1-\xFE])//) {
$r .= $1;
$etype = <Q::cs|unassigned-code-point-error>;
}
} elsif ($r eq "\x8F") {
if ($self->{<H::mce|byteBuffer>}
=~ s/^([\xA1-\xFE][\xA1-\xFE]?)//) {
$r .= $1;
$etype = <Q::cs|unassigned-code-point-error> if length $1 == 2;
}
} elsif ($r eq "\x8E") {
if ($self->{<H::mce|byteBuffer>} =~ s/^([\xA1-\xFE])//) {
$r .= $1;
$etype = <Q::cs|unassigned-code-point-error>;
}
} elsif ($r eq "\xA0" or $r eq "\xFF") {
$etype = <Q::cs|unassigned-code-point-error>;
}
$self->{<H::mce|onerror>}
->($self->{<H::mce|onerror>}, $self, $etype,
octets => \$r);
}
}__;
}
@Test:
@@QName: MCEUCJPDecodeHandle.1.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my @testdata = (
{
id => q<l=0>,
in => q<>,
out => [null],
},
{
id => q<l=1.00>,
in => qq<\x00>,
out => [null, "\x00", null],
},
{
id => q<l=1.0d>,
in => qq<\x0D>,
out => [null, "\x0D", null],
},
{
id => q<l=1.0e>,
in => qq<\x0E>,
out => [null, "\x0E", null],
}, # Error??
{
id => q<l=1.0f>,
in => qq<\x0F>,
out => [null, "\x0F", null],
}, # Error??
{
id => q<l=1.1b>,
in => qq<\x1B>,
out => [null, "\x1B", null],
}, # Error??
{
id => q<l=1.a>,
in => q<a>,
out => [null, "a", null],
},
{
id => q<l=1.20>,
in => qq<\x20>,
out => [null, "\x20", null],
},
{
id => q<5C>,
in => qq<\x5C>,
out => [null, "\x5C", null],
},
{
id => q<l=1.7E>,
in => qq<\x7E>,
out => [null, "\x7E", null],
},
{
id => q<l=1.7F>,
in => qq<\x7F>,
out => [null, "\x7F", null],
},
{
id => q<l=1.80>,
in => qq<\x80>,
out => [null, "\x80", null],
},
{
id => q<l=1.8c>,
in => qq<\x8C>,
out => [null, "\x8C", null],
},
{
id => q<l=1.8e>,
in => qq<\x8E>,
out => [null, "\x8E", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.8f>,
in => qq<\x8F>,
out => [null, "\x8F", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.a0>,
in => qq<\xA0>,
out => [null, "\xA0", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=1.a1>,
in => qq<\xA1>,
out => [null, "\xA1", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.a2>,
in => qq<\xA2>,
out => [null, "\xA2", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.fd>,
in => qq<\xFD>,
out => [null, "\xFD", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.fe>,
in => qq<\xFE>,
out => [null, "\xFE", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.ff>,
in => qq<\xFF>,
out => [null, "\xFF", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=2.0000>,
in => qq<\x00\x00>,
out => [null, "\x00", null, "\x00", null],
},
{
id => q<l=2.0D0A>,
in => qq<\x0D\x0A>,
out => [null, "\x0D", null, "\x0A", null],
},
{
id => q<l=2.1B28>,
in => qq<\x1B\x28>,
out => [null, "\x1B", null, "\x28", null],
},# Error??
{
id => q<l=2.2020>,
in => qq<\x20\x20>,
out => [null, "\x20", null, "\x20", null],
},
{
id => q<l=2.ab>,
in => qq<ab>,
out => [null, "a", null, "b", null],
},
{
id => q<l=2.a0a1>,
in => qq<\xA0\xA1>,
out => [null, "\xA0", [<Q::cs|unassigned-code-point-error>],
"\xA1", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=2.a1a1>,
in => qq<\xA1\xA1>,
out => [null, "\x{3000}", null],
},
{
id => q<l=2.a1a2>,
in => qq<\xA1\xA2>,
out => [null, "\x{3001}", null],
},
{
id => q<l=2.a1a4>,
in => qq<\xA1\xA4>,
out => [null, "\x{FF0C}", null], # FULLWIDTH COMMA
},
{
id => q<a1a6>,
in => qq<\xA1\xA6>,
out => [null, "\x{30FB}", null], # KATAKABA MIDDLE DOT
},
{
id => q<a1a7>,
in => qq<\xA1\xA7>,
out => [null, "\x{FF1A}", null], # FULLWIDTH COLON
},
{
id => q<a1b1>,
in => qq<\xA1\xB1>,
out => [null, "\x{203E}", null], # OVERLINE
},
{
id => q<a1bd>,
in => qq<\xA1\xBD>,
out => [null, "\x{2014}", null], # EM DASH
},
{
id => q<a1c0>,
in => qq<\xA1\xC0>,
out => [null, "\x{FF3C}", null], # FULLWIDTH REVERSE SOLIDUS
},
{
id => q<a1c1>,
in => qq<\xA1\xC1>,
out => [null, "\x{301C}", null], # WAVE DASH
},
{
id => q<a1c2>,
in => qq<\xA1\xC2>,
out => [null, "\x{2016}", null], # DOUBLE VERTICAL LINE
},
{
id => q<a1c4>,
in => qq<\xA1\xC4>,
out => [null, "\x{2026}", null], # HORIZONTAL ELLIPSIS
},
{
id => q<a1dd>,
in => qq<\xA1\xDD>,
out => [null, "\x{2212}", null], # MINUS SIGN
},
{
id => q<a1ef>,
in => qq<\xA1\xEF>,
out => [null, "\x{00A5}", null], # YEN SIGN
},
{
id => q<a1f1>,
in => qq<\xA1\xF1>,
out => [null, "\x{00A2}", null], # CENT SIGN
},
{
id => q<a1f2>,
in => qq<\xA1\xF2>,
out => [null, "\x{00A3}", null], # POUND SIGN
},
{
id => q<a1f2>,
in => qq<\xA1\xFF>,
out => [null, "\xA1", [<Q::cs|illegal-octets-error>],
"\xFF", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<a2ae>,
in => qq<\xA2\xAE>,
out => [null, "\x{3013}", null], # GETA MARK
},
{
id => q<a2af>,
in => qq<\xA2\xAF>,
out => [null, "\xA2\xAF", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<a2ba>,
in => qq<\xA2\xBA>,
out => [null, "\x{2208}", null], # ELEMENT OF
},
{
id => q<a2fe>,
in => qq<\xA2\xFE>,
out => [null, "\x{25EF}", null], # LARGE CIRCLE
},
{
id => q<adce>,
in => qq<\xAD\xCE>,
out => [null, "\xAD\xCE", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<b0a6>,
in => qq<\xB0\xA6>,
out => [null, "\x{611B}", null], # han
},
{
id => q<f4a6>,
in => qq<\xF4\xA6>,
out => [null, "\x{7199}", null], # han
},
{
id => q<8ea1>,
in => qq<\x8E\xA1>,
out => [null, "\x{FF61}", null],
},
{
id => q<8efe>,
in => qq<\x8E\xFE>,
out => [null, "\x8E\xFE", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<8ffe>,
in => qq<\x8F\xFE>,
out => [null, "\x8F\xFE", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=2.a1a2a3>,
in => qq<\xA1\xA2\xA3>,
out => [null, "\x{3001}", null,
"\xA3", [<Q::cs|illegal-octets-error>]],
},
{
id => q<8ea1a1>,
in => qq<\x8E\xA1\xA1>,
out => [null, "\x{FF61}", null,
"\xA1", [<Q::cs|illegal-octets-error>]],
},
{
id => q<8fa1a1>,
in => qq<\x8F\xA1\xA1>,
out => [null, "\x8F\xA1\xA1", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<8fa2af>,
in => qq<\x8F\xA2\xAF>,
out => [null, "\x{02D8}", null],
},
{
id => q<8fa2b7>,
in => qq<\x8F\xA2\xB7>,
out => [null, "\x{FF5E}", null], # FULLWIDTH TILDE
},
{
id => q<a1a2a1a3>,
in => qq<\xA1\xA2\xA1\xA3>,
out => [null, "\x{3001}", null, "\x{3002}", null],
},
{
id => q<8fa2af>,
in => qq<\x8F\xA2\xAF\xAF>,
out => [null, "\x{02D8}", null,
"\xAF", [<Q::cs|illegal-octets-error>]],
},
{
id => q<8fa2afafa1>,
in => qq<\x8F\xA2\xAF\xAF\xA1>,
out => [null, "\x{02D8}", null,
"\xAF\xA1", [<Q::cs|unassigned-code-point-error>]],
},
);
for my $testdata (@testdata) {
my $byte = $testdata->{in};
my $error;
my $i = 0;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.euc-jp>, $fh, sub {
my (null, null, $etype, %opt) = @_;
$error = [$etype, \%opt];
});
while (@{$testdata->{out}}) {
if ($i != 0) {
my $c = shift @{$testdata->{out}};
$test->id ("$testdata->{id}.$i");
$test->assert_equals ($efh->getc, $c);
}
my $v = shift @{$testdata->{out}};
$test->id ("$testdata->{id}.$i.error");
if (defined $v) {
$test->assert_not_null ($error);
$test->assert_equals ($error->[0], $v->[0]);
} else {
$test->assert_null ($error->[0]);
}
$error = null;
$i++;
}
$test->id ("$testdata->{id}.eof");
$test->assert_null ($efh->getc);
$test->assert_null ($error);
} # testdata
##MCEUCJPDecodeHandle
ClsDef:
@ClsQName: ManakaiMCShiftJISDecodeHandle
@ClsISA: ManakaiMCDecodeHandle
@Method:
@@Name: getc
@@enDesc:
Returns the next character from the input.
@@Return:
@@@Type: String
@@@enDesc:
The next character.
@@@nullCase:
@@@@enDesc:
If at the end of the file, or if there was an error, in which
case <Perl::$!> is set.
@@@PerlDef:
if (@{$self->{<H::mce|characterQueue>}}) {
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
__DEEP{
my $error;
if ($self->{<H::mce|continue>}) {
if (read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>}) {
#
} else {
$error = true;
}
$self->{<H::mce|continue>} = false;
} elsif (512 > length $self->{<H::mce|byteBuffer>}) {
read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>};
}
unless ($error) {
my $string = Encode::decode ($self->{<H::mce|perlEncodingName>},
$self->{<H::mce|byteBuffer>},
Encode::FB_QUIET ());
if (length $string) {
push @{$self->{<H::mce|characterQueue>}}, split //, $string;
$r = shift @{$self->{<H::mce|characterQueue>}};
if (length $self->{<H::mce|byteBuffer>}) {
$self->{<H::mce|continue>} = true;
}
} else {
if (length $self->{<H::mce|byteBuffer>}) {
$error = true;
} else {
$r = null;
}
}
}
if ($error) {
$r = substr $self->{<H::mce|byteBuffer>}, 0, 1, '';
my $etype = <Q::cs|illegal-octets-error>;
if ($r =~ /^[\x81-\x9F\xE0-\xEF]/) {
if ($self->{<H::mce|byteBuffer>} =~ s/(.)//s) {
$r .= $1; # not limited to \x40-\xFC - \x7F
$etype = <Q::cs|unassigned-code-point-error>;
}
} elsif ($r =~ /^[\x80\xA0\xF0-\xFF]/) {
$etype = <Q::cs|unassigned-code-point-error>;
}
$self->{<H::mce|onerror>}
->($self->{<H::mce|onerror>}, $self, $etype,
octets => \$r);
}
}__;
}
@Test:
@@QName: MCShiftJISDecodeHandle.1.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my @testdata = (
{
id => q<l=0>,
in => q<>,
out => [null],
},
{
id => q<l=1.00>,
in => qq<\x00>,
out => [null, "\x00", null],
},
{
id => q<l=1.0d>,
in => qq<\x0D>,
out => [null, "\x0D", null],
},
{
id => q<l=1.0e>,
in => qq<\x0E>,
out => [null, "\x0E", null],
}, # Error??
{
id => q<l=1.0f>,
in => qq<\x0F>,
out => [null, "\x0F", null],
}, # Error??
{
id => q<l=1.1b>,
in => qq<\x1B>,
out => [null, "\x1B", null],
}, # Error??
{
id => q<l=1.a>,
in => q<a>,
out => [null, "a", null],
},
{
id => q<l=1.20>,
in => qq<\x20>,
out => [null, "\x20", null],
},
{
id => q<l=1.5C>,
in => qq<\x5C>,
out => [null, "\xA5", null], # YEN SIGN
},
{
id => q<l=1.7E>,
in => qq<\x7E>,
out => [null, "\x{203E}", null], # OVERLINE
},
{
id => q<l=1.7F>,
in => qq<\x7F>,
out => [null, "\x7F", null],
},
{
id => q<l=1.80>,
in => qq<\x80>,
out => [null, "\x80", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=1.8c>,
in => qq<\x8C>,
out => [null, "\x8C", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.8e>,
in => qq<\x8E>,
out => [null, "\x8E", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.8f>,
in => qq<\x8F>,
out => [null, "\x8F", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.a0>,
in => qq<\xA0>,
out => [null, "\xA0", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=1.a1>,
in => qq<\xA1>,
out => [null, "\x{FF61}", null],
},
{
id => q<l=1.a2>,
in => qq<\xA2>,
out => [null, "\x{FF62}", null],
},
{
id => q<l=1.df>,
in => qq<\xdf>,
out => [null, "\x{FF9F}", null],
},
{
id => q<l=1.e0>,
in => qq<\xe0>,
out => [null, "\xE0", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.ef>,
in => qq<\xEF>,
out => [null, "\xEF", [<Q::cs|illegal-octets-error>]],
},
{
id => q<F0>,
in => qq<\xF0>,
out => [null, "\xF0", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=1.fc>,
in => qq<\xFC>,
out => [null, "\xFC", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=1.fd>,
in => qq<\xFD>,
out => [null, "\xFD", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=1.fe>,
in => qq<\xFE>,
out => [null, "\xFE", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=1.ff>,
in => qq<\xFF>,
out => [null, "\xFF", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<l=2.0000>,
in => qq<\x00\x00>,
out => [null, "\x00", null, "\x00", null],
},
{
id => q<l=2.0D0A>,
in => qq<\x0D\x0A>,
out => [null, "\x0D", null, "\x0A", null],
},
{
id => q<l=2.1B28>,
in => qq<\x1B\x28>,
out => [null, "\x1B", null, "\x28", null],
},# Error??
{
id => q<l=2.2020>,
in => qq<\x20\x20>,
out => [null, "\x20", null, "\x20", null],
},
{
id => q<l=2.ab>,
in => qq<ab>,
out => [null, "a", null, "b", null],
},
{
id => q<8040>,
in => qq<\x80\x40>,
out => [null, "\x80", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<8100>,
in => qq<\x81\x00>,
out => [null, "\x81\x00", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<8101>,
in => qq<\x81\x01>,
out => [null, "\x81\x01", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<813F>,
in => qq<\x81\x3F>,
out => [null, "\x81\x3F", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<8140>,
in => qq<\x81\x40>,
out => [null, "\x{3000}", null],
},
{
id => q<8141>,
in => qq<\x81\x41>,
out => [null, "\x{3001}", null],
},
{
id => q<8143>,
in => qq<\x81\x43>,
out => [null, "\x{FF0C}", null], # FULLWIDTH COMMA
},
{
id => q<8150>,
in => qq<\x81\x50>,
out => [null, "\x{FFE3}", null], # FULLWIDTH MACRON
},
{
id => q<815C>,
in => qq<\x81\x5C>,
out => [null, "\x{2014}", null], # EM DASH
},
{
id => q<815F>,
in => qq<\x81\x5F>,
out => [null, "\x{005C}", null], # REVERSE SOLIDUS
},
{
id => q<8160>,
in => qq<\x81\x60>,
out => [null, "\x{301C}", null], # WAVE DASH
},
{
id => q<8161>,
in => qq<\x81\x61>,
out => [null, "\x{2016}", null], # DOUBLE VERTICAL LINE
},
{
id => q<8163>,
in => qq<\x81\x63>,
out => [null, "\x{2026}", null], # HORIZONTAL ELLIPSIS
},
{
id => q<817C>,
in => qq<\x81\x7C>,
out => [null, "\x{2212}", null], # MINUS SIGN
},
{
id => q<817F>,
in => qq<\x81\x7F>,
out => [null, "\x81\x7F", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<818F>,
in => qq<\x81\x8F>,
out => [null, "\x{FFE5}", null], # FULLWIDTH YEN SIGN
},
{
id => q<8191>,
in => qq<\x81\x91>,
out => [null, "\x{00A2}", null], # CENT SIGN
},
{
id => q<8192>,
in => qq<\x81\x92>,
out => [null, "\x{00A3}", null], # POUND SIGN
},
{
id => q<81AC>,
in => qq<\x81\xAC>,
out => [null, "\x{3013}", null], # GETA MARK
},
{
id => q<81AD>,
in => qq<\x81\xAD>,
out => [null, "\x81\xAD", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<81B8>,
in => qq<\x81\xB8>,
out => [null, "\x{2208}", null], # ELEMENT OF
},
{
id => q<81CA>,
in => qq<\x81\xCA>,
out => [null, "\x{00AC}", null], # NOT SIGN
},
{
id => q<81FC>,
in => qq<\x81\xFC>,
out => [null, "\x{25EF}", null], # LARGE CIRCLE
},
{
id => q<81FD>,
in => qq<\x81\xFD>,
out => [null, "\x81\xFD", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<81FE>,
in => qq<\x81\xFE>,
out => [null, "\x81\xFE", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<81FF>,
in => qq<\x81\xFF>,
out => [null, "\x81\xFF", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<DDDE>,
in => qq<\xDD\xDE>,
out => [null, "\x{FF9D}", null, "\x{FF9E}", null],
},
{
id => q<e040>,
in => qq<\xE0\x40>,
out => [null, "\x{6F3E}", null],
},
{
id => q<eaa4>,
in => qq<\xEA\xA4>,
out => [null, "\x{7199}", null],
},
{
id => q<eaa5>,
in => qq<\xEA\xA5>,
out => [null, "\xEA\xA5", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<eb40>,
in => qq<\xEB\x40>,
out => [null, "\xEB\x40", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<ed40>,
in => qq<\xED\x40>,
out => [null, "\xED\x40", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<effc>,
in => qq<\xEF\xFC>,
out => [null, "\xEF\xFC", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<f040>,
in => qq<\xF0\x40>,
out => [null, "\xF0", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<f140>,
in => qq<\xF1\x40>,
out => [null, "\xF1", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<fb40>,
in => qq<\xFB\x40>,
out => [null, "\xFB", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<fc40>,
in => qq<\xFc\x40>,
out => [null, "\xFC", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<fd40>,
in => qq<\xFD\x40>,
out => [null, "\xFD", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<fE40>,
in => qq<\xFE\x40>,
out => [null, "\xFE", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<ff40>,
in => qq<\xFF\x40>,
out => [null, "\xFF", [<Q::cs|unassigned-code-point-error>],
"\x40", null],
},
{
id => q<81408142>,
in => qq<\x81\x40\x81\x42>,
out => [null, "\x{3000}", null, "\x{3002}", null],
},
);
for my $testdata (@testdata) {
my $byte = $testdata->{in};
my $error;
my $i = 0;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
(<Q::cs|XML.shift_jis>, $fh, sub {
my (null, null, $etype, %opt) = @_;
$error = [$etype, \%opt];
});
while (@{$testdata->{out}}) {
if ($i != 0) {
my $c = shift @{$testdata->{out}};
$test->id ("$testdata->{id}.$i");
$test->assert_equals ($efh->getc, $c);
}
my $v = shift @{$testdata->{out}};
$test->id ("$testdata->{id}.$i.error");
if (defined $v) {
$test->assert_not_null ($error);
$test->assert_equals ($error->[0], $v->[0]);
} else {
$test->assert_null ($error->[0]);
}
$error = null;
$i++;
}
$test->id ("$testdata->{id}.eof");
$test->assert_null ($efh->getc);
$test->assert_null ($error);
} # testdata
##MCShiftJISDecodeHandle
ClsDef:
@ClsQName: ManakaiMCISO2022JPDecodeHandle
@ClsISA: ManakaiMCDecodeHandle
@Method:
@@Name: getc
@@enDesc:
Returns the next character from the input.
@@Return:
@@@Type: String
@@@enDesc:
The next character.
@@@nullCase:
@@@@enDesc:
If at the end of the file, or if there was an error, in which
case <Perl::$!> is set.
@@@PerlDef:
if (@{$self->{<H::mce|characterQueue>}}) {
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
__DEEP{
A: {
my $error;
if ($self->{<H::mce|continue>}) {
if (read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>}) {
#
} else {
$error = true;
}
$self->{<H::mce|continue>} = false;
} elsif (512 > length $self->{<H::mce|byteBuffer>}) {
read $self->{<H::mce|filehandle>},
$self->{<H::mce|byteBuffer>}, 256,
length $self->{<H::mce|byteBuffer>};
}
unless ($error) {
if ($self->{<H::mce|byteBuffer>}
=~ s/^\x1B(\x24[\x40\x42]|\x28[\x42\x4A])//) {
$self->{<H::mce|state>} = {
"\x24\x40" => <H::mce|State.2440>,
"\x24\x42" => <H::mce|State.2442>,
"\x28\x42" => <H::mce|State.2842>,
"\x28\x4A" => <H::mce|State.284A>,
}->{$1};
redo A;
} elsif ($self->{<H::mce|state>} eq <H::mce|State.2842>) { # IRV
if ($self->{<H::mce|byteBuffer>}
=~ s/^([\x00-\x0D\x10-\x1A\x1C-\x7F]+)//) {
push @{$self->{<H::mce|characterQueue>}}, split //, $1;
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
if (length $self->{<H::mce|byteBuffer>}) {
$error = true;
} else {
$r = null;
}
}
} elsif ($self->{<H::mce|state>} eq <H::mce|State.284A>) { # 0201
if ($self->{<H::mce|byteBuffer>}
=~ s/^([\x00-\x0D\x10-\x1A\x1C-\x7F]+)//) {
my $v = $1; $v =~ tr/\x5C\x7E/\xA5\x{203E}/;
push @{$self->{<H::mce|characterQueue>}}, split //, $v;
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
if (length $self->{<H::mce|byteBuffer>}) {
$error = true;
} else {
$r = null;
$self->{<H::mce|onerror>}
->($self->{<H::mce|onerror>}, $self,
<Q::cs|invalid-state-error>,
state => $self->{<H::mce|state>});
}
}
} elsif ($self->{<H::mce|state>} eq <H::mce|State.2442>) { # 1983
my $v = Encode::decode ($self->{<H::mce|State.2442>},
$self->{<H::mce|byteBuffer>},
Encode::FB_QUIET ());
if (length $v) {
push @{$self->{<H::mce|characterQueue>}}, split //, $v;
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
if (length $self->{<H::mce|byteBuffer>}) {
$error = true;
} else {
$r = null;
$self->{<H::mce|onerror>}
->($self->{<H::mce|onerror>}, $self,
<Q::cs|invalid-state-error>,
state => $self->{<H::mce|state>});
}
}
} elsif ($self->{<H::mce|state>} eq <H::mce|State.2440>) { # 1978
my $v = Encode::decode ($self->{<H::mce|State.2440>},
$self->{<H::mce|byteBuffer>},
Encode::FB_QUIET ());
if (length $v) {
push @{$self->{<H::mce|characterQueue>}}, split //, $v;
$r = shift @{$self->{<H::mce|characterQueue>}};
} else {
if (length $self->{<H::mce|byteBuffer>}) {
$error = true;
} else {
$r = null;
$self->{<H::mce|onerror>}
->($self->{<H::mce|onerror>}, $self,
<Q::cs|invalid-state-error>,
state => $self->{<H::mce|state>});
}
}
} else {
$error = true;
}
}
if ($error) {
$r = substr $self->{<H::mce|byteBuffer>}, 0, 1, '';
my $etype = <Q::cs|illegal-octets-error>;
if (($self->{<H::mce|state>} eq <H::mce|State.2442> or
$self->{<H::mce|state>} eq <H::mce|State.2440>) and
$r =~ /^[\x21-\x7E]/ and
$self->{<H::mce|byteBuffer>} =~ s/^([\x21-\x7E])//) {
$r .= $1;
$etype = <Q::cs|unassigned-code-point-error>;
} elsif ($r eq "\x1B" and
$self->{<H::mce|byteBuffer>} =~ s/^\(H//) { # Old 0201
$r .= "(H";
$self->{<H::mce|state>} = <H::mce|State.284A>;
}
$self->{<H::mce|onerror>}
->($self->{<H::mce|onerror>}, $self, $etype,
octets => \$r);
}
} # A
}__;
}
@Test:
@@QName: MCISO2022JPDecodeHandle.1.test
@@PerlDef:
my $impl;
__CODE{createImplForTest:: $impl => $impl}__;
my @testdata = (
{
id => q<l=0>,
in => q<>,
out1 => [null],
out2 => [null],
},
{
id => q<l=1.00>,
in => qq<\x00>,
out1 => [null, "\x00", null],
out2 => [null, "\x00", null],
},
{
id => q<l=1.0d>,
in => qq<\x0D>,
out1 => [null, "\x0D", null],
out2 => [null, "\x0D", null],
}, # Error?
{
id => q<0A>,
in => qq<\x0A>,
out1 => [null, "\x0A", null],
out2 => [null, "\x0A", null],
}, # Error?
{
id => q<l=1.0e>,
in => qq<\x0E>,
out1 => [null, "\x0E", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x0E", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.0f>,
in => qq<\x0F>,
out1 => [null, "\x0F", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x0F", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.1b>,
in => qq<\x1B>,
out1 => [null, "\x1B", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x1B", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.a>,
in => q<a>,
out1 => [null, "a", null],
out2 => [null, "a", null],
},
{
id => q<l=1.20>,
in => qq<\x20>,
out1 => [null, "\x20", null],
out2 => [null, "\x20", null],
},
{
id => q<l=1.5C>,
in => qq<\x5C>,
out1 => [null, "\x5C", null],
out2 => [null, "\x5C", null],
},
{
id => q<l=1.7E>,
in => qq<\x7E>,
out1 => [null, "\x7E", null],
out2 => [null, "\x7E", null],
},
{
id => q<l=1.7F>,
in => qq<\x7F>,
out1 => [null, "\x7F", null],
out2 => [null, "\x7F", null],
},
{
id => q<l=1.80>,
in => qq<\x80>,
out1 => [null, "\x80", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x80", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.8c>,
in => qq<\x8C>,
out1 => [null, "\x8C", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x8C", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.8e>,
in => qq<\x8E>,
out1 => [null, "\x8E", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x8E", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.8f>,
in => qq<\x8F>,
out1 => [null, "\x8F", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x8F", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.a0>,
in => qq<\xA0>,
out1 => [null, "\xA0", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xA0", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.a1>,
in => qq<\xA1>,
out1 => [null, "\xA1", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xA1", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.a2>,
in => qq<\xA2>,
out1 => [null, "\xA2", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xA2", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.df>,
in => qq<\xdf>,
out1 => [null, "\xDF", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xDF", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.e0>,
in => qq<\xe0>,
out1 => [null, "\xE0", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xE0", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.ef>,
in => qq<\xEF>,
out1 => [null, "\xEF", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xEF", [<Q::cs|illegal-octets-error>]],
},
{
id => q<F0>,
in => qq<\xF0>,
out1 => [null, "\xF0", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xF0", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.fc>,
in => qq<\xFC>,
out1 => [null, "\xFC", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xFC", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.fd>,
in => qq<\xFD>,
out1 => [null, "\xFD", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xFD", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.fe>,
in => qq<\xFE>,
out1 => [null, "\xFE", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xFE", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=1.ff>,
in => qq<\xFF>,
out1 => [null, "\xFF", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\xFF", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=2.0000>,
in => qq<\x00\x00>,
out1 => [null, "\x00", null, "\x00", null],
out2 => [null, "\x00", null, "\x00", null],
},
{
id => q<l=2.0D0A>,
in => qq<\x0D\x0A>,
out1 => [null, "\x0D", null, "\x0A", null],
out2 => [null, "\x0D", null, "\x0A", null],
},
{
id => q<l=2.1B1B>,
in => qq<\x1B\x1B>,
out1 => [null, "\x1B", [<Q::cs|illegal-octets-error>],
"\x1B", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x1B", [<Q::cs|illegal-octets-error>],
"\x1B", [<Q::cs|illegal-octets-error>]],
},
{
id => q<l=2.1B20>,
in => qq<\x1B\x20>,
out1 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "\x20", null],
out2 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "\x20", null],
},
{
id => q<l=2.1B24>,
in => qq<\x1B\x24>,
out1 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "\x24", null],
out2 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "\x24", null],
},
{
id => q<l=2.1B28>,
in => qq<\x1B\x28>,
out1 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "\x28", null],
out2 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "\x28", null],
},
{
id => q<l=2.2020>,
in => qq<\x20\x20>,
out1 => [null, "\x20", null, "\x20", null],
out2 => [null, "\x20", null, "\x20", null],
},
{
id => q<l=2.ab>,
in => qq<ab>,
out1 => [null, "a", null, "b", null],
out2 => [null, "a", null, "b", null],
},
{
id => q<8040>,
in => qq<\x80\x40>,
out1 => [null, "\x80", [<Q::cs|illegal-octets-error>],
"\x40", null],
out2 => [null, "\x80", [<Q::cs|illegal-octets-error>],
"\x40", null],
},
{
id => q<1B2440>,
in => qq<\x1B\x24\x40>,
out1 => [null],
out2 => [null],
eof_error => [<Q::cs|invalid-state-error>],
},
{
id => q<1B2442>,
in => qq<\x1B\x24\x42>,
out1 => [null],
out2 => [null],
eof_error => [<Q::cs|invalid-state-error>],
},
{
id => q<1B2840>,
in => qq<\x1B\x28\x40>,
out1 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "(", null,
"\x40", null],
out2 => [null, "\x1B", [<Q::cs|illegal-octets-error>], "(", null,
"\x40", null],
},
{
id => q<1B2842>,
in => qq<\x1B\x28\x42>,
out1 => [null],
out2 => [null],
},
{
id => q<1B284A>,
in => qq<\x1B\x28\x4A>,
out1 => [null],
out2 => [null],
eof_error => [<Q::cs|invalid-state-error>],
},
{
id => q<1B$B1B(B>,
in => qq<\x1B\x24\x42\x1B\x28\x42>,
out1 => [null],
out2 => [null],
},
{
id => q<1B(B1B(B>,
in => qq<\x1B\x28\x42\x1B\x28\x42>,
out1 => [null],
out2 => [null],
},
{
id => q<1B(Ba1B(B>,
in => qq<\x1B\x28\x42a\x1B\x28\x42>,
out1 => [null, "a", null],
out2 => [null, "a", null],
},
{
id => q<1B(Ba1B(B1B(B>,
in => qq<\x1B\x28\x42a\x1B\x28\x42\x1B\x28\x42>,
out1 => [null, "a", null],
out2 => [null, "a", null],
},
{
id => q<1B$42!!1B2842>,
in => qq<\x1B\x24\x42!!\x1B\x28\x42>,
out1 => [null, "\x{3000}", null],
out2 => [null, "\x{3000}", null],
},
{
id => q<1B$4221211B284A>,
in => qq<\x1B\x24\x42!!\x1B\x28\x4A>,
out1 => [null, "\x{3000}", null],
out2 => [null, "\x{3000}", null],
eof_error => [<Q::cs|invalid-state-error>],
},
{
id => q<1B$4021211B2842>,
in => qq<\x1B\x24\x40!!\x1B\x28\x42>,
out1 => [null, "\x{3000}", null],
out2 => [null, "\x{3000}", null],
},
{
id => q<1B$402121211B2842>,
in => qq<\x1B\x24\x40!!!\x1B\x28\x42>,
out1 => [null, "\x{3000}", null, "!", [<Q::cs|illegal-octets-error>]],
out2 => [null, "\x{3000}", null, "!", [<Q::cs|illegal-octets-error>]],
},
{
id => q<1B$4021211B2442!!1B2842>,
in => qq<\x1B\x24\x40!!\x1B\x24\x42!!\x1B\x28\x42>,
out1 => [null, "\x{3000}", null, "\x{3000}", null],
out2 => [null, "\x{3000}", null, "\x{3000}", null],
},
{
id => q<1B$4021211B2440!!1B2842>,
in => qq<\x1B\x24\x40!!\x1B\x24\x40!!\x1B\x28\x42>,
out1 => [null, "\x{3000}", null, "\x{3000}", null],
out2 => [null, "\x{3000}", null, "\x{3000}", null],
},
{
id => q<1B$@!"1B(B\~|>,
in => qq<\x1B\x24\x40!"\x1B(B\\~|>,
out1 => [null, "\x{3001}", null, "\x5C", null,
"\x7E", null, "|", null],
out2 => [null, "\x{3001}", null, "\x5C", null,
"\x7E", null, "|", null],
},
{
id => q<1B$B!"1B(J\~|1B(B>,
in => qq<\x1B\x24\x42!"\x1B(J\\~|\x1B(B>,
out1 => [null, "\x{3001}", null, "\xA5", null,
"\x{203E}", null, "|", null],
out2 => [null, "\x{3001}", null, "\xA5", null,
"\x{203E}", null, "|", null],
},
{
id => q<78compat.3022(16-02)>,
in => qq<\x1B\$\@\x30\x22\x1B\$B\x30\x22\x1B(B>,
out1 => [null, "\x{555E}", null, "\x{5516}", null],
out2 => [null, "\x{5516}", null, "\x{5516}", null],
},
{
id => q<unassigned.2239>,
in => qq<\x1B\$\@\x22\x39\x1B\$B\x22\x39\x1B(B>,
out1 => [null, "\x22\x39", [<Q::cs|unassigned-code-point-error>],
"\x22\x39", [<Q::cs|unassigned-code-point-error>]],
out2 => [null, "\x22\x39", [<Q::cs|unassigned-code-point-error>],
"\x22\x39", [<Q::cs|unassigned-code-point-error>]],
},
{
id => q<83add.223A>,
in => qq<\x1B\$\@\x22\x3A\x1B\$B\x22\x3A\x1B(B>,
out1 => [null, "\x22\x3A", [<Q::cs|unassigned-code-point-error>],
"\x{2208}", null],
out2 => [null, "\x{2208}", null, "\x{2208}", null],
},
{
id => q<83add.2840>,
in => qq<\x1B\$\@\x28\x40\x1B\$B\x28\x40\x1B(B>,
out1 => [null, "\x28\x40", [<Q::cs|unassigned-code-point-error>],
"\x{2542}", null],
out2 => [null, "\x{2542}", null, "\x{2542}", null],
},
{
id => q<83add.7421>,
in => qq<\x1B\$\@\x74\x21\x1B\$B\x74\x21\x1B(B>,
out1 => [null, "\x74\x21", [<Q::cs|unassigned-code-point-error>],
"\x{582F}", null],
out2 => [null, "\x{5C2D}", null, "\x{582F}", null],
},
{
id => q<83swap.3033>,
in => qq<\x1B\$\@\x30\x33\x1B\$B\x30\x33\x1B(B>,
out1 => [null, "\x{9C3A}", null, "\x{9BF5}", null],
out2 => [null, "\x{9C3A}", null, "\x{9BF5}", null],
},
{
id => q<83swap.724D>,
in => qq<\x1B\$\@\x72\x4D\x1B\$B\x72\x4D\x1B(B>,
out1 => [null, "\x{9BF5}", null, "\x{9C3A}", null],
out2 => [null, "\x{9BF5}", null, "\x{9C3A}", null],
},
{
id => q<90add.7425>,
in => qq<\x1B\$\@\x74\x25\x1B\$B\x74\x25\x1B(B>,
out1 => [null, "\x74\x25", [<Q::cs|unassigned-code-point-error>],
"\x74\x25", [<Q::cs|unassigned-code-point-error>]],
out2 => [null, "\x{51DC}", null, "\x{51DC}", null],
},
{
id => q<90add.7426>,
in => qq<\x1B\$\@\x74\x26\x1B\$B\x74\x26\x1B(B>,
out1 => [null, "\x74\x26", [<Q::cs|unassigned-code-point-error>],
"\x74\x26", [<Q::cs|unassigned-code-point-error>]],
out2 => [null, "\x{7199}", null, "\x{7199}", null],
},
);
for my $testdata (@testdata) {
for my $c (1..2) {
my $byte = $testdata->{in};
my $error;
my $i = 0;
open my $fh, '<', \$byte;
my $efh = $impl-><M::MCEncodeImplementation.createMCDecodeHandle>
([null, <Q::icharset|iso-2022-jp>,
<Q::cs|XML.iso-2022-jp>]->[$c], $fh, sub {
my (null, null, $etype, %opt) = @_;
$error = [$etype, \%opt];
});
while (@{$testdata->{"out$c"}}) {
if ($i != 0) {
my $c = shift @{$testdata->{"out$c"}};
$test->id ("$testdata->{id}.$i.$c");
$test->assert_equals ($efh->getc, $c);
}
my $v = shift @{$testdata->{"out$c"}};
$test->id ("$testdata->{id}.$i.error.$c");
if (defined $v) {
$test->assert_not_null ($error);
$test->assert_equals ($error->[0], $v->[0]);
} else {
$test->assert_null ($error->[0]);
}
$error = null;
$i++;
}
$test->id ("$testdata->{id}.eof.$c");
$test->assert_null ($efh->getc);
my $v = $testdata->{eof_error};
$test->id ("$testdata->{id}.$i.error.$c");
if (defined $v) {
$test->assert_not_null ($error);
$test->assert_equals ($error->[0], $v->[0]);
} else {
$test->assert_null ($error->[0]);
}
$error = null;
}} # testdata
##MCISO2022JPDecodeHandle
PropDef:
@QName: mce|state
@mce:key: s
@enDesc:
ISO-2022-JP state.
ResourceDef:
@QName: mce|State.2440
@mce:key: s1
@enDesc:
ISO-2022-JP state: ESC 2/4 4/0.
@DISCore:resourceType: DISCore|Resource
@For: =ManakaiDOM|all
@DISCore:resourceType: DISCore|Property
ResourceDef:
@QName: mce|State.2442
@mce:key: s2
@enDesc:
ISO-2022-JP state: ESC 2/4 4/2.
@DISCore:resourceType: DISCore|Resource
@For: =ManakaiDOM|all
@DISCore:resourceType: DISCore|Property
ResourceDef:
@QName: mce|State.2842
@mce:key: s3
@enDesc:
ISO-2022-JP state: ESC 2/8 4/2.
@DISCore:resourceType: DISCore|Resource
@For: =ManakaiDOM|all
ResourceDef:
@QName: mce|State.284A
@mce:key: s4
@enDesc:
ISO-2022-JP state: ESC 2/8 4/10.
@DISCore:resourceType: DISCore|Resource
@For: =ManakaiDOM|all
ResourceDef:
@QName: String
@AliasFor: f|MIString
@For: ManakaiDOM|ManakaiDOM
PropDef:
@QName: mce|onerror
@mce:key: onerr
PropDef:
@QName: mce|inputEncoding
@mce:key: ie
PropDef:
@QName: mce|hasBOM
@mce:key: bom
PropDef:
@QName: mce|continue
@mce:key: cc
@enDesc:
Whether the <Q::mce|byteBuffer> contains octets that might
be part of characters.
PropDef:
@QName: mce|charset
@mce:key: cs
PropDef:
@QName: mce|perlEncodingName
@mce:key: enc
PropDef:
@QName: mce|filehandle
@mce:key: fh
RPropDef:
@QName: mce|key
@subsetOf: DISPerl|propHashKey
PropDef:
@QName: mce|characterQueue
@mce:key: cq
PropDef:
@QName: mce|byteBuffer
@mce:key: bb
ElementTypeBinding:
@Name: PropDef
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISCore|Property
@@ForCheck: =ManakaiDOM|all
ElementTypeBinding:
@Name: RPropDef
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: DISSource|ResourceProperty
@@ForCheck: =ManakaiDOM|all
ElementTypeBinding:
@Name: nullCase
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: ManakaiDOM|InCase
@@Value:
@@@is-null:1
@@@ContentType: DISCore|String
ElementTypeBinding:
@Name: TrueCase
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: ManakaiDOM|InCase
@@Value:
@@@@: 1
@@@ContentType: DISCore|Boolean
@@Type: idl|boolean||ManakaiDOM|all
ElementTypeBinding:
@Name: FalseCase
@ElementType:
dis:ResourceDef
@ShadowContent:
@@DISCore:resourceType: ManakaiDOM|InCase
@@Value:
@@@@: 0
@@@ContentType: DISCore|Boolean
@@Type: idl|boolean||ManakaiDOM|all
ResourceDef:
@DISCore:resourceType: cs|CharsetSet
@cs:moduleRef: DISlib|Charset