Whatpm/Charset/WebLatin1.pm

#!/usr/bin/perl
package Whatpm::Charset::WebLatin1;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

## NOTE: This module does not expect that its standalone uses.
## See Message::Charset::Info for how it is used.

require Encode::Encoding;
push our @ISA, 'Encode::Encoding';
__PACKAGE__->Define (qw/web-latin1/);

sub encode ($$;$) {
  # $self, $str, $chk
  if ($_[2]) {
    if ($_[1] =~ s/^([\x00-\x7F\xA0-\xFF]+)//) {
      return Encode::encode ('iso-8859-1', $1);
    } else {
      return '';
    }
  } else {
    my $r = $_[1];
    $r =~ s/[^\x00-\x7F\xA0-\xFF]/?/g;
    return Encode::encode ('iso-8859-1', $r);
  }
} # encode

sub decode ($$;$) {
  # $self, $s, $chk
  if ($_[2]) {
    my $r = '';
    while (1) {
      if ($_[1] =~ s/^([\x00-\x7F\xA0-\xFF]+)//) {
        $r .= $1;
      #} elsif ($_[1] =~ s/^([\x80\x82-\x8C\x8E\x91-\x9C\x9E\x9F])//) {
      #  my $v = $1;
      #  $v =~ tr/\x80-\x9F/\x{20AC}\x{FFFD}\x{201A}\x{0192}\x{201E}\x{2026}\x{2020}\x{2021}\x{02C6}\x{2030}\x{0160}\x{2039}\x{0152}\x{FFFD}\x{017D}\x{FFFD}\x{FFFD}\x{2018}\x{2019}\x{201C}\x{201D}\x{2022}\x{2013}\x{2014}\x{02DC}\x{2122}\x{0161}\x{203A}\x{0153}\x{FFFD}\x{017E}\x{0178}/;
      #  $r .= $v;
      } else {
        return $r;
      }
    }
  } else {
    my $r = $_[1];
    $r =~ tr/\x80-\x9F/\x{20AC}\x{FFFD}\x{201A}\x{0192}\x{201E}\x{2026}\x{2020}\x{2021}\x{02C6}\x{2030}\x{0160}\x{2039}\x{0152}\x{FFFD}\x{017D}\x{FFFD}\x{FFFD}\x{2018}\x{2019}\x{201C}\x{201D}\x{2022}\x{2013}\x{2014}\x{02DC}\x{2122}\x{0161}\x{203A}\x{0153}\x{FFFD}\x{017E}\x{0178}/;
    return $r;
  }
} # decode

1;
## $Date:$
1	wakaba	1.1	#!/usr/bin/perl
2			package Whatpm::Charset::WebLatin1;
3			use strict;
4			our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
5
6			## NOTE: This module does not expect that its standalone uses.
7			## See Message::Charset::Info for how it is used.
8
9			require Encode::Encoding;
10			push our @ISA, 'Encode::Encoding';
11			__PACKAGE__->Define (qw/web-latin1/);
12
13			sub encode ($$;$) {
14			# $self, $str, $chk
15			if ($_[2]) {
16			if ($_[1] =~ s/^([\x00-\x7F\xA0-\xFF]+)//) {
17			return Encode::encode ('iso-8859-1', $1);
18			} else {
19			return '';
20			}
21			} else {
22			my $r = $_[1];
23			$r =~ s/[^\x00-\x7F\xA0-\xFF]/?/g;
24			return Encode::encode ('iso-8859-1', $r);
25			}
26			} # encode
27
28			sub decode ($$;$) {
29			# $self, $s, $chk
30			if ($_[2]) {
31			my $r = '';
32			while (1) {
33			if ($_[1] =~ s/^([\x00-\x7F\xA0-\xFF]+)//) {
34			$r .= $1;
35			#} elsif ($_[1] =~ s/^([\x80\x82-\x8C\x8E\x91-\x9C\x9E\x9F])//) {
36			# my $v = $1;
37			# $v =~ tr/\x80-\x9F/\x{20AC}\x{FFFD}\x{201A}\x{0192}\x{201E}\x{2026}\x{2020}\x{2021}\x{02C6}\x{2030}\x{0160}\x{2039}\x{0152}\x{FFFD}\x{017D}\x{FFFD}\x{FFFD}\x{2018}\x{2019}\x{201C}\x{201D}\x{2022}\x{2013}\x{2014}\x{02DC}\x{2122}\x{0161}\x{203A}\x{0153}\x{FFFD}\x{017E}\x{0178}/;
38			# $r .= $v;
39			} else {
40			return $r;
41			}
42			}
43			} else {
44			my $r = $_[1];
45			$r =~ tr/\x80-\x9F/\x{20AC}\x{FFFD}\x{201A}\x{0192}\x{201E}\x{2026}\x{2020}\x{2021}\x{02C6}\x{2030}\x{0160}\x{2039}\x{0152}\x{FFFD}\x{017D}\x{FFFD}\x{FFFD}\x{2018}\x{2019}\x{201C}\x{201D}\x{2022}\x{2013}\x{2014}\x{02DC}\x{2122}\x{0161}\x{203A}\x{0153}\x{FFFD}\x{017E}\x{0178}/;
46			return $r;
47			}
48			} # decode
49
50			1;
51			## $Date:$