view release on metacpan or  search on metacpan

lib/App/Muter.pm  view on Meta::CPAN

        when ([0x00 .. 0x1f, 0x7f]) { return '\^' . chr($ascii ^ 0x40) }
        when ([0x80 .. 0x9f, 0xff]) { return '\M^' . chr($ascii ^ 0x40) }
        when ([0xa1 .. 0xfe]) { return '\M-' . chr($ascii) }
        when (0x20)           { return '\040' }
        when (0xa0)           { return '\240' }
        default { die sprintf 'Found byte value %#02x', $byte; }
    }
    return;
}

sub encode {
    my ($self, $data) = @_;
    $data = $self->{chunk} . $data;
    if (length $data && substr($data, -1) eq "\0") {
        $data = substr($data, 0, -1);
        $self->{chunk} = "\0";
    }
    else {
        $self->{chunk} = '';
    }
    return $self->SUPER::encode($data);
}

sub encode_chunk {
    my ($self, $data) = @_;
    my $result = join('', map { $self->{map}[$_] } unpack('C*', $data));
    if ($self->{flags}{cstyle}) {
        # Do this twice to fix multiple consecutive NUL bytes.
        $result =~ s/\\000($|[^0-7])/\\0$1/g for 1 .. 2;
    }
    return $result;
}

sub _decode {
    my ($self, $val) = @_;
    use bytes;
    return '' if !length $val;
    return chr($self->{rmap}{$val} // die "val '$_'") if $val =~ /^\\/;
    return pack('C*', map { $self->{rmap}{$_} } split //, $val);
}

sub decode_chunk {
    my ($self, $data) = @_;
    return join('',
        map { $self->_decode($_) }
            split /(\\(?:M[-^].|\^.|[0-7]{3}|\\|[0abtnvfrs]))/,
        $data);
}

sub metadata {
    my $self = shift;
    my $meta = $self->SUPER::metadata;
    return {
        %$meta,
        args => {
            sp     => 'Encode space',
            space  => 'Encode space',
            tab    => 'Encode tab',
            nl     => 'Encode newline',
            white  => 'Encode space, tab, and newline',
            cstyle => 'Encode using C-like escape sequences',
            octal  => 'Encode using octal escape sequences',
            glob   => 'Encode characters recognized by glob(3) and hash mark',
        }
    };
}

App::Muter::Registry->instance->register(__PACKAGE__);

package App::Muter::Backend::Ascii85;
$App::Muter::Backend::Ascii85::VERSION = '0.003000';
our @ISA = qw/App::Muter::Backend::Chunked/;

sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args, enchunksize => 4, dechunksize => 5);
    $self->{start} = '';
    return $self;
}

sub encode {
    my ($self, $data) = @_;
    return '' unless length $data;
    my $prefix = defined $self->{start} ? '<~' : '';
    $self->{start} = undef;
    return $prefix . $self->SUPER::encode($data);
}

sub encode_final {
    my ($self, $data) = @_;
    return $self->SUPER::encode_final($data) .
        (defined $self->{start} ? '' : '~>');
}

sub _encode_seq {
    my ($x, $flag) = @_;
    return (89) if !$x && !$flag;
    my @res;
    for (0 .. 4) {
        push @res, $x % 85;
        $x = int($x / 85);
    }
    return reverse @res;
}

sub encode_chunk {
    my (undef, $data) = @_;
    my $rem = length($data) % 4;
    my $pad = $rem ? (4 - $rem) : 0;
    $data .= "\0" x $pad;
    my @chunks = unpack("N*", $data);
    my @last = $pad ? (pop @chunks) : ();
    my $res = pack('C*', map { _encode_seq($_) } @chunks);
    $res .= pack('C*', map { _encode_seq($_, 1) } @last);
    $res =~ tr/\x00-\x54\x59/!-uz/;
    $res = substr($res, 0, -$pad) if $pad;
    return $res;
}

sub decode {
    my ($self, $data) = @_;