File Coverage

blib/lib/Encode/Escape/ASCII.pm

Criterion	Covered	Total	%
statement	17	56	30.3
branch	0	10	0.0
condition	0	6	0.0
subroutine	6	15	40.0
pod	2	9	22.2
total	25	96	26.0

# Encoding of ASCII Escape Sequences (or Escaped ASCII)

# $Id: ASCII.pm,v 1.19 2007-12-05 22:11:11+09 you Exp $

package Encode::Escape::ASCII;

our $VERSION  = do { q$Revision: 1.19 $ =~ /\d+\.(\d+)/; sprintf "%.2f", $1 / 100  };

use 5.008008;
use strict;
use warnings;

use Encode::Encoding;
use base qw(Encode::Encoding);

__PACKAGE__->Define(qw/ascii-escape ascii_escape/);

sub import {

    require Encode;
    Encode->export_to_level(1, @_);
}

sub enmode ($$) {
    my ($class, $mode) = @_;

}

sub demode ($$) {
    my ($class, $mode) = @_;
}


sub encode($$;$) {
    my ($obj, $str, $chk) = @_;
    my $escaped = escape($str);
    return $escaped;
}


sub decode($$;$) {
    my ($obj, $str, $chk) = @_;
    my $unescaped = unescape($str);
    return $unescaped;
}

my %ESCAPED = (
    "\\" => '\\',
    "\r" => 'r',
    "\n" => 'n',
    "\t" => 't',
    "\a" => 'a',
    "\b" => 'b',
    "\e" => 'e',
    "\f" => 'f',
    "\"" => '"',
    "\$" => '$',
    "\@" => '@',
);

my %UNESCAPED = ( reverse %ESCAPED );

sub chr2hex {
    my($c) = @_;
    if ( ord($c) < 128 ) {
        return sprintf("\\x%02x", ord($c));
    }
    else {
        require Carp;
        Carp::croak (
            "'ascii-escape' codec can't encode character: ordinal " . ord($c)
        );
    }
}


sub escape ($) {
    local $_ = ( defined $_[0] ? $_[0] : '' );
    s/([\a\b\e\f\r\n\t\"\\\$\@])/\\$ESCAPED{$1}/sg;
    s/([\x00-\x1f\x7f-\xff])/chr2hex($1)/gse;
    return $_;
}

sub hex2chr {
    my($hex) = @_;
    if ( hex($hex) >= 0 and hex($hex) < 128) {
        return chr(hex($hex));
    }
    else {
        require Carp;
        Carp::croak(
            "'ascii-escape' codec can't decode escape sequence: "
            . "\\x$hex (ordinal " . hex($hex) . ")"
        );
    }
}
sub oct2chr {
    my($oct) = @_;
    if ( oct($oct) >= 0 and oct($oct) < 128 ) {
        return chr(oct($oct));
    }
    else {
        require Carp;
        Carp::croak (
            "'ascii-escape' codec can't decode escape sequence: "
            . "\\$oct (ordinal " . oct($oct). ")"
        );
    }
}

# $original_string = unprintable( $special_characters_escaped );
sub unescape ($) {
    local $_ = ( defined $_[0] ? $_[0] : '' );

    s/((?:\A|\G|[^\\]))\\x([\da-fA-F]{1,2})/$1.hex2chr($2)/gse;
    s/((?:\A|\G|[^\\]))\\x\{([\da-fA-F]{1,4})\}/$1.hex2chr($2)/gse;
    s/((?:\A|\G|[^\\]))\\([0-7]{1,3})/$1.oct2chr($2)/gse;

    s/((?:\A|\G|[^\\]))\\([^aAbBeEfFrRnNtT\\\"\$\@])/$1$2/g;
    s/((?:\A|\G|[^\\]))\\([aAbBeEfFrRnNtT\\\"\$\@])/$1.$UNESCAPED{lc($2)}/gse;

    return $_;
}


1;
__END__