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

package Acme::Encode::WhiteSpace8;

use strict;
use warnings;
use base qw(Encode::Encoding);
use utf8;

our $VERSION = '0.01';

__PACKAGE__->Define('WHITESPACE-8');

our $OPTIONAL_DIRECT_CHARS = 1;
my $specials = quotemeta "\'(),-./:?";
$OPTIONAL_DIRECT_CHARS
    and $specials .= quotemeta "!\"#$%&*;<=>@[]^_`{|}";

my %whitespaces2bit = (
    " "    => "0000",
    "\001" => "0001",
    "\002" => "0010",
    "\003" => "0011",
    "\004" => "0100",
    "\005" => "0101",
    "\006" => "0110",
    "\007" => "0111",

    "\010" => "1000",
    "\011" => "1001",
    "\013" => "1010",
    "\014" => "1011",
    "\016" => "1100",
    "\017" => "1101",
    "\020" => "1110",
    "\021" => "1111",
);
my %bit2whitespaces = map { $whitespaces2bit{$_} => $_ } keys %whitespaces2bit;

sub encode($$;$) {
    my ($obj, $str, $chk) = @_;

    my $bytes = Encode::encode('utf8', $str);
    my $bits = unpack('B*', $bytes);
    $bits =~ s/([01][01][01][01])/$bit2whitespaces{$1}/g;
    $bits;
}

sub decode($$;$) {
    my ($obj, $bytes, $chk) = @_;
    return '' unless $bytes;
    return $bytes unless $bytes =~ /^[ \001\002\003\004\005\006\007\010\011\013\014\016\017\020\021]{2,}$/;

    my @bits = map {
        $whitespaces2bit{$_}
    } split //, $bytes;

    my $ret = '';
    while (my @byte = splice @bits, 0, 2) {
        $ret .= pack('B8', join '', @byte);
    }
    $ret;
}


1;
__END__

=encoding utf8

=head1 NAME

Acme::Encode::WhiteSpace8 -

=head1 SYNOPSIS

  use Acme::Encode::WhiteSpace8;

=head1 DESCRIPTION

Acme::Encode::WhiteSpace8 is

=head1 AUTHOR

Kazuhiro Osawa E<lt>ko@yappo.ne.jpE<gt>

=head1 SEE ALSO

=head1 REPOSITORY

  svn co http://svn.coderepos.org/share/lang/perl/Acme-Encode-WhiteSpace8/trunk Acme-Encode-WhiteSpace8

Acme::Encode::WhiteSpace8 is Subversion repository is hosted at L<http://coderepos.org/share/>.
patches and collaborators are welcome.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut