root/lang/perl/Acme-Encode-WhiteSpace8/trunk/lib/Acme/Encode/WhiteSpace8.pm @ 18385

Revision 18385, 1.9 kB (checked in by yappo, 6 years ago)

import

Line 
1package Acme::Encode::WhiteSpace8;
2
3use strict;
4use warnings;
5use base qw(Encode::Encoding);
6use utf8;
7
8our $VERSION = '0.01';
9
10__PACKAGE__->Define('WHITESPACE-8');
11
12our $OPTIONAL_DIRECT_CHARS = 1;
13my $specials = quotemeta "\'(),-./:?";
14$OPTIONAL_DIRECT_CHARS
15    and $specials .= quotemeta "!\"#$%&*;<=>@[]^_`{|}";
16
17my @whitespaces = (' ', "\t");
18my %whitespaces = do {
19    my $i = 0;
20    map { $_ => $i++ } @whitespaces;
21};
22
23sub encode($$;$) {
24    my ($obj, $str, $chk) = @_;
25
26    my $bytes = Encode::encode('utf8', $str);
27
28    my @spaces = ();
29    for my $byte (split //, $bytes) {
30        push @spaces, map {
31            $whitespaces[$_]
32        } split //, unpack('B*', $byte);
33    }
34
35    my $ret = join '', @spaces;
36    return '' unless $ret;
37
38    Encode::encode('utf8', $whitespaces[0]x8 . $ret . $whitespaces[1]x8);
39}
40
41sub decode($$;$) {
42    my ($obj, $bytes, $chk) = @_;
43    return '' unless $bytes;
44
45    $bytes = Encode::decode('utf8', $bytes);
46    return $bytes unless $bytes =~ /^        ([ \t]{8,})\t\t\t\t\t\t\t\t$/;
47    my $body = $1;
48
49    my @bits = grep { defined $_ } map {
50        $whitespaces{$_}
51    } split //, $body;
52    warn join('', @bits, "\n");
53
54    my $ret = '';
55    while (my @byte = splice @bits, 0, 8) {
56        $ret .= pack('B8', join '', @byte);
57    }
58
59    $ret;
60}
61
62
631;
64__END__
65
66=encoding utf8
67
68=head1 NAME
69
70Acme::Encode::WhiteSpace8 -
71
72=head1 SYNOPSIS
73
74  use Acme::Encode::WhiteSpace8;
75
76=head1 DESCRIPTION
77
78Acme::Encode::WhiteSpace8 is
79
80=head1 AUTHOR
81
82Kazuhiro Osawa E<lt>ko@yappo.ne.jpE<gt>
83
84=head1 SEE ALSO
85
86=head1 REPOSITORY
87
88  svn co http://svn.coderepos.org/share/lang/perl/Acme-Encode-WhiteSpace8/trunk Acme-Encode-WhiteSpace8
89
90Acme::Encode::WhiteSpace8 is Subversion repository is hosted at L<http://coderepos.org/share/>.
91patches and collaborators are welcome.
92
93=head1 LICENSE
94
95This library is free software; you can redistribute it and/or modify
96it under the same terms as Perl itself.
97
98=cut
Note: See TracBrowser for help on using the browser.