lib/Encode/ISO2022.pm


=head1 NAME

Encode::ISO2022 --- ISO/IEC 2022 encoder and decoder

=head1 ENCODINGS

=over 4

=item iso2022

ISO/IEC 2022:1994.  Default status is:

=over 2

=item CL = C0 = ISO/IEC 6429:1991 C0 set

=item CR = C1 = ISO/IEC 6429:1991 C1 set

=item GL = G0 = ISO/IEC 646:1991 IRV GL(G0) set

=item GR = G1 = empty set

=item G2 = empty set

=item G3 = empty set

=back

(Alias: iso/iec2022, iso-2022, 2022, cp2022)

=back

Note that ISO/IEC 2022 based encodings are found in
Encode::ISO2022::* modules.  This module, Encode::ISO2022
only provides a general ISO/IEC 2022 encoder/decoder.

=cut

require v5.7.3;
package Encode::ISO2022;
use strict;
use vars qw(%CHARSET %CODING_SYSTEM $VERSION);
$VERSION=do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
use base qw(Encode::Encoding);
__PACKAGE__->Define (qw!iso-2022 iso/iec2022 iso2022 2022 cp2022!);
require Encode::Charset;
        *CHARSET = \%Encode::Charset::CHARSET;
        *CODING_SYSTEM = \%Encode::Charset::CODING_SYSTEM;

### --- Perl Encode module common functions

sub encode ($$;$) {
  my ($obj, $str, $chk) = @_;
  $_[1] = '' if $chk;
  $str = &internal_to_iso2022 ($str);
  return $str;
}

sub decode ($$;$) {
  my ($obj, $str, $chk) = @_;
  $_[1] = '' if $chk;
  return &iso2022_to_internal ($str);
}

### --- Encode::ISO2022 unique functions
*new_object = \&Encode::Charset::new_object;

sub iso2022_to_internal ($;\%) {
  my ($s, $C) = @_;
  $C ||= &new_object;
  my $t = '';
  $s =~ s{^((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)}{
    my $i2 = $1;
    $t = _iso2022_to_internal ($i2, $C);
    '';
  }es;
  my $pad = '';
  use re 'eval';
  $s =~ s{
     ## ISO/IEC 2022
      (??{"$pad\x1B$pad\x25$pad\x40"})((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)
     ## UTF-8
     |(??{"$pad\x1B$pad\x25$pad(?:\x47|\x2F$pad"."[\x47-\x49])"})
       ((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)
     ## UCS-2, UTF-16
     |(??{"$pad\x1B$pad\x25$pad\x2F$pad"})([\x40\x43\x45\x4A-\x4C])
       ((?:(?!\x00\x1B\x00\x25(?:\x00\x2F)?\x00[\x30-\x7E])..)*)
     ## UCS-4
     |(??{"$pad\x1B$pad\x25$pad\x2F$pad"})[\x41\x44\x46]
       ((?:(?!\x00\x00\x00\x1B\x00\x00\x00\x25(?:\x00\x00\x00\x2F)?
           \x00\x00\x00[\x30-\x7E])....)*)
     ## with standard return
     |(??{"$pad\x1B$pad\x25$pad"})([\x30-\x7E])
       ((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)
     ## without standard return
     |(??{"$pad\x1B$pad\x25$pad\x2F$pad"})([\x30-\x7E])(.*)
  }{
    my ($i2,$u8,$Fu2,$u2,$u4,$Fsr,$sr,$Fnsr,$nsr) = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
    my $r = '';
    if (defined $i2) {
      $r = _iso2022_to_internal ($i2, $C);  $pad = '';
    } elsif (defined $u8) {
      $r = Encode::decode ('utf8', $u8);  $pad = '';
    } elsif ($Fu2) {
      if (ord ($Fu2) > 0x49) {
        $r = Encode::decode ('utf-16be', $u2);
      } else {
        $r = Encode::decode ('ucs-2be', $u2);
      }
      $pad = "\x00";
    } elsif (defined $u4) {
      $r = Encode::decode ('ucs-4be', $u2);  $pad = "\x00\x00\x00";
    } elsif (defined $Fsr && $CODING_SYSTEM{$Fsr}->{perl_name}) {
      $r = Encode::decode ($CODING_SYSTEM{$Fsr}->{perl_name}, $sr);  $pad = '';
    } elsif (defined $Fnsr && $CODING_SYSTEM{$Fnsr}->{perl_name}) {
      $r = Encode::decode ($CODING_SYSTEM{$Fnsr}->{perl_name}, $nsr);  $pad = '';
    } else {    ## temporary
      $r = '?' x length ($sr.$nsr);  $pad = '';
    }
    $r;
  }gesx;
  $t . $s;
}

# this is very very trickey.  my perl 5.8.0 does not process
# regex with eval except the first time (i think it's a bug
# of perl), so we redefine this function whenever being called!
# when this unexpected behavior is fixed or someone finds
# better way to avoid it, we will rewrite this code.
&_iso2022_to_internal (undef);
sub _iso2022_to_internal ($;\%) {
  eval q{ sub __iso2022_to_internal ($;\%) { 0 } };
  eval q{
sub __iso2022_to_internal ($;\%) {
  use re 'eval';
  my ($s, $C) = @_;
  my %_GB_to_GN = (
    "\x28"=>'G0',"\x29"=>'G1',"\x2A"=>'G2',"\x2B"=>'G3',
    "\x2C"=>'G0',"\x2D"=>'G1',"\x2E"=>'G2',"\x2F"=>'G3',
  );
  my %_CHARS_to_RANGE = (
        l94     => q/[\x21-\x7E]/,      l96     => q/[\x20-\x7F]/,
        l128    => q/[\x00-\x7F]/,      l256    => q/[\x00-\xFF]/,
        r94     => q/[\xA1-\xFE]/,      r96     => q/[\xA0-\xFF]/,
        r128    => q/[\x80-\xFF]/,      r256    => q/[\x80-\xFF]/,
        b94     => q/[\x21-\x7E\xA1-\xFE]/,     b96     => q/[\x20-\x7F\xA0-\xFF]/,
        b128    => q/[\x00-\xFF]/,      b256    => q/[\x00-\xFF]/,
  );
  
  $s =~ s{
     ((??{ $_CHARS_to_RANGE{'l'.$C->{$C->{GL}}->{chars}}
         . qq/{$C->{$C->{GL}}->{dimension},$C->{$C->{GL}}->{dimension}}/ }))
    |((??{ $_CHARS_to_RANGE{'r'.$C->{$C->{GR}}->{chars}}
         . qq/{$C->{$C->{GR}}->{dimension},$C->{$C->{GR}}->{dimension}}/  }))
    |  (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS2} || '(?!)')
             . ($C->{$C->{ESC_Fe}}->{r_SS2_ESC} ?
                 qq/|$C->{$C->{ESC_Fe}}->{r_SS2_ESC}/ : '')
             . ($C->{$C->{CL}}->{r_SS2} ? qq/|$C->{$C->{CL}}->{r_SS2}/ : '') . q/)/
          . (  $C->{$C->{CL}}->{r_LS0}
             ||$C->{$C->{CL}}->{r_LS1}? ## ISO/IEC 6429:1992 9
             qq/[$C->{$C->{CL}}->{r_LS0}$C->{$C->{CL}}->{r_LS1}]*/:'')
        })
      ((??{ $_CHARS_to_RANGE{'b'.$C->{G2}->{chars}}
         . qq/{$C->{G2}->{dimension},$C->{G2}->{dimension}}/ }))
    |  (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS3} || '(?!)')
             . ($C->{$C->{ESC_Fe}}->{r_SS3_ESC} ?
                qq/|$C->{$C->{ESC_Fe}}->{r_SS3_ESC}/ : '')
             . ($C->{$C->{CL}}->{r_SS3} ? qq/|$C->{$C->{CL}}->{r_SS3}/ : '') . q/)/
          . (  $C->{$C->{CL}}->{r_LS0}
            || $C->{$C->{CL}}->{r_LS1}? ## ISO/IEC 6429:1992 9
             qq/[$C->{$C->{CL}}->{r_LS0}$C->{$C->{CL}}->{r_LS1}]*/:'')
        })
      ((??{ $_CHARS_to_RANGE{'b'.$C->{G3}->{chars}}
            . qq/{$C->{G3}->{dimension},$C->{G3}->{dimension}}/ }))
    
    ## Locking shift
    |(  (??{ $C->{$C->{CL}}->{r_LS0}||'(?!)' })
       |(??{ $C->{$C->{CL}}->{r_LS1}||'(?!)' })
     )
    
    ## Control sequence
    |(??{ '(?:'.($C->{$C->{CR}}->{r_CSI}||'(?!)')
               .($C->{$C->{ESC_Fe}}->{r_CSI_ESC} ?
                 qq/|$C->{$C->{ESC_Fe}}->{r_CSI_ESC}/: '')
          .')'
        })
    ((??{ qq/[\x30-\x3F$C->{$C->{CL}}->{LS0}$C->{$C->{CL}}->{LS1}\xB0-\xBF]*/
         .qq/[\x20-\x2F$C->{$C->{CL}}->{LS0}$C->{$C->{CL}}->{LS1}\xA0-\xAF]*/
        }) [\x40-\x7E\xD0-\xFE])
    
    ## Other escape sequence
    |(\x1B[\x20-\x2F]*[\x30-\x7E])
    
    ## Misc. sequence (SP, control, or broken data)
    |([\x00-\xFF])
  }{
    my ($gl,$gr,$ss2,$ss3,$ls,$csi,$esc,$misc)
      = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
    $C->{_irr} = undef unless defined $esc;
    ## GL graphic character
    if (defined $gl) {
      my $c = 0;
      my $m = $C->{$C->{GL}}->{chars}==94?0x21:$C->{$C->{GL}}->{chars}==96?0x20:0;
      for (split //, $gl) {
        $c = $c * $C->{$C->{GL}}->{chars} + unpack ('C', $_) - $m;
      }
      chr ($C->{$C->{GL}}->{ucs} + $c);
    ## Control, SP, or broken data
    ## TODO: support control sets other than ISO/IEC 6429's
    } elsif (defined $misc) {
      $misc;
    ## GR graphic character
    } elsif ($gr) {
      my $c = 0;
      my $m = $C->{$C->{GR}}->{chars}==94?0xA1:$C->{$C->{GR}}->{chars}==96?0xA0:0x80;
      for (split //, $gr) {
        $c = $c * $C->{$C->{GR}}->{chars} + unpack ('C', $_) - $m;
      }
      chr ($C->{$C->{GR}}->{ucs} + $c);
    ## Graphic character with SS2
    } elsif ($ss2) {
      $ss2 =~ tr/\x80-\xFF/\x00-\x7F/;
      my $c = 0;  my $m = $C->{G2}->{chars}==94?0x21:$C->{G2}->{chars}==96?0x20:0;
      for (split //, $ss2) {
        $c = $c * $C->{G2}->{chars} + unpack ('C', $_) - $m;
      }
      chr ($C->{G2}->{ucs} + $c);
    ## Graphic character with SS3
    } elsif ($ss3) {
      $ss3 =~ tr/\x80-\xFF/\x00-\x7F/;
      my $c = 0;  my $m = $C->{G3}->{chars}==94?0x21:$C->{G3}->{chars}==96?0x20:0;
      for (split //, $ss3) {
        $c = $c * $C->{G3}->{chars} + unpack ('C', $_) - $m;
      }
1	wakaba	1.1
2			=head1 NAME
3
4			Encode::ISO2022 --- ISO/IEC 2022 encoder and decoder
5
6	wakaba	1.6	=head1 ENCODINGS
7
8			=over 4
9
10			=item iso2022
11
12			ISO/IEC 2022:1994. Default status is:
13
14			=over 2
15
16			=item CL = C0 = ISO/IEC 6429:1991 C0 set
17
18			=item CR = C1 = ISO/IEC 6429:1991 C1 set
19
20			=item GL = G0 = ISO/IEC 646:1991 IRV GL(G0) set
21
22			=item GR = G1 = empty set
23
24			=item G2 = empty set
25
26			=item G3 = empty set
27
28			=back
29
30			(Alias: iso/iec2022, iso-2022, 2022, cp2022)
31
32			=back
33
34			Note that ISO/IEC 2022 based encodings are found in
35			Encode::ISO2022::* modules. This module, Encode::ISO2022
36			only provides a general ISO/IEC 2022 encoder/decoder.
37
38	wakaba	1.1	=cut
39
40			require v5.7.3;
41			package Encode::ISO2022;
42			use strict;
43	wakaba	1.5	use vars qw(%CHARSET %CODING_SYSTEM $VERSION);
44	wakaba	1.9	$VERSION=do{my @r=(q$Revision: 1.8 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
45	wakaba	1.1	use base qw(Encode::Encoding);
46	wakaba	1.6	__PACKAGE__->Define (qw!iso-2022 iso/iec2022 iso2022 2022 cp2022!);
47	wakaba	1.5	require Encode::Charset;
48			*CHARSET = \%Encode::Charset::CHARSET;
49			*CODING_SYSTEM = \%Encode::Charset::CODING_SYSTEM;
50	wakaba	1.1
51			### --- Perl Encode module common functions
52
53			sub encode ($$;$) {
54			my ($obj, $str, $chk) = @_;
55			$_[1] = '' if $chk;
56			$str = &internal_to_iso2022 ($str);
57			return $str;
58			}
59
60			sub decode ($$;$) {
61			my ($obj, $str, $chk) = @_;
62			$_[1] = '' if $chk;
63			return &iso2022_to_internal ($str);
64			}
65
66			### --- Encode::ISO2022 unique functions
67	wakaba	1.6	*new_object = \&Encode::Charset::new_object;
68	wakaba	1.1
69			sub iso2022_to_internal ($;\%) {
70			my ($s, $C) = @_;
71	wakaba	1.6	$C \|\|= &new_object;
72	wakaba	1.5	my $t = '';
73	wakaba	1.9	$s =~ s{^((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)}{
74	wakaba	1.5	my $i2 = $1;
75			$t = _iso2022_to_internal ($i2, $C);
76			'';
77	wakaba	1.9	}es;
78	wakaba	1.6	my $pad = '';
79			use re 'eval';
80	wakaba	1.5	$s =~ s{
81			## ISO/IEC 2022
82	wakaba	1.6	(??{"$pad\x1B$pad\x25$pad\x40"})((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)
83	wakaba	1.5	## UTF-8
84	wakaba	1.6	\|(??{"$pad\x1B$pad\x25$pad(?:\x47\|\x2F$pad"."[\x47-\x49])"})
85			((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)
86	wakaba	1.5	## UCS-2, UTF-16
87	wakaba	1.6	\|(??{"$pad\x1B$pad\x25$pad\x2F$pad"})([\x40\x43\x45\x4A-\x4C])
88			((?:(?!\x00\x1B\x00\x25(?:\x00\x2F)?\x00[\x30-\x7E])..)*)
89	wakaba	1.5	## UCS-4
90	wakaba	1.6	\|(??{"$pad\x1B$pad\x25$pad\x2F$pad"})[\x41\x44\x46]
91			((?:(?!\x00\x00\x00\x1B\x00\x00\x00\x25(?:\x00\x00\x00\x2F)?
92			\x00\x00\x00[\x30-\x7E])....)*)
93	wakaba	1.5	## with standard return
94	wakaba	1.6	\|(??{"$pad\x1B$pad\x25$pad"})([\x30-\x7E])
95			((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)
96	wakaba	1.5	## without standard return
97	wakaba	1.6	\|(??{"$pad\x1B$pad\x25$pad\x2F$pad"})([\x30-\x7E])(.*)
98	wakaba	1.5	}{
99			my ($i2,$u8,$Fu2,$u2,$u4,$Fsr,$sr,$Fnsr,$nsr) = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
100			my $r = '';
101			if (defined $i2) {
102	wakaba	1.6	$r = _iso2022_to_internal ($i2, $C); $pad = '';
103	wakaba	1.5	} elsif (defined $u8) {
104	wakaba	1.6	$r = Encode::decode ('utf8', $u8); $pad = '';
105	wakaba	1.5	} elsif ($Fu2) {
106			if (ord ($Fu2) > 0x49) {
107			$r = Encode::decode ('utf-16be', $u2);
108			} else {
109			$r = Encode::decode ('ucs-2be', $u2);
110			}
111	wakaba	1.6	$pad = "\x00";
112	wakaba	1.5	} elsif (defined $u4) {
113	wakaba	1.6	$r = Encode::decode ('ucs-4be', $u2); $pad = "\x00\x00\x00";
114			} elsif (defined $Fsr && $CODING_SYSTEM{$Fsr}->{perl_name}) {
115			$r = Encode::decode ($CODING_SYSTEM{$Fsr}->{perl_name}, $sr); $pad = '';
116			} elsif (defined $Fnsr && $CODING_SYSTEM{$Fnsr}->{perl_name}) {
117			$r = Encode::decode ($CODING_SYSTEM{$Fnsr}->{perl_name}, $nsr); $pad = '';
118	wakaba	1.5	} else { ## temporary
119	wakaba	1.6	$r = '?' x length ($sr.$nsr); $pad = '';
120	wakaba	1.5	}
121			$r;
122			}gesx;
123			$t . $s;
124			}
125
126	wakaba	1.9	# this is very very trickey. my perl 5.8.0 does not process
127			# regex with eval except the first time (i think it's a bug
128			# of perl), so we redefine this function whenever being called!
129			# when this unexpected behavior is fixed or someone finds
130			# better way to avoid it, we will rewrite this code.
131			&_iso2022_to_internal (undef);
132	wakaba	1.5	sub _iso2022_to_internal ($;\%) {
133	wakaba	1.9	eval q{ sub __iso2022_to_internal ($;\%) { 0 } };
134			eval q{
135			sub __iso2022_to_internal ($;\%) {
136			use re 'eval';
137	wakaba	1.5	my ($s, $C) = @_;
138	wakaba	1.1	my %_GB_to_GN = (
139			"\x28"=>'G0',"\x29"=>'G1',"\x2A"=>'G2',"\x2B"=>'G3',
140			"\x2C"=>'G0',"\x2D"=>'G1',"\x2E"=>'G2',"\x2F"=>'G3',
141			);
142	wakaba	1.9	my %_CHARS_to_RANGE = (
143			l94 => q/[\x21-\x7E]/, l96 => q/[\x20-\x7F]/,
144			l128 => q/[\x00-\x7F]/, l256 => q/[\x00-\xFF]/,
145			r94 => q/[\xA1-\xFE]/, r96 => q/[\xA0-\xFF]/,
146			r128 => q/[\x80-\xFF]/, r256 => q/[\x80-\xFF]/,
147			b94 => q/[\x21-\x7E\xA1-\xFE]/, b96 => q/[\x20-\x7F\xA0-\xFF]/,
148			b128 => q/[\x00-\xFF]/, b256 => q/[\x00-\xFF]/,
149			);
150	wakaba	1.1
151			$s =~ s{
152			((??{ $_CHARS_to_RANGE{'l'.$C->{$C->{GL}}->{chars}}
153			. qq/{$C->{$C->{GL}}->{dimension},$C->{$C->{GL}}->{dimension}}/ }))
154	wakaba	1.6	\|((??{ $_CHARS_to_RANGE{'r'.$C->{$C->{GR}}->{chars}}
155	wakaba	1.9	. qq/{$C->{$C->{GR}}->{dimension},$C->{$C->{GR}}->{dimension}}/ }))
156	wakaba	1.1	\| (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS2} \|\| '(?!)')
157			. ($C->{$C->{ESC_Fe}}->{r_SS2_ESC} ?
158			qq/\|$C->{$C->{ESC_Fe}}->{r_SS2_ESC}/ : '')
159			. ($C->{$C->{CL}}->{r_SS2} ? qq/\|$C->{$C->{CL}}->{r_SS2}/ : '') . q/)/
160			. ( $C->{$C->{CL}}->{r_LS0}
161			\|\|$C->{$C->{CL}}->{r_LS1}? ## ISO/IEC 6429:1992 9
162			qq/[$C->{$C->{CL}}->{r_LS0}$C->{$C->{CL}}->{r_LS1}]*/:'')
163			})
164	wakaba	1.6	((??{ $_CHARS_to_RANGE{'b'.$C->{G2}->{chars}}
165	wakaba	1.9	. qq/{$C->{G2}->{dimension},$C->{G2}->{dimension}}/ }))
166	wakaba	1.1	\| (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS3} \|\| '(?!)')
167			. ($C->{$C->{ESC_Fe}}->{r_SS3_ESC} ?
168			qq/\|$C->{$C->{ESC_Fe}}->{r_SS3_ESC}/ : '')
169			. ($C->{$C->{CL}}->{r_SS3} ? qq/\|$C->{$C->{CL}}->{r_SS3}/ : '') . q/)/
170			. ( $C->{$C->{CL}}->{r_LS0}
171			\|\| $C->{$C->{CL}}->{r_LS1}? ## ISO/IEC 6429:1992 9
172			qq/[$C->{$C->{CL}}->{r_LS0}$C->{$C->{CL}}->{r_LS1}]*/:'')
173			})
174	wakaba	1.6	((??{ $_CHARS_to_RANGE{'b'.$C->{G3}->{chars}}
175	wakaba	1.1	. qq/{$C->{G3}->{dimension},$C->{G3}->{dimension}}/ }))
176
177	wakaba	1.3	## Locking shift
178	wakaba	1.6	\|( (??{ $C->{$C->{CL}}->{r_LS0}\|\|'(?!)' })
179	wakaba	1.3	\|(??{ $C->{$C->{CL}}->{r_LS1}\|\|'(?!)' })
180			)
181	wakaba	1.1
182			## Control sequence
183			\|(??{ '(?:'.($C->{$C->{CR}}->{r_CSI}\|\|'(?!)')
184			.($C->{$C->{ESC_Fe}}->{r_CSI_ESC} ?
185			qq/\|$C->{$C->{ESC_Fe}}->{r_CSI_ESC}/: '')
186			.')'
187			})
188			((??{ qq/[\x30-\x3F$C->{$C->{CL}}->{LS0}$C->{$C->{CL}}->{LS1}\xB0-\xBF]*/
189			.qq/[\x20-\x2F$C->{$C->{CL}}->{LS0}$C->{$C->{CL}}->{LS1}\xA0-\xAF]*/
190			}) [\x40-\x7E\xD0-\xFE])
191
192			## Other escape sequence
193			\|(\x1B[\x20-\x2F]*[\x30-\x7E])
194
195			## Misc. sequence (SP, control, or broken data)
196			\|([\x00-\xFF])
197			}{
198	wakaba	1.3	my ($gl,$gr,$ss2,$ss3,$ls,$csi,$esc,$misc)
199			= ($1,$2,$3,$4,$5,$6,$7,$8,$9);
200	wakaba	1.1	$C->{_irr} = undef unless defined $esc;
201			## GL graphic character
202			if (defined $gl) {
203			my $c = 0;
204			my $m = $C->{$C->{GL}}->{chars}==94?0x21:$C->{$C->{GL}}->{chars}==96?0x20:0;
205			for (split //, $gl) {
206			$c = $c * $C->{$C->{GL}}->{chars} + unpack ('C', $_) - $m;
207			}
208			chr ($C->{$C->{GL}}->{ucs} + $c);
209			## Control, SP, or broken data
210			## TODO: support control sets other than ISO/IEC 6429's
211			} elsif (defined $misc) {
212			$misc;
213			## GR graphic character
214			} elsif ($gr) {
215			my $c = 0;
216			my $m = $C->{$C->{GR}}->{chars}==94?0xA1:$C->{$C->{GR}}->{chars}==96?0xA0:0x80;
217			for (split //, $gr) {
218			$c = $c * $C->{$C->{GR}}->{chars} + unpack ('C', $_) - $m;
219			}
220			chr ($C->{$C->{GR}}->{ucs} + $c);
221			## Graphic character with SS2
222			} elsif ($ss2) {
223			$ss2 =~ tr/\x80-\xFF/\x00-\x7F/;
224			my $c = 0; my $m = $C->{G2}->{chars}==94?0x21:$C->{G2}->{chars}==96?0x20:0;
225			for (split //, $ss2) {
226			$c = $c * $C->{G2}->{chars} + unpack ('C', $_) - $m;
227			}
228			chr ($C->{G2}->{ucs} + $c);
229			## Graphic character with SS3
230			} elsif ($ss3) {
231			$ss3 =~ tr/\x80-\xFF/\x00-\x7F/;
232			my $c = 0; my $m = $C->{G3}->{chars}==94?0x21:$C->{G3}->{chars}==96?0x20:0;
233			for (split //, $ss3) {
234			$c = $c * $C->{G3}->{chars} + unpack ('C', $_) - $m;
235			}
236