1#!/usr/bin/perl 2package HTML::HTML5::Parser::Charset::WebLatin1; 3## skip Test::Tabs 4use strict; 5use warnings; 6our $VERSION='0.992'; 7 8## NOTE: This module does not expect that its standalone uses. 9## See Message::Charset::Info for how it is used. 10 11require Encode::Encoding; 12push our @ISA, 'Encode::Encoding'; 13__PACKAGE__->Define (qw/web-latin1/); 14 15sub encode ($$;$) { 16 # $self, $str, $chk 17 if ($_[2]) { 18 if ($_[1] =~ s/^([\x00-\x7F\xA0-\xFF]+)//) { 19 return Encode::encode ('iso-8859-1', $1); 20 } else { 21 return ''; 22 } 23 } else { 24 my $r = $_[1]; 25 $r =~ s/[^\x00-\x7F\xA0-\xFF]/?/g; 26 return Encode::encode ('iso-8859-1', $r); 27 } 28} # encode 29 30sub decode ($$;$) { 31 # $self, $s, $chk 32 if ($_[2]) { 33 my $r = ''; 34 while (1) { 35 if ($_[1] =~ s/^([\x00-\x7F\xA0-\xFF]+)//) { 36 $r .= $1; 37 #} elsif ($_[1] =~ s/^([\x80\x82-\x8C\x8E\x91-\x9C\x9E\x9F])//) { 38 # my $v = $1; 39 # $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}/; 40 # $r .= $v; 41 } else { 42 return $r; 43 } 44 } 45 } else { 46 my $r = $_[1]; 47 $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}/; 48 return $r; 49 } 50} # decode 51 52package HTML::HTML5::Parser::Charset::USASCII; 53push our @ISA, 'Encode::Encoding'; 54__PACKAGE__->Define (qw/web-latin1-us-ascii/); 55 56sub encode ($$;$) { 57 # $self, $str, $chk 58 if ($_[2]) { 59 if ($_[1] =~ s/^([\x00-\x7F]+)//) { 60 return Encode::encode ('iso-8859-1', $1); 61 } else { 62 return ''; 63 } 64 } else { 65 my $r = $_[1]; 66 $r =~ s/[^\x00-\x7F]/?/g; 67 return Encode::encode ('iso-8859-1', $r); 68 } 69} # encode 70 71sub decode ($$;$) { 72 # $self, $s, $chk 73 if ($_[2]) { 74 my $r = ''; 75 while (1) { 76 if ($_[1] =~ s/^([\x00-\x7F]+)//) { 77 $r .= $1; 78 #} elsif ($_[1] =~ s/^([\x80\x82-\x8C\x8E\x91-\x9C\x9E\x9F-\xFF])//) { 79 # my $v = $1; 80 # $v =~ tr/\x80-\xFF/\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}\xA0-\xFF/; 81 # $r .= $v; 82 } else { 83 return $r; 84 } 85 } 86 } else { 87 my $r = $_[1]; 88 $r =~ tr/\x80-\xFF/\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}\xA0-\xFF/; 89 return $r; 90 } 91} # decode 92 93package HTML::HTML5::Parser::Charset::WebLatin5; 94push our @ISA, 'Encode::Encoding'; 95__PACKAGE__->Define (qw/web-latin5/); 96 97sub encode ($$;$) { 98 # $self, $str, $chk 99 if ($_[2]) { 100 if ($_[1] =~ s/^([\x00-\x7F]+)//) { 101 return Encode::encode ('iso-8859-9', $1); 102 } else { 103 return ''; 104 } 105 } else { 106 my $r = $_[1]; 107 $r =~ s/[^\x00-\x7F]/?/g; 108 return Encode::encode ('iso-8859-9', $r); 109 } 110} # encode 111 112sub decode ($$;$) { 113 # $self, $s, $chk 114 if ($_[2]) { 115 my $r = ''; 116 while (1) { 117 if ($_[1] =~ s/^([\x00-\x7F\xA0-\xFF]+)//) { 118 $r .= Encode::decode ('windows-1254', $1); 119 #} elsif ($_[1] =~ s/^([\x80\x82-\x8C\x91-\x9C\x9F])//) { 120 # my $v = $1; 121 # $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{FFFD}\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{FFFD}\x{0178}/; 122 # $r .= $v; 123 } else { 124 return $r; 125 } 126 } 127 } else { 128 my $r = Encode::decode ('windows-1254', $_[1]); 129 return $r; 130 } 131} # decode 132 1331; 134## $Date: 2008/09/10 10:27:09 $ 135